tcltk98/TK/ascend.tcl

#  ascend.tcl: startup tcl code for ASCEND called via the .ascendrc
#  by Benjamin A. Allan and Kirk A. Abbott
#  Created: January 1994
#  Part of ASCEND
#  Revision: $Revision: 1.43 $
#  Last modified on: $Date: 2003/02/06 04:08:26 $
#  Last modified by: $Author: ballan $
#  Revision control file: $RCSfile: ascend.tcl,v $
#
#  This file is part of the ASCEND Tcl/Tk Interface.
#
#  Copyright (C) 1994-1998 Carnegie Mellon University
#
#  The ASCEND Tcl/Tk Interface is free software; you can redistribute
#  it and/or modify it under the terms of the GNU General Public
#  License as published by the Free Software Foundation; either
#  version 2 of the License, or (at your option) any later version.
#
#  The ASCEND Tcl/Tk Interface is distributed in hope that it will be
#  useful, but WITHOUT ANY WARRANTY; without even the implied warranty
#  of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with the program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA.  Check the
#  file named COPYING.  COPYING is found in ../compiler.

# startup tcl code for ASCEND called via the .ascendrc sourced in the binary
#
# Global init file for windows configurations, button configurations, var inits
# assumes toplevel windows have  not  already been created
#
# all procedures called at the bottom.
#

proc AscGnuButton {} {
  global env
  # pack widget .
  wm positionfrom . user
  wm geometry . 1x1
  wm sizefrom . ""
  wm iconname . "Ascend IV Information"
  wm protocol . WM_DELETE_WINDOW {EXIT}
  wm title . {Ascend IV}
  wm withdraw .
}

proc Help {{arg1 ""} args} {
  if {[catch {set foo [help "$arg1"]} msg]} {
    puts stdout $msg
  } else {
    foreach i $foo {
      puts stdout "$i"
    }
  }
}

# stupid little function to get around the brain-deadisms that
# source possesses in tcl8
proc asc_source {file} {
  global ascSourceVect errorInfo
  if {![info exists ascSourceVect(count)]} {
    set ascSourceVect(count) 0
    set ascSourceVect(errcount) 0
    set ascSourceVect(tails) {}
  }
  incr ascSourceVect(count)
  set fn $ascSourceVect(count)
  set ascSourceVect($fn) $file
  set ascSourceVect($fn,error) none
  if {![file readable $file]} {
    incr ascSourceVect(errcount)
    puts stderr "*** Unable to open ${fn}th sourced file $file"
    puts stderr "*** ASCEND probably will not work well without it."
    set ascSourceVect($fn,error) $errorInfo
    return
  }
  append ascSourceVect(tails) \n[file tail $file]
  if {[catch {source $file} err]} {
    incr ascSourceVect(errcount)
    set ascSourceVect($fn,error) $errorInfo
    puts stderr "*** Error while loading $file:"
    puts stderr $err
    puts stderr "* details *"
    puts stderr $ascSourceVect($fn,error)
    puts stderr "******"
  }
}

#
# methods to test global var setting/reading when all else fails
# during startup or later. Would be nice to activate these from
# the Internal window
#
proc trace_var {a s} {
  global $a
  if {![info exists ${a}($s)]} {
    puts stderr "Trace: init trace on ${a}($s)"
    set ${a}($s) {}
  }
  trace variable  ${a}($s) w trace_log
  trace variable  ${a}($s) r trace_log
  trace variable  ${a}($s) u trace_log
  trace variable  $a u trace_log
}

proc trace_log {n1 n2 op} {
  puts stderr "Trace: $n1 $n2 $op"
  if {$op == "w"} { global $n1; puts "New value: [set ${n1}($n2)]" }
}

proc load_Templates {} {
  global env
  puts "loading templates from $env(ASCENDTK)/templates/"
  puts "source $env(ASCENDTK)/templates/AscMonoEntry1.t"
  asc_source "$env(ASCENDTK)/templates/AscMonoEntry1.t"
  puts "source $env(ASCENDTK)/templates/AscMonoEntry2.t"
  asc_source "$env(ASCENDTK)/templates/AscMonoEntry2.t"
  puts "source $env(ASCENDTK)/templates/AscMonoEntry4.t"
  asc_source "$env(ASCENDTK)/templates/AscMonoEntry4.t"
  puts "source $env(ASCENDTK)/templates/AscConfirm.t"
  asc_source "$env(ASCENDTK)/templates/AscConfirm.t"
  puts "source $env(ASCENDTK)/templates/ascfontsel.tcl"
  asc_source "$env(ASCENDTK)/templates/ascfontsel.tcl"
  puts "source $env(ASCENDTK)/templates/balloon.tcl"
  asc_source "$env(ASCENDTK)/templates/balloon.tcl"
  puts "source $env(ASCENDTK)/templates/ascparm.tcl"
  asc_source "$env(ASCENDTK)/templates/ascparm.tcl"
  puts "source $env(ASCENDTK)/templates/ascKeepOnTop.tcl"
  asc_source "$env(ASCENDTK)/templates/ascKeepOnTop.tcl"
  puts "source $env(ASCENDTK)/templates/ascListSelect.tcl"
  asc_source "$env(ASCENDTK)/templates/ascListSelect.tcl"
  puts "source $env(ASCENDTK)/templates/ascListSelectB1.tcl"
  asc_source "$env(ASCENDTK)/templates/ascListSelectB1.tcl"
  puts "source $env(ASCENDTK)/templates/amlscroll.tcl"
  asc_source "$env(ASCENDTK)/templates/amlscroll.tcl"
  global tcl_platform tk_version
  if {$tcl_platform(platform) == "unix"} {
    switch $tk_version {
    8.5 -
    8.4 {
        puts "source $env(ASCENDTK)/templates/asctkfbox84.tcl"
        asc_source "$env(ASCENDTK)/templates/asctkfbox84.tcl"
      }
    default  {
        puts "source $env(ASCENDTK)/templates/asctkfbox.tcl"
        asc_source "$env(ASCENDTK)/templates/asctkfbox.tcl"
      }
    }
  }
  puts "source $env(ASCENDTK)/templates/ascdialog.tcl"
  asc_source "$env(ASCENDTK)/templates/ascdialog.tcl"
  puts "source $env(ASCENDTK)/templates/ascMsgBox.tcl"
  asc_source "$env(ASCENDTK)/templates/ascMsgBox.tcl"
  puts "source $env(ASCENDTK)/ascplotproc.tcl"
  asc_source "$env(ASCENDTK)/ascplotproc.tcl"
  puts "source $env(ASCENDTK)/ascplot.tcl"
  asc_source "$env(ASCENDTK)/ascplot.tcl"
  puts "source $env(ASCENDTK)/mergedat.tcl"
  asc_source "$env(ASCENDTK)/mergedat.tcl"
  puts "source $env(ASCENDTK)/ascStudy.tcl"
  asc_source "$env(ASCENDTK)/ascStudy.tcl"
  puts "source $env(ASCENDTK)/callback.tcl"
  asc_source "$env(ASCENDTK)/callback.tcl"
  puts "source $env(ASCENDTK)/notebox.tcl"
  asc_source "$env(ASCENDTK)/notebox.tcl"
}


