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 |
ben.allan |
538 |
global tcl_platform tk_version |
139 |
aw0a |
1 |
if {$tcl_platform(platform) == "unix"} { |
140 |
ben.allan |
538 |
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 |
aw0a |
1 |
} |
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 |
johnpye |
89 |
if {[catch {package require Tktable 2.8} err]} { |
229 |
aw0a |
1 |
# 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 |
johnpye |
89 |
puts stderr "tck_pkgPath: $tcl_pkgPath" |
234 |
|
|
puts stderr "auto_path: $auto_path" |
235 |
aw0a |
1 |
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 |
|
|
|