/[ascend]/trunk/tcltk/TK/CallbackProc.tcl
ViewVC logotype

Contents of /trunk/tcltk/TK/CallbackProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 571 - (show annotations) (download) (as text)
Tue May 9 00:14:59 2006 UTC (14 years ago) by johnpye
File MIME type: text/x-tcl
File size: 9345 byte(s)
Renaming 'tcltk98' to 'tcltk', continued...
1 # CallbackProc.tcl: Tcl functions to animate the callback help window.
2 # By Benjamin Allan
3 # March 14, 1998
4 # Part of ASCEND
5 # Revision: $Revision: 1.5 $
6 # Last modified on: $Date: 1998/06/18 15:54:40 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: CallbackProc.tcl,v $
9 #
10 # This file is part of the ASCEND Tcl/Tk Interface.
11 #
12 # Copyright (C) 1998 Carnegie Mellon University
13 #
14 # The ASCEND Tcl/Tk Interface is free software; you can redistribute
15 # it and/or modify it under the terms of the GNU General Public
16 # License as published by the Free Software Foundation; either
17 # version 2 of the License, or (at your option) any later version.
18 #
19 # The ASCEND Tcl/Tk Interface is distributed in hope that it will be
20 # useful, but WITHOUT ANY WARRANTY; without even the implied warranty
21 # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License
25 # along with the program; if not, write to the Free Software
26 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the
27 # file named COPYING. COPYING is found in ../compiler.
28
29 # based on the ascend callback 'help', processes info into easy-eye form
30
31 proc set_Callback_Defaults {} {
32 global ascCallbackVect
33 set ascCallbackVect(allorgroup) group ;# all is the alternative
34 set ascCallbackVect(curgroup) none ;# currently listed group
35 set ascCallbackVect(curcommand) none ;# currently explained command
36 set ascCallbackVect(grouplist) .callback.grp_frm.com_list.listbox1
37 set ascCallbackVect(grouptext) .callback.grp_frm.com_expl.text2
38 set ascCallbackVect(comlist) .callback.com_frm.frame.listbox1
39 set ascCallbackVect(comtext) .callback.com_frm.frame11.text2
40 set ascCallbackVect(helpgroups) [help groups]
41 set ascCallbackVect(dbglist) [dbghelp]
42 set ascCallbackVect(slvlist) [slvhelp]
43 set ascCallbackVect(mtxlist) [mtxhelp]
44 set ascCallbackVect(ulist) [uhelp]
45 set ascCallbackVect(mode) a;# c is for commands, a for arrays
46 }
47
48 proc set_Callback_bindings {} {
49 global ascCallbackVect
50 # put in sliders
51 HPane-Bind .callback grp_frm com_frm 10 0.333
52 VPane-Bind [winfo parent [winfo parent $ascCallbackVect(grouplist)]] \
53 [winfo name [winfo parent $ascCallbackVect(grouplist)]] \
54 [winfo name [winfo parent $ascCallbackVect(grouptext)]] 10 0.333
55 VPane-Bind [winfo parent [winfo parent $ascCallbackVect(comlist)]] \
56 [winfo name [winfo parent $ascCallbackVect(comlist)]] \
57 [winfo name [winfo parent $ascCallbackVect(comtext)]] 10 0.333
58 # bind m1 in group list to update explanation
59 bind $ascCallbackVect(grouplist) <Button-1> {
60 global ascCallbackVect
61 set ndx [%W nearest %y]
62 if {$ndx != ""} {
63 set ascCallbackVect(curgroup) [%W get $ndx]
64 Callback_Update_group_expl $ascCallbackVect(curgroup)
65 Callback_Update_Commands
66 }
67 }
68 # bind double m1 in group list to update command list
69 bind $ascCallbackVect(grouplist) <Double-1> {
70 set ndx [%W curselection]
71 if {$ndx != ""} {
72 set ascCallbackVect(curgroup) [%W get $ndx]
73 Callback_Update_Commands
74 }
75 }
76 # bind m1 in command list to update explanation
77 bind $ascCallbackVect(comlist) <Button-1> {
78 global ascCallbackVect
79 set ndx [%W nearest %y]
80 if {$ndx != ""} {
81 set ascCallbackVect(curcommand) [%W get $ndx]
82 Callback_Update_command_expl $ascCallbackVect(curcommand)
83 }
84 }
85 Callback_UpdateMode
86 }
87
88 # change window to reflect current value of mode
89 proc Callback_UpdateMode {} {
90 global ascCallbackVect
91 switch $ascCallbackVect(mode) {
92 a {
93 set ascCallbackVect(purposelabel) "Array purpose:"
94 set ascCallbackVect(grouplabel) "Global arrays"
95 set ascCallbackVect(listlabel) "Array elements"
96 }
97 c -
98 default {
99 set ascCallbackVect(purposelabel) "Group purpose:"
100 set ascCallbackVect(grouplabel) "Command groups:"
101 set ascCallbackVect(listlabel) "Commands:"
102 }
103 }
104 }
105
106 proc Callback_Open {} {
107 global ascCallbackVect
108 if {![info exists ascCallbackVect(allorgroup)]} {
109 set_Callback_Defaults
110 }
111 VShowWindow.callback ;# which calls Callback_Update when done
112 set_Callback_bindings
113 Callback_Update
114 }
115
116 proc Callback_Update_group_expl {group} {
117 global ascCallbackVect
118 $ascCallbackVect(grouptext) delete 1.0 end
119 switch $ascCallbackVect(mode) {
120 a {
121 switch $group {
122 none {$ascCallbackVect(grouptext) insert end \
123 {purpose of selected array}}
124 default {
125 global $group
126 if {[info exists ${group}(purpose)]} {
127 $ascCallbackVect(grouptext) insert end ${group}(purpose)
128 } else {
129 $ascCallbackVect(grouptext) insert end \
130 {Purpose not internally documented.}
131 }
132 }
133 }
134 }
135 c -
136 default {
137 switch $group {
138 none {$ascCallbackVect(grouptext) insert end \
139 {explanation of selected group}}
140 default {
141 $ascCallbackVect(grouptext) insert end [lindex [help $group] 0]
142 }
143 }
144 }
145 }
146 }
147
148 proc Callback_Update_command_expl {command} {
149 global ascCallbackVect
150 $ascCallbackVect(comtext) configure -state normal
151 $ascCallbackVect(comtext) delete 1.0 end
152
153 if {[string compare $ascCallbackVect(mode) "a"]== 0} {
154 upvar #0 $ascCallbackVect(curgroup) PA
155 catch {$ascCallbackVect(comtext) insert end $PA($command)} err
156 $ascCallbackVect(comtext) configure -state disabled
157 return
158 }
159 # else handle callbacks mess
160 switch $command {
161 none {
162 $ascCallbackVect(comtext) insert end \
163 {explanation of command selected at left}
164 }
165 default {
166 append data "Internal documentation of $command is missing.\n" \
167 "Mail ascend+help@edrc.cmu.edu with your question about it.\n" \
168 "IFF you are ambitious, " \
169 "check the C headers in directory ascend4/interface/."
170 if {[catch {set data [help $command]} err]} {
171 if {[lsearch $ascCallbackVect(slvlist) $command] != -1} {
172 set data {See the output of 'slvhelp long' on the console.}
173 slvhelp long
174 }
175 if {[lsearch $ascCallbackVect(dbglist) $command] != -1} {
176 set data {See the output of 'dbghelp long' on the console.}
177 dbghelp long
178 }
179 if {[lsearch $ascCallbackVect(ulist) $command] != -1} {
180 set data {See the output of 'uhelp long' on the console.}
181 uhelp long
182 }
183 if {[lsearch $ascCallbackVect(mtxlist) $command] != -1} {
184 set data {See the output of 'mtxhelp long' on the console.}
185 mtxhelp long
186 }
187 }
188
189 $ascCallbackVect(comtext) insert end $data
190 }
191 }
192 $ascCallbackVect(comtext) configure -state disabled
193 }
194
195 proc Callback_Update_Groups {} {
196 global ascCallbackVect
197 # $ascCallbackVect(grouplist) configure -state normal
198 $ascCallbackVect(grouplist) delete 0 end
199 switch $ascCallbackVect(mode) {
200 a {
201 eval $ascCallbackVect(grouplist) insert end \
202 [lsort -dictionary [info globals asc*Vect]]
203 set index [lsearch [info vars asc*Vect] $ascCallbackVect(curgroup)]
204 }
205 c -
206 default {
207 eval $ascCallbackVect(grouplist) insert end $ascCallbackVect(helpgroups)
208 set index \
209 [lsearch $ascCallbackVect(helpgroups) $ascCallbackVect(curgroup)]
210 }
211 }
212 $ascCallbackVect(grouplist) see $index
213 $ascCallbackVect(grouplist) selection set $index $index
214 Callback_Update_group_expl $ascCallbackVect(curgroup)
215 }
216
217 proc Callback_Update_Commands {} {
218 global ascCallbackVect
219 $ascCallbackVect(comlist) delete 0 end
220 set clist {}
221 switch $ascCallbackVect(mode) {
222 a {
223 global $ascCallbackVect(curgroup)
224 catch {set clist [lsort -dictionary \
225 [array names $ascCallbackVect(curgroup)]]} err
226 # may leave elements list empty
227 }
228 c -
229 default {
230 switch {$ascCallbackVect(allorgroup)} {
231 all { set clist [help all] }
232 default {
233 catch {set clist \
234 [lrange [help $ascCallbackVect(curgroup)] 1 end]} err
235 # may leave commands list empty
236 }
237 }
238 }
239 }
240
241 eval $ascCallbackVect(comlist) insert end $clist
242 set index [lsearch $clist $ascCallbackVect(curcommand)]
243 $ascCallbackVect(comlist) see $index
244 $ascCallbackVect(comlist) selection set $index $index
245 }
246
247 proc Callback_Update {} {
248 Callback_Update_Groups
249 Callback_Update_Commands
250 }
251
252 proc Callback_do_Print {} {
253 error "Callback_do_Print not implemented"
254 }
255 proc Callback_do_Close {} {
256 DestroyWindow.callback
257 }
258 proc Callback_do_wordsearch {} {
259 }
260 proc Callback_do_usagesearch {} {
261 }
262 proc Callback_do_textsearch {} {
263 }
264 proc Callback_do_command {} {
265 }
266 proc Callback_do_All {} {
267 }
268
269 proc Callback_do_Groups {} {
270 global ascCallbackVect
271 set ascCallbackVect(mode) c
272 set ascCallbackVect(curcommand) none
273 set ascCallbackVect(curgroup) none
274 Callback_UpdateMode ;# change titles
275 Callback_Update ;#change data
276 }
277
278 proc Callback_do_Font {} {
279 }
280 proc Callback_do_About {} {
281 }
282 proc Callback_do_syntax {} {
283 }
284 proc Callback_do_TOC {} {
285 }
286
287 proc Callback_do_Arrays {} {
288 global ascCallbackVect
289 set ascCallbackVect(mode) a
290 set ascCallbackVect(curgroup) none
291 set ascCallbackVect(curcommand) none
292 Callback_UpdateMode ;# change titles
293 Callback_Update ;#change data
294 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22