ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/gethelp3.6.tcl
Revision: 2.12
Committed: Sat Feb 22 02:07:30 2003 UTC (21 years, 1 month ago) by greg
Content type: application/x-tcl
Branch: MAIN
CVS Tags: rad3R7P1, rad4R0, rad3R5, rad3R6, rad3R6P1, rad3R8, rad3R9, rad3R7P2
Changes since 2.11: +1 -1 lines
Log Message:
Changes and check-in for 3.5 release
Includes new source files and modifications not recorded for many years
See ray/doc/notes/ReleaseNotes for notes between 3.1 and 3.5 release

File Contents

# Content
1 # RCSid: $Id$
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 -cursor top_left_arrow
28 wm minsize .helpwin 500 400
29 wm iconbitmap .helpwin question
30 frame .helpwin.but -width 150 -height 400
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 .0600
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 .0600
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 .0600
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 .0600
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 .0600
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 .0600
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 .0600
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 .0600
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--14-*-*-*-*-*-iso8859-1
84 .helpwin.txt tag configure highlight \
85 -font -*-courier-bold-r-normal--14-*-*-*-*-*-iso8859-1
86 set helpfontwidth 9
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 } elseif {! [winfo ismapped .helpwin]} { # map window
95 wm deiconify .helpwin
96 } else { # raise window
97 raise .helpwin
98 }
99 focus .helpwin.but.srche
100 helpopen $helpfile
101 helphist new $category $topic
102 }
103
104 proc helpopen fname { # open the named help file
105 global curhelp helpindex helplib
106 if {"$fname" == "$curhelp(file)"} {return}
107 if {"$curhelp(file)" != {}} {
108 close $curhelp(fid)
109 unset curhelp helpindex
110 }
111 if {[set curhelp(file) $fname] == {}} {return}
112 # Complete file name as required
113 if {! [info exists helplib]} {
114 set helplib /usr/local/lib/tk/help
115 }
116 if {"[file rootname $fname]" == "$fname"} {
117 append fname .hlp
118 }
119 if {! [string match {[~/.]*} $fname]} {
120 set fname $helplib/$fname
121 }
122 wm title .helpwin $fname
123 set curhelp(title) "[string toupper\
124 [file rootname [file tail $fname]]] HELP"
125 set ifile [file rootname $fname].ndx
126 wm iconname .helpwin [string tolower $curhelp(title)]
127 .helpwin.txt configure -state normal
128 .helpwin.txt delete 1.0 end
129 .helpwin.txt insert end "Loading $fname..."
130 update
131 set curhelp(fid) [open $fname r]
132 if {! [file isfile $ifile] ||
133 [file mtime $fname] > [file mtime $ifile]} {
134 set helpindex(catlist) {}
135 while {[gets $curhelp(fid) li] >= 0} {
136 if [regexp -nocase {^\.([A-Z][A-Z0-9]*)\.([A-Z][A-Z0-9]*)$} \
137 $li dummy cat top] {
138 lappend helpindex([string toupper $cat]) $top
139 set helpindex([string toupper $cat,$top]) \
140 [tell $curhelp(fid)]
141 if {[lsearch -exact $helpindex(catlist) $cat] < 0} {
142 lappend helpindex(catlist) $cat
143 }
144 }
145 }
146 if {! [catch {set fi [open $ifile w]}]} {
147 puts $fi "# This is an automatically created index\
148 file -- DO NOT EDIT!"
149 writevars $fi helpindex
150 close $fi
151 catch {exec chmod 666 $ifile}
152 }
153 } else {
154 source $ifile
155 }
156 .helpwin.but.catb.m delete 0 last
157 foreach cat $helpindex(catlist) {
158 .helpwin.but.catb.m add command -label $cat \
159 -command "helphist new $cat intro"
160 }
161 set curhelp(category) None
162 .helpwin.but.topb.m delete 0 last
163 set curhelp(topic) None
164 set curhelp(next) {}
165 helphist clear
166 }
167
168 proc helpgoto {cat top} { # find selected category and topic
169 global curhelp helpindex
170 # Capitalize "just in case"
171 set cat [string toupper $cat]
172 set top [string toupper $top]
173 # Change topic menu if category is changed
174 set curhelp(topic) $top
175 if {"$cat" != "$curhelp(category)"} {
176 set curhelp(category) $cat
177 .helpwin.but.topb.m delete 0 last
178 foreach top $helpindex($cat) {
179 .helpwin.but.topb.m add command -label $top \
180 -command "helphist new \$curhelp(category) $top"
181 }
182 }
183 helpupdate
184 }
185
186 proc helpupdate {} { # update help text window
187 global curhelp helpindex helpfontwidth
188 # Print category and topic
189 set linelen [expr "[winfo width .helpwin.txt] / $helpfontwidth - 1"]
190 .helpwin.txt configure -state normal
191 .helpwin.txt delete 1.0 end
192 set titlen [expr [string length $curhelp(category)] + \
193 [string length $curhelp(topic)] + 1]
194 for {set i [expr ($linelen - $titlen)/2]} {[incr i -1] >= 0} {} {
195 .helpwin.txt insert end { }
196 }
197 .helpwin.txt insert end "$curhelp(category) $curhelp(topic)\n"
198 .helpwin.txt tag add highlight "1.0 lineend - $titlen c" "1.0 lineend"
199 # Search for it in file
200 if {"$curhelp(category) $curhelp(topic)" !=
201 "[string toupper $curhelp(next)]"} {
202 if [info exists helpindex($curhelp(category),$curhelp(topic))] {
203 seek $curhelp(fid) $helpindex($curhelp(category),$curhelp(topic))
204 } else {
205 .helpwin.txt insert end "\nNo such help topic."
206 .helpwin.txt configure -state disabled
207 return ".$curhelp(category).$curhelp(topic) not found\
208 in $curhelp(file)"
209 }
210 }
211 # Load help text into our window
212 set linepos 0
213 while {[set ll [gets $curhelp(fid) li]] >= 0 && ! [regexp -nocase \
214 {^\.([A-Z][A-Z0-9]*)\.([A-Z][A-Z0-9]*)$} \
215 $li dummy cat top]} {
216 if {$ll == 0} { # paragraph
217 if $linepos {
218 .helpwin.txt insert end "\n\n"
219 set linepos 0
220 } else {
221 .helpwin.txt insert end "\n"
222 }
223 } else { # line
224 .helpwin.txt insert end $li
225 incr linepos $ll
226 .helpwin.txt insert end { }
227 incr linepos
228 # Highlight search string match
229 if {"$curhelp(search)" != {}} {
230 if [regexp -nocase -indices \
231 $curhelp(search) $li mi] {
232 .helpwin.txt tag add highlight\
233 "end - 1 c - $ll c\
234 + [lindex $mi 0] c"\
235 "end - $ll c\
236 + [lindex $mi 1] c"
237 }
238 }
239 # Add extra space at the end of a sentence
240 if [regexp {[.?!:][)"']?$} $li] {
241 .helpwin.txt insert end { }
242 incr linepos
243 }
244 }
245 }
246 # Highlight next category and topic
247 if {$ll > 0} {
248 .helpwin.txt insert end "Next: $cat $top"
249 .helpwin.txt tag add highlight "end linestart" end
250 set curhelp(next) "$cat $top"
251 .helpwin.but.next configure -state normal
252 } else {
253 set curhelp(next) {}
254 .helpwin.but.next configure -state disabled
255 }
256 .helpwin.txt configure -state disabled
257 return {}
258 }
259
260 proc helphist {op args} { # access help history list
261 global curhelp
262 switch -exact $op {
263 clear {
264 set curhelp(histlst) {}
265 set curhelp(histpos) 0
266 set gotoit 0
267 }
268 new {
269 set curhelp(histpos) \
270 [expr [llength $curhelp(histlst)] - 1]
271 if {"[string toupper [lindex $curhelp(histlst) \
272 $curhelp(histpos)]]"
273 != "[string toupper $args]"} {
274 lappend curhelp(histlst) $args
275 incr curhelp(histpos)
276 }
277 set gotoit 1
278 }
279 append {
280 lappend curhelp(histlst) $args
281 set gotoit 0
282 }
283 back {
284 incr curhelp(histpos) -1
285 set gotoit 1
286 }
287 forward {
288 incr curhelp(histpos) 1
289 set gotoit 1
290 }
291 }
292 if {$curhelp(histpos) + 1 >= [llength $curhelp(histlst)]} {
293 .helpwin.but.forw configure -state disabled
294 } else {
295 .helpwin.but.forw configure -state normal
296 }
297 if {$curhelp(histpos) <= 0} {
298 .helpwin.but.back configure -state disabled
299 } else {
300 .helpwin.but.back configure -state normal
301 }
302 if $gotoit {
303 eval helpgoto [lindex $curhelp(histlst) $curhelp(histpos)]
304 }
305 }
306
307 proc helpsearch word { # search for occurances of the given word
308 global curhelp helpindex
309 if {"$curhelp(search)" == {}} {
310 set curhelp(msg) "No pattern."
311 return 0
312 }
313 set nmatches 0
314 set cat [lindex $helpindex(catlist) 0]
315 set top [lindex $helpindex([string toupper $cat]) 0]
316 set startpos [tell $curhelp(fid)]
317 seek $curhelp(fid) $helpindex([string toupper $cat,$top])
318 set foundmatch 0
319 while {[gets $curhelp(fid) li] >= 0} {
320 if [regexp -nocase {^\.([A-Z][A-Z0-9]*)\.([A-Z][A-Z0-9]*)$} \
321 $li dummy cat top] {
322 set foundmatch 0
323 } elseif {! $foundmatch && \
324 [regexp -nocase $curhelp(search) $li]} {
325 set foundmatch 1
326 if $nmatches {
327 helphist append $cat $top
328 } else {
329 helphist new $cat $top
330 }
331 incr nmatches
332 }
333 }
334 if $nmatches {
335 set curhelp(msg) "$nmatches topic(s)."
336 } else {
337 set curhelp(msg) "Not found."
338 }
339 seek $curhelp(fid) $startpos
340 return $nmatches
341 }