/[ascend]/trunk/tcltk/TK/baatest.tcl
ViewVC logotype

Annotation of /trunk/tcltk/TK/baatest.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 571 - (hide annotations) (download) (as text)
Tue May 9 00:14:59 2006 UTC (18 years, 1 month ago) by johnpye
File MIME type: text/x-tcl
File size: 2615 byte(s)
Renaming 'tcltk98' to 'tcltk', continued...
1 johnpye 571 # baatest.tcl
2     # by Benjamin A. Allan and Kirk A. Abbott
3     # Created: January 1994
4     # Part of ASCEND
5     # Revision: $Revision: 1.5 $
6     # Last modified on: $Date: 1998/06/18 15:55:19 $
7     # Last modified by: $Author: mthomas $
8     # Revision control file: $RCSfile: baatest.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     # Module: batest.tcl
30     # Tcl version: 7.1 (Tcl/Tk/XF)
31     # Tk version: 3.4
32     # XF version: 2.2
33     #
34    
35     # module contents
36     global moduleList
37     global autoLoadList
38     set moduleList(batest.tcl) { envVal loadAppDefaults showVars}
39     set autoLoadList(batest.tcl) {0}
40    
41     source templates/ascDoubleE.tcl
42    
43     # procedures to show toplevel windows
44    
45    
46     # User defined procedures
47    
48    
49     # Procedure: envVal
50     proc envVal { envValName} {
51     global env
52     if [info exists env($envValName)] {return $env($envValName)} {return {}}
53     }
54    
55    
56     # Procedure: loadAppDefaults
57     proc loadAppDefaults { classNameList {priority "startupFile"}} {
58     set filepath "[split [envVal XUSERFILESEARCHPATH] :] [envVal XAPPLRESDIR] [split [envVal XFILESEARCHPATH] :] /usr/lib/X11"
59     foreach i $classNameList {
60     foreach j $filepath {
61     if {[file exists $j/$i]} {
62     option readfile $j/$i $priority; break
63     }
64     }
65     }
66     }
67    
68    
69     # Procedure: showVars
70     proc showVars { w args} {
71     catch {destroy $w}
72     toplevel $w
73     wm title $w "Variable values"
74     label $w.title \
75     -text "Variable values:" \
76     -width 20 \
77     -anchor center \
78     -font {helvetica 18 bold}
79     pack append $w $w.title {top fillx}
80     foreach i $args {
81     frame $w.$i
82     label $w.$i.name -text "$i: "
83     label $w.$i.value -textvar $i
84     pack append $w.$i $w.$i.name left $w.$i.value left
85     pack append $w $w.$i {top frame w}
86     }
87     button $w.ok -text OK -command "destroy $w"
88     pack append $w $w.ok {bottom pady 2}
89     }
90    

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