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

Contents of /trunk/tcltk98/TK/probe.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (show annotations) (download) (as text)
Sat Nov 13 16:40:11 2004 UTC (17 years ago) by aw0a
File MIME type: text/x-tcl
File size: 11864 byte(s)
try again to commit moving tcl stuff
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