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

# User Rev Content
1 greg 2.12 # RCSid: $Id$
2 greg 2.1 #
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 greg 2.5 toplevel .helpwin -cursor top_left_arrow
28 greg 2.3 wm minsize .helpwin 500 400
29 greg 2.1 wm iconbitmap .helpwin question
30 greg 2.10 frame .helpwin.but -width 150 -height 400
31 greg 2.1 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 greg 2.3 -relwidth .5000 -relheight .0600
40 greg 2.1 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 greg 2.3 -relwidth .5000 -relheight .0600
46 greg 2.1 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 greg 2.3 -relwidth .5000 -relheight .0600
51 greg 2.1 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 greg 2.3 -relwidth .6667 -relheight .0600
56 greg 2.1 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 greg 2.3 -relwidth .5 -relheight .0600
65 greg 2.1 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 greg 2.3 -relwidth .5 -relheight .0600
70 greg 2.1 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 greg 2.3 -relwidth .5 -relheight .0600
75 greg 2.1 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 greg 2.3 -relwidth .5 -relheight .0600
80 greg 2.1 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 greg 2.2 -font -*-courier-medium-r-normal--14-*-*-*-*-*-iso8859-1
84 greg 2.1 .helpwin.txt tag configure highlight \
85 greg 2.2 -font -*-courier-bold-r-normal--14-*-*-*-*-*-iso8859-1
86     set helpfontwidth 9
87 greg 2.1 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 greg 2.4 global curhelp helpindex helplib
106 greg 2.1 if {"$fname" == "$curhelp(file)"} {return}
107     if {"$curhelp(file)" != {}} {
108     close $curhelp(fid)
109 greg 2.4 unset curhelp helpindex
110 greg 2.1 }
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 greg 2.6 set ifile [file rootname $fname].ndx
126 greg 2.1 wm iconname .helpwin [string tolower $curhelp(title)]
127 greg 2.2 .helpwin.txt configure -state normal
128     .helpwin.txt delete 1.0 end
129     .helpwin.txt insert end "Loading $fname..."
130     update
131 greg 2.1 set curhelp(fid) [open $fname r]
132 greg 2.11 if {! [file isfile $ifile] ||
133 greg 2.6 [file mtime $fname] > [file mtime $ifile]} {
134 greg 2.8 set helpindex(catlist) {}
135 greg 2.6 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 greg 2.8 if {[lsearch -exact $helpindex(catlist) $cat] < 0} {
142     lappend helpindex(catlist) $cat
143 greg 2.6 }
144 greg 2.1 }
145     }
146 greg 2.6 if {! [catch {set fi [open $ifile w]}]} {
147 greg 2.9 puts $fi "# This is an automatically created index\
148     file -- DO NOT EDIT!"
149 greg 2.8 writevars $fi helpindex
150 greg 2.6 close $fi
151     catch {exec chmod 666 $ifile}
152     }
153     } else {
154     source $ifile
155 greg 2.1 }
156     .helpwin.but.catb.m delete 0 last
157 greg 2.8 foreach cat $helpindex(catlist) {
158 greg 2.1 .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 greg 2.4 global curhelp helpindex
170 greg 2.1 # 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 greg 2.4 foreach top $helpindex($cat) {
179 greg 2.1 .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 greg 2.4 global curhelp helpindex helpfontwidth
188 greg 2.1 # 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 greg 2.4 if [info exists helpindex($curhelp(category),$curhelp(topic))] {
203     seek $curhelp(fid) $helpindex($curhelp(category),$curhelp(topic))
204     } else {
205 greg 2.1 .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 greg 2.7 set curhelp(next) {}
254 greg 2.1 .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 greg 2.4 global curhelp helpindex
309 greg 2.1 if {"$curhelp(search)" == {}} {
310     set curhelp(msg) "No pattern."
311     return 0
312     }
313     set nmatches 0
314 greg 2.8 set cat [lindex $helpindex(catlist) 0]
315 greg 2.4 set top [lindex $helpindex([string toupper $cat]) 0]
316 greg 2.3 set startpos [tell $curhelp(fid)]
317 greg 2.4 seek $curhelp(fid) $helpindex([string toupper $cat,$top])
318 greg 2.1 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 greg 2.3 seek $curhelp(fid) $startpos
340 greg 2.1 return $nmatches
341     }