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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 89 - (hide annotations) (download) (as text)
Wed Dec 7 15:44:43 2005 UTC (14 years, 11 months ago) by johnpye
File MIME type: text/x-tcl
File size: 9403 byte(s)
Small changes to eliminate GCC warnings
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 johnpye 89 if {[catch {package require Tktable 2.8} err]} {
220 aw0a 1 # 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 johnpye 89 puts stderr "tck_pkgPath: $tcl_pkgPath"
225     puts stderr "auto_path: $auto_path"
226 aw0a 1 error "ASCEND cannot locate the tkTable package.\ninternal message: $err"
227     }
228    
229    
230     # load separate templates for transient toplevels
231     # must be done before buttons using those templates are wired via
232     # global variable vectors
233     ###puts "NOT LOADING TEMPLATES"
234     load_Templates
235     puts "templates loaded"
236    
237     # configure swiped widgets: set_Template_defaults
238     # routine is in GlobalProc.tcl
239     set_Template_defaults
240    
241     # Load button smarts files. Each file is responsible for checking
242     # existence of its needed global variables (i.e. do the
243     # initialization of things at the top of the *Proc.tcl
244     global ascGlobalVect
245     # puts "[info commands awin] w_load = $ascGlobalVect(w_load)"
246     #
247     # Switch to determine whether to load all the windows or no.
248     if {$ascGlobalVect(w_load)} {
249     puts "All windows will be loaded"
250     awin all
251     } {
252     puts "Nowindows will be loaded"
253     }
254     # load in .ascend-config
255     puts "Reading utilities"
256     Util_do_Read
257     puts stdout "Interface Loaded."
258    
259     global ascSourceVect
260     if {$ascSourceVect(errcount)} {
261     puts stderr "'parray ascSourceVect' to review error messages."
262     }
263     #
264     # Giving the location of the directory in which the user options
265     # are saved (if it exists)
266     #
267     if {$ascGlobalVect(saveoptions) == 1} {
268     puts stdout " "
269     puts stdout "-----------------------------------"
270     puts stdout "User data directory is $ascGlobalVect(userhome)"
271     puts stdout "-----------------------------------"
272     puts stdout " "
273     }
274    
275     # try to straighten out iconnames
276     asc_fixiconnames
277    
278     balloon_notice
279     mcgraw_notice
280     # bind help to buttons
281     #>>Help_BindAllM3
282    
283    

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