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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (15 years, 5 months ago) by aw0a
File MIME type: text/x-tcl
File size: 39052 byte(s)
Setting up web subdirectory in repository
1 # View.tcl: assigns the default params to the global vectors of each window
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.20 $
6 # Last modified on: $Date: 1998/06/18 20:11:42 $
7 # Last modified by: $Author: ballan $
8 # Revision control file: $RCSfile: View.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 #
30 # This file contains support Tcl code for the assignment of the default
31 # parameters to the global vectors of each ascend window
32 #
33
34
35 # this is the first batch that must deal with geometry,
36 # so we define a mess of geometry handlers that used to be
37 # in generalk.tcl here.
38 #
39 # proc setpos {master {offsetx "70"} {offsety "70"}}
40 #-------------------------------------------------------------------------
41 # calculate screen position as deltas from position of an existing window
42 # existing window does not have to be a toplevel. returns +x+y
43 #-------------------------------------------------------------------------
44 proc setpos {master {offsetx "70"} {offsety "70"}} {# calculates offsets
45 set xpos [expr [winfo rootx $master] + $offsetx]
46 set ypos [expr [winfo rooty $master] + $offsety]
47 return "+$xpos+$ypos"
48 }
49
50 #
51 # proc getpos {master}
52 #-------------------------------------------------------------------------
53 # master is a toplevel wm knows about. returns +x+y of master
54 #-------------------------------------------------------------------------
55 proc getpos {master} {
56 set list [split [wm geometry $master] +]
57 set xpos [lindex $list 1]
58 set ypos [lindex $list 2]
59 return "+$xpos+$ypos"
60 }
61 # reparse geometry to a more sane state.
62 # tk broken. returns a geometry spec with extra signs deleted.
63 proc sanegeometry {geom} {
64 set result {}
65 set len [string length $geom]
66 set rlen 0
67 set lastsign {}
68 set state digit; # other state is sign
69 for {set i 0} {$i < $len} {incr i} {
70 set c [string index $geom $i]
71 switch -exact -- $c {
72 0 -
73 1 -
74 2 -
75 3 -
76 4 -
77 5 -
78 6 -
79 7 -
80 8 -
81 9 -
82 X -
83 x {
84 switch -exact -- $lastsign {
85 + -
86 - {
87 append result $lastsign
88 set lastsign {}
89 }
90 }
91 append result $c
92 }
93 - -
94 + {
95 set lastsign $c
96 }
97 default {
98 error "bad geometry $geom specified"
99 }
100 }
101 }
102 return $result
103 }
104
105 #
106 # proc osgpos {geom}
107 #-------------------------------------------------------------------------
108 # given a complete geometry of the form WxH+X+Y returns a geometry
109 # such that the lower right corner will be on the screen. if this geometry
110 # would force the upper left corner to be above/left of +2+2,
111 # returns a geometry such that upper left corner is +2+2
112 # ignores signs on X Y arguments
113 # does not understand gridded windows, window dressing may result in
114 # slight misalignment due to the style of wm-Tk geometry interaction
115 #-------------------------------------------------------------------------
116 proc osgpos {geom} {
117 set geom [sanegeometry $geom]
118 set sh [winfo screenheight .]
119 set sw [winfo screenwidth .]
120 set glist [split $geom +-]
121 if {[llength $glist] != 3} {error "Invalid geometry spec passed to osg"}
122 set x [lindex $glist 1]
123 set y [lindex $glist 2]
124 set slist [split [lindex $glist 0] x]
125 if {[llength $slist] != 2} {error "Invalid window size given to osg"}
126 set w [lindex $slist 0]
127 set h [lindex $slist 1]
128 set newx $x
129 set newy $y
130 if {($x + $w) > $sw} {set newx [expr $sw - $w]}
131 if {($y + $h) > $sh} {set newy [expr $sh - $h -20]}
132 if { $newx < 10 } {set newx 10}
133 if { $newy < 10 } {set newy 10}
134 return [lindex $glist 0]+$newx+$newy
135 }
136
137 #
138 # proc ospos {w h x y}
139 #-------------------------------------------------------------------------
140 # given a geometry of the form W H X Y returns a geometry
141 # such that the lower right corner will be on the screen. if this geometry
142 # would force the upper left corner to be above/left of +2+2,
143 # returns a geometry such that upper left corner is +2+2
144 # does not understand gridded windows, window dressing may result in
145 # slight misalignment due to the style of wm-Tk geometry interaction
146 #-------------------------------------------------------------------------
147 proc ospos {w h x y} {
148 set sh [winfo screenheight .]
149 set sw [winfo screenwidth .]
150 set newx $x
151 set newy $y
152 if {($x + $w) > $sw} {set newx [expr $sw - $w]}
153 if {($y + $h) > $sh} {set newy [expr $sh - $h -20]}
154 if { $newx < 2 } {set newx 2}
155 if { $newy < 2 } {set newy 2}
156 return ${w}x${h}+$newx+$newy
157 }
158
159 #
160 # proc gospos {w x y}
161 #-------------------------------------------------------------------------
162 # given a gridded window, w, and coordinates x y, generate geometry
163 # such that the lower right corner will be on the screen. If this geometry
164 # would force the upper left corner to be above/left of +2+2,
165 # returns a geometry such that upper left corner is +2+2.
166 # Window dressing may result in
167 # slight misalignment due to the style of wm-Tk geometry interaction
168 # Note: this requires that the window in question already have the desired
169 # size set. you may have to do an idletask update to get the geom set.
170 # The geometry returned is useful only for relocation, not creation.
171 #-------------------------------------------------------------------------
172 proc gospos {gw x y} {
173 set h [winfo height $gw]
174 set w [winfo width $gw]
175 set pgeom [ospos $w $h $x $y]
176 set px +[lindex [split $pgeom +] 1]
177 set py +[lindex [split $pgeom +] 2]
178 set wgeom [wm geometry $gw]
179 set wsize [lindex [split $wgeom +] 0]
180 return ${wsize}${px}${py}
181 }
182
183
184 # Vector containing the name of the vector for each ascend window
185 global ascViewWindowVect
186
187 #
188 # proc Browser {args}
189 #------------------------------------------------------------------------
190 # Sets the default parameters for the vector ascBrowVect
191 #------------------------------------------------------------------------
192 proc Browser {args} {
193
194 global ascBrowVect
195
196 if {$args == {}} {
197 puts "ERROR: No arguments passed to Browser"
198 return
199 }
200
201 set ind 0
202 set attr [lindex $args $ind]
203
204 if {[llength $args] == 1} {
205 return $ascBrowVect($attr)
206 } else {
207 incr ind
208 set value [lrange $args $ind end]
209 set ascBrowVect($attr) $value
210 return $value
211 }
212 }
213
214
215 #
216 #
217 # proc Debugger {args}
218 #------------------------------------------------------------------------
219 # Sets the default parameters for the vector ascDebuVect
220 #------------------------------------------------------------------------
221 proc Debugger {args} {
222
223 global ascDebuVect
224
225 if {$args == {}} {
226 puts "ERROR: No arguments passed to Debugger"
227 return
228 }
229
230 set ind 0
231 set attr [lindex $args $ind]
232
233 if {[llength $args] == 1} {
234 return $ascDebuVect($attr)
235 } else {
236 incr ind
237 set value [lrange $args $ind end]
238 set ascDebuVect($attr) $value
239 return $value
240 }
241 }
242
243
244 #
245 #
246 # proc Display {args}
247 #------------------------------------------------------------------------
248 # Sets the default parameters for the vector ascDispVect
249 #------------------------------------------------------------------------
250 proc Display {args} {
251
252 global ascDispVect
253
254 if {$args == {}} {
255 puts "ERROR: No arguments passed to Display"
256 return
257 }
258
259 set ind 0
260 set attr [lindex $args $ind]
261
262 if {[llength $args] == 1} {
263 return $ascDispVect($attr)
264 } else {
265 incr ind
266 set value [lrange $args $ind end]
267 set ascDispVect($attr) $value
268 return $value
269 }
270 }
271
272
273 #
274 # This file contains support Tcl code for the assignment of the default
275 # parameters to the global vectors of each ascend window
276 #
277 #
278 # proc Global {args}
279 #------------------------------------------------------------------------
280 # Sets the default parameters for the vector ascGlobalVect
281 #------------------------------------------------------------------------
282 proc Global {args} {
283
284 global ascGlobalVect
285
286 if {$args == {}} {
287 puts "ERROR: No arguments passed to Global"
288 return
289 }
290
291 set ind 0
292 set attr [lindex $args $ind]
293
294 if {[llength $args] == 1} {
295 return $ascGlobalVect($attr)
296 } else {
297 incr ind
298 set value [lrange $args $ind end]
299 set ascGlobalVect($attr) $value
300 return $value
301 }
302 }
303
304
305 #
306 #
307 # proc Library {args}
308 #------------------------------------------------------------------------
309 # Sets the default parameters for the vector ascLibrVect
310 #------------------------------------------------------------------------
311 proc Library {args} {
312
313 global ascLibrVect
314
315 if {$args == {}} {
316 puts "ERROR: No arguments passed to Library"
317 return
318 }
319
320 set ind 0
321 set attr [lindex $args $ind]
322
323 if {[llength $args] == 1} {
324 return $ascLibrVect($attr)
325 } else {
326 incr ind
327 set value [lrange $args $ind end]
328 set ascLibrVect($attr) $value
329 return $value
330 }
331 }
332
333
334 #
335 #
336 # proc Matrix {args}
337 #------------------------------------------------------------------------
338 # Sets the default parameters for the vector ascMtxVect
339 #------------------------------------------------------------------------
340 proc Matrix {args} {
341
342 global ascMtxVect
343
344 if {$args == {}} {
345 puts "ERROR: No arguments passed to Matrix"
346 return
347 }
348
349 set ind 0
350 set attr [lindex $args $ind]
351
352 if {[llength $args] == 1} {
353 return $ascMtxVect($attr)
354 } else {
355 incr ind
356 set value [lrange $args $ind end]
357 set ascMtxVect($attr) $value
358 return $value
359 }
360 }
361
362
363 #
364 #
365 # proc Probe {args}
366 #------------------------------------------------------------------------
367 # Sets the default parameters for the vector ascProbVect
368 #------------------------------------------------------------------------
369 proc Probe {args} {
370
371 global ascProbVect
372
373 if {$args == {}} {
374 puts "ERROR: No arguments passed to Probe"
375 return
376 }
377
378 set ind 0
379 set attr [lindex $args $ind]
380
381 if {[llength $args] == 1} {
382 return $ascProbVect($attr)
383 } else {
384 incr ind
385 set value [lrange $args $ind end]
386 set ascProbVect($attr) $value
387 return $value
388 }
389 }
390
391
392 #
393 #
394 # proc Script {args}
395 #------------------------------------------------------------------------
396 # Sets the default parameters for the vector ascScripVect
397 #------------------------------------------------------------------------
398 proc Script {args} {
399
400 global ascScripVect
401
402 if {$args == {}} {
403 puts "ERROR: No arguments passed to Script"
404 return
405 }
406
407 set ind 0
408 set attr [lindex $args $ind]
409
410 if {[llength $args] == 1} {
411 return $ascScripVect($attr)
412 } else {
413 incr ind
414 set value [lrange $args $ind end]
415 set ascScripVect($attr) $value
416 return $value
417 }
418 }
419
420
421 #
422 #
423 # proc Simulations {args}
424 #------------------------------------------------------------------------
425 # Sets the default parameters for the vector ascSimsVect
426 #------------------------------------------------------------------------
427 proc Simulations {args} {
428
429 global ascSimsVect
430
431 if {$args == {}} {
432 puts "ERROR: No arguments passed to Simulations"
433 return
434 }
435
436 set ind 0
437 set attr [lindex $args $ind]
438
439 if {[llength $args] == 1} {
440 return $ascSimsVect($attr)
441 } else {
442 incr ind
443 set value [lrange $args $ind end]
444 set ascSimsVect($attr) $value
445 return $value
446 }
447 }
448
449
450 #
451 #
452 # proc Solver {args}
453 #------------------------------------------------------------------------
454 # Sets the default parameters for the vector ascSolvVect
455 #------------------------------------------------------------------------
456 proc Solver {args} {
457
458 global ascSolvVect
459
460 if {$args == {}} {
461 puts "ERROR: No arguments passed to Solver"
462 return
463 }
464
465 set ind 0
466 set attr [lindex $args $ind]
467
468 if {[llength $args] == 1} {
469 return $ascSolvVect($attr)
470 } else {
471 incr ind
472 set value [lrange $args $ind end]
473 set ascSolvVect($attr) $value
474 return $value
475 }
476 }
477 #
478 #
479 # proc SolverGeneral {args}
480 #------------------------------------------------------------------------
481 # Sets the default parameters for the vector ascSolv32767Vect
482 #------------------------------------------------------------------------
483 proc SolverGeneral {args} {
484
485 global ascSolv32767Vect
486
487 if {$args == {}} {
488 puts "ERROR: No arguments passed to SolverGeneral"
489 return
490 }
491
492 set ind 0
493 set attr [lindex $args $ind]
494
495 if {[llength $args] == 1} {
496 return $ascSolv32767Vect($attr)
497 } else {
498 incr ind
499 set value [lrange $args $ind end]
500 set ascSolv32767Vect($attr) $value
501 return $value
502 }
503 }
504
505
506 #
507 #
508 # proc Toolbox {args}
509 #------------------------------------------------------------------------
510 # Sets the default parameters for the vector ascToolVect
511 #------------------------------------------------------------------------
512 proc Toolbox {args} {
513
514 global ascToolVect
515
516 if {$args == {}} {
517 puts "ERROR: No arguments passed to Toolbox"
518 return
519 }
520
521 set ind 0
522 set attr [lindex $args $ind]
523
524 if {[llength $args] == 1} {
525 return $ascToolVect($attr)
526 } else {
527 incr ind
528 set value [lrange $args $ind end]
529 set ascToolVect($attr) $value
530 return $value
531 }
532 }
533
534
535 #
536 #
537 # proc Units {args}
538 #------------------------------------------------------------------------
539 # Sets the default parameters for the vector ascUnitVect
540 #------------------------------------------------------------------------
541 proc Units {args} {
542
543 global ascUnitVect
544
545 if {$args == {}} {
546 puts "ERROR: No arguments passed to Units"
547 return
548 }
549
550 set ind 0
551 set attr [lindex $args $ind]
552
553 if {[llength $args] == 1} {
554 return $ascUnitVect($attr)
555 } else {
556 incr ind
557 set value [lrange $args $ind end]
558 set ascUnitVect($attr) $value
559 return $value
560 }
561 }
562
563 #
564 #
565 # proc AscPlot {args}
566 #------------------------------------------------------------------------
567 # Sets the default parameters for the vector ascplotvect
568 #------------------------------------------------------------------------
569 proc AscPlot {args} {
570
571 global ascplotvect
572
573 if {$args == {}} {
574 puts "ERROR: No arguments passed to Units"
575 return
576 }
577
578 set ind 0
579 set attr [lindex $args $ind]
580
581 if {[llength $args] == 1} {
582 return $ascplotvect($attr)
583 } else {
584 incr ind
585 set value [lrange $args $ind end]
586 set ascplotvect($attr) $value
587 return $value
588 }
589 }
590
591 #
592 #
593 # proc Environment {args}
594 #------------------------------------------------------------------------
595 # Sets the default parameters for the vector env
596 #------------------------------------------------------------------------
597 proc Environment {args} {
598
599 global env
600
601 if {$args == {}} {
602 puts "ERROR: No arguments passed to Environment"
603 return
604 }
605
606 set ind 0
607 set attr [lindex $args $ind]
608
609 if {[llength $args] == 1} {
610 return $env($attr)
611 } else {
612 incr ind
613 set value [lrange $args $ind end]
614 set env($attr) $value
615 return $value
616 }
617 }
618
619
620 #
621 #
622 # proc Set_ViewVect_Values {}
623 #------------------------------------------------------------------------
624 # Define a vector containing the names of the vectors corresponding to each
625 # of the ASCEND window
626 #------------------------------------------------------------------------
627 proc Set_ViewVect_Values {} {
628 global ascViewWindowVect
629
630 set ascViewWindowVect(browser) "ascBrowVect"
631 set ascViewWindowVect(debugger) "ascDebuVect"
632 set ascViewWindowVect(display) "ascDispVect"
633 set ascViewWindowVect(global) "ascGlobalVect"
634 set ascViewWindowVect(library) "ascLibrVect"
635 set ascViewWindowVect(matrix) "ascMtxVect"
636 set ascViewWindowVect(probe) "ascProbVect"
637 set ascViewWindowVect(script) "ascScripVect"
638 set ascViewWindowVect(simulations) "ascSimsVect"
639 set ascViewWindowVect(solver) "ascSolvVect"
640 set ascViewWindowVect(toolbox) "ascToolVect"
641 set ascViewWindowVect(units) "ascUnitVect"
642 set ascViewWindowVect(ascplot) "ascplotvect"
643 set ascViewWindowVect(environment) "env"
644 set ascViewWindowVect(slv32767parms) "ascSolv32767Vect"
645
646 return
647 }
648
649 #
650 #
651 # proc Set_View_Option_Values {}
652 #------------------------------------------------------------------------
653 # For the global vectors of ASCEND, this functions define an element
654 # called viewoptions, which are the names of other array elements (in
655 # the same vector) that the user may want be able to get and modify.
656 #
657 # For each toplevel window, we define a set of cosmetic appearance
658 # (viewoptions) and a set of saved control parameters (controloptions).
659 # The split among these is somewhat arbitrary, in a few cases.
660 # cosmetic options should just be saved whenever we feel like,
661 # while the user should direct us to save control options because
662 # these change default behavior from that which we describe in the
663 # documentation.
664 #------------------------------------------------------------------------
665 proc Set_View_Option_Values {} {
666
667 global ascBrowVect ascDebuVect ascDispVect ascGlobalVect ascLibrVect
668 global ascMtxVect ascProbVect ascScripVect ascSimsVect ascSolvVect
669 global ascToolVect ascUnitVect ascplotvect env ascSolv32767Vect
670
671 # View_InitDialog
672 set ascBrowVect(controloptions) [list \
673 TypeorValue \
674 ShowAtoms \
675 HidePassed \
676 dimconsistency \
677 queryfile \
678 localshow,BOOLEAN_ATOM_INST \
679 localshow,BOOLEAN_CONSTANT_INST \
680 localshow,INTEGER_ATOM_INST \
681 localshow,INTEGER_CONSTANT_INST \
682 localshow,LREL_INST \
683 localshow,REAL_ATOM_INST \
684 localshow,REAL_CONSTANT_INST \
685 localshow,REL_INST \
686 localshow,SET_ATOM_INST \
687 localshow,SYMBOL_ATOM_INST \
688 localshow,SYMBOL_CONSTANT_INST \
689 ]
690 set ascSolv32767Vect(viewoptions) {}
691 # this list should follow from ascSolv32767Vect(namelist)
692 # but may not yet exist at startup.
693 set ascSolv32767Vect(controloptions) [list \
694 lnmepsilon \
695 update_frequency \
696 update_time dtmin \
697 dtmax \
698 dtzero \
699 moststeps \
700 newlog \
701 checksing \
702 showavgs \
703 yfilename \
704 obsfilename \
705 logsi \
706 logcol \
707 nearbound \
708 farnom
709 ]
710 set ascBrowVect(viewoptions) [list \
711 font \
712 geometry \
713 minsize \
714 iconname \
715 initialstate \
716 visibility \
717 ]
718 set ascDebuVect(controloptions) {}
719 set ascDebuVect(viewoptions) [list \
720 geometry \
721 minsize \
722 iconname \
723 initialstate \
724 visibility \
725 ]
726 set ascDispVect(controloptions) "ShowComments"
727 set ascDispVect(viewoptions) "geometry minsize iconname initialstate font"
728 set ascGlobalVect(viewoptions) "font labelfont tbg tfg"
729 set ascGlobalVect(controloptions) hideinfoforever
730 set ascLibrVect(controloptions) [list \
731 ignorestop \
732 compileC \
733 compilerWarnings \
734 parserWarnings \
735 simplifyRelations \
736 lastreadextension \
737 ]
738 set ascLibrVect(viewoptions) [list \
739 font \
740 geometry \
741 minsize \
742 iconname \
743 initialstate \
744 visibility \
745 entryFont \
746 ]
747 set ascMtxVect(controloptions) {}
748 set ascMtxVect(viewoptions) "geometry font initialstate visibility"
749 set ascProbVect(controloptions) {}
750 set ascProbVect(viewoptions) [list \
751 font \
752 geometry \
753 minsize \
754 iconname \
755 initialstate \
756 visibility \
757 ]
758 set ascScripVect(controloptions) lastreadextension
759 set ascScripVect(viewoptions) [list \
760 font \
761 geometry \
762 minsize \
763 iconname \
764 initialstate \
765 visibility
766 ]
767 set ascSimsVect(controloptions) {}
768 set ascSimsVect(viewoptions) [list \
769 iconname \
770 initialstate \
771 visibility
772 ]
773 set ascSolvVect(controloptions) [list font \
774 statreport \
775 modelbar \
776 ]
777 set ascSolvVect(viewoptions) [list font \
778 geometry \
779 minsize \
780 iconname \
781 initialstate \
782 visibility \
783 ]
784 set ascToolVect(controloptions) {}
785 set ascToolVect(viewoptions) [list geometry minsize iconname initialstate]
786 set ascUnitVect(viewoptions) [list font \
787 precision geometry minsize iconname initialstate]
788 set ascUnitVect(controloptions) {}
789 set ascplotvect(controloptions) {}
790 set ascplotvect(viewoptions) "minsize maxsize btnfont textfont titlefont"
791 set env(viewoptions) {}
792 set env(controloptions) {}
793 return
794 }
795
796 #
797 # proc View_Options {window}
798 #------------------------------------------------------------------------
799 # return the value of the array element viewoptions for the global vector
800 # of the ASCEND window given by the argument window.
801 #------------------------------------------------------------------------
802 proc View_Options {window} {
803
804 global ascBrowVect ascDebuVect ascDispVect ascGlobalVect ascLibrVect
805 global ascMtxVect ascProbVect ascScripVect ascSimsVect ascSolvVect
806 global ascToolVect ascUnitVect ascplotvect env ascSolv32767Vect
807 global ascViewWindowVect
808
809 Set_ViewVect_Values
810 Set_View_Option_Values
811
812 set vectorname $ascViewWindowVect($window)
813 return [set [set vectorname](controloptions)]
814 }
815
816 #
817 # proc View_Appearance {window}
818 #------------------------------------------------------------------------
819 # return the value of the array element viewoptions for the global vector
820 # of the ASCEND window given by the argument window.
821 #------------------------------------------------------------------------
822 proc View_Appearance {window} {
823
824 global ascBrowVect ascDebuVect ascDispVect ascGlobalVect ascLibrVect
825 global ascMtxVect ascProbVect ascScripVect ascSimsVect ascSolvVect
826 global ascToolVect ascUnitVect ascplotvect env ascSolv32767Vect
827 global ascViewWindowVect
828
829 Set_ViewVect_Values
830 Set_View_Option_Values
831
832 set vectorname $ascViewWindowVect($window)
833 return [set [set vectorname](viewoptions)]
834 }
835
836
837 #
838 # proc View_Get_Proc_Name {window}
839 #------------------------------------------------------------------------
840 # take a util default subscript and return its variable
841 # for the utility box. you better have set these vars
842 # elsewhere or trap those not ever set
843 #------------------------------------------------------------------------
844 proc View_Get_Proc_Name {window} {
845 switch $window {
846 {browser} {return "Browser"}
847 {debugger} {return "Debugger"}
848 {display} {return "Display"}
849 {global} {return "Global"}
850 {library} {return "Library"}
851 {matrix} {return "Matrix"}
852 {probe} {return "Probe"}
853 {script} {return "Script"}
854 {simulations} {return "Simulations"}
855 {solver} {return "Solver"}
856 {slv32767parms} {return "SolverGeneral"}
857 {toolbox} {return "Toolbox"}
858 {units} {return "Units"}
859 {ascplot} {return "AscPlot"}
860 {environment} {return "Environment"}
861 default {error "View_Get_Proc_Name called with bad option $window"}
862 }
863 }
864
865 #
866 # proc View_Save_Values {}
867 #------------------------------------------------------------------------
868 # save ascend.ad overwriting the previous file. It does not store values
869 # for windows which are created only when needed, like ascplot, utilities
870 # matrix, and debugger. The viewoptions for those windows are saved when
871 # one closes them after using them
872 #------------------------------------------------------------------------
873 proc View_Save_Values {} {
874
875 global env ascGlobalVect
876
877 set window_list [list \
878 browser display global library \
879 probe script simulations solver slv32767parms \
880 toolbox units environment
881 ]
882 set outfile $ascGlobalVect(userhome)/ascend.ad
883 if {[catch {set ascendfile [open $outfile w]} ]} {
884 puts "Error writing $outfile."
885 return
886 }
887
888 puts $ascendfile "\#"
889 puts $ascendfile "\# This is a generated file containing the Tcl code for"
890 puts $ascendfile "\# the assignment of the Application defaults."
891 catch {
892 puts $ascendfile "\# Saved [clock format [clock clicks]] on [info hostname]"
893 }
894 puts $ascendfile "\#"
895 puts $ascendfile " "
896
897 puts $ascendfile "\# Appearance Settings"
898 foreach win $window_list {
899 set windowproc [View_Get_Proc_Name $win]
900 set option_list [View_Appearance $win]
901 foreach opt $option_list {
902 set value [$windowproc $opt]
903 if {$opt == "geometry"} {
904 if {[wm state [$windowproc windowname]] != "withdrawn" } {
905 set value [wm geometry [$windowproc windowname]]
906 }
907 }
908 puts $ascendfile "$windowproc $opt $value"
909 }
910 }
911 puts $ascendfile "\# Behavior Option Settings"
912 foreach win $window_list {
913 set windowproc [View_Get_Proc_Name $win]
914 set option_list [View_Options $win]
915 foreach opt $option_list {
916 set value [$windowproc $opt]
917 puts $ascendfile "$windowproc $opt $value"
918 }
919 }
920 puts $ascendfile "set readoptions OK"
921 close $ascendfile
922 puts stdout "Wrote ascend.ad file $outfile."
923
924 # write appearances, global, script options
925 Script_do_SaveOptions
926
927 # write misc options
928 View_Save_Window_Options browser
929 View_Save_Window_Options display
930 View_Save_Window_Options library
931
932 # write solver options
933 View_Save_Solvers_Params
934 }
935
936 # proc View_InitDialog {}
937 #-------------------------
938 # init vector to control
939 # info save.
940 #-------------------------
941 proc View_InitDialog {} {
942 global ascViewSaveVect
943 global tcl_platform ascViewSaveVect env
944
945 set ascViewSaveVect(grab) 0
946 set ascViewSaveVect(cancellable) 1
947 set ascViewSaveVect(entrywidth) 20
948 set ascViewSaveVect(npages) 1
949 set ascViewSaveVect(toplevel) .viewsaveconfig
950 set ascViewSaveVect(title) "Save options for all windows"
951 set ascViewSaveVect(helpcommand) {View_Help}
952 set ascViewSaveVect(whenokcommand) {View_Save_Interface_Values}
953 set ascViewSaveVect(namelist) [list \
954 windowpositions \
955 fonts \
956 colors \
957 solversparams \
958 ]
959 set ascViewSaveVect(windowpositions) 1
960 set ascViewSaveVect(fonts) 1
961 set ascViewSaveVect(colors) 1
962 set ascViewSaveVect(solversparams) 1
963 set ascViewSaveVect(windowpositions.label) "Save window placements"
964 set ascViewSaveVect(fonts.label) "Save current font selections"
965 set ascViewSaveVect(colors.label) "Save current color selections"
966 set ascViewSaveVect(solversparams.label) "Save solvers parameters"
967 set ascViewSaveVect(windowpositions.type) bool
968 set ascViewSaveVect(fonts.type) bool
969 set ascViewSaveVect(colors.type) bool
970 set ascViewSaveVect(solversparams.type) bool
971
972 }
973
974 #
975 # The following procedures are used to set the values specific to
976 # a individual windows
977 #
978 #
979
980 # proc View_WindowInitDialog {}
981 #-------------------------
982 # init vector to control save information for specific window
983 # info save.
984 #-------------------------
985 proc View_WindowInitDialog {window} {
986 global ascViewSaveWindowVect
987
988 set ascViewSaveWindowVect(grab) 0
989 set ascViewSaveWindowVect(cancellable) 1
990 set ascViewSaveWindowVect(entrywidth) 20
991 set ascViewSaveWindowVect(npages) 1
992 set ascViewSaveWindowVect(toplevel) .viewsavewindow
993 set ascViewSaveWindowVect(title) "Save window options"
994 set ascViewSaveWindowVect(helpcommand) {View_Help}
995 set ascViewSaveWindowVect(whenokcommand) "View_Save_Window_Appearance $window"
996 set ascViewSaveWindowVect(namelist) [list \
997 windowpositions \
998 fonts \
999 colors \
1000 ]
1001 set ascViewSaveWindowVect(windowpositions) 1
1002 set ascViewSaveWindowVect(fonts) 1
1003 set ascViewSaveWindowVect(colors) 1
1004 set ascViewSaveWindowVect(windowpositions.label) "Save window placements"
1005 set ascViewSaveWindowVect(fonts.label) "Save current font selections"
1006 set ascViewSaveWindowVect(colors.label) "Save current color selections"
1007 set ascViewSaveWindowVect(windowpositions.type) bool
1008 set ascViewSaveWindowVect(fonts.type) bool
1009 set ascViewSaveWindowVect(colors.type) bool
1010 }
1011
1012
1013 #
1014 # proc View_Set_Save_Options {window}
1015 #------------------------------------------------------------------------
1016 # Ask for the selection of the values to to be saved.
1017 # saves the appearances.
1018 #------------------------------------------------------------------------
1019 proc View_Set_Save_Options {window} {
1020 global ascBrowVect ascDebuVect ascDispVect ascGlobalVect ascLibrVect
1021 global ascMtxVect ascProbVect ascScripVect ascSimsVect ascSolvVect
1022 global ascToolVect ascUnitVect ascplotvect env
1023 global ascViewWindowVect
1024 global ascViewSaveWindowVect
1025 global ascParPageVect
1026
1027 Set_ViewVect_Values
1028 Set_View_Option_Values
1029 View_WindowInitDialog $window
1030
1031 # set vectorname $ascViewWindowVect($window)
1032 # ascParPage ascViewSaveWindowVect [setpos [set [set vectorname](windowname)] 0 0] 1 0
1033 # just do it for appearances only
1034 View_Save_Window_Appearance $window
1035 }
1036
1037
1038 #
1039 # proc View_Save_Window_Appearance {window}
1040 #------------------------------------------------------------------------
1041 # save window.a4o appearance options overwriting the previous file
1042 #------------------------------------------------------------------------
1043 proc View_Save_Window_Appearance {window} {
1044
1045 global ascViewSaveWindowVect ascGlobalVect
1046 set outfile $ascGlobalVect(userhome)/$window.a4o
1047 if {[catch {set ascendfile [open $outfile w]} ]} {
1048 puts "Error writing $outfile "
1049 return
1050 }
1051 if {![info exists ascViewSaveWindowVect(fonts)]} {
1052 set ascViewSaveWindowVect(fonts) 1
1053 }
1054 if {![info exists ascViewSaveWindowVect(colors)]} {
1055 set ascViewSaveWindowVect(colors) 1
1056 }
1057 if {![info exists ascViewSaveWindowVect(windowpositions)]} {
1058 set ascViewSaveWindowVect(windowpositions) 1
1059 }
1060
1061 set windowproc [View_Get_Proc_Name $window]
1062 set option_list [View_Appearance $window]
1063
1064 puts $ascendfile "set read_appearance error-$window"
1065 foreach opt $option_list {
1066 set value [$windowproc $opt]
1067
1068 if {[string first "font" [string tolower $opt]] != -1} {
1069 if {$ascViewSaveWindowVect(fonts) == 0} {
1070 continue;
1071 }
1072 }
1073
1074 if { $opt == "bg" || $opt == "fg" ||
1075 $opt == "abg" || $opt == "afg" ||
1076 $opt == "sbg" || $opt == "sfg" ||
1077 $opt == "tbg" || $opt == "tfg" } {
1078 if {$ascViewSaveWindowVect(colors) == 0} {
1079 continue;
1080 }
1081 }
1082
1083 if {$opt == "geometry" || $opt == "minsize" || $opt == "maxsize"} {
1084 if {$ascViewSaveWindowVect(windowpositions) == 0} {
1085 continue;
1086 }
1087 if {$opt == "geometry"} {
1088 if {[wm state [$windowproc windowname]] != "withdrawn" } {
1089 set value1 [wm geometry [$windowproc windowname]]
1090 # disallow saving negative window positions. flip signs.
1091 regsub -all -- - $value1 + value
1092 }
1093 }
1094 }
1095
1096 puts $ascendfile "$windowproc $opt $value"
1097 }
1098
1099 catch {
1100 puts $ascendfile "\# Saved [clock format [clock clicks]] on [info hostname]"
1101 }
1102 puts $ascendfile "update"
1103 puts $ascendfile "set read_appearance OK"
1104 close $ascendfile
1105 puts stdout "Wrote $window appearance file $outfile."
1106
1107 set ascViewSaveWindowVect(fonts) 1
1108
1109 return
1110 }
1111
1112 #
1113 # proc View_Save_Window_Options {window}
1114 #------------------------------------------------------------------------
1115 # save window_opt.a4o appearance options overwriting the previous file
1116 #------------------------------------------------------------------------
1117 proc View_Save_Window_Options {window} {
1118
1119 global ascViewSaveWindowVect ascGlobalVect
1120 set outfile $ascGlobalVect(userhome)/${window}_opt.a4o
1121 if {[catch {set ascendfile [open $outfile w]} ]} {
1122 puts "Error writing $outfile "
1123 return
1124 }
1125
1126 set windowproc [View_Get_Proc_Name $window]
1127 set option_list [View_Options $window]
1128
1129 foreach opt $option_list {
1130 set value [$windowproc $opt]
1131 puts $ascendfile "$windowproc $opt $value"
1132 }
1133
1134 catch {
1135 puts $ascendfile "\# Saved [clock format [clock clicks]] on [info hostname]"
1136 }
1137 puts $ascendfile "update"
1138 puts $ascendfile "set read_options OK"
1139 close $ascendfile
1140 puts stdout "Wrote $window options file $outfile."
1141
1142 return
1143 }
1144
1145 #
1146 # proc View_Save_SpecialWindow_Values {opt_win}
1147 #------------------------------------------------------------------------
1148 # save opt_win.a4o overwriting the previous file. This function should
1149 # be called only for those windows which are dynamically created:
1150 # Matrix, ascplot and debugger. It is also
1151 # used for environment vectors like env and global. The window utilities
1152 # already have its own save options button.
1153 #------------------------------------------------------------------------
1154 proc View_Save_SpecialWindow_Values {opt_win} {
1155 entertrace
1156
1157 global ascViewSaveVect
1158 global ascGlobalVect
1159
1160 if {$ascGlobalVect(saveoptions) == 0} {
1161 return
1162 }
1163 set outfile $ascGlobalVect(userhome)/$opt_win.a4o
1164 if {[catch {set ascendfile [open $outfile w]} ]} {
1165 puts "Error writing $outfile "
1166 return
1167 }
1168
1169 set windowproc [View_Get_Proc_Name $opt_win]
1170 set option_list [View_Appearance $opt_win]
1171 if {![info exists ascViewSaveVect(colors)]} {
1172 set ascViewSaveVect(colors) 1
1173 }
1174 if {![info exists ascViewSaveVect(fonts)]} {
1175 set ascViewSaveVect(fonts) 1
1176 }
1177 if {![info exists ascViewSaveVect(windowpositions)]} {
1178 set ascViewSaveVect(windowpositions) 1
1179 }
1180
1181 foreach opt $option_list {
1182 set value [$windowproc $opt]
1183
1184 if {$opt == "font" || $opt == "labelfont"
1185 || $opt == "textfont" || $opt == "titlefont" || $opt == "btnfont"
1186 || $opt == "entryFont" || $opt == "textFont" } {
1187 if {$ascViewSaveVect(fonts) == 0} {
1188 continue;
1189 }
1190 }
1191
1192 if { $opt == "bg" || $opt == "fg" ||
1193 $opt == "abg" || $opt == "afg" ||
1194 $opt == "sbg" || $opt == "sfg" ||
1195 $opt == "tbg" || $opt == "tfg" } {
1196 if {$ascViewSaveVect(colors) == 0} {
1197 continue;
1198 }
1199 }
1200
1201 if {$opt == "geometry" || $opt == "minsize" || $opt == "maxsize"} {
1202 if {$ascViewSaveVect(windowpositions) == 0} {
1203 continue;
1204 }
1205 if {$opt == "geometry"} {
1206 if {[wm state [$windowproc windowname]] != "withdrawn" } {
1207 set value [wm geometry [$windowproc windowname]]
1208 }
1209 }
1210 }
1211
1212 puts $ascendfile "$windowproc $opt $value"
1213 }
1214
1215 puts $ascendfile "set readoptions OK"
1216 close $ascendfile
1217 puts stdout "Wrote $opt_win options file $outfile."
1218
1219 return
1220
1221 leavetrace
1222 }
1223
1224 #
1225 # proc View_Save_Windows_Values {}
1226 #------------------------------------------------------------------------
1227 # save files *.a4o for all of the windows in the window list
1228 #------------------------------------------------------------------------
1229 proc View_Save_Windows_Values {} {
1230 entertrace
1231 global env
1232
1233 set window_list [list \
1234 browser display library \
1235 probe script solver units toolbox
1236 ]
1237
1238 foreach window $window_list {
1239 View_Save_Window_Appearance $window
1240 }
1241
1242 return
1243 leavetrace
1244 }
1245
1246
1247 #
1248 # proc View_Save_Interface_Values {}
1249 #------------------------------------------------------------------------
1250 # save current interface settings
1251 #------------------------------------------------------------------------
1252 proc View_Save_Interface_Values {} {
1253 entertrace
1254 global ascViewSaveVect ascViewSaveWindowVect
1255
1256 set ascViewSaveWindowVect(fonts) 1
1257 set ascViewSaveWindowVect(windowpositions) 1
1258 set ascViewSaveWindowVect(colors) 1
1259
1260 catch {
1261 set ascViewSaveWindowVect(fonts) $ascViewSaveVect(fonts)
1262 set ascViewSaveWindowVect(windowpositions) \
1263 $ascViewSaveVect(windowpositions)
1264 set ascViewSaveWindowVect(colors) $ascViewSaveVect(colors)
1265 }
1266
1267 # View_Save_Values
1268 View_Save_SpecialWindow_Values global
1269 View_Save_Windows_Values
1270 # catch those options which don't have buttons for saving yet.
1271 View_Save_Window_Options global
1272 View_Save_Window_Options script
1273
1274 return
1275 leavetrace
1276 }
1277
1278 #
1279 # proc View_Save_Solver_Params {number}
1280 #------------------------------------------------------------------------
1281 # save solverx_params.a4o overwriting the previous file
1282 #------------------------------------------------------------------------
1283 proc View_Save_Solver_Params {number} {
1284 entertrace
1285 global ascSolvVect
1286 set name $ascSolvVect(name.$number)
1287 global ascSolv${name}Vect ascGlobalVect
1288 set outfile $ascGlobalVect(userhome)/${name}params.a4o
1289 if {[catch {set ascendfile [open $outfile w]} ]} {
1290 puts "Error writing $outfile "
1291 return
1292 }
1293
1294 puts $ascendfile "global ascSolv${name}Vect"
1295
1296 set par_list [set ascSolv${name}Vect(namelist) ]
1297
1298 foreach par $par_list {
1299 set value [ set ascSolv${name}Vect($par) ]
1300 puts $ascendfile "set ascSolv${name}Vect($par) $value"
1301 }
1302
1303 puts $ascendfile "set readoptions OK"
1304 close $ascendfile
1305 puts "Wrote ${name}params options file $outfile."
1306
1307 return
1308 leavetrace
1309 }
1310
1311
1312 #
1313 # proc View_Save_Solvers_Params {}
1314 #------------------------------------------------------------------------
1315 # save solvers_params.a4o overwriting the previous file
1316 #------------------------------------------------------------------------
1317 proc View_Save_Solvers_Params {} {
1318 entertrace
1319 global ascSolvVect
1320
1321 set number $ascSolvVect(numberofsolvers)
1322
1323 for {set j 0} {$j < $number} {incr j} {
1324 set solver $j
1325 View_Save_Solver_Params $solver
1326 }
1327 View_Save_Window_Options solver
1328 View_Save_Window_Options slv32767parms
1329 return
1330 leavetrace
1331 }
1332
1333 #
1334 # proc View_Source_Option_Files {}
1335 #------------------------------------------------------------------------
1336 # source option files
1337 #------------------------------------------------------------------------
1338 proc View_Source_Option_Files {} {
1339 entertrace
1340
1341 global ascGlobalVect errorInfo
1342 set file_list [list \
1343 global browser debugger display library \
1344 probe script solver slv32767parms toolbox units matrix ascplot \
1345 global_opt browser_opt debugger_opt display_opt library_opt \
1346 probe_opt script_opt solver_opt slv32767parms_opt \
1347 toolbox_opt units_opt matrix_opt \
1348 ascplot_opt
1349 ]
1350 foreach optionfile $file_list {
1351 set infile $ascGlobalVect(userhome)/${optionfile}.a4o
1352 if { [ file readable $infile ]} {
1353 if {[catch {asc_source $infile} aderror]} {
1354 } else {
1355 puts "source $infile"
1356 }
1357 # puts $aderror
1358 }
1359 }
1360 return
1361 leavetrace
1362 }
1363
1364 #
1365 # proc View_Source_Params_Files {}
1366 #------------------------------------------------------------------------
1367 # source solver option files
1368 #------------------------------------------------------------------------
1369 proc View_Source_Params_Files {} {
1370 entertrace
1371
1372 global ascSolvVect ascGlobalVect
1373
1374 set number $ascSolvVect(numberofsolvers)
1375
1376 for {set j 0} {$j < $number} {incr j} {
1377
1378 set name $ascSolvVect(name.$j)
1379 set optionfile ${name}params
1380
1381 set infile $ascGlobalVect(userhome)/${optionfile}.a4o
1382 if { [ file exists $infile ]} {
1383 if {[catch {asc_source $infile} aderror]} {
1384 } else {
1385 puts "source $infile"
1386 }
1387 # puts $aderror
1388 }
1389 }
1390 return
1391 leavetrace
1392 }
1393
1394 #
1395 # proc View_Help {}
1396 #------------------------------------------------------------------------
1397 # source solver option files
1398 #------------------------------------------------------------------------
1399 proc View_Help {} {
1400 entertrace
1401
1402 bell
1403 puts "No help available for Save options"
1404
1405 return
1406 leavetrace
1407 }

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