ascend4/TK/CallbackProc.tcl

#  CallbackProc.tcl: Tcl functions to animate the callback help window.
#  By Benjamin Allan
#  March 14, 1998
#  Part of ASCEND
#  Revision: $Revision: 1.5 $
#  Last modified on: $Date: 1998/06/18 15:54:40 $
#  Last modified by: $Author: mthomas $
#  Revision control file: $RCSfile: CallbackProc.tcl,v $
#
#  This file is part of the ASCEND Tcl/Tk Interface.
#
#  Copyright (C) 1998 Carnegie Mellon University
#
#  The ASCEND Tcl/Tk Interface is free software; you can redistribute
#  it and/or modify it under the terms of the GNU General Public
#  License as published by the Free Software Foundation; either
#  version 2 of the License, or (at your option) any later version.
#
#  The ASCEND Tcl/Tk Interface is distributed in hope that it will be
#  useful, but WITHOUT ANY WARRANTY; without even the implied warranty
#  of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with the program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA.  Check the
#  file named COPYING.  COPYING is found in ../compiler.

# based on the ascend callback 'help', processes info into easy-eye form

proc set_Callback_Defaults {} {
  global ascCallbackVect
  set ascCallbackVect(allorgroup) group ;# all is the alternative
  set ascCallbackVect(curgroup) none ;# currently listed group
  set ascCallbackVect(curcommand) none ;# currently explained command
  set ascCallbackVect(grouplist) .callback.grp_frm.com_list.listbox1
  set ascCallbackVect(grouptext) .callback.grp_frm.com_expl.text2
  set ascCallbackVect(comlist) .callback.com_frm.frame.listbox1
  set ascCallbackVect(comtext) .callback.com_frm.frame11.text2
  set ascCallbackVect(helpgroups) [help groups]
  set ascCallbackVect(dbglist) [dbghelp]
  set ascCallbackVect(slvlist) [slvhelp]
  set ascCallbackVect(mtxlist) [mtxhelp]
  set ascCallbackVect(ulist) [uhelp]
  set ascCallbackVect(mode) a;# c is for commands, a for arrays
}

proc set_Callback_bindings {} {
  global ascCallbackVect
  # put in sliders
  HPane-Bind .callback grp_frm com_frm 10 0.333
  VPane-Bind [winfo parent [winfo parent $ascCallbackVect(grouplist)]] \
   [winfo name [winfo parent $ascCallbackVect(grouplist)]] \
   [winfo name [winfo parent $ascCallbackVect(grouptext)]] 10 0.333
  VPane-Bind [winfo parent [winfo parent $ascCallbackVect(comlist)]] \
   [winfo name [winfo parent $ascCallbackVect(comlist)]] \
   [winfo name [winfo parent $ascCallbackVect(comtext)]] 10 0.333
  # bind m1 in group list to update explanation
  bind $ascCallbackVect(grouplist) <Button-1> {
    global ascCallbackVect
    set ndx [%W nearest %y]
    if {$ndx != ""} {
      set ascCallbackVect(curgroup) [%W get $ndx]
      Callback_Update_group_expl $ascCallbackVect(curgroup)
      Callback_Update_Commands
    }
  }
  # bind double m1 in group list to update command list
  bind $ascCallbackVect(grouplist) <Double-1> {
    set ndx [%W curselection]
    if {$ndx != ""} {
      set ascCallbackVect(curgroup) [%W get $ndx]
      Callback_Update_Commands
    }
  }
  # bind m1 in command list to update explanation
  bind $ascCallbackVect(comlist) <Button-1> {
    global ascCallbackVect
    set ndx [%W nearest %y]
    if {$ndx != ""} {
      set ascCallbackVect(curcommand) [%W get $ndx]
      Callback_Update_command_expl $ascCallbackVect(curcommand)
    }
  }
  Callback_UpdateMode
}

# change window to reflect current value of mode
proc Callback_UpdateMode {} {
  global ascCallbackVect
  switch $ascCallbackVect(mode) {
  a {
      set ascCallbackVect(purposelabel) "Array purpose:"
      set ascCallbackVect(grouplabel) "Global arrays"
      set ascCallbackVect(listlabel) "Array elements"
    }
  c -
  default {
      set ascCallbackVect(purposelabel) "Group purpose:"
      set ascCallbackVect(grouplabel) "Command groups:"
      set ascCallbackVect(listlabel) "Commands:"
    }
  }
}

proc Callback_Open {} {
  global ascCallbackVect
  if {![info exists ascCallbackVect(allorgroup)]} {
    set_Callback_Defaults
  }
  VShowWindow.callback ;# which calls Callback_Update when done
  set_Callback_bindings
  Callback_Update
}

proc Callback_Update_group_expl {group} {
  global ascCallbackVect
  $ascCallbackVect(grouptext) delete 1.0 end
  switch $ascCallbackVect(mode) {
  a {
      switch $group {
      none {$ascCallbackVect(grouptext) insert end \
         {purpose of selected array}}
      default {
           global $group
           if {[info exists ${group}(purpose)]} {
             $ascCallbackVect(grouptext) insert end ${group}(purpose)
           } else {
             $ascCallbackVect(grouptext) insert end \
                {Purpose not internally documented.}
           }
        }
      }
    }
  c -
  default {
      switch $group {
      none {$ascCallbackVect(grouptext) insert end \
         {explanation of selected group}}
      default {
           $ascCallbackVect(grouptext) insert end [lindex [help $group] 0]
        }
      }
    }
  }
}

