/[ascend]/trunk/ascend4/TK/probe.tcl
ViewVC logotype

Annotation of /trunk/ascend4/TK/probe.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (17 years, 8 months ago) by aw0a
File MIME type: text/x-tcl
File size: 11864 byte(s)
Setting up web subdirectory in repository
1 aw0a 1 # probe.tcl
2     # by Benjamin A. Allan and Kirk A. Abbott
3     # Created: January 1994
4     # Part of ASCEND
5     # Revision: $Revision: 1.27 $
6     # Last modified on: $Date: 1998/06/18 15:55:37 $
7     # Last modified by: $Author: mthomas $
8     # Revision control file: $RCSfile: probe.tcl,v $
9     #
10     # This file is part of the ASCEND Tcl/Tk Interface.
11     #
12     # Copyright (C) 1994-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     # Module: probe.tcl
30     # Tcl version: 7.1 (Tcl/Tk/XF)
31     # Tk version: 3.4
32     # XF version: 2.2
33     #
34    
35     # module contents
36     global moduleList
37     global autoLoadList
38     set moduleList(probe.tcl) { .probe}
39     set autoLoadList(probe.tcl) {0}
40    
41     # procedures to show toplevel windows
42    
43    
44     # procedure to show window ShowWindow.probe
45     # proc ShowWindow.probe { args}
46     proc ShowWindow.probe {args} {
47     # xf ignore me 7
48    
49     global env
50     global ascGlobalVect
51     global ascProbVect
52    
53     StartupSrc.probe
54    
55     # build widget .probe
56     if {"[info procs XFEdit]" != ""} {
57     catch "XFDestroy .probe"
58     } {
59     catch "destroy .probe"
60     }
61     toplevel .probe
62    
63     # Ascend patched window manager configurations
64     wm iconify .probe
65     wm positionfrom .probe user
66     wm sizefrom .probe user
67     wm iconname .probe {Probe}
68     wm minsize .probe 100 100
69     wm title .probe {A4 Probe}
70     wm protocol .probe WM_DELETE_WINDOW {Toggle_Remote ascProbVect}
71    
72    
73     # build widget .probe.main_frm
74     frame .probe.main_frm \
75     -borderwidth 0 \
76     -relief {raised}
77    
78     build_probebox .probe.main_frm 0 $ascGlobalVect(font)
79    
80     # pack widget .probe.main_frm
81     pack append .probe.main_frm \
82     .probe.main_frm.probe_box_0 {top frame center expand fill}
83    
84    
85     #
86     # Build the menu bar and submenus
87     #
88     menu .probe.menubar \
89     -tearoffcommand .PROBE.MENUBAR \
90     -tearoff 0
91    
92     # The Edit menu
93     menu .probe.menubar.edit \
94     -tearoffcommand .PROBE.MENUBAR.EDIT \
95     -tearoff 0
96     .probe.menubar.edit add command \
97     -command {Probe_do_SelectAll} \
98     -label {Highlight all} \
99     -accelerator {Alt-e h} \
100     -underline 0
101     .probe.menubar.edit add command \
102     -command {Probe_do_RemoveSelections} \
103     -label {Remove selected names} \
104     -accelerator {Alt-e s} \
105     -underline 7
106     .probe.menubar.edit add command \
107     -command {Probe_do_RemoveAll} \
108     -label {Remove all names} \
109     -accelerator {Alt-e a} \
110     -underline 7
111     .probe.menubar.edit add command \
112     -command {Probe_do_RemoveUncertain} \
113     -label {Remove UNCERTAIN names} \
114     -accelerator {Alt-e u} \
115     -underline 7
116     .probe.menubar.edit add command \
117     -command {Probe_do_Copy} \
118     -accelerator {Alt-e c} \
119     -label {Copy} \
120     -underline 0
121    
122    
123     # The Export menu
124     menu .probe.menubar.export \
125     -tearoffcommand .PROBE.MENUBAR.EXPORT \
126     -tearoff 0
127     .probe.menubar.export add command \
128     -command {Probe_do_Export2Browser} \
129     -accelerator {Alt-x b} \
130     -label {to Browser} \
131     -underline 3
132     .probe.menubar.export add command \
133     -command {Probe_do_Export2Display} \
134     -accelerator {Alt-x d} \
135     -label {to Display} \
136     -underline 3
137    
138    
139     # The File menu
140     menu .probe.menubar.file \
141     -tearoffcommand .PROBE.MENUBAR.FILE \
142     -tearoff 0
143     .probe.menubar.file add command \
144     -command {Probe_do_NewBuffer} \
145     -label {New buffer...} \
146     -accelerator {Alt-f n} \
147     -underline 0
148     .probe.menubar.file add command \
149     -command {Probe_do_ReadFile} \
150     -label {Read...} \
151     -accelerator {Alt-f r} \
152     -underline 0
153     .probe.menubar.file add command \
154     -command {Probe_do_WriteBuf} \
155     -label {Save...} \
156     -accelerator {Alt-f s} \
157     -underline 0
158     .probe.menubar.file add command \
159     -command {Probe_do_WriteBufAs} \
160     -label {Save As...} \
161     -accelerator {Alt-f a} \
162     -underline 5
163     .probe.menubar.file add command \
164     -command {Probe_do_Print} \
165     -label {Print...} \
166     -accelerator {Alt-f p} \
167     -underline 0
168     .probe.menubar.file add command \
169     -command {Toggle_Remote ascProbVect} \
170     -accelerator {Alt-f c} \
171     -label {Close window} \
172     -underline 0
173     .probe.menubar.file add command \
174     -command {Script_do_Exit} \
175     -label {Exit ASCEND...} \
176     -accelerator {Alt-f e} \
177     -underline 0
178     .probe.menubar.file add separator
179    
180    
181     # The Help menu
182     menu .probe.menubar.help \
183     -tearoffcommand .PROBE.MENUBAR.HELP \
184     -tearoff 0
185     .probe.menubar.help add command \
186     -command {Probe_do_Help} \
187     -label {On Probe} \
188     -underline 3
189    
190    
191     # The View menu
192     menu .probe.menubar.view \
193     -tearoffcommand .PROBE.MENUBAR.VIEW \
194     -tearoff 0
195     .probe.menubar.view add command \
196     -command {Probe_do_Font} \
197     -label {Font ...} \
198     -accelerator {Alt-v f} \
199     -underline 0
200     .probe.menubar.view add checkbutton \
201     -offvalue {0} \
202     -onvalue {1} \
203     -variable {ascProbVect(visibility)} \
204     -accelerator {Alt-v o} \
205     -label {Open automatically} \
206     -underline 0
207     .probe.menubar.view add command \
208     -command {View_Set_Save_Options probe} \
209     -label {Save window appearance} \
210     -accelerator {Alt-v s} \
211     -underline 0
212    
213    
214     #
215     # Add the menus as cascades of the toplevel's menu;
216     # add the toplevel's menu to the toplevel
217     #
218     .probe.menubar add cascade \
219     -menu .probe.menubar.file \
220     -label {File} \
221     -underline 0
222     .probe.menubar add cascade \
223     -menu .probe.menubar.edit \
224     -label {Edit} \
225     -underline 0
226     .probe.menubar add cascade \
227     -menu .probe.menubar.view \
228     -label {View} \
229     -underline 0
230     .probe.menubar add cascade \
231     -menu .probe.menubar.export \
232     -label {Export} \
233     -underline 1
234     .probe.menubar add cascade \
235     -menu .probe.menubar.help \
236     -label {Help} \
237     -underline 0
238     .probe configure \
239     -menu .probe.menubar
240    
241    
242     # build frame and entry at bottom of window to hold current buffer name
243     frame .probe.buffer_frm \
244     -borderwidth {2} \
245     -relief {raised}
246    
247     entry .probe.buffer_frm.buffer_entry \
248     -relief {raised} \
249     -width {24} \
250     -state {disabled} \
251     -exportselection 0 \
252     -textvariable ascProbVect(filename) \
253     -font $ascProbVect(font)
254    
255     pack append .probe.buffer_frm \
256     .probe.buffer_frm.buffer_entry {left frame center expand fillx}
257    
258    
259     #
260     # Pack the widgets into the probe toplevel
261     #
262     pack append .probe \
263     .probe.main_frm {top frame center expand fill} \
264     .probe.buffer_frm {top frame center fillx}
265    
266     EndSrc.probe
267    
268     if {"[info procs XFEdit]" != ""} {
269     catch "XFMiscBindWidgetTree .probe"
270     after 2 "catch {XFEditSetShowWindows}"
271     }
272     }
273    
274     # proc DestroyWindow.probe {}
275     proc DestroyWindow.probe {} {# xf ignore me 7
276     if {"[info procs XFEdit]" != ""} {
277     if {"[info commands .probe]" != ""} {
278     global xfShowWindow.probe
279     set xfShowWindow.probe 0
280     XFEditSetPath .
281     after 2 "XFSaveAsProc .probe; XFEditSetShowWindows"
282     }
283     } {
284     catch "destroy .probe"
285     update
286     }
287     }
288    
289     # proc StartupSrc.probe {args}
290     # probe startup entrance
291     # as much of the C/global dependencies managed here as possible
292     proc StartupSrc.probe {args} {
293    
294     global env
295     global ascGlobalVect
296     global ascProbVect
297    
298     if {[info procs Probe_bindListbox] != "Probe_bindListbox"} {
299     proc Probe_bindListbox {args} {
300     error "Driver needs to define Probe_bindListbox!"
301     }
302     }
303    
304     if {[catch {set ascProbVect(windowname)} ]} {
305     set ascProbVect(minsize) 100x100
306     set ascProbVect(geometry) 200x400+10+10
307     set ascProbVect(iconname) Probe
308     set ascProbVect(initialstate) normal
309     set ascProbVect(font) "courier 12 bold"
310     }
311     if {[catch {set ascGlobalVect(font)} ]} {
312     set ascGlobalVect(font) "courier 10 bold"
313     set ascGlobalVect(labelfont) "courier 12 bold"
314     set ascGlobalVect(tbg) "white"
315     set ascGlobalVect(tfg) "black"
316     set ascGlobalVect(bg) "white"
317     set ascGlobalVect(fg) "black"
318     set ascGlobalVect(afg) "white"
319     set ascGlobalVect(abg) "black"
320     set ascGlobalVect(sfg) "white"
321     set ascGlobalVect(sbg) "black"
322     set ascGlobalVect(visibility) 1
323     set ascGlobalVect(c_loaded) "0"
324     set ascGlobalVect(toolbitmap) \
325     "@$env(ASCENDBITMAPS)/toolAttributes.xbm"
326     }
327     }
328    
329     # proc EndSrc.probe {}
330     proc EndSrc.probe {} {
331     # probe startup exit
332     global ascProbVect
333     set ascProbVect(geometry) [sanegeometry $ascProbVect(geometry)]
334     set minw [lindex [split $ascProbVect(minsize) x] 0]
335     set minh [lindex [split $ascProbVect(minsize) x] 1]
336     set gw [lindex [split [lindex [split $ascProbVect(geometry) +] 0] x] 0]
337     set gh [lindex [split [lindex [split $ascProbVect(geometry) +] 0] x] 1]
338     set gp "+[lindex [split [split $ascProbVect(geometry) x] +] 1]+[lindex [split [split $ascProbVect(geometry) x] +] 2]"
339     if {[expr $gw < $minw]} {set gw $minw}
340     if {[expr $gh < $minh]} {set gh $minh}
341     set gwh "${gw}x${gh}"
342     wm positionfrom .probe user
343     wm sizefrom .probe user
344     wm minsize .probe $minw $minh
345     wm geometry .probe [osgpos $gwh$gp]
346     wm iconname .probe $ascProbVect(iconname)
347    
348     if {$ascProbVect(initialstate)!="iconic" && \
349     $ascProbVect(initialstate)!="iconified" &&
350     $ascProbVect(initialstate)!="withdrawn"} {
351     wm deiconify .probe
352     }
353     if {"$ascProbVect(initialstate)"=="withdrawn"} {
354     wm withdraw .probe
355     }
356    
357     }
358    
359    
360    
361     # proc build_probebox {parentname winnum font}
362     #---------------------------------------------------------------------------
363     # creates a listbox widget with scrollbars in the context
364     # of parentname, if same does not already exist.
365     # the name of the listbox widget is
366     # $parentname.probe_box_$winnum
367     # returns the name $parentname.script_box_$winnum
368     # The widget with this name has a child named listbox1.
369     # scrollbars are done with bg/fg colors
370     # text is done with tbg/tfg, sbg/sfg for plain and selected text,
371     # respectively.
372     # if the widget already exists, recolors it from the given input.
373     #---------------------------------------------------------------------------
374     #
375     proc build_probebox {parentname winnum font} {
376     if { ! [winfo exists $parentname.probe_box_$winnum] } {
377     # It does not exist, build it.
378    
379     # build Frame to hold scrollbars and listbox
380     frame $parentname.probe_box_$winnum
381    
382     # build Verticle Scrollbar
383     scrollbar $parentname.probe_box_$winnum.scrollbarV \
384     -command "$parentname.probe_box_$winnum.listbox1 yview"
385    
386     # build Horizontal Scrollbar
387     scrollbar $parentname.probe_box_$winnum.scrollbarH \
388     -command "$parentname.probe_box_$winnum.listbox1 xview" \
389     -orient {horizontal}
390    
391     # build Listbox to hold probe variables
392     listbox $parentname.probe_box_$winnum.listbox1 \
393     -relief {raised} \
394     -xscrollcommand "$parentname.probe_box_$winnum.scrollbarH set" \
395     -yscrollcommand "$parentname.probe_box_$winnum.scrollbarV set" \
396     -width 1 \
397     -height 1 \
398     -font $font \
399     -exportselection 0 \
400     -selectmode extended
401    
402     # pack widget $parentname.probe_box_$winnum
403     pack append $parentname.probe_box_$winnum \
404     $parentname.probe_box_$winnum.scrollbarV {right frame center filly} \
405     $parentname.probe_box_$winnum.listbox1 {top frame center expand fill} \
406     $parentname.probe_box_$winnum.scrollbarH {bottom frame center fillx}
407     }
408    
409     $parentname.probe_box_$winnum.listbox1 configure \
410     -font $font
411    
412     return $parentname.probe_box_$winnum
413     }
414    
415    
416     # Internal procedures
417    
418     # eof
419     #
420    

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