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

Annotation of /trunk/tcltk/TK/ToolboxProc.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: 8627 byte(s)
Renaming 'tcltk98' to 'tcltk', continued...
1 johnpye 571 # 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