#  Create a temporary EXIT command so that if something goes
#  wrong during startup, we can still exit the application.
#  If startup goes well, this EXIT will be overwritten by the
#  one in ScriptProc.tcl
#
if {[info command EXIT] == ""} {
  proc EXIT {args} {
    catch {destroy .}
    catch {user_shutdown}
    return;
  }
}

proc mcgraw_notice {} {
  puts "\n% The authors of ASCEND thank McGraw-Hill for permission to"
  puts "% distribute the database from Reid, Prausnitz, and Poling"
  puts "% Properties of Liquids and Gases, 4th Edition (RPP)"
  puts "% http://www.bookstore.mcgraw-hill.com"
  puts "% via the World Wide Web as part of ASCEND IV."
  puts "% RPP is copyright 1987, The McGraw-Hill Companies"
}

proc balloon_notice {} {
puts "\n# balloon.tcl - procedures used by balloon help from vTcl."
puts "# Copyright (C) 1996-1998 Stewart Allen"
puts "# Modified and used in compliance with the GNU License 2.0 or later."
puts "# See the ASCEND License for details."

}

global env
AscGnuButton


#stuff that has to be set before windows are shown goes in set_global_defaults
# which is in GlobalProc.tcl.
# i.e. flags that check for whether features are available that are used
#  determine button states, or toplevel existences.
#
# load delayed window instantiation code [ proc awin ] is in GlobalProc too

puts "source $env(ASCENDTK)/GlobalProc.tcl"
source "$env(ASCENDTK)/GlobalProc.tcl"
set_Global_Defaults
Glob_do_GNU

# main sources the window definitions
# main also sources some needed templates in generalk.tcl
puts "source $env(ASCENDTK)/main.tcl"
source "$env(ASCENDTK)/main.tcl"

puts "tk sourced"


# The plot window and the solver window require the
# TkTable exension package by Roland King
# mthomas 98.05.07: require 1.8 until we debug the memory errors in 2.0
if {[catch {package require Tktable 2.8} err]} {
  # print a message to stderr since a catch further up the call stack
  # eats the call to "error"
  puts stderr "ASCEND cannot locate the tkTable package."
  puts stderr "internal message: $err"
  puts stderr "tck_pkgPath: $tcl_pkgPath"
  puts stderr "auto_path: $auto_path"
  error "ASCEND cannot locate the tkTable package.\ninternal message: $err"
}


# load separate templates for transient toplevels
# must be done before buttons using those templates are wired via
# global variable vectors
###puts "NOT LOADING TEMPLATES"
load_Templates
puts "templates loaded"

# configure swiped widgets: set_Template_defaults
# routine is in GlobalProc.tcl
set_Template_defaults

# Load button smarts files. Each file is responsible for checking
# existence of its needed global variables (i.e. do the
# initialization of things at the top of the *Proc.tcl
global ascGlobalVect
 # puts "[info commands awin] w_load = $ascGlobalVect(w_load)"
#
 # Switch to determine whether to load all the windows or no.
if {$ascGlobalVect(w_load)} {
  puts "All windows will be loaded"
  awin all
} {
  puts "Nowindows will be loaded"
}
# load in .ascend-config
puts "Reading utilities"
Util_do_Read
puts stdout "Interface Loaded."

global ascSourceVect
if {$ascSourceVect(errcount)} {
  puts stderr "'parray ascSourceVect' to review error messages."
}
#
# Giving the location of the directory in which the user options
# are saved (if it exists)
#
  if {$ascGlobalVect(saveoptions) == 1} {
    puts stdout " "
    puts stdout "-----------------------------------"
    puts stdout "User data directory is $ascGlobalVect(userhome)"
    puts stdout "-----------------------------------"
    puts stdout " "
  }

# try to straighten out iconnames
asc_fixiconnames

balloon_notice
mcgraw_notice
# bind help to buttons
#>>Help_BindAllM3


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