blob: 86e61dbc7934270fcaf5248b6908e00b5a8abef4 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
# 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
|
