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

# User Rev Content
1 greg 2.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     }