proc Callback_Update_command_expl {command} {
  global ascCallbackVect
  $ascCallbackVect(comtext) configure -state normal
  $ascCallbackVect(comtext) delete 1.0 end
  
  if {[string compare $ascCallbackVect(mode) "a"]== 0} {
    upvar #0 $ascCallbackVect(curgroup) PA
    catch {$ascCallbackVect(comtext) insert end $PA($command)} err
    $ascCallbackVect(comtext) configure -state disabled
    return
  }
  # else handle callbacks mess
  switch $command {
  none {
      $ascCallbackVect(comtext) insert end \
           {explanation of command selected at left}
    }
  default {
       append data "Internal documentation of $command is missing.\n" \
         "Mail ascend+help@edrc.cmu.edu with your question about it.\n" \
         "IFF you are ambitious, " \
         "check the C headers in directory ascend4/interface/."
       if {[catch {set data [help $command]} err]} {
         if {[lsearch $ascCallbackVect(slvlist) $command] != -1} {
            set data {See the output of 'slvhelp long' on the console.}
            slvhelp long
         }
         if {[lsearch $ascCallbackVect(dbglist) $command] != -1} {
            set data {See the output of 'dbghelp long' on the console.}
            dbghelp long
         }
         if {[lsearch $ascCallbackVect(ulist) $command] != -1} {
            set data {See the output of 'uhelp long' on the console.}
            uhelp long
         }
         if {[lsearch $ascCallbackVect(mtxlist) $command] != -1} {
            set data {See the output of 'mtxhelp long' on the console.}
            mtxhelp long
         }
       }
       
       $ascCallbackVect(comtext) insert end $data
    }
  }
  $ascCallbackVect(comtext) configure -state disabled
}

proc Callback_Update_Groups {} {
  global ascCallbackVect
  # $ascCallbackVect(grouplist) configure -state normal 
  $ascCallbackVect(grouplist) delete 0 end
  switch $ascCallbackVect(mode) {
  a {
      eval $ascCallbackVect(grouplist) insert end \
        [lsort -dictionary [info globals asc*Vect]]
      set index [lsearch [info vars asc*Vect] $ascCallbackVect(curgroup)]
    }
  c -
  default {
      eval $ascCallbackVect(grouplist) insert end $ascCallbackVect(helpgroups)
      set index \
        [lsearch $ascCallbackVect(helpgroups) $ascCallbackVect(curgroup)]
    }
  }
  $ascCallbackVect(grouplist) see $index
  $ascCallbackVect(grouplist) selection set $index $index
  Callback_Update_group_expl $ascCallbackVect(curgroup)
}

proc Callback_Update_Commands {} {
  global ascCallbackVect
  $ascCallbackVect(comlist) delete 0 end
  set clist {}
  switch $ascCallbackVect(mode) {
  a {
      global $ascCallbackVect(curgroup)
      catch {set clist [lsort -dictionary \
                         [array names $ascCallbackVect(curgroup)]]} err
      # may leave elements list empty
    } 
  c -
  default {
      switch {$ascCallbackVect(allorgroup)} {
      all { set clist [help all] }
      default {
          catch {set clist \
                  [lrange [help $ascCallbackVect(curgroup)] 1 end]} err
          # may leave commands list empty
        }
      }
    }
  }

  eval $ascCallbackVect(comlist) insert end $clist
  set index [lsearch $clist $ascCallbackVect(curcommand)]
  $ascCallbackVect(comlist) see $index
  $ascCallbackVect(comlist) selection set $index $index
}

proc Callback_Update {} {
  Callback_Update_Groups
  Callback_Update_Commands
}

proc Callback_do_Print {} {
  error "Callback_do_Print not implemented"
}
proc Callback_do_Close {} {
  DestroyWindow.callback
}
proc Callback_do_wordsearch {} {
}
proc Callback_do_usagesearch {} {
}
proc Callback_do_textsearch {} {
}
proc Callback_do_command {} {
}
proc Callback_do_All {} {
}

proc Callback_do_Groups {} {
  global ascCallbackVect
  set ascCallbackVect(mode) c
  set ascCallbackVect(curcommand) none
  set ascCallbackVect(curgroup) none
  Callback_UpdateMode ;# change titles
  Callback_Update ;#change data
}

proc Callback_do_Font {} {
}
proc Callback_do_About {} {
}
proc Callback_do_syntax {} {
}
proc Callback_do_TOC {} {
}

proc Callback_do_Arrays {} {
  global ascCallbackVect
  set ascCallbackVect(mode) a
  set ascCallbackVect(curgroup) none
  set ascCallbackVect(curcommand) none
  Callback_UpdateMode ;# change titles
  Callback_Update ;#change data
}
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	}