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

Contents of /trunk/ascend4/TK/script.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (20 years, 4 months ago) by aw0a
File MIME type: text/x-tcl
File size: 14827 byte(s)
Setting up web subdirectory in repository
1 # script.tcl
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.37 $
6 # Last modified on: $Date: 1998/06/18 15:55:38 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: script.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: script.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(script.tcl) { .script}
39 set autoLoadList(script.tcl) {0}
40
41 # procedures to show toplevel windows
42
43 #----------------------------
44 # procedure to show window ShowWindow.script
45 # proc ShowWindow.script { args}
46 proc ShowWindow.script { args} {
47 # xf ignore me 7
48 global ascScripVect ascGlobalVect env
49
50 StartupSrc.script
51
52 # build widget .script
53 if {"[info procs XFEdit]" != ""} {
54 catch "XFDestroy .script"
55 } {
56 catch "destroy .script"
57 }
58 toplevel .script
59
60 #
61 # Window manager configurations
62 #
63 wm positionfrom .script user
64 wm sizefrom .script user
65 wm iconname .script {Script}
66 wm minsize .script 100 100
67 wm title .script {A4 Script}
68 wm protocol .script WM_DELETE_WINDOW {Script_do_Exit}
69
70 #
71 # Build frame along bottom of script to hold
72 # record button and file name
73 #
74 frame .script.check_frm \
75 -borderwidth {2} \
76 -relief {raised}
77
78 entry .script.check_frm.file_entry \
79 -relief {raised} \
80 -width {24} \
81 -textvariable ascScripVect(filename) \
82 -font $ascScripVect(font) \
83 -state disabled \
84 -exportselection 0
85
86 label .script.check_frm.record_btn \
87 -text { } \
88 -font $ascGlobalVect(font)
89
90 pack append .script.check_frm \
91 .script.check_frm.record_btn {left frame center padx 10 pady 6} \
92 .script.check_frm.file_entry {left frame w pady 5 expand fill}
93
94 #
95 # Build the main frame of the script. This holds the text boxes.
96 #
97 frame .script.main_frm \
98 -borderwidth {0}
99
100 # Build the first script-text-box (script_box_0)
101 build_scriptbox .script.main_frm 0 $ascScripVect(font)
102 pack append .script.main_frm \
103 .script.main_frm.script_box_0 {top frame center expand fill}
104
105 #
106 # Build the menu bar and submenus
107 #
108 menu .script.menubar \
109 -tearoffcommand .SCRIPT.MENUBAR \
110 -tearoff 0
111
112 # The Edit menu.
113 menu .script.menubar.edit \
114 -tearoffcommand .SCRIPT.MENUBAR.EDIT \
115 -tearoff 0
116 .script.menubar.edit add checkbutton \
117 -variable ascScripVect(Record) \
118 -offvalue {0} \
119 -onvalue {1} \
120 -label {Record actions} \
121 -accelerator {Alt-e r} \
122 -underline 0
123 .script.menubar.edit add command \
124 -command {Script_do_SelectAll} \
125 -label {Select all} \
126 -accelerator {Alt-e s} \
127 -underline 0
128 .script.menubar.edit add separator
129 .script.menubar.edit add command \
130 -command {Script_do_RemoveStats} \
131 -accelerator {Alt-e d} \
132 -label {Delete statements} \
133 -underline 0
134 .script.menubar.edit add command \
135 -command Script_do_Cut \
136 -label Cut \
137 -accelerator F2 \
138 -underline -1
139 .script.menubar.edit add command \
140 -command Script_do_Copy \
141 -label Copy \
142 -accelerator F3 \
143 -underline -1
144 .script.menubar.edit add command \
145 -command Script_do_Paste \
146 -label Paste \
147 -accelerator F4 \
148 -underline -1
149
150
151 # The Execute menu.
152 menu .script.menubar.execute \
153 -tearoffcommand .SCRIPT.MENUBAR.EXECUTE \
154 -tearoff 0
155 .script.menubar.execute add command \
156 -command {Script_do_ExecuteStats} \
157 -label {Run statements selected} \
158 -accelerator {F5} \
159 -underline 0
160 .script.menubar.execute add command \
161 -command {Script_do_ExecuteStats 0} \
162 -label {Step through statements selected} \
163 -accelerator {F6} \
164 -underline 0
165
166
167 # The File menu
168 menu .script.menubar.file \
169 -tearoffcommand .SCRIPT.MENUBAR.FILE \
170 -tearoff 0
171 .script.menubar.file add command \
172 -command {Script_do_NewFile} \
173 -accelerator {Alt-f n} \
174 -label {New file} \
175 -underline 0
176 .script.menubar.file add command \
177 -command {Script_do_ReadFile} \
178 -label {Read file...} \
179 -accelerator {Alt-f r} \
180 -underline 0
181 .script.menubar.file add command \
182 -command {Script_do_Import_File} \
183 -label {Import file...} \
184 -accelerator {Alt-f i} \
185 -underline 0
186 .script.menubar.file add separator
187 .script.menubar.file add command \
188 -command {Script_do_Exit} \
189 -accelerator {Alt-f e} \
190 -underline 0 \
191 -label {Exit ASCEND...}
192 .script.menubar.file add separator
193 .script.menubar.file add command \
194 -command {Script_do_WriteBuf} \
195 -label {Save} \
196 -accelerator {Alt-f s} \
197 -underline 0
198 .script.menubar.file add command \
199 -command {Script_do_WriteBufAs} \
200 -label {Save As...} \
201 -accelerator {Alt-f a} \
202 -underline 5
203 .script.menubar.file add separator
204
205
206 # The Help menu.
207 menu .script.menubar.help \
208 -tearoffcommand .SCRIPT.MENUBAR.HELP \
209 -tearoff 0
210 .script.menubar.help add command \
211 -command {Script_do_Help} \
212 -label {On Script} \
213 -underline 3
214 .script.menubar.help add command \
215 -command {Script_getting_started} \
216 -label {On getting started with ASCEND} \
217 -underline 3
218 .script.menubar.help add command \
219 -command {ascShowInfo 1} \
220 -label {About ASCEND IV} \
221 -underline 3
222
223
224 # The Tools menu.
225 menu .script.menubar.tools \
226 -tearoffcommand .SCRIPT.MENUBAR.TOOLS \
227 -tearoff 0
228 .script.menubar.tools add checkbutton \
229 -variable ascLibrVect(window.open) \
230 -onvalue 1 \
231 -offvalue 0 \
232 -label {Type class library ...} \
233 -accelerator {Alt-t l} \
234 -underline 11
235 .script.menubar.tools add checkbutton \
236 -variable ascBrowVect(window.open) \
237 -onvalue 1 \
238 -offvalue 0 \
239 -accelerator {Alt-t b} \
240 -label {Instance browser ...} \
241 -underline 9
242 .script.menubar.tools add checkbutton \
243 -variable ascProbVect(window.open) \
244 -onvalue 1 \
245 -offvalue 0 \
246 -label {Data probe ...} \
247 -accelerator {Alt-t p} \
248 -underline 5
249 .script.menubar.tools add checkbutton \
250 -variable ascSolvVect(window.open) \
251 -onvalue 1 \
252 -offvalue 0 \
253 -label {Solvers ...} \
254 -accelerator {Alt-t s} \
255 -underline 0
256 .script.menubar.tools add checkbutton \
257 -variable ascDispVect(window.open) \
258 -onvalue 1 \
259 -offvalue 0 \
260 -label {Display slave ...} \
261 -accelerator {Alt-t d} \
262 -underline 0
263 .script.menubar.tools add checkbutton \
264 -variable ascUnitVect(window.open) \
265 -onvalue 1 \
266 -offvalue 0 \
267 -accelerator {Alt-t m} \
268 -label {Measuring units ...} \
269 -underline 0
270 .script.menubar.tools add checkbutton \
271 -variable ascToolVect(window.open) \
272 -onvalue 1 \
273 -offvalue 0 \
274 -label {Toolbox ...} \
275 -accelerator {Alt-t t} \
276 -underline 0
277 .script.menubar.tools add separator
278 .script.menubar.tools add command \
279 -command {NoteBrowse} \
280 -label {Notes on models ...} \
281 -accelerator {Alt-t n} \
282 -underline 0
283 .script.menubar.tools add command \
284 -command {ascconsole_open} \
285 -label {Open console} \
286 -accelerator {Alt-t c} \
287 -underline 5
288 .script.menubar.tools add command \
289 -command {ascplot_open} \
290 -accelerator {Alt-t a} \
291 -label {ASCPLOT ...} \
292 -underline 0
293 .script.menubar.tools add command \
294 -command {Tool_do_UtilBox} \
295 -accelerator {Alt-t u} \
296 -label {System utilities ...} \
297 -underline 7
298 .script.menubar.tools add command \
299 -command {Tool_do_Callbacks} \
300 -accelerator {Alt-t i} \
301 -label {Internal functions ...} \
302 -underline 0
303 .script.menubar.tools add command \
304 -command {Tool_do_Bugs} \
305 -accelerator {Alt-t g} \
306 -label {Report bug ...} \
307 -underline 9
308
309
310 # The options menu.
311 menu .script.menubar.options \
312 -tearoffcommand .SCRIPT.MENUBAR.OPTIONS \
313 -tearoff 0
314 .script.menubar.options add command \
315 -command {View_Save_Values} \
316 -label {Save all options and appearances for all windows} \
317 -accelerator {Alt-o s} \
318 -underline 0
319
320 # The View menu.
321 menu .script.menubar.view \
322 -tearoffcommand .SCRIPT.MENUBAR.VIEW \
323 -tearoff 0
324 .script.menubar.view add command \
325 -command {Script_do_Font} \
326 -label {Font ...} \
327 -accelerator {Alt-v f} \
328 -underline 0
329 .script.menubar.view add command \
330 -command {View_Set_Save_Options script} \
331 -label {Save Script appearance} \
332 -accelerator {Alt-v s} \
333 -underline 0
334 .script.menubar.view add command \
335 -command {Script_do_SaveOptions} \
336 -label {Save all appearances} \
337 -accelerator {Alt-v a} \
338 -underline 5
339
340
341 #
342 # Add the menus as cascades of the toplevel's menu;
343 # add the toplevel's menu to the toplevel
344 #
345 .script.menubar add cascade \
346 -menu .script.menubar.file \
347 -label {File} \
348 -underline 0
349 .script.menubar add cascade \
350 -menu .script.menubar.edit \
351 -label {Edit} \
352 -underline 0
353 .script.menubar add cascade \
354 -menu .script.menubar.execute \
355 -label {Execute} \
356 -underline 1
357 .script.menubar add cascade \
358 -menu .script.menubar.options \
359 -label {Options} \
360 -underline 0
361 .script.menubar add cascade \
362 -menu .script.menubar.view \
363 -label {View} \
364 -underline 0
365 .script.menubar add cascade \
366 -menu .script.menubar.tools \
367 -label {Tools} \
368 -underline 0
369 .script.menubar add cascade \
370 -menu .script.menubar.help \
371 -label {Help} \
372 -underline 0
373 .script configure \
374 -menu .script.menubar
375
376 #
377 # Add the main frame and the bottom frame to the toplevel .script
378 #
379 pack append .script \
380 .script.main_frm {top frame center expand fill} \
381 .script.check_frm {top frame center fillx}
382
383 EndSrc.script
384
385 if {"[info procs XFEdit]" != ""} {
386 catch "XFMiscBindWidgetTree .script"
387 after 2 "catch {XFEditSetShowWindows}"
388 }
389 }
390
391 # proc StartupSrc.script {args}
392 proc StartupSrc.script {args} {
393 # script startup entrance
394 # as much of the C/global dependencies managed here as possible
395 global ascScripVect ascGlobalVect env
396 if {[catch {set ascScripVect(windowname)} ]} {
397 set ascScripVect(minsize) 10x10
398 set ascScripVect(geometry) 37x21+10+10
399 set ascScripVect(iconname) Script
400 set ascScripVect(initialstate) normal
401 set ascScripVect(font) "-*-*"
402 }
403 if {[catch {set ascGlobalVect(font)} ]} {
404 set ascGlobalVect(font) "-*-*"
405 set ascGlobalVect(labelfont) "-*-*"
406 set ascGlobalVect(tbg) "white"
407 set ascGlobalVect(tfg) "black"
408 set ascGlobalVect(bg) "white"
409 set ascGlobalVect(fg) "black"
410 set ascGlobalVect(afg) "white"
411 set ascGlobalVect(abg) "black"
412 set ascGlobalVect(sfg) "white"
413 set ascGlobalVect(sbg) "black"
414 set ascGlobalVect(visibility) 1
415 set ascGlobalVect(c_loaded) "0"
416 set ascGlobalVect(toolbitmap) \
417 "@$env(ASCENDBITMAPS)/toolAttributes.xbm"
418 }
419 }
420
421 # proc EndSrc.script {}
422 proc EndSrc.script {} {
423 # script startup exit
424 global ascScripVect
425 set ascScripVect(geometry) [sanegeometry $ascScripVect(geometry)]
426 set minw [lindex [split $ascScripVect(minsize) x] 0]
427 set minh [lindex [split $ascScripVect(minsize) x] 1]
428 set gw [lindex [split [lindex [split $ascScripVect(geometry) +-] 0] x] 0]
429 set gh [lindex [split [lindex [split $ascScripVect(geometry) +-] 0] x] 1]
430 set gpx [lindex [split [split $ascScripVect(geometry) x] +-] 1]
431 set gpy [lindex [split [split $ascScripVect(geometry) x] +-] 2]
432 if {[expr $gw < $minw]} {set gw $minw}
433 if {[expr $gh < $minh]} {set gh $minh}
434 set gwh "${gw}x${gh}"
435 wm minsize .script $minw $minh
436 wm geometry .script "${gwh}+${gpx}+$gpy"
437 # wm geometry .script [gospos .script $gpx $gpy]
438 wm iconname .script $ascScripVect(iconname)
439
440 if {$ascScripVect(initialstate)!="iconic" && \
441 $ascScripVect(initialstate)!="iconified" && \
442 $ascScripVect(initialstate) !="withdrawn"} {
443 wm deiconify .script
444 }
445 if {"$ascScripVect(initialstate)"=="withdrawn"} {
446 wm withdraw .script
447 }
448
449 }
450
451
452 #
453 # proc build_scriptbox {parentname winnum font}
454 #---------------------------------------------------------------------------
455 # creates a text widget with scrollbars in the context
456 # of parentname, if same does not already exist.
457 # the name of the text widget is
458 # $parentname.script_box_$winnum
459 # returns the name $parentname.script_box_$winnum
460 # The widget with this name has a child named text2.
461 # scrollbars are done with bg/fg colors
462 # text is done with tbg/tfg, sbg/sfg for plain and selected text,
463 # respectively.
464 # if the widget already exists, recolors it from the given input.
465 #---------------------------------------------------------------------------
466 #
467 proc build_scriptbox {parentname winnum font} {
468
469 if {[winfo exists $parentname.script_box_$winnum]} {
470 return $parentname.script_box_$winnum
471 }
472
473 # build widget $parentname.script_box_$winnum
474 frame $parentname.script_box_$winnum \
475 -relief {raised}
476
477 # build widget $parentname.script_box_$winnum.scrollbar1
478 scrollbar $parentname.script_box_$winnum.scrollbar1 \
479 -command "$parentname.script_box_$winnum.text2 yview"
480
481 # build widget $parentname.script_box_$winnum.text2
482 text $parentname.script_box_$winnum.text2 \
483 -exportselection 0 \
484 -borderwidth {2} \
485 -height {2} \
486 -relief {raised} \
487 -setgrid {1} \
488 -width {10} \
489 -wrap {word} \
490 -yscrollcommand "$parentname.script_box_$winnum.scrollbar1 set" \
491 -font $font
492
493 # pack widget $parentname.script_box_$winnum
494 pack append $parentname.script_box_$winnum \
495 $parentname.script_box_$winnum.scrollbar1 {right frame center filly} \
496 $parentname.script_box_$winnum.text2 {top frame center expand fill}
497 catch {emacs-bind $parentname.script_box_$winnum.text2}
498 set w $parentname.script_box_$winnum.text2
499 bind $w <F2> Script_do_Cut
500 bind $w <F3> Script_do_Copy
501 bind $w <F4> Script_do_Paste
502 bind $w <F5> {
503 Script_do_ExecuteStats
504 }
505 bind $w <F6> {
506 Script_do_ExecuteStats 0
507 }
508 $w mark set insert end
509 }
510
511
512 # Internal procedures
513
514 # eof
515 #

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