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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide 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 aw0a 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