/[ascend]/trunk/ascend4/TK/util.tcl
ViewVC logotype

Contents of /trunk/ascend4/TK/util.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (17 years, 1 month ago) by aw0a
File MIME type: text/x-tcl
File size: 7942 byte(s)
Setting up web subdirectory in repository
1 # util.tcl: utility window code for ascend
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.10 $
6 # Last modified on: $Date: 1998/06/18 15:55:47 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: util.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 #
30 # proc VShowWindow.util {args}
31 #------------------------------------------------------------------------
32 # procedure to show window .util
33 # builds a line for every thing in utilvect
34 # but in sets of ascglobalbect(maxutilrow)
35 # pages are numbered from 0 internally
36 # if a line is called for without the variable
37 # set first, this will set it to something dumb but displayable
38 #------------------------------------------------------------------------
39 proc VShowWindow.util {args} {
40
41 global ascUtilVect ascGlobalVect ascScripVect
42 Util_Init
43 set rows [array size ascUtilVect]
44 if {$rows ==0 } {return}
45 set lblwid [Util_Label_Width]
46 # build widget .util
47 if {[info commands .util] != ""} {set utilup 1} {set utilup 0}
48
49 set argc [llength $args]
50 if {$argc==1} {
51 set nrows $ascGlobalVect(maxutilrow)
52 set pagenum $args
53 set maxpage [expr [llength [array names ascUtilVect]] / $nrows]
54 if {[expr $rows % $nrows] ==0} { incr maxpage -1}
55 if {$maxpage==0} {set nomore 1} {set nomore 0}
56 } else {error "VShowWindow.util wants 1 page num arg"}
57
58 if {!$utilup} {
59 # Window manager configurations
60 toplevel .util
61 wm positionfrom .util user
62 wm sizefrom .util user
63 wm minsize .util 10 10
64 wm protocol .util WM_DELETE_WINDOW {Util_do_OK}
65 wm title .util {A4 Utilities}
66
67
68 # build widget .util.box
69 frame .util.box \
70 -borderwidth {0} \
71 -relief {raised}
72
73 # build widget .util.box.label
74 label .util.box.label \
75 -font $ascGlobalVect(labelfont) \
76 -borderwidth {5} \
77 -relief {groove} \
78 -text {ASCEND Utility Settings}
79
80 # build widget .util.box.main_frm
81 frame .util.box.main_frm \
82 -borderwidth {2} \
83 -relief {raised}
84
85 # build widget .util.box.main_frm.lbl_frm
86 frame .util.box.main_frm.lbl_frm \
87 -relief {raised}
88
89 # build widget .util.box.main_frm.val_frm
90 frame .util.box.main_frm.val_frm \
91 -relief {raised}
92 }
93
94 if {[expr $pagenum >= $maxpage]} {
95 set nextpage 0
96 set pagenum $maxpage
97 } else {
98 set nextpage [expr $pagenum +1]
99 }
100 set subs [lsort [array names ascUtilVect]]
101 set first [expr $pagenum * $nrows]
102 set last [expr $first + $nrows -1]
103 set psubs [lrange $subs $first $last]
104
105 # forget anyone who's packed now in val_frm or lbl_frm
106 set slaves "[winfo children .util.box.main_frm.lbl_frm]"
107 append slaves " [winfo children .util.box.main_frm.val_frm]"
108 foreach s $slaves {pack forget $s}
109 # build all the entries, if not out there, and pack, if on current page
110 foreach s $subs {
111 #
112 # init unset vars
113 set varname [Util_Get_Var $s]
114 global $varname
115 if {[info var $varname]==""} {
116 set $varname "unset"
117 }
118 if {[info command ".util.box.main_frm.lbl_frm.$s"] ==""} {
119 # build widget .util.box.main_frm.lbl_frm.$s
120 set tmplbl "[Util_Get_Label $s]"
121 label .util.box.main_frm.lbl_frm.$s \
122 -font $ascScripVect(font) \
123 -width "$lblwid" \
124 -text "[Util_Get_Label $s]"
125 catch {
126 set btnpath [string trim $tmplbl]
127 set btnpath [string tolower $btnpath]
128 set btnpath [join [split $btnpath] .]
129 Help_BindButton .util.box.main_frm.lbl_frm.$s utilities $btnpath
130 }
131 # build widget .util.box.main_frm.val_frm.$s
132 entry .util.box.main_frm.val_frm.$s \
133 -font $ascScripVect(font) \
134 -borderwidth {3} \
135 -exportselection 0 \
136 -relief {groove} \
137 -textvariable "$varname"
138 }
139
140 if {[lsearch $psubs $s] != "-1"} {
141 # pack widget .util.box.main_frm.lbl_frm, if displayed on this page
142 pack append .util.box.main_frm.lbl_frm \
143 .util.box.main_frm.lbl_frm.$s {top frame center expand fill}
144 # pack widget .util.box.main_frm.val_frm if displayed on this page
145 pack append .util.box.main_frm.val_frm \
146 .util.box.main_frm.val_frm.$s {top frame center expand fill}
147 }
148 }
149 # pack rest if not done already
150 if {!$utilup} {
151 # pack widget .util.box.main_frm
152 pack append .util.box.main_frm \
153 .util.box.main_frm.lbl_frm {left frame center fill} \
154 .util.box.main_frm.val_frm {left frame center expand fill}
155
156 # build widget .util.box.mb_frm
157 frame .util.box.mb_frm \
158 -relief {raised}
159
160 # build widget .util.box.mb_frm.btn_hlp
161 button .util.box.mb_frm.btn_hlp \
162 -font $ascScripVect(font) \
163 -command {Util_do_Help} \
164 -text { Help }
165
166 # build widget .util.box.mb_frm.btn_ok
167 button .util.box.mb_frm.btn_ok \
168 -font $ascScripVect(font) \
169 -command {Util_do_OK} \
170 -text { OK }
171
172 # build widget .util.box.mb_frm.btn_read
173 button .util.box.mb_frm.btn_read \
174 -font $ascScripVect(font) \
175 -command {Util_do_Read} \
176 -text { Read }
177
178 # build widget .util.box.mb_frm.btn_save
179 button .util.box.mb_frm.btn_save \
180 -font $ascScripVect(font) \
181 -command {Util_do_Save} \
182 -text { Save }
183
184 # build widget .util.box.mb_frm.btn_more
185 if {!$nomore} {
186 button .util.box.mb_frm.btn_more \
187 -font $ascScripVect(font) \
188 -command "VShowWindow.util $nextpage" \
189 -text { More }
190
191 # pack widget .util.box.mb_frm
192 pack append .util.box.mb_frm \
193 .util.box.mb_frm.btn_ok {left frame center expand fill} \
194 .util.box.mb_frm.btn_save {left frame center expand fill} \
195 .util.box.mb_frm.btn_read {left frame center expand fill} \
196 .util.box.mb_frm.btn_more {left frame center expand fill} \
197 .util.box.mb_frm.btn_hlp {left frame center expand fill}
198 } else {
199 pack append .util.box.mb_frm \
200 .util.box.mb_frm.btn_ok {left frame center expand fill} \
201 .util.box.mb_frm.btn_save {left frame center expand fill} \
202 .util.box.mb_frm.btn_read {left frame center expand fill} \
203 .util.box.mb_frm.btn_hlp {left frame center expand fill}
204 }
205 # pack widget .util.box
206 pack append .util.box \
207 .util.box.label {top frame center fillx} \
208 .util.box.mb_frm {bottom frame center fill} \
209 .util.box.main_frm {top frame center expand fill}
210
211 # pack widget .util
212 pack append .util \
213 .util.box {top frame center expand fill}
214
215 if {"[info procs XFEdit]" != ""} {
216 catch "XFMiscBindWidgetTree .util"
217 after 2 "catch {XFEditSetShowWindows}"
218 }
219 } else {
220 if {!$nomore} {
221 .util.box.mb_frm.btn_more config -command "VShowWindow.util $nextpage"
222 }
223 }
224 }
225
226 # proc DestroyWindow.util {}
227 proc DestroyWindow.util {} {# xf ignore me 7
228 if {"[info procs XFEdit]" != ""} {
229 if {"[info commands .util]" != ""} {
230 global xfShowWindow.util
231 set xfShowWindow.util 0
232 XFEditSetPath .
233 after 2 "XFSaveAsProc .util; XFEditSetShowWindows"
234 }
235 } {
236 catch "destroy .util"
237 update
238 }
239 }
240

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