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

Annotation of /trunk/tcltk98/TK/ascend.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (hide annotations) (download) (as text)
Sat Nov 13 16:40:11 2004 UTC (16 years ago) by aw0a
File MIME type: text/x-tcl
File size: 9320 byte(s)
try again to commit moving tcl stuff
1 aw0a 1 # ascend.tcl: startup tcl code for ASCEND called via the .ascendrc
2     # by Benjamin A. Allan and Kirk A. Abbott
3     # Created: January 1994
4     # Part of ASCEND
5     # Revision: $Revision: 1.43 $
6     # Last modified on: $Date: 2003/02/06 04:08:26 $
7     # Last modified by: $Author: ballan $
8     # Revision control file: $RCSfile: ascend.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     # startup tcl code for ASCEND called via the .ascendrc sourced in the binary
30     #
31     # Global init file for windows configurations, button configurations, var inits
32     # assumes toplevel windows have not already been created
33     #
34     # all procedures called at the bottom.
35     #
36    
37     proc AscGnuButton {} {
38     global env
39     # pack widget .
40     wm positionfrom . user
41     wm geometry . 1x1
42     wm sizefrom . ""
43     wm iconname . "Ascend IV Information"
44     wm protocol . WM_DELETE_WINDOW {EXIT}
45     wm title . {Ascend IV}
46     wm withdraw .
47     }
48    
49     proc Help {{arg1 ""} args} {
50     if {[catch {set foo [help "$arg1"]} msg]} {
51     puts stdout $msg
52     } else {
53     foreach i $foo {
54     puts stdout "$i"
55     }
56     }
57     }
58    
59     # stupid little function to get around the brain-deadisms that
60     # source possesses in tcl8
61     proc asc_source {file} {
62     global ascSourceVect errorInfo
63     if {![info exists ascSourceVect(count)]} {
64     set ascSourceVect(count) 0
65     set ascSourceVect(errcount) 0
66     set ascSourceVect(tails) {}
67     }
68     incr ascSourceVect(count)
69     set fn $ascSourceVect(count)
70     set ascSourceVect($fn) $file
71     set ascSourceVect($fn,error) none
72     if {![file readable $file]} {
73     incr ascSourceVect(errcount)
74     puts stderr "*** Unable to open ${fn}th sourced file $file"
75     puts stderr "*** ASCEND probably will not work well without it."
76     set ascSourceVect($fn,error) $errorInfo
77     return
78     }
79     append ascSourceVect(tails) \n[file tail $file]
80     if {[catch {source $file} err]} {
81     incr ascSourceVect(errcount)
82     set ascSourceVect($fn,error) $errorInfo
83     puts stderr "*** Error while loading $file:"
84     puts stderr $err
85     puts stderr "* details *"
86     puts stderr $ascSourceVect($fn,error)
87     puts stderr "******"
88     }
89     }
90    
91     #
92     # methods to test global var setting/reading when all else fails
93     # during startup or later. Would be nice to activate these from
94     # the Internal window
95     #
96     proc trace_var {a s} {
97     global $a
98     if {![info exists ${a}($s)]} {
99     puts stderr "Trace: init trace on ${a}($s)"
100     set ${a}($s) {}
101     }
102     trace variable ${a}($s) w trace_log
103     trace variable ${a}($s) r trace_log
104     trace variable ${a}($s) u trace_log
105     trace variable $a u trace_log
106     }
107    
108     proc trace_log {n1 n2 op} {
109     puts stderr "Trace: $n1 $n2 $op"
110     if {$op == "w"} { global $n1; puts "New value: [set ${n1}($n2)]" }
111     }
112    
113     proc load_Templates {} {
114     global env
115     puts "loading templates from $env(ASCENDTK)/templates/"
116     puts "source $env(ASCENDTK)/templates/AscMonoEntry1.t"
117     asc_source "$env(ASCENDTK)/templates/AscMonoEntry1.t"
118     puts "source $env(ASCENDTK)/templates/AscMonoEntry2.t"
119     asc_source "$env(ASCENDTK)/templates/AscMonoEntry2.t"
120     puts "source $env(ASCENDTK)/templates/AscMonoEntry4.t"
121     asc_source "$env(ASCENDTK)/templates/AscMonoEntry4.t"
122     puts "source $env(ASCENDTK)/templates/AscConfirm.t"
123     asc_source "$env(ASCENDTK)/templates/AscConfirm.t"
124     puts "source $env(ASCENDTK)/templates/ascfontsel.tcl"
125     asc_source "$env(ASCENDTK)/templates/ascfontsel.tcl"
126     puts "source $env(ASCENDTK)/templates/balloon.tcl"
127     asc_source "$env(ASCENDTK)/templates/balloon.tcl"
128     puts "source $env(ASCENDTK)/templates/ascparm.tcl"
129     asc_source "$env(ASCENDTK)/templates/ascparm.tcl"
130     puts "source $env(ASCENDTK)/templates/ascKeepOnTop.tcl"
131     asc_source "$env(ASCENDTK)/templates/ascKeepOnTop.tcl"
132     puts "source $env(ASCENDTK)/templates/ascListSelect.tcl"
133     asc_source "$env(ASCENDTK)/templates/ascListSelect.tcl"
134     puts "source $env(ASCENDTK)/templates/ascListSelectB1.tcl"
135     asc_source "$env(ASCENDTK)/templates/ascListSelectB1.tcl"
136     puts "source $env(ASCENDTK)/templates/amlscroll.tcl"
137     asc_source "$env(ASCENDTK)/templates/amlscroll.tcl"
138     global tcl_platform
139     if {$tcl_platform(platform) == "unix"} {
140     puts "source $env(ASCENDTK)/templates/asctkfbox.tcl"
141     asc_source "$env(ASCENDTK)/templates/asctkfbox.tcl"
142     }
143     puts "source $env(ASCENDTK)/templates/ascdialog.tcl"
144     asc_source "$env(ASCENDTK)/templates/ascdialog.tcl"
145     puts "source $env(ASCENDTK)/templates/ascMsgBox.tcl"
146     asc_source "$env(ASCENDTK)/templates/ascMsgBox.tcl"
147     puts "source $env(ASCENDTK)/ascplotproc.tcl"
148     asc_source "$env(ASCENDTK)/ascplotproc.tcl"
149     puts "source $env(ASCENDTK)/ascplot.tcl"
150     asc_source "$env(ASCENDTK)/ascplot.tcl"
151     puts "source $env(ASCENDTK)/mergedat.tcl"
152     asc_source "$env(ASCENDTK)/mergedat.tcl"
153     puts "source $env(ASCENDTK)/ascStudy.tcl"
154     asc_source "$env(ASCENDTK)/ascStudy.tcl"
155     puts "source $env(ASCENDTK)/callback.tcl"
156     asc_source "$env(ASCENDTK)/callback.tcl"
157     puts "source $env(ASCENDTK)/notebox.tcl"
158     asc_source "$env(ASCENDTK)/notebox.tcl"
159     }
160    
161    
162     # Create a temporary EXIT command so that if something goes
163     # wrong during startup, we can still exit the application.
164     # If startup goes well, this EXIT will be overwritten by the
165     # one in ScriptProc.tcl
166     #
167     if {[info command EXIT] == ""} {
168     proc EXIT {args} {
169     catch {destroy .}
170     catch {user_shutdown}
171     return;
172     }
173     }
174    
175     proc mcgraw_notice {} {
176     puts "\n% The authors of ASCEND thank McGraw-Hill for permission to"
177     puts "% distribute the database from Reid, Prausnitz, and Poling"
178     puts "% Properties of Liquids and Gases, 4th Edition (RPP)"
179     puts "% http://www.bookstore.mcgraw-hill.com"
180     puts "% via the World Wide Web as part of ASCEND IV."
181     puts "% RPP is copyright 1987, The McGraw-Hill Companies"
182     }
183    
184     proc balloon_notice {} {
185     puts "\n# balloon.tcl - procedures used by balloon help from vTcl."
186     puts "# Copyright (C) 1996-1998 Stewart Allen"
187     puts "# Modified and used in compliance with the GNU License 2.0 or later."
188     puts "# See the ASCEND License for details."
189    
190     }
191    
192     global env
193     AscGnuButton
194    
195    
196     #stuff that has to be set before windows are shown goes in set_global_defaults
197     # which is in GlobalProc.tcl.
198     # i.e. flags that check for whether features are available that are used
199     # determine button states, or toplevel existences.
200     #
201     # load delayed window instantiation code [ proc awin ] is in GlobalProc too
202    
203     puts "source $env(ASCENDTK)/GlobalProc.tcl"
204     source "$env(ASCENDTK)/GlobalProc.tcl"
205     set_Global_Defaults
206     Glob_do_GNU
207    
208     # main sources the window definitions
209     # main also sources some needed templates in generalk.tcl
210     puts "source $env(ASCENDTK)/main.tcl"
211     source "$env(ASCENDTK)/main.tcl"
212    
213     puts "tk sourced"
214    
215    
216     # The plot window and the solver window require the
217     # TkTable exension package by Roland King
218     # mthomas 98.05.07: require 1.8 until we debug the memory errors in 2.0
219     if {[catch {package require Tktable } err]} {
220     # print a message to stderr since a catch further up the call stack
221     # eats the call to "error"
222     puts stderr "ASCEND cannot locate the tkTable package."
223     puts stderr "internal message: $err"
224     error "ASCEND cannot locate the tkTable package.\ninternal message: $err"
225     }
226    
227    
228     # load separate templates for transient toplevels
229     # must be done before buttons using those templates are wired via
230     # global variable vectors
231     ###puts "NOT LOADING TEMPLATES"
232     load_Templates
233     puts "templates loaded"
234    
235     # configure swiped widgets: set_Template_defaults
236     # routine is in GlobalProc.tcl
237     set_Template_defaults
238    
239     # Load button smarts files. Each file is responsible for checking
240     # existence of its needed global variables (i.e. do the
241     # initialization of things at the top of the *Proc.tcl
242     global ascGlobalVect
243     # puts "[info commands awin] w_load = $ascGlobalVect(w_load)"
244     #
245     # Switch to determine whether to load all the windows or no.
246     if {$ascGlobalVect(w_load)} {
247     puts "All windows will be loaded"
248     awin all
249     } {
250     puts "Nowindows will be loaded"
251     }
252     # load in .ascend-config
253     puts "Reading utilities"
254     Util_do_Read
255     puts stdout "Interface Loaded."
256    
257     global ascSourceVect
258     if {$ascSourceVect(errcount)} {
259     puts stderr "'parray ascSourceVect' to review error messages."
260     }
261     #
262     # Giving the location of the directory in which the user options
263     # are saved (if it exists)
264     #
265     if {$ascGlobalVect(saveoptions) == 1} {
266     puts stdout " "
267     puts stdout "-----------------------------------"
268     puts stdout "User data directory is $ascGlobalVect(userhome)"
269     puts stdout "-----------------------------------"
270     puts stdout " "
271     }
272    
273     # try to straighten out iconnames
274     asc_fixiconnames
275    
276     balloon_notice
277     mcgraw_notice
278     # bind help to buttons
279     #>>Help_BindAllM3
280    
281    

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