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

Contents of /trunk/tcltk/TK/GlobalProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 604 - (show annotations) (download) (as text)
Mon May 15 18:59:21 2006 UTC (17 years, 11 months ago) by ben.allan
File MIME type: text/x-tcl
File size: 29185 byte(s)
believed to fix issue 67, del/bksp reversal.
The user may now adjust this in their ascendrc file
as needed to make their favorite window manager
behave itself.
1 # GlobalProc.tcl: global commands to do with window management
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.71 $
6 # Last modified on: $Date: 1998/07/01 09:06:32 $
7 # Last modified by: $Author: ballan $
8 # Revision control file: $RCSfile: GlobalProc.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 ascsetdebug {{on 1}}
31 # -------------------------------------------------------------------------
32 # Note that in the following we see the feature that all tcl procs are
33 # global and that procedures may define procedures.
34 # Use examples:
35 # ascsetdebug 0
36 # this turns debugging spew info off.
37 # ascsetdebug 1
38 # this turns debugging spew info on.
39 # ascsetdebug
40 # this also turns debugging spew on because the DEFAULT given is 1.
41 # -------------------------------------------------------------------------
42 proc ascsetdebug {{on 1}} {
43 if {$on} {
44 proc entertrace {args} {
45 set depth [expr {[info level]-1}]
46 puts "entering [lindex [info level $depth] 0] : $args"
47 }
48 proc leavetrace {args} {
49 set depth [expr {[info level]-1}]
50 puts "leaving [lindex [info level $depth] 0] : $args"
51 }
52 } else {
53 proc entertrace {args} {}
54 proc leavetrace {args} {}
55 }
56 }
57
58 ascsetdebug 0
59
60 # this handles functions with arguments nicely for startup
61 proc asc_catch {func} {
62 if {[catch {$func} errmessage]} {
63 puts stderr "*** Error calling $func"
64 puts stderr $errmessage
65 puts stderr "***"
66 }
67 }
68
69 # requires double braces to deal with xfs dot qualified procedure names.
70
71 #
72 # proc awin {window}
73 #-----------------------------------------------------------------------
74 # start (or destroy) windows. awin help for detail
75 #-----------------------------------------------------------------------
76 proc awin {window} {
77
78 global xfShowWindow.browser xfShowWindow.display xfShowWindow.library
79 global xfShowWindow.probe xfShowWindow.script
80 global xfShowWindow.solver xfShowWindow.toolbox xfShowWindow.units
81 global xfShowWindow.debug xfShowWindow.mtx
82 global ascSolvVect
83 global env
84
85 switch $window {
86 # getting the toolbox requires all its attachments.
87 {t*} -
88 {all} -
89 {t*} -
90 {T*} {
91 set xfShowWindow.browser 1
92 ShowWindow.browser
93 puts -nonewline "."; flush stdout
94 set xfShowWindow.display 1
95 ShowWindow.display
96 puts -nonewline "."; flush stdout
97 set xfShowWindow.library 1
98 ShowWindow.library
99 puts -nonewline "."; flush stdout
100 set xfShowWindow.probe 1
101 ShowWindow.probe
102 puts -nonewline "."; flush stdout
103 set xfShowWindow.script 1
104 ShowWindow.script
105 puts -nonewline "."; flush stdout
106 set xfShowWindow.solver 1
107 ShowWindow.solver
108 puts -nonewline "."; flush stdout
109 set xfShowWindow.units 1
110 ShowWindow.units
111 puts -nonewline "."; flush stdout
112 set xfShowWindow.toolbox 1
113 ShowWindow.toolbox
114 puts "."; flush stdout
115 update idletask
116 # resource everything
117 puts "source $env(ASCENDTK)/ToolboxProc.tcl"
118 asc_source "$env(ASCENDTK)/ToolboxProc.tcl"
119 puts "source $env(ASCENDTK)/UtilProc.tcl"
120 asc_source "$env(ASCENDTK)/UtilProc.tcl"
121 puts "source $env(ASCENDTK)/DisplayProc.tcl"
122 asc_source "$env(ASCENDTK)/DisplayProc.tcl"
123 puts "source $env(ASCENDTK)/UnitsProc.tcl"
124 asc_source "$env(ASCENDTK)/UnitsProc.tcl"
125 puts "source $env(ASCENDTK)/ProbeProc.tcl"
126 asc_source "$env(ASCENDTK)/ProbeProc.tcl"
127 puts "source $env(ASCENDTK)/LibraryProc.tcl"
128 asc_source "$env(ASCENDTK)/LibraryProc.tcl"
129 puts "source $env(ASCENDTK)/TypetreeProc.tcl"
130 asc_source "$env(ASCENDTK)/TypetreeProc.tcl"
131 puts "source $env(ASCENDTK)/BrowserProc.tcl"
132 asc_source "$env(ASCENDTK)/BrowserProc.tcl"
133 puts "source $env(ASCENDTK)/DebugProc.tcl"
134 asc_source "$env(ASCENDTK)/DebugProc.tcl"
135 puts "source $env(ASCENDTK)/MtxProc.tcl"
136 asc_source "$env(ASCENDTK)/MtxProc.tcl"
137 puts "source $env(ASCENDTK)/SolverProc.tcl"
138 asc_source "$env(ASCENDTK)/SolverProc.tcl"
139 puts "source $env(ASCENDTK)/ScriptProc.tcl"
140 asc_source "$env(ASCENDTK)/ScriptProc.tcl"
141 puts "source $env(ASCENDTK)/WWWHelpProc.tcl"
142 asc_source "$env(ASCENDTK)/WWWHelpProc.tcl"
143 puts "source $env(ASCENDTK)/HubProc.tcl"
144 asc_source "$env(ASCENDTK)/HubProc.tcl"
145 puts "source $env(ASCENDTK)/mps.tcl"
146 asc_source "$env(ASCENDTK)/mps.tcl"
147 puts "source $env(ASCENDTK)/CallbackProc.tcl"
148 asc_source "$env(ASCENDTK)/CallbackProc.tcl"
149 puts "source $env(ASCENDTK)/NoteboxProc.tcl"
150 asc_source "$env(ASCENDTK)/NoteboxProc.tcl"
151 puts "source $env(ASCENDTK)/methods.tcl"
152 asc_source "$env(ASCENDTK)/methods.tcl"
153 # puts "Wiring up the buttons..."
154 asc_catch set_Browser_Defaults
155 asc_catch set_Display_Defaults
156 asc_catch set_Library_Defaults
157 asc_catch set_Typetree_Defaults
158 asc_catch set_Probe_Defaults
159 asc_catch set_Script_Defaults
160 asc_catch set_Solver_Defaults
161 # Overwriting with parameters defined by user rc file
162 # but now we don't really need an rc file do we?
163 asc_catch View_Source_Params_Files
164 asc_catch set_Debug_Defaults
165 asc_catch set_Mtx_Defaults
166 asc_catch set_Units_Defaults
167 asc_catch set_Toolbox_Defaults
168 asc_catch set_Util_Defaults
169 asc_catch set_HUB_Defaults
170 asc_catch set_Help_Defaults
171
172 }
173 {b*} -
174 {B*} {set xfShowWindow.browser 1
175 ShowWindow.browser
176 puts "source $env(ASCENDTK)/BrowserProc.tcl"
177 asc_source "$env(ASCENDTK)/BrowserProc.tcl"
178 set_Browser_Defaults
179 update idletask}
180
181 {d*} -
182 {D*} {set xfShowWindow.display 1
183 ShowWindow.display
184 puts "source $env(ASCENDTK)/DisplayProc.tcl"
185 # update idletask
186 asc_source "$env(ASCENDTK)/DisplayProc.tcl"
187 set_Display_Defaults
188 update idletask}
189
190 {l*} -
191 {L*} {set xfShowWindow.library 1
192 ShowWindow.library
193 puts "source $env(ASCENDTK)/LibraryProc.tcl"
194 # update idletask
195 asc_source "$env(ASCENDTK)/LibraryProc.tcl"
196 set_Library_Defaults
197 update idletask}
198
199 {p*} -
200 {P*} {set xfShowWindow.probe 1
201 ShowWindow.probe
202 puts "source $env(ASCENDTK)/ProbeProc.tcl"
203 # update idletask
204 asc_source "$env(ASCENDTK)/ProbeProc.tcl"
205 set_Probe_Defaults
206 update idletask}
207
208 {sc*} -
209 {Sc*} -
210 {SC*} {set xfShowWindow.script 1
211 ShowWindow.script
212 puts "source $env(ASCENDTK)/ScriptProc.tcl"
213 # update idletask
214 asc_source "$env(ASCENDTK)/ScriptProc.tcl"
215 set_Script_Defaults
216 update idletask}
217
218 # theoretically the general parameters are always there
219 {so*} -
220 {So*} -
221 {SO*} { set xfShowWindow.solver 1
222 ShowWindow.solver
223 puts "source $env(ASCENDTK)/SolverProc.tcl"
224 # update idletask
225 asc_source "$env(ASCENDTK)/SolverProc.tcl"
226 set_Solver_Defaults
227 #
228 # Overwriting with parameters defined by user
229 #
230 View_Source_Params_Files
231 update idletask}
232
233 {u*} -
234 {U*} {set xfShowWindow.units 1
235 ShowWindow.units
236 puts "source $env(ASCENDTK)/UnitsProc.tcl"
237 # update idletask
238 asc_source "$env(ASCENDTK)/UnitsProc.tcl"
239 set_Units_Defaults
240 update idletask}
241
242 {noall} -
243 {noT*} -
244 {not*} {
245 if {${xfShowWindow.toolbox}} {DestroyWindow.toolbox
246 DestroyWindow.util}
247 if {${xfShowWindow.browser}} {DestroyWindow.browser}
248 if {${xfShowWindow.display}} {DestroyWindow.display}
249 if {${xfShowWindow.library}} {DestroyWindow.library}
250 if {${xfShowWindow.probe}} {DestroyWindow.probe}
251 if {${xfShowWindow.script}} {DestroyWindow.script}
252 if {${xfShowWindow.solver}} {DestroyWindow.solver}
253 if {${xfShowWindow.units}} {DestroyWindow.units}
254 set xfShowWindow.browser 0
255 set xfShowWindow.display 0
256 set xfShowWindow.library 0
257 set xfShowWindow.probe 0
258 set xfShowWindow.script 0
259 set xfShowWindow.solver 0
260 set xfShowWindow.units 0
261 set xfShowWindow.toolbox 0
262 update idletask }
263
264 {nob*} -
265 {noB*} {if {${xfShowWindow.browser}} {DestroyWindow.browser}
266 set xfShowWindow.browser 0}
267
268 {nod*} -
269 {noD*} {if {${xfShowWindow.browser}} {DestroyWindow.browser}
270 set xfShowWindow.display 0}
271
272 {nol*} -
273 {noL*} {if {${xfShowWindow.library}} {DestroyWindow.library}
274 set xfShowWindow.library 0}
275
276 {nop*} -
277 {noP*} {if {${xfShowWindow.probe}} {DestroyWindow.probe}
278 set xfShowWindow.probe 0}
279
280 {nosc*} -
281 {noSC*} -
282 {noSc*} {if {${xfShowWindow.script}} {DestroyWindow.script}
283 set xfShowWindow.script 0}
284
285 {noso*} -
286 {noSo*} -
287 {noSO*} {
288 if {${xfShowWindow.solver}} {DestroyWindow.solver}
289 set xfShowWindow.solver 0}
290
291 {noU*} -
292 {nou*} {if {${xfShowWindow.units}} {DestroyWindow.units}
293 set xfShowWindow.units 0}
294 default { puts "awin syntax: awin \[no\]arg"
295 puts " where arg is 'all' or the name of a window." }
296 }
297 #end switch
298 set_ascplot_defaults
299 # update idletask
300 # update
301 }
302 # end awin
303
304 #
305 # proc asc_fixiconnames {}
306 #-----------------------------------------------------------------------
307 # asc iconname silliness under twm, maybe mwm. once the hurly burly's done,
308 # call this. still buggy under sun3twm
309 #-----------------------------------------------------------------------
310 proc asc_fixiconnames {} {
311 global ascBrowVect ascLibrVect ascSolvVect ascProbVect
312 global ascToolVect ascSimsVect ascUnitVect ascDispVect
313 global ascScripVect
314
315 catch {wm iconname .browser}
316 catch {wm title .}
317 catch {wm iconname .}
318 catch {wm iconname .display}
319 catch {wm iconname .library}
320 catch {wm iconname .probe}
321 catch {wm iconname .script}
322 catch {wm iconname .solver}
323 catch {wm iconname .units }
324 catch {wm iconname .toolbox}
325 wm title . "Ascend IV"
326 wm iconname . "Ascend IV"
327 # update idletasks
328 wm title . "Ascend IV"
329 wm iconname .browser $ascBrowVect(iconname)
330 wm iconname .display $ascDispVect(iconname)
331 wm iconname .library $ascLibrVect(iconname)
332 wm iconname .probe $ascProbVect(iconname)
333 wm iconname .script $ascScripVect(iconname)
334 wm iconname .solver $ascSolvVect(iconname)
335 wm iconname .toolbox $ascToolVect(iconname)
336 wm iconname .units $ascUnitVect(iconname)
337
338 }
339
340 #
341 # proc Redraw {}
342 #-----------------------------------------------------------------------
343 # Repaint info (as much as possible) from C structure after interface
344 # resourced
345 #-----------------------------------------------------------------------
346 proc Redraw {} {
347 Libr_Redraw
348 Solve_Redraw
349 Probe_Redraw
350 Units_Redraw
351 Sims_Redraw
352 }
353
354 #
355 # Binding hacks for Tk widgets in ASCEND.
356 # Ben Allan, 5/97.
357 #
358 proc set_cmuBindings {} {
359 global tcl_platform tk_strictMotif
360 # we don't understand why scanning is supposed to work only with
361 # b1 down. haven't been able to find any unwanted side effects of this
362 # baa 6/12/97, tk80b1-no patches
363 bind Menubutton <Motion> {
364 global tk_strictMotif
365 switch $tk_version {
366 8.5 -
367 8.4 {
368 if {$tk_strictMotif} {
369 tk::MbMotion %W up %X %Y
370 } else {
371 tk::MbMotion %W down %X %Y
372 }
373 }
374 default {
375 if {$tk_strictMotif} {
376 tkMbMotion %W up %X %Y
377 } else {
378 tkMbMotion %W down %X %Y
379 }
380 }
381 }
382 }
383 # puts "Adding cmu Entry and Text bindings"
384 #
385 # Entries:
386 #
387 # define Ctrl-u for unix folks.
388 bind Entry <Control-Key-u> {
389 if !$tk_strictMotif {
390 %W delete 0 end
391 }
392 }
393 #
394 #define delete and backspace to be backspace.
395 bind Entry <Key-Delete> {
396 if !$tk_strictMotif {
397 tkEntryBackspace %W
398 }
399 }
400 #
401 #Texts
402 #
403 global asc_swap_del_backspace
404 # munge both backspace and delete to
405 if {$tcl_platform(platform)=="unix" && !$tk_strictMotif && $asc_swap_del_backspace=="1" } {
406 # the standard tcl text bindings. Swap them.
407 # bind Text <Delete> {
408 # if {[%W tag nextrange sel 1.0 end] != ""} {
409 # %W delete sel.first sel.last
410 # } else {
411 # %W delete insert
412 # %W see insert
413 # }
414 #}
415 #bind Text <BackSpace> {
416 # if {[%W tag nextrange sel 1.0 end] != ""} {
417 # %W delete sel.first sel.last
418 # } elseif [%W compare insert != 1.0] {
419 # %W delete insert-1c
420 # %W see insert
421 # }
422 #}
423 bind Text <BackSpace> {
424 if {[%W tag nextrange sel 1.0 end] != ""} {
425 %W delete sel.first sel.last
426 } else {
427 %W delete insert
428 %W see insert
429 }
430 }
431 bind Text <Delete> {
432 if {[%W tag nextrange sel 1.0 end] != ""} {
433 %W delete sel.first sel.last
434 } elseif [%W compare insert != 1.0] {
435 %W delete insert-1c
436 %W see insert
437 }
438 }
439 }
440 if {!$tk_strictMotif} {
441 if {$tcl_platform(platform) =="windows"} {
442 bind Text <Control-Key-x> {
443 asctk_textCut %W
444 }
445 bind Text <Control-Key-c> {
446 asctk_textCopy %W
447 }
448 bind Text <Control-Key-v> {
449 asctk_textPaste %W
450 }
451 }
452 proc asctk_textCut {w} {
453 set expo [$w cget -exportselection]
454 $w configure -exportselection 1
455 selection own $w
456 tk_textCut $w
457 $w configure -exportselection $expo
458 }
459 proc asctk_textCopy {w} {
460 set expo [$w cget -exportselection]
461 $w configure -exportselection 1
462 selection own $w
463 tk_textCopy $w
464 $w configure -exportselection $expo
465 }
466 proc asctk_textPaste {w} {
467 set expo [$w cget -exportselection]
468 $w configure -exportselection 1
469 tk_textPaste $w
470 $w configure -exportselection $expo
471 }
472 }
473 }
474
475 #
476 # Function to manage which ascend window, if any, claims the
477 # PRIMARY X selection. With this function, PRIMARY should
478 # shadow CLIPBOARD as long as ASCEND owns primary.
479 # We must have no more than 1 widget at a time exporting or
480 # life is very difficult.
481 # calling this function with a widget name makes that widget
482 # the exporting window and unmakes the previous widget exporterness.
483 proc asc_export_selection {w} {
484 global ascGlobalVect
485 if {![string length $w]} {
486 return
487 }
488 if {![winfo exists $w]} {
489 return
490 }
491 catch {$ascGlobalVect(selection_exporter) configure -exportselection 0} err
492 set ascGlobalVect(selection_exporter) $w
493 $w configure -exportselection 1
494 }
495
496 #
497 # proc set_Global_Defaults {}
498 #-----------------------------------------------------------------------
499 # proc set_Global_Defaults
500 # These following must be set here to control window creation in Main.
501 #-----------------------------------------------------------------------
502 proc set_Global_Defaults {} {
503 set_cmuBindings
504
505 global env tcl_platform asc_tkfbox
506 global ascBrowVect ascLibrVect ascSolvVect ascProbVect ascDebuVect
507 global ascToolVect ascSimsVect ascUnitVect ascDispVect ascGlobalVect
508 global ascScripVect ascMtxVect
509
510 #
511 # Check if the directory for saving window options exists or can be
512 # created
513 #
514 if {[string compare $tcl_platform(platform) "unix"]==0} {
515 if { [ file exists ~/ascdata ]} {
516 set ascGlobalVect(saveoptions) 1
517 } else {
518 if { [catch {file mkdir ~/ascdata} direrror] } {
519 set ascGlobalVect(saveoptions) 0
520 puts $direrror
521 } else {
522 set ascGlobalVect(saveoptions) 1
523 puts "directory ~/ascdata has been created"
524 }
525 }
526 set ascGlobalVect(userhome) ""
527 catch {set ascGlobalVect(userhome) "[glob ~/ascdata]"}
528 }
529 if {[string compare $tcl_platform(platform) "windows"]==0} {
530 set uhome {}
531 catch {set uhome [glob ~]}
532 if {[info exists env(HOME)] &&
533 [file isdirectory $env(HOME)] &&
534 [file writable $env(HOME)]} {
535 set uhome $env(HOME)
536 }
537 set upfound 0
538 if {[string length $uhome] < 4} {
539 if {[info exists env(USERPROFILE)] &&
540 [file isdirectory $env(USERPROFILE)] &&
541 [file writable $env(USERPROFILE)]} {
542 set uhome $env(USERPROFILE)
543 set upfound 1
544 }
545 }
546 if {!$upfound && [string length $uhome] < 4} {
547 if {[info exists env(USERHOME)] &&
548 [file isdirectory $env(USERHOME)] &&
549 [file writable $env(USERHOME)]} {
550 set uhome $env(USERHOME)
551 set upfound 1
552 }
553 }
554 append uhome /ascdata
555 puts stderr "data home = $uhome"
556
557 if { [ file exists $uhome ] && \
558 [file writable $uhome] && \
559 [file isdirectory $uhome]} {
560 set ascGlobalVect(saveoptions) 1
561 } else {
562 if { [catch {file mkdir $uhome} direrror] } {
563 set ascGlobalVect(saveoptions) 0
564 puts $direrror
565 } else {
566 set ascGlobalVect(saveoptions) 1
567 puts "directory $uhome has been created"
568 }
569 }
570 set ascGlobalVect(userhome) $uhome
571 }
572
573 if {[info exists env(ASCENDLIBRARY)] == 0} {
574 puts stderr "setting lib in global to [pwd]"
575 set env(ASCENDLIBRARY) [pwd]
576 }
577 if {$ascGlobalVect(saveoptions)} {
578 switch $tcl_platform(platform) {
579 unix {
580 set env(ASCENDLIBRARY) $ascGlobalVect(userhome):$env(ASCENDLIBRARY)
581 }
582 windows {
583 set crap [file nativename $ascGlobalVect(userhome)]
584 append crap ";"
585 append crap $env(ASCENDLIBRARY)
586 set env(ASCENDLIBRARY) $crap
587 }
588 macintosh {
589 puts stderr "ASCEND IV's Tcl/Tk interface has not yet been ported"
590 puts stderr "to Macintosh. Lots and lots of things are broken."
591 error "ASCEND load aborted on macintosh."
592 }
593 }
594 }
595 puts stderr "Library directories:"
596 puts stderr $env(ASCENDLIBRARY)
597 set ascGlobalVect(librarypathdirs) ""
598 if {$tcl_platform(platform) == "unix"} {
599 set ascGlobalVect(librarypathdirs) [split $env(ASCENDLIBRARY) :]
600 } else { #windoze. mac? mac uses : instead of /, ugh.
601 set ascGlobalVect(librarypathdirs) [split $env(ASCENDLIBRARY) \;]
602 }
603 if {$tcl_platform(platform) == "unix"} {
604 set ascGlobalVect(ascend2gms) \
605 [file nativename [file dirname [info nameofexecutable]]]/ascend2gms.pl
606 set ascGlobalVect(gms2ascend) \
607 [file nativename [file dirname [info nameofexecutable]]]/convertoutput.pl
608 }
609
610 # take care of the PRIMARY selection under unix. the last window to
611 # have <<Copy>> call should be the only window to export selection.
612 set ascGlobalVect(selection_exporter) .
613
614 set slist ""
615 set s 0
616 catch {set slist [slv_available]}
617 set ascSolvVect(numberofsolvers) [llength $slist]
618 foreach i $slist {
619 set ascSolvVect(name.$s) $i
620 if {[string range $i 0 2]=="no_"} {
621 set ascSolvVect(available.$s) 0
622 set ascSolvVect(name.$s) [string range $i 3 end]
623 } else { set ascSolvVect(available.$s) 1}
624 incr s
625 }
626
627 set winshortlist \
628 "Solv Brow Libr Prob Debu Tool Scrip Mtx Unit Disp Global"
629 foreach w $winshortlist {
630 set asc${w}Vect(initialstate) "withdrawn"
631 set asc${w}Vect(geometry) "200x200+10+10"
632 set asc${w}Vect(iconname) $w
633 set asc${w}Vect(font) {helvetica 12 bold}
634 set asc${w}Vect(visibility) 1
635 }
636 #this next line sets the toolbitmap under the assumption that GlobalProc
637 # will never be present under xf. toolAttributes is C-registered
638 set ascGlobalVect(toolbitmap) toolAttributes
639
640 set ascToolVect(initialstate) "withdrawn"
641 set ascGlobalVect(maxutilrow) 8
642 set ascGlobalVect(hideinfoforever) 0
643 set ascGlobalVect(warrinfo) 0
644 set ascGlobalVect(liceinfo) 0
645 set ascGlobalVect(authinfo) 0
646
647 set ascDebuVect(windowname) .debug
648 set ascDispVect(windowname) .display
649 set ascMtxVect(windowname) .mtx
650 set ascScripVect(windowname) .script
651 set ascToolVect(windowname) .toolbox
652 set ascUnitVect(windowname) .units
653 set ascSolvVect(windowname) .solver
654 set ascBrowVect(windowname) .browser
655 set ascLibrVect(windowname) .library
656 set ascProbVect(windowname) .probe
657 # do the option database load which will override above settings
658 # the next line sets a dummy value for ScrollCommand at a low
659 # priority. if you see NoFunction returned from an option query
660 # you should apply some default instead. The tk Class default for
661 # ScrollCommand is {} so NoFunction is ok.
662 option add *ScrollComand NoFunction 20
663 #
664 # New tcl file ascend.ad
665 # View contains the procedures required by ascend.ad
666 #
667 puts "source $env(ASCENDTK)/View.tcl"
668 asc_source "$env(ASCENDTK)/View.tcl"
669 puts "source $env(ASCENDTK)/ascend.ad"
670 asc_source $env(ASCENDTK)/ascend.ad
671
672 update
673 if {[file exists $ascGlobalVect(userhome)/ascend.ad]} {
674 if {[catch {asc_source $ascGlobalVect(userhome)/ascend.ad} aderror]} {
675 puts $aderror
676 }
677 }
678 update
679
680 Set_View_Option_Values
681 View_Source_Option_Files
682
683 #
684 # # make ascend global ->Xglobal
685 # # do not add these at priorities >=20 as this will give conflicts
686 # # when reading the options with Foreground in get_opt
687 # option add *Font $ascGlobalVect(font) 60
688 option add *Text*Foreground $ascGlobalVect(tfg) 40
689 option add *Listbox*Foreground $ascGlobalVect(tfg) 40
690 option add *Text*Background $ascGlobalVect(tbg) 40
691 option add *Listbox*Background $ascGlobalVect(tbg) 40
692 # option add *Background $ascGlobalVect(bg) 60
693 # option add *Foreground $ascGlobalVect(fg) 60
694 # # initialize read/write virtual.
695 __userdata_init
696 set ascGlobalVect(w_load) "1"
697 }
698
699 # set color/etc vectors for transients with arrays
700 proc set_Template_defaults {} {
701 global ascGlobalVect asc_tkfbox
702 global AscMonoEntry1 AscMonoEntry2 AscMonoEntry4 AscConfirm VPaned
703 global AscPopSlide ascParPageVect ascMsgVect
704 global ascListSelectBox ascListSelectB1Box
705 set asc_tkfbox(cancelled) 0
706 set AscMonoEntry1(font) $ascGlobalVect(font)
707 set AscMonoEntry2(font) $ascGlobalVect(font)
708 set AscMonoEntry4(font) $ascGlobalVect(font)
709 set AscConfirm(font) $ascGlobalVect(font)
710 set VPaned(knobcolor) white
711 set AscPopSlide(font) $ascGlobalVect(font)
712 set ascParPageVect(btn_font) $ascGlobalVect(font)
713 set ascListSelectB1Box(font) $ascGlobalVect(font)
714 set ascListSelectB1Box(grab) 1
715 set ascListSelectBox(font) $ascGlobalVect(font)
716 set ascListSelectBox(grab) 1
717 set ascMsgVect(lbl_font) $ascGlobalVect(font)
718 set ascMsgVect(btn_font) $ascGlobalVect(font)
719 }
720
721 #
722 # proc Glob_do_GNU {}
723 #-----------------------------------------------------------------------
724 # the gnubutton callback
725 #-----------------------------------------------------------------------
726 # d_dumpfile defined in generalk.tcl, so this is silent until main loads
727 # generalk
728 proc Glob_do_GNU {} {
729 # old version
730 # global env
731 # set path "[lindex [split $env(ASCENDHELP) :] 0]/notices/startup"
732 # catch {d_dumpfile stdout $path}
733 # wm iconify .
734 ascShowInfo
735 }
736
737 proc ascShowInfo {{force 0}} {
738 global ascGlobalVect env
739
740 wm withdraw .
741 if {[winfo exists .itop]==1} {
742 destroy .itop
743 }
744 if {$ascGlobalVect(hideinfoforever)==1 && !$force} {
745 return
746 }
747 set f .itop.info
748 wm title . "ASCEND IV"
749 toplevel .itop
750 wm positionfrom .itop user
751 wm title .itop "ASCEND IV"
752 wm iconname .itop "ASCEND IV"
753 frame $f -highlightthickness 2 -borderwidth 2 -relief sunken
754 set t $f.text
755 text $t -yscrollcommand "$f.scroll set" -setgrid true \
756 -font {Helvetica 8} -width 80 -exportselection 0 \
757 -height 35 -wrap word -highlightthickness 0 -borderwidth 0
758 pack append $f $t {right frame center expand fill}
759 scrollbar $f.scroll -command "$t yview"
760 pack append $f $f.scroll {left frame center expand filly}
761 pack append .itop $f {bottom frame center expand fill}
762 $t tag configure center -justify center -spacing1 5m -spacing3 5m
763 $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
764 -spacing1 3m -spacing2 0 -spacing3 0
765
766 button $t.click -text "Authors" \
767 -command "ascAuthInfo" \
768 -font {Helvetica 8} \
769 -cursor top_left_arrow
770 button $t.delete -text "Help (starts browser)" \
771 -command {Script_getting_started} \
772 -font {Helvetica 8} \
773 -cursor top_left_arrow
774 button $t.goaway -text "Dismiss" \
775 -command {destroy .itop} \
776 -font {Helvetica 8} \
777 -cursor top_left_arrow
778 button $t.die -text "Dismiss forever" \
779 -command "Global_Dismiss_Forever" \
780 -font {Helvetica 8} \
781 -cursor top_left_arrow
782 button $t.gnu_btn \
783 -bitmap "@$env(ASCENDBITMAPS)/gnu-ascend.xbm" \
784 -state normal \
785 -text {}
786
787
788 $t insert end " ASCEND IV\n"
789 $t insert end "Advanced System for Computations in ENgineering Design\n"
790 $t insert end "(C) Copyright 1992-1998 Carnegie Mellon University\n"
791 $t insert end "\tRelease 0.9.0, June 19, 1998\n"
792 $t insert end "\n"
793 $t insert end "Click on the buttons below if you want to see who we are. "
794 $t insert end "By using ASCEND IV you are agreeing to the terms of "
795 $t insert end "the GNU Public License and Warranty in the first Script:."
796 $t insert end "License-Warranty.tcl\n"
797 $t insert end "\n"
798 $t insert end "ASCEND was developed by the students of Art Westerberg "
799 $t insert end "from 1984 to 1998. A number of other students have also "
800 $t insert end "contributed models to the ASCEND libraries. A list "
801 $t insert end "of the known contributors (in any capacity) is here: "
802 $t window create end -window $t.click
803 $t insert end "(Please let us know if we missed you.)"
804 $t insert end "\n"
805 $t insert end "\n"
806 $t insert end "Help for getting started with ASCEND should be available "
807 $t insert end "at "
808 $t insert end "\n"
809 $t insert end " http://www.cs.cmu.edu/~ascend/pdfhelp.htm\n"
810 $t insert end "(you should be able to paste the address above with a mouse)"
811 $t insert end " where you will find links to our on-line help and link to "
812 $t insert end "our bug report form.\n\n"
813 $t insert end " E-mail: ascend+help@cs.cmu.edu\n\n"
814
815 $t insert end " "
816 $t window create end -window $t.goaway
817 $t insert end " "
818 $t window create end -window $t.die
819 $t insert end "\n\n "
820 $t window create end -window $t.gnu_btn
821 $t insert end "\n\n"
822 $t insert end "USER DATA DIRECTORY $ascGlobalVect(userhome)"
823 $t insert end "\n\n"
824 wm deiconify .itop
825 }
826
827 #
828 # proc Global_Dismiss_Forever {}
829 #_________________________________________________________________
830 # Save the value of hideinfoforever = 1 in the file global.a4o
831 #_________________________________________________________________
832 proc Global_Dismiss_Forever {} {
833 entertrace
834 global ascGlobalVect
835
836 if {$ascGlobalVect(saveoptions) == 0} {
837 return
838 }
839
840 Global hideinfoforever 1
841 View_Save_Window_Options global
842 ascShowInfo
843 return
844
845 leavetrace
846 }
847
848 #
849 # proc ascAuthInfo {}
850 #_________________________________________________________________
851 # pops up a tkdialog with the content of TK/WhoDunnit.tcl
852 # all merged into a single string.
853 #_________________________________________________________________
854 proc ascAuthInfo {} {
855 global env ascScripVect
856 set fileInFile [open $env(ASCENDTK)/WhoDunnit.tcl r]
857 set textValue [read $fileInFile]
858 # regsub -all \n $textValue { } textValue2
859 asctk_dialog .authinfo $ascScripVect(font) "ASCEND Authors" \
860 $textValue toolAttributes 0 OK
861 }

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