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

Contents of /trunk/ascend4/TK/display.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: 9480 byte(s)
Setting up web subdirectory in repository
1 # display.tcl
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.22 $
6 # Last modified on: $Date: 1998/06/18 15:55:24 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: display.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: display.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(display.tcl) { .display}
39 set autoLoadList(display.tcl) {0}
40
41 # procedures to show toplevel windows
42
43
44 # procedure to show window ShowWindow.display
45 # proc ShowWindow.display { args}
46 proc ShowWindow.display { args} { # xf ignore me 7
47 global env ascGlobalVect ascDispVect
48
49 StartupSrc.display
50
51 # build widget .display
52 if {"[info procs XFEdit]" != ""} {
53 catch "XFDestroy .display"
54 } {
55 catch "destroy .display"
56 }
57 toplevel .display \
58 -relief {raised}
59
60 # Ascend patched window manager configurations
61 wm iconify .display
62 wm positionfrom .display user
63 wm sizefrom .display user
64 wm iconname .display {Display}
65 wm minsize .display 100 100
66 wm title .display {A4 Display}
67 wm protocol .display WM_DELETE_WINDOW {Toggle_Remote ascDispVect}
68
69
70 # build widget .display.entry_frm
71 frame .display.entry_frm \
72 -borderwidth {2} \
73 -relief {raised}
74
75 # build widget .display.entry_frm.entry_box
76 entry .display.entry_frm.entry_box \
77 -exportselection 0 \
78 -textvariable ascDispVect(entry)
79
80 # pack widget .display.entry_frm
81 pack append .display.entry_frm \
82 .display.entry_frm.entry_box {left frame center expand fillx}
83
84
85 # build widget .display.main_frm
86 frame .display.main_frm \
87 -borderwidth {0} \
88 -relief {raised}
89
90 # build widget .display.main_frm.display_box
91 frame .display.main_frm.display_box \
92 -relief {raised}
93
94 # build widget .display.main_frm.display_box.scrollbar1
95 scrollbar .display.main_frm.display_box.scrollbar1 \
96 -command {.display.main_frm.display_box.text2 yview}
97
98 # build widget .display.main_frm.display_box.text2
99 text .display.main_frm.display_box.text2 \
100 -exportselection 0 \
101 -borderwidth {2} \
102 -relief {raised} \
103 -wrap {word} \
104 -yscrollcommand {.display.main_frm.display_box.scrollbar1 set} \
105 -font $ascDispVect(font) \
106 -height 1
107
108 # pack widget .display.main_frm.display_box
109 pack append .display.main_frm.display_box \
110 .display.main_frm.display_box.scrollbar1 {right frame center filly} \
111 .display.main_frm.display_box.text2 {top frame center expand fill}
112
113 # pack widget .display.main_frm
114 pack append .display.main_frm \
115 .display.main_frm.display_box {top frame center expand fill}
116
117
118 #
119 # Build the menu bar and submenus
120 #
121 menu .display.menubar \
122 -tearoffcommand .DISPLAY.MENUBAR \
123 -tearoff 0
124
125 # The File menu
126 menu .display.menubar.file \
127 -tearoffcommand .DISPLAY.MENUBAR.FILE \
128 -tearoff 0
129 .display.menubar.file add command \
130 -command {DispExecutePrint} \
131 -label {Print...} \
132 -accelerator {Alt-f p} \
133 -underline 0
134 .display.menubar.file add command \
135 -command {Toggle_Remote ascDispVect} \
136 -label {Close window} \
137 -accelerator {Alt-f c} \
138 -underline 0
139 .display.menubar.file add command \
140 -command {Script_do_Exit} \
141 -accelerator {Alt-f e} \
142 -label {Exit ASCEND...} \
143 -underline 0
144
145 # The Edit menu
146 menu .display.menubar.edit \
147 -tearoffcommand .DISPLAY.MENUBAR.EDIT \
148 -tearoff 0
149 .display.menubar.edit add command \
150 -command {Disp_do_Cut} \
151 -label {Cut} \
152 -accelerator {F2} \
153 -underline -1
154 .display.menubar.edit add command \
155 -command {Disp_do_Copy} \
156 -label {Copy} \
157 -accelerator {F3} \
158 -underline -1
159 .display.menubar.edit add command \
160 -command {Disp_do_Paste} \
161 -label Paste \
162 -accelerator {F4} \
163 -underline -1
164
165 # The View menu
166 menu .display.menubar.view \
167 -tearoffcommand .DISPLAY.MENUBAR.VIEW \
168 -tearoff 0
169 .display.menubar.view add checkbutton \
170 -command { } \
171 -offvalue {0} \
172 -onvalue {1} \
173 -variable {ascDispVect(ShowComments)} \
174 -label {Show comments in code} \
175 -accelerator {Alt-v c} \
176 -underline 5
177 .display.menubar.view add command \
178 -command {Disp_do_SaveOptions} \
179 -label {Save Display options} \
180 -accelerator {Alt-v d} \
181 -underline 5
182 .display.menubar.view add separator
183 .display.menubar.view add command \
184 -command {Disp_do_Font} \
185 -accelerator {Alt-v f} \
186 -label {Font ...} \
187 -underline 0
188 .display.menubar.view add checkbutton \
189 -offvalue {0} \
190 -onvalue {1} \
191 -variable {ascDispVect(visibility)} \
192 -label {Open automatically} \
193 -accelerator {Alt-v o} \
194 -underline 0
195 .display.menubar.view add command \
196 -command {View_Set_Save_Options display} \
197 -label {Save window appearance} \
198 -accelerator {Alt-v s} \
199 -underline 0
200
201
202 # The Help menu
203 menu .display.menubar.help \
204 -tearoffcommand .DISPLAY.MENUBAR.HELP \
205 -tearoff 0
206 .display.menubar.help add command \
207 -command {Disp_do_Help} \
208 -label {On Display} \
209 -underline 3
210
211
212 #
213 # Add the menus as cascades of the toplevel's menu;
214 # add the toplevel's menu to the toplevel
215 #
216 .display.menubar add cascade \
217 -menu .display.menubar.file \
218 -label {File} \
219 -underline 0
220 .display.menubar add cascade \
221 -menu .display.menubar.edit \
222 -label Edit \
223 -underline 0
224 .display.menubar add cascade \
225 -menu .display.menubar.view \
226 -label {View} \
227 -underline 0
228 .display.menubar add cascade \
229 -menu .display.menubar.help \
230 -label {Help} \
231 -underline 0
232 .display configure \
233 -menu .display.menubar
234
235
236 #
237 # Add the entry and main frames into the toplevel .display
238 #
239 pack append .display \
240 .display.main_frm {top frame center expand fill} \
241 .display.entry_frm {top frame center fillx}
242
243
244 .display.entry_frm.entry_box insert end {}
245 .display.main_frm.display_box.text2 insert end {}
246
247 EndSrc.display
248
249 if {"[info procs XFEdit]" != ""} {
250 catch "XFMiscBindWidgetTree .display"
251 after 2 "catch {XFEditSetShowWindows}"
252 }
253 }
254
255 # proc DestroyWindow.display {}
256 proc DestroyWindow.display {} {# xf ignore me 7
257 if {"[info procs XFEdit]" != ""} {
258 if {"[info commands .display]" != ""} {
259 global xfShowWindow.display
260 set xfShowWindow.display 0
261 XFEditSetPath .
262 after 2 "XFSaveAsProc .display; XFEditSetShowWindows"
263 }
264 } {
265 catch "destroy .display"
266 update
267 }
268 }
269
270 # proc StartupSrc.display {args}
271 proc StartupSrc.display {args} {
272 # display startup entrance
273 # as much of the C/global dependencies managed here as possible
274 global ascDispVect ascGlobalVect env
275 if {[catch {set ascDispVect(windowname)} ]} {
276 set ascDispVect(minsize) 100x100
277 set ascDispVect(geometry) 200x400+10+10
278 set ascDispVect(iconname) Display
279 set ascDispVect(initialstate) normal
280 set ascDispVect(font) "-*-*"
281 }
282 if {[catch {set ascGlobalVect(font)} ]} {
283 set ascGlobalVect(font) "-*-*"
284 set ascGlobalVect(labelfont) "-*-*"
285 set ascGlobalVect(tbg) "white"
286 set ascGlobalVect(tfg) "black"
287 set ascGlobalVect(bg) "white"
288 set ascGlobalVect(fg) "black"
289 set ascGlobalVect(afg) "white"
290 set ascGlobalVect(abg) "black"
291 set ascGlobalVect(sfg) "white"
292 set ascGlobalVect(sbg) "black"
293 set ascGlobalVect(visibility) 1
294 set ascGlobalVect(c_loaded) "0"
295 set ascGlobalVect(toolbitmap) \
296 "@$env(ASCENDBITMAPS)/toolAttributes.xbm"
297 }
298 }
299
300 proc EndSrc.display {} {
301 # display startup exit
302 global ascDispVect
303 set ascDispVect(geometry) [sanegeometry $ascDispVect(geometry)]
304 set minw [lindex [split $ascDispVect(minsize) x] 0]
305 set minh [lindex [split $ascDispVect(minsize) x] 1]
306 set gw [lindex [split [lindex [split $ascDispVect(geometry) +] 0] x] 0]
307 set gh [lindex [split [lindex [split $ascDispVect(geometry) +] 0] x] 1]
308 set gp "+[lindex [split [split $ascDispVect(geometry) x] +] 1]+[lindex [split [split $ascDispVect(geometry) x] +] 2]"
309 if {[expr $gw < $minw]} {set gw $minw}
310 if {[expr $gh < $minh]} {set gh $minh}
311 set gwh "${gw}x${gh}"
312 wm positionfrom .display user
313 wm sizefrom .display user
314 wm minsize .display $minw $minh
315 wm geometry .display [osgpos $gwh$gp]
316 wm iconname .display $ascDispVect(iconname)
317
318 if {$ascDispVect(initialstate)!="iconic" && \
319 $ascDispVect(initialstate)!="iconified" && \
320 $ascDispVect(initialstate)!="withdrawn"} {
321 wm deiconify .display
322 }
323 if {$ascDispVect(initialstate)=="withdrawn"} {
324 wm withdraw .display
325 }
326 }
327
328
329
330 # Internal procedures
331
332 # eof
333 #
334

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