# HTML.GUI -- Test HTML widget.

reset-server
appInitialize html HTML {
    *objects:\
	toplevel		Form		helloForm\
	helloForm		Label		helloLabel\
	helloForm		Command		prevButton\
	helloForm		Command		nextButton\
	helloForm		Command		quitButton\
        helloForm               HTML            textwin\
        helloForm               TextBox         info


    *helloForm.background:			bisque
    *helloForm.helloLabel.background:		bisque
    *helloForm.Command.background:		bisque
    *helloForm.info*background:			bisque
    *helloForm.textwin*background:		gray81
    *beNiceToColormap:				false

    *helloLabel.label:				HTML widget demo
    *prevButton.fromHoriz:			helloLabel
    *prevButton.label:				Previous File
    *nextButton.fromHoriz:			prevButton
    *nextButton.label:				Next File
    *quitButton.fromHoriz:			nextButton
    *quitButton.label:				Quit
    *textwin.fromVert:				helloLabel
    *info.fromVert:				textwin
    *info.width:				500
    *info.height:				20
    *info.frameWidth:				0
    *info.frameType:				sunken
    *info.borderWidth:				0
    *info.outerOffset:				0
    *info.innerOffset:				0

    *textwin.width:				500
    *textwin.height:				800
    *textwin.anchorUnderlines:			1
    *textwin.visitedAnchorUnderlines:		1
    *textwin.dashedVisitedAnchorUnderlines:	true
    *textwin.plainFont:				6x13
}

createObjects
proc quit args { send client gkey q; deactivate unmap }
send quitButton addCallback quit
activate

# Get list of viewable files in the current directory.
set files [glob *.html *.\[cfhlsxy\] *.notes \[A-Z\]* *.gui]
set fileIndex 0
set html [lindex $files $fileIndex]

proc loadFile {filename} {
    set fd [open $filename]; set text [read $fd]; close $fd
    if {[file extension $filename] == ".html"} {
	send textwin setText $text
    } else {
	send textwin setText "<plaintext>$text"
    }
    send textwin retestAnchors
}

# Load initial file.
loadFile [lindex $files $fileIndex]

# Stuff for keeping track of visited anchors.
set url(0) empty
proc anchorSelected {widget cbtype event text href args} {
    global url
    set url($href) 1
    send textwin retestAnchors
}
proc testAnchor {widget cbtype href} {
    global url
    return [info exists url($href)]
}
proc anchorVisited {widget cbtype href} {
    send info set label $href
}
send textwin addCallback anchorVisited pointerMotion
send textwin addCallback testAnchor testAnchor
send textwin addCallback anchorSelected anchor

# Callbacks to position forwards and backwards in file list.
proc next args {
    global files fileIndex
    incr fileIndex
    if {$fileIndex >= [llength $files]} {
	set fileIndex 0
    }
    loadFile [lindex $files $fileIndex]
}
proc prev args {
    global files fileIndex
    if {$fileIndex <= 0} {
	set fileIndex [llength $files]
    }
    incr fileIndex -1
    loadFile [lindex $files $fileIndex]
}
send prevButton addCallback prev
send nextButton addCallback next

# Test submit form callback.
proc submitFormCalled {widget cbtype event attrs href method args} {
    print [format "\nSubmit Form to: %s\nMethod: %s\n%s\n" \
	$href $method $attrs]
}
send textwin addCallback submitFormCalled submitForm