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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 538 - (show annotations) (download) (as text)
Tue Apr 25 22:49:54 2006 UTC (14 years, 6 months ago) by ben.allan
File MIME type: text/x-tcl
File size: 9629 byte(s)
tk84 is at least contemplatable now. don't know
what other errors lurk.
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 tk_version
139 if {$tcl_platform(platform) == "unix"} {
140 switch $tk_version {
141 8.5 -
142 8.4 {
143 puts "source $env(ASCENDTK)/templates/asctkfbox84.tcl"
144 asc_source "$env(ASCENDTK)/templates/asctkfbox84.tcl"
145 }
146 default {
147 puts "source $env(ASCENDTK)/templates/asctkfbox.tcl"
148 asc_source "$env(ASCENDTK)/templates/asctkfbox.tcl"
149 }
150 }
151 }
152 puts "source $env(ASCENDTK)/templates/ascdialog.tcl"
153 asc_source "$env(ASCENDTK)/templates/ascdialog.tcl"
154 puts "source $env(ASCENDTK)/templates/ascMsgBox.tcl"
155 asc_source "$env(ASCENDTK)/templates/ascMsgBox.tcl"
156 puts "source $env(ASCENDTK)/ascplotproc.tcl"
157 asc_source "$env(ASCENDTK)/ascplotproc.tcl"
158 puts "source $env(ASCENDTK)/ascplot.tcl"
159 asc_source "$env(ASCENDTK)/ascplot.tcl"
160 puts "source $env(ASCENDTK)/mergedat.tcl"
161 asc_source "$env(ASCENDTK)/mergedat.tcl"
162 puts "source $env(ASCENDTK)/ascStudy.tcl"
163 asc_source "$env(ASCENDTK)/ascStudy.tcl"
164 puts "source $env(ASCENDTK)/callback.tcl"
165 asc_source "$env(ASCENDTK)/callback.tcl"
166 puts "source $env(ASCENDTK)/notebox.tcl"
167 asc_source "$env(ASCENDTK)/notebox.tcl"
168 }
169
170
171 # Create a temporary EXIT command so that if something goes
172 # wrong during startup, we can still exit the application.
173 # If startup goes well, this EXIT will be overwritten by the
174 # one in ScriptProc.tcl
175 #
176 if {[info command EXIT] == ""} {
177 proc EXIT {args} {
178 catch {destroy .}
179 catch {user_shutdown}
180 return;
181 }
182 }
183
184 proc mcgraw_notice {} {
185 puts "\n% The authors of ASCEND thank McGraw-Hill for permission to"
186 puts "% distribute the database from Reid, Prausnitz, and Poling"
187 puts "% Properties of Liquids and Gases, 4th Edition (RPP)"
188 puts "% http://www.bookstore.mcgraw-hill.com"
189 puts "% via the World Wide Web as part of ASCEND IV."
190 puts "% RPP is copyright 1987, The McGraw-Hill Companies"
191 }
192
193 proc balloon_notice {} {
194 puts "\n# balloon.tcl - procedures used by balloon help from vTcl."
195 puts "# Copyright (C) 1996-1998 Stewart Allen"
196 puts "# Modified and used in compliance with the GNU License 2.0 or later."
197 puts "# See the ASCEND License for details."
198
199 }
200
201 global env
202 AscGnuButton
203
204
205 #stuff that has to be set before windows are shown goes in set_global_defaults
206 # which is in GlobalProc.tcl.
207 # i.e. flags that check for whether features are available that are used
208 # determine button states, or toplevel existences.
209 #
210 # load delayed window instantiation code [ proc awin ] is in GlobalProc too
211
212 puts "source $env(ASCENDTK)/GlobalProc.tcl"
213 source "$env(ASCENDTK)/GlobalProc.tcl"
214 set_Global_Defaults
215 Glob_do_GNU
216
217 # main sources the window definitions
218 # main also sources some needed templates in generalk.tcl
219 puts "source $env(ASCENDTK)/main.tcl"
220 source "$env(ASCENDTK)/main.tcl"
221
222 puts "tk sourced"
223
224
225 # The plot window and the solver window require the
226 # TkTable exension package by Roland King
227 # mthomas 98.05.07: require 1.8 until we debug the memory errors in 2.0
228 if {[catch {package require Tktable 2.8} err]} {
229 # print a message to stderr since a catch further up the call stack
230 # eats the call to "error"
231 puts stderr "ASCEND cannot locate the tkTable package."
232 puts stderr "internal message: $err"
233 puts stderr "tck_pkgPath: $tcl_pkgPath"
234 puts stderr "auto_path: $auto_path"
235 error "ASCEND cannot locate the tkTable package.\ninternal message: $err"
236 }
237
238
239 # load separate templates for transient toplevels
240 # must be done before buttons using those templates are wired via
241 # global variable vectors
242 ###puts "NOT LOADING TEMPLATES"
243 load_Templates
244 puts "templates loaded"
245
246 # configure swiped widgets: set_Template_defaults
247 # routine is in GlobalProc.tcl
248 set_Template_defaults
249
250 # Load button smarts files. Each file is responsible for checking
251 # existence of its needed global variables (i.e. do the
252 # initialization of things at the top of the *Proc.tcl
253 global ascGlobalVect
254 # puts "[info commands awin] w_load = $ascGlobalVect(w_load)"
255 #
256 # Switch to determine whether to load all the windows or no.
257 if {$ascGlobalVect(w_load)} {
258 puts "All windows will be loaded"
259 awin all
260 } {
261 puts "Nowindows will be loaded"
262 }
263 # load in .ascend-config
264 puts "Reading utilities"
265 Util_do_Read
266 puts stdout "Interface Loaded."
267
268 global ascSourceVect
269 if {$ascSourceVect(errcount)} {
270 puts stderr "'parray ascSourceVect' to review error messages."
271 }
272 #
273 # Giving the location of the directory in which the user options
274 # are saved (if it exists)
275 #
276 if {$ascGlobalVect(saveoptions) == 1} {
277 puts stdout " "
278 puts stdout "-----------------------------------"
279 puts stdout "User data directory is $ascGlobalVect(userhome)"
280 puts stdout "-----------------------------------"
281 puts stdout " "
282 }
283
284 # try to straighten out iconnames
285 asc_fixiconnames
286
287 balloon_notice
288 mcgraw_notice
289 # bind help to buttons
290 #>>Help_BindAllM3
291
292

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