ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/gethelp3.6.tcl
Revision: 2.1
Committed: Thu Oct 27 15:56:11 1994 UTC (29 years, 5 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
Log Message:
Initial revision

File Contents

# Content
1 # SCCSid "$SunId$ LBL"
2 #
3 # Get help from a file, formatted like so:
4 #
5 # .category1.topic1
6 #
7 # A bunch of unformatted text...
8 #
9 # .category2.topic2
10 #
11 # etc.
12 #
13
14 # Calling program should define global help file directory as $helplib
15
16 proc helplink {win file cat top} { # Create link for window(s)
17 foreach w $win {
18 bind $w <Control-Button-1> "gethelp $file $cat $top"
19 }
20 }
21
22 set curhelp(file) {}
23
24 proc gethelp {helpfile category topic} { # Open help window
25 global curhelp helpfontwidth
26 if {! [winfo exists .helpwin]} { # Set up window
27 toplevel .helpwin
28 wm minsize .helpwin 400 400
29 wm iconbitmap .helpwin question
30 frame .helpwin.but -geometry 200x500
31 pack .helpwin.but -side right -fill none -expand no
32 label .helpwin.but.lab -textvariable curhelp(title)
33 place .helpwin.but.lab -relx .1667 -rely 0
34 helplink .helpwin.but.lab help help intro
35 menubutton .helpwin.but.catb -relief raised -height 1 \
36 -text Category -menu .helpwin.but.catb.m
37 menu .helpwin.but.catb.m
38 place .helpwin.but.catb -relx .1667 -rely .1100 \
39 -relwidth .5000 -relheight .0500
40 helplink .helpwin.but.catb help help category
41 menubutton .helpwin.but.topb -relief raised -height 1 \
42 -text Topic -menu .helpwin.but.topb.m
43 menu .helpwin.but.topb.m
44 place .helpwin.but.topb -relx .1667 -rely .2200 \
45 -relwidth .5000 -relheight .0500
46 helplink .helpwin.but.topb help help topic
47 button .helpwin.but.srchb -text Grep -relief raised \
48 -height 1 -command {helpsearch $curhelp(search)}
49 place .helpwin.but.srchb -relx .1667 -rely .3500 \
50 -relwidth .5000 -relheight .0500
51 helplink .helpwin.but.srchb help navigate search
52 entry .helpwin.but.srche -relief sunken -insertofftime 0 \
53 -textvariable curhelp(search)
54 place .helpwin.but.srche -relx .1667 -rely .4200 \
55 -relwidth .6667 -relheight .0500
56 bind .helpwin.but.srche <Return> {set curhelp(msg) {}
57 helpupdate}
58 helplink .helpwin.but.srche help navigate search
59 label .helpwin.but.msg -textvariable curhelp(msg)
60 place .helpwin.but.msg -relx .1667 -rely .4800
61 button .helpwin.but.next -text Next -relief raised -height 1 \
62 -command {eval helphist new $curhelp(next)}
63 place .helpwin.but.next -relx .1667 -rely .7500 \
64 -relwidth .5 -relheight .0500
65 helplink .helpwin.but.next help navigate next
66 button .helpwin.but.back -text Back -relief raised -height 1 \
67 -command "helphist back"
68 place .helpwin.but.back -relx .1667 -rely .6500 \
69 -relwidth .5 -relheight .0500
70 helplink .helpwin.but.back help navigate back
71 button .helpwin.but.forw -text Forward -relief raised -height 1\
72 -command "helphist forward"
73 place .helpwin.but.forw -relx .1667 -rely .5500 \
74 -relwidth .5 -relheight .0500
75 helplink .helpwin.but.forw help navigate forward
76 button .helpwin.but.done -text Done -relief raised -height 1 \
77 -command "destroy .helpwin ; helpopen {}"
78 place .helpwin.but.done -relx .1667 -rely .9000 \
79 -relwidth .5 -relheight .0500
80 helplink .helpwin.but.done help help done
81 text .helpwin.txt -wrap word -width 48 -height 20 -bd 2 \
82 -yscrollcommand ".helpwin.sb set" -relief raised \
83 -font -*-courier-medium-r-normal--18-*-*-*-*-*-iso8859-1
84 .helpwin.txt tag configure highlight \
85 -font -*-courier-bold-r-normal--18-*-*-*-*-*-iso8859-1
86 set helpfontwidth 11
87 scrollbar .helpwin.sb -relief flat \
88 -command ".helpwin.txt yview"
89 pack .helpwin.sb -side right -fill y
90 pack .helpwin.txt -expand yes -fill both
91 helplink .helpwin.sb help helpwin scroll
92 helplink .helpwin.txt help helpwin intro
93 tkwait visibility .helpwin
94 update
95 } elseif {! [winfo ismapped .helpwin]} { # map window
96 wm deiconify .helpwin
97 } else { # raise window
98 raise .helpwin
99 }
100 focus .helpwin.but.srche
101 helpopen $helpfile
102 helphist new $category $topic
103 }
104
105 proc helpopen fname { # open the named help file
106 global curhelp helplib
107 if {"$fname" == "$curhelp(file)"} {return}
108 if {"$curhelp(file)" != {}} {
109 close $curhelp(fid)
110 unset curhelp
111 }
112 if {[set curhelp(file) $fname] == {}} {return}
113 # Complete file name as required
114 if {! [info exists helplib]} {
115 set helplib /usr/local/lib/tk/help
116 }
117 if {"[file rootname $fname]" == "$fname"} {
118 append fname .hlp
119 }
120 if {! [string match {[~/.]*} $fname]} {
121 set fname $helplib/$fname
122 }
123 wm title .helpwin $fname
124 set curhelp(title) "[string toupper\
125 [file rootname [file tail $fname]]] HELP"
126 wm iconname .helpwin [string tolower $curhelp(title)]
127 set curhelp(fid) [open $fname r]
128 set curhelp(index) {}
129 set catlist {}
130 while {[gets $curhelp(fid) li] >= 0} {
131 if [regexp -nocase {^\.([A-Z][A-Z0-9]*)\.([A-Z][A-Z0-9]*)$} \
132 $li dummy cat top] {
133 lappend curhelp(index) "$cat $top [tell $curhelp(fid)]"
134 if {[lsearch -exact $catlist $cat] < 0} {
135 lappend catlist $cat
136 }
137 }
138 }
139 .helpwin.but.catb.m delete 0 last
140 foreach cat $catlist {
141 .helpwin.but.catb.m add command -label $cat \
142 -command "helphist new $cat intro"
143 }
144 set curhelp(category) None
145 .helpwin.but.topb.m delete 0 last
146 set curhelp(topic) None
147 set curhelp(next) {}
148 helphist clear
149 }
150
151 proc helpgoto {cat top} { # find selected category and topic
152 global curhelp
153 # Capitalize "just in case"
154 set cat [string toupper $cat]
155 set top [string toupper $top]
156 # Change topic menu if category is changed
157 set curhelp(topic) $top
158 if {"$cat" != "$curhelp(category)"} {
159 set curhelp(category) $cat
160 set toplist {}
161 set n [llength $curhelp(index)]
162 for {set i 0} {$i < $n} {incr i} {
163 if {"[string toupper [lindex [lindex \
164 $curhelp(index) $i] 0]]" == "$cat"} {
165 lappend toplist [lindex [lindex \
166 $curhelp(index) $i] 1]
167 }
168 }
169 .helpwin.but.topb.m delete 0 last
170 foreach top $toplist {
171 .helpwin.but.topb.m add command -label $top \
172 -command "helphist new \$curhelp(category) $top"
173 }
174 }
175 helpupdate
176 }
177
178 proc helpupdate {} { # update help text window
179 global curhelp helpfontwidth
180 # Print category and topic
181 set linelen [expr "[winfo width .helpwin.txt] / $helpfontwidth - 1"]
182 .helpwin.txt configure -state normal
183 .helpwin.txt delete 1.0 end
184 set titlen [expr [string length $curhelp(category)] + \
185 [string length $curhelp(topic)] + 1]
186 for {set i [expr ($linelen - $titlen)/2]} {[incr i -1] >= 0} {} {
187 .helpwin.txt insert end { }
188 }
189 .helpwin.txt insert end "$curhelp(category) $curhelp(topic)\n"
190 .helpwin.txt tag add highlight "1.0 lineend - $titlen c" "1.0 lineend"
191 # Search for it in file
192 if {"$curhelp(category) $curhelp(topic)" !=
193 "[string toupper $curhelp(next)]"} {
194 for {set i [llength $curhelp(index)]} {[incr i -1] >= 0} {} {
195 if {"$curhelp(category) $curhelp(topic)" ==
196 [lrange [string toupper [lindex \
197 $curhelp(index) $i]] 0 1]} {
198 break
199 }
200 }
201 if {$i < 0} {
202 .helpwin.txt insert end "\nNo such help topic."
203 .helpwin.txt configure -state disabled
204 return ".$curhelp(category).$curhelp(topic) not found\
205 in $curhelp(file)"
206 }
207 seek $curhelp(fid) [lindex [lindex $curhelp(index) $i] 2]
208 }
209 # Load help text into our window
210 set linepos 0
211 while {[set ll [gets $curhelp(fid) li]] >= 0 && ! [regexp -nocase \
212 {^\.([A-Z][A-Z0-9]*)\.([A-Z][A-Z0-9]*)$} \
213 $li dummy cat top]} {
214 if {$ll == 0} { # paragraph
215 if $linepos {
216 .helpwin.txt insert end "\n\n"
217 set linepos 0
218 } else {
219 .helpwin.txt insert end "\n"
220 }
221 } else { # line
222 .helpwin.txt insert end $li
223 incr linepos $ll
224 .helpwin.txt insert end { }
225 incr linepos
226 # Highlight search string match
227 if {"$curhelp(search)" != {}} {
228 if [regexp -nocase -indices \
229 $curhelp(search) $li mi] {
230 .helpwin.txt tag add highlight\
231 "end - 1 c - $ll c\
232 + [lindex $mi 0] c"\
233 "end - $ll c\
234 + [lindex $mi 1] c"
235 }
236 }
237 # Add extra space at the end of a sentence
238 if [regexp {[.?!:][)"']?$} $li] {
239 .helpwin.txt insert end { }
240 incr linepos
241 }
242 }
243 }
244 # Highlight next category and topic
245 if {$ll > 0} {
246 .helpwin.txt insert end "Next: $cat $top"
247 .helpwin.txt tag add highlight "end linestart" end
248 set curhelp(next) "$cat $top"
249 .helpwin.but.next configure -state normal
250 } else {
251 .helpwin.but.next configure -state disabled
252 }
253 .helpwin.txt configure -state disabled
254 return {}
255 }
256
257 proc helphist {op args} { # access help history list
258 global curhelp
259 switch -exact $op {
260 clear {
261 set curhelp(histlst) {}
262 set curhelp(histpos) 0
263 set gotoit 0
264 }
265 new {
266 set curhelp(histpos) \
267 [expr [llength $curhelp(histlst)] - 1]
268 if {"[string toupper [lindex $curhelp(histlst) \
269 $curhelp(histpos)]]"
270 != "[string toupper $args]"} {
271 lappend curhelp(histlst) $args
272 incr curhelp(histpos)
273 }
274 set gotoit 1
275 }
276 append {
277 lappend curhelp(histlst) $args
278 set gotoit 0
279 }
280 back {
281 incr curhelp(histpos) -1
282 set gotoit 1
283 }
284 forward {
285 incr curhelp(histpos) 1
286 set gotoit 1
287 }
288 }
289 if {$curhelp(histpos) + 1 >= [llength $curhelp(histlst)]} {
290 .helpwin.but.forw configure -state disabled
291 } else {
292 .helpwin.but.forw configure -state normal
293 }
294 if {$curhelp(histpos) <= 0} {
295 .helpwin.but.back configure -state disabled
296 } else {
297 .helpwin.but.back configure -state normal
298 }
299 if $gotoit {
300 eval helpgoto [lindex $curhelp(histlst) $curhelp(histpos)]
301 }
302 }
303
304 proc helpsearch word { # search for occurances of the given word
305 global curhelp
306 if {"$curhelp(search)" == {}} {
307 set curhelp(msg) "No pattern."
308 return 0
309 }
310 set nmatches 0
311 set cat [lindex [lindex $curhelp(index) 0] 0]
312 set top [lindex [lindex $curhelp(index) 0] 1]
313 seek $curhelp(fid) [lindex [lindex $curhelp(index) 0] 2]
314 set foundmatch 0
315 while {[gets $curhelp(fid) li] >= 0} {
316 if [regexp -nocase {^\.([A-Z][A-Z0-9]*)\.([A-Z][A-Z0-9]*)$} \
317 $li dummy cat top] {
318 set foundmatch 0
319 } elseif {! $foundmatch && \
320 [regexp -nocase $curhelp(search) $li]} {
321 set foundmatch 1
322 if $nmatches {
323 helphist append $cat $top
324 } else {
325 helphist new $cat $top
326 }
327 incr nmatches
328 }
329 }
330 if $nmatches {
331 set curhelp(msg) "$nmatches topic(s)."
332 } else {
333 set curhelp(msg) "Not found."
334 }
335 return $nmatches
336 }