| 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 |
|
Parent Directory
| 
Revision Log