/[ascend]/trunk/tcltk98/TK/ToolboxProc.tcl
ViewVC logotype

Contents of /trunk/tcltk98/TK/ToolboxProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (show annotations) (download) (as text)
Sat Nov 13 16:40:11 2004 UTC (17 years ago) by aw0a
File MIME type: text/x-tcl
File size: 8627 byte(s)
try again to commit moving tcl stuff
1 # ToolboxProc.tcl: Code for the toolbox buttons and aliases
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.16 $
6 # Last modified on: $Date: 1998/06/18 15:55:03 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: ToolboxProc.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 set_Toolbox_Defaults {}
31 #------------------------------------------------------------------------
32 # startup toolbox vars
33 #------------------------------------------------------------------------
34 proc set_Toolbox_Defaults {} {
35
36 global ascToolVect ascGlobalVect {xfShowWindow.toolbox}
37 global env ascScripVect
38 if {${xfShowWindow.toolbox}} {
39
40 # puts "setting toolbox buttons"
41 set ascToolVext(windowname) .toolbox
42 if {[info exists ascGlobalVect(userhome)] && \
43 [file isdirectory $ascGlobalVect(userhome)]} {
44 if {![info exists ascScripVect(developer)] ||
45 !$ascScripVect(developer)} {
46 cd $ascGlobalVect(userhome)
47 }
48 }
49 set ascToolVect(dirargs) [pwd]
50 set ascToolVect(dirinput) [pwd]
51 set ascToolVect(printargs) "xa2ps -Pmirage"
52 set ascToolVect(exitargs) ""
53
54 global ascToolVect
55
56 set ascToolVect(utilBtn) .toolbox.bottom_frm.util_btn
57 set ascToolVect(helpBtn) .toolbox.bottom_frm.hlp_btn
58 set ascToolVect(exitBtn) .toolbox.bottom_frm.exit_btn
59 set ascToolVect(librBtn) .toolbox.bottom_frm.library_btn
60 set ascToolVect(browBtn) .toolbox.bottom_frm.browser_btn
61 set ascToolVect(solvBtn) .toolbox.bottom_frm.solver_btn
62 set ascToolVect(probBtn) .toolbox.bottom_frm.probe_btn
63 set ascToolVect(unitBtn) .toolbox.bottom_frm.units_btn
64 set ascToolVect(dispBtn) .toolbox.bottom_frm.display_btn
65 set ascToolVect(scripBtn) .toolbox.bottom_frm.script_btn
66
67 # set ptr
68 .toolbox configure -cursor left_ptr
69
70 Configure_Toolbox
71
72 } else {
73 puts "toolbox doesn't exist! buttons not set"
74 }
75 }
76
77 #
78 # proc Configure_Toolbox {}
79 #------------------------------------------------------------------------
80 # Now attaching some do_raise_lower procedures to the items of
81 # the Toolboxand the Toolbox itself. -- attached to its label.!!
82 #------------------------------------------------------------------------
83 proc Configure_Toolbox {} {
84 global ascToolVect
85
86 $ascToolVect(librBtn) configure -command {Toggle_Remote ascLibrVect}
87 $ascToolVect(browBtn) configure -command {Toggle_Remote ascBrowVect}
88 $ascToolVect(solvBtn) configure -command {Toggle_Remote ascSolvVect}
89 $ascToolVect(probBtn) configure -command {Toggle_Remote ascProbVect}
90 $ascToolVect(unitBtn) configure -command {Toggle_Remote ascUnitVect}
91 $ascToolVect(dispBtn) configure -command {Toggle_Remote ascDispVect}
92 $ascToolVect(scripBtn) configure -command {do_raise_lower .script}
93
94 $ascToolVect(helpBtn) configure -command Tool_do_Help
95 $ascToolVect(exitBtn) configure -command Tool_exit
96 }
97
98
99 #
100 # proc Tool_do_UtilBox {}
101 #------------------------------------------------------------------------
102 # utility box button
103 #------------------------------------------------------------------------
104 proc Tool_do_UtilBox {} {
105 VShowWindow.util 0
106 }
107
108 #
109 # proc Tool_do_Bugs {}
110 #------------------------------------------------------------------------
111 # bug mail call button
112 #------------------------------------------------------------------------
113 proc Tool_do_Bugs {} {
114 Help_button toolbox.bugreport
115 }
116
117 #
118 # proc Tool_do_Help {}
119 #------------------------------------------------------------------------
120 # help button for toolbox. starts up help
121 #------------------------------------------------------------------------
122 proc Tool_do_Help {} {
123 Help_Open
124 }
125
126 #
127 # proc Tool_do_Callbacks {}
128 #------------------------------------------------------------------------
129 # callbacks button for toolbox. starts up callbacks
130 #------------------------------------------------------------------------
131 proc Tool_do_Callbacks {} {
132 global ascScripVect
133 if {![info exists ascScripVect(developer)]} {
134 error "Internals browser disabled by default. Set ascScripVect(developer) to enable it."
135 }
136 Callback_Open
137 }
138
139 #
140 # proc Tool_set_dir {}
141 #------------------------------------------------------------------------
142 # should be modified to work with util box
143 #------------------------------------------------------------------------
144 proc Tool_set_dir {} {
145
146 global ascToolVect
147
148 if {$ascToolVect(dirinput) == ""} {
149 set ascToolVect(dirinput) [pwd];
150 }
151 if {[file isdirectory $ascToolVect(dirinput)]} {
152 set ascToolVect(dirargs) $ascToolVect(dirinput);
153 return;
154 } else {
155 set errmsg "Directory\n"
156 append errmsg $ascToolVect(dirinput)
157 append errmsg "\n not found!"
158 Script_Raise_Alert $errmsg "Path Error"
159 set ascToolVect(dirinput) $ascToolVect(dirargs)
160 error "bad directory";
161 }
162 }
163
164 #
165 # proc Tool_printinstr
166 #------------------------------------------------------------------------
167 # sanity check on print option string. weak.
168 #------------------------------------------------------------------------
169 proc Tool_printinstr {} {
170
171 global ascToolVect
172 global env
173 if {$ascToolVect(printargs) == ""} {
174 set ascToolVect(printargs) "lpr -P $env(PRINTER)"
175 return;
176 }
177 }
178
179 #
180 # proc Tool_ExitGeom {}
181 #------------------------------------------------------------------------
182 # calc some misc geometry for exit widget to be near exit button
183 #------------------------------------------------------------------------
184 proc Tool_ExitGeom {} {
185
186 #set geom [wm geometry .toolbox]
187 #set data [split $geom "x+"]
188 #set xpos [lindex $data 0]
189 #set ypos [lindex $data 1]
190 #set xoff [lindex $data 2]
191 #set yoff [lindex $data 3]
192 #set centrx [expr $xpos / 2 + $xoff - 190 / 2]
193 #set centry [expr $ypos / 2 + $yoff]
194 #return "$centrx\+$centry"
195 return [setpos .toolbox.bottom_frm.exit_btn 20 12]
196 }
197
198 #
199 # proc ExitProbe
200 #------------------------------------------------------------------------
201 # flush probe C structures. call on ascend exit only.
202 #------------------------------------------------------------------------
203 proc ExitProbe {} {
204 __probe destroy
205 }
206 #
207 # proc ExitLibrary {}
208 #------------------------------------------------------------------------
209 # flush the library and interface module lists. call on ascend exit only.
210 #------------------------------------------------------------------------
211 proc ExitLibrary {} {
212 libr_destroy_types
213 libr_destroy_libr
214 }
215
216 #
217 # proc ExitUnits {}
218 #------------------------------------------------------------------------
219 # flush the library and interface module lists. call on ascend exit only.
220 #------------------------------------------------------------------------
221 proc ExitUnits {} {
222 u_destroy_units
223 }
224
225 #
226 # proc ExitIVP {}
227 #------------------------------------------------------------------------
228 # empty integrate interface buffers steps and filenames
229 #------------------------------------------------------------------------
230 proc ExitIVP {} {
231 integrate_set_samples
232 integrate_set_y_file ""
233 integrate_set_obs_file ""
234 }
235
236 #
237 # proc Tool_exit {}
238 #------------------------------------------------------------------------
239 # the exit button callup
240 #------------------------------------------------------------------------
241 proc Tool_exit {} {
242
243 set position [Tool_ExitGeom]
244 set res [VShowWindow.ascConfirm "240x50$position" "Exit"]
245 if {$res == 1} {
246 Tool_exit_internal
247 }
248 }
249 #
250 # proc Tool_exit_internal {}
251 #------------------------------------------------------------------------
252 # the exit/confirm button actions
253 #------------------------------------------------------------------------
254 proc Tool_exit_internal {} {
255
256 catch {Solve_do_Flush}
257 catch {ExitProbe}
258 catch {ExitLibrary}
259 catch {ExitUnits}
260 ExitIVP
261 destroy .
262 catch {user_shutdown}
263 }

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