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

Annotation of /trunk/tcltk/TK/GlobalProc.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: 29116 byte(s)
Renaming 'tcltk98' to 'tcltk', continued...
1 johnpye 571 # 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     8.3 {
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     # munge both backspace and delete to
404     if {$tcl_platform(platform)=="unix" && !$tk_strictMotif} {
405     # the standard tcl text bindings. Swap them.
406     # bind Text <Delete> {
407     # if {[%W tag nextrange sel 1.0 end] != ""} {
408     # %W delete sel.first sel.last
409     # } else {
410     # %W delete insert
411     # %W see insert
412     # }
413     #}
414     #bind Text <BackSpace> {
415     # if {[%W tag nextrange sel 1.0 end] != ""} {
416     # %W delete sel.first sel.last
417     # } elseif [%W compare insert != 1.0] {
418     # %W delete insert-1c
419     # %W see insert
420     # }
421     #}
422     bind Text <BackSpace> {
423     if {[%W tag nextrange sel 1.0 end] != ""} {
424     %W delete sel.first sel.last
425     } else {
426     %W delete insert
427     %W see insert
428     }
429     }
430     bind Text <Delete> {
431     if {[%W tag nextrange sel 1.0 end] != ""} {
432     %W delete sel.first sel.last
433     } elseif [%W compare insert != 1.0] {
434     %W delete insert-1c
435     %W see insert
436     }
437     }
438     }
439     if {!$tk_strictMotif} {
440     if {$tcl_platform(platform) =="windows"} {
441     bind Text <Control-Key-x> {
442     asctk_textCut %W
443     }
444     bind Text <Control-Key-c> {
445     asctk_textCopy %W
446     }
447     bind Text <Control-Key-v> {
448     asctk_textPaste %W
449     }
450     }
451     proc asctk_textCut {w} {
452     set expo [$w cget -exportselection]
453     $w configure -exportselection 1
454     selection own $w
455     tk_textCut $w
456     $w configure -exportselection $expo
457     }
458     proc asctk_textCopy {w} {
459     set expo [$w cget -exportselection]
460     $w configure -exportselection 1
461     selection own $w
462     tk_textCopy $w
463     $w configure -exportselection $expo
464     }
465     proc asctk_textPaste {w} {
466     set expo [$w cget -exportselection]
467     $w configure -exportselection 1
468     tk_textPaste $w
469     $w configure -exportselection $expo
470     }
471     }
472     }
473    
474     #
475     # Function to manage which ascend window, if any, claims the
476     # PRIMARY X selection. With this function, PRIMARY should
477     # shadow CLIPBOARD as long as ASCEND owns primary.
478     # We must have no more than 1 widget at a time exporting or
479     # life is very difficult.
480     # calling this function with a widget name makes that widget
481     # the exporting window and unmakes the previous widget exporterness.
482     proc asc_export_selection {w} {
483     global ascGlobalVect
484     if {![string length $w]} {
485     return
486     }
487     if {![winfo exists $w]} {
488     return
489     }
490     catch {$ascGlobalVect(selection_exporter) configure -exportselection 0} err
491     set ascGlobalVect(selection_exporter) $w
492     $w configure -exportselection 1
493     }
494    
495     #
496     # proc set_Global_Defaults {}
497     #-----------------------------------------------------------------------
498     # proc set_Global_Defaults
499     # These following must be set here to control window creation in Main.
500     #-----------------------------------------------------------------------
501     proc set_Global_Defaults {} {
502     set_cmuBindings
503    
504     global env tcl_platform asc_tkfbox
505     global ascBrowVect ascLibrVect ascSolvVect ascProbVect ascDebuVect
506     global ascToolVect ascSimsVect ascUnitVect ascDispVect ascGlobalVect
507     global ascScripVect ascMtxVect
508    
509     #
510     # Check if the directory for saving window options exists or can be
511     # created
512     #
513     if {[string compare $tcl_platform(platform) "unix"]==0} {
514     if { [ file exists ~/ascdata ]} {
515     set ascGlobalVect(saveoptions) 1
516     } else {
517     if { [catch {file mkdir ~/ascdata} direrror] } {
518     set ascGlobalVect(saveoptions) 0
519     puts $direrror
520     } else {
521     set ascGlobalVect(saveoptions) 1
522     puts "directory ~/ascdata has been created"
523     }
524     }
525     set ascGlobalVect(userhome) ""
526     catch {set ascGlobalVect(userhome) "[glob ~/ascdata]"}
527     }
528     if {[string compare $tcl_platform(platform) "windows"]==0} {
529     set uhome {}
530     catch {set uhome [glob ~]}
531     if {[info exists env(HOME)] &&
532     [file isdirectory $env(HOME)] &&
533     [file writable $env(HOME)]} {
534     set uhome $env(HOME)
535     }
536     set upfound 0
537     if {[string length $uhome] < 4} {
538     if {[info exists env(USERPROFILE)] &&
539     [file isdirectory $env(USERPROFILE)] &&
540     [file writable $env(USERPROFILE)]} {
541     set uhome $env(USERPROFILE)
542     set upfound 1
543     }
544     }
545     if {!$upfound && [string length $uhome] < 4} {
546     if {[info exists env(USERHOME)] &&
547     [file isdirectory $env(USERHOME)] &&
548     [file writable $env(USERHOME)]} {
549     set uhome $env(USERHOME)
550     set upfound 1
551     }
552     }
553     append uhome /ascdata
554     puts stderr "data home = $uhome"
555    
556     if { [ file exists $uhome ] && \
557     [file writable $uhome] && \
558     [file isdirectory $uhome]} {
559     set ascGlobalVect(saveoptions) 1
560     } else {
561     if { [catch {file mkdir $uhome} direrror] } {
562     set ascGlobalVect(saveoptions) 0
563     puts $direrror
564     } else {
565     set ascGlobalVect(saveoptions) 1
566     puts "directory $uhome has been created"
567     }
568     }
569     set ascGlobalVect(userhome) $uhome
570     }
571    
572     if {[info exists env(ASCENDLIBRARY)] == 0} {
573     puts stderr "setting lib in global to [pwd]"
574     set env(ASCENDLIBRARY) [pwd]
575     }
576     if {$ascGlobalVect(saveoptions)} {
577     switch $tcl_platform(platform) {
578     unix {
579     set env(ASCENDLIBRARY) $ascGlobalVect(userhome):$env(ASCENDLIBRARY)
580     }
581     windows {
582     set crap [file nativename $ascGlobalVect(userhome)]
583     append crap ";"
584     append crap $env(ASCENDLIBRARY)
585     set env(ASCENDLIBRARY) $crap
586     }
587     macintosh {
588     puts stderr "ASCEND IV's Tcl/Tk interface has not yet been ported"
589     puts stderr "to Macintosh. Lots and lots of things are broken."
590     error "ASCEND load aborted on macintosh."
591     }
592     }
593     }
594     puts stderr "Library directories:"
595     puts stderr $env(ASCENDLIBRARY)
596     set ascGlobalVect(librarypathdirs) ""
597     if {$tcl_platform(platform) == "unix"} {
598     set ascGlobalVect(librarypathdirs) [split $env(ASCENDLIBRARY) :]
599     } else { #windoze. mac? mac uses : instead of /, ugh.
600     set ascGlobalVect(librarypathdirs) [split $env(ASCENDLIBRARY) \;]
601     }
602     if {$tcl_platform(platform) == "unix"} {
603     set ascGlobalVect(ascend2gms) \
604     [file nativename [file dirname [info nameofexecutable]]]/ascend2gms.pl
605     set ascGlobalVect(gms2ascend) \
606     [file nativename [file dirname [info nameofexecutable]]]/convertoutput.pl
607     }
608    
609     # take care of the PRIMARY selection under unix. the last window to
610     # have <<Copy>> call should be the only window to export selection.
611     set ascGlobalVect(selection_exporter) .
612    
613     set slist ""
614     set s 0
615     catch {set slist [slv_available]}
616     set ascSolvVect(numberofsolvers) [llength $slist]
617     foreach i $slist {
618     set ascSolvVect(name.$s) $i
619     if {[string range $i 0 2]=="no_"} {
620     set ascSolvVect(available.$s) 0
621     set ascSolvVect(name.$s) [string range $i 3 end]
622     } else { set ascSolvVect(available.$s) 1}
623     incr s
624     }
625    
626     set winshortlist \
627     "Solv Brow Libr Prob Debu Tool Scrip Mtx Unit Disp Global"
628     foreach w $winshortlist {
629     set asc${w}Vect(initialstate) "withdrawn"
630     set asc${w}Vect(geometry) "200x200+10+10"
631     set asc${w}Vect(iconname) $w
632     set asc${w}Vect(font) {helvetica 12 bold}
633     set asc${w}Vect(visibility) 1
634     }
635     #this next line sets the toolbitmap under the assumption that GlobalProc
636     # will never be present under xf. toolAttributes is C-registered
637     set ascGlobalVect(toolbitmap) toolAttributes
638    
639     set ascToolVect(initialstate) "withdrawn"
640     set ascGlobalVect(maxutilrow) 8
641     set ascGlobalVect(hideinfoforever) 0
642     set ascGlobalVect(warrinfo) 0
643     set ascGlobalVect(liceinfo) 0
644     set ascGlobalVect(authinfo) 0
645    
646     set ascDebuVect(windowname) .debug
647     set ascDispVect(windowname) .display
648     set ascMtxVect(windowname) .mtx
649     set ascScripVect(windowname) .script
650     set ascToolVect(windowname) .toolbox
651     set ascUnitVect(windowname) .units
652     set ascSolvVect(windowname) .solver
653     set ascBrowVect(windowname) .browser
654     set ascLibrVect(windowname) .library
655     set ascProbVect(windowname) .probe
656     # do the option database load which will override above settings
657     # the next line sets a dummy value for ScrollCommand at a low
658     # priority. if you see NoFunction returned from an option query
659     # you should apply some default instead. The tk Class default for
660     # ScrollCommand is {} so NoFunction is ok.
661     option add *ScrollComand NoFunction 20
662     #
663     # New tcl file ascend.ad
664     # View contains the procedures required by ascend.ad
665     #
666     puts "source $env(ASCENDTK)/View.tcl"
667     asc_source "$env(ASCENDTK)/View.tcl"
668     puts "source $env(ASCENDTK)/ascend.ad"
669     asc_source $env(ASCENDTK)/ascend.ad
670    
671     update
672     if {[file exists $ascGlobalVect(userhome)/ascend.ad]} {
673     if {[catch {asc_source $ascGlobalVect(userhome)/ascend.ad} aderror]} {
674     puts $aderror
675     }
676     }
677     update
678    
679     Set_View_Option_Values
680     View_Source_Option_Files
681    
682     #
683     # # make ascend global ->Xglobal
684     # # do not add these at priorities >=20 as this will give conflicts
685     # # when reading the options with Foreground in get_opt
686     # option add *Font $ascGlobalVect(font) 60
687     option add *Text*Foreground $ascGlobalVect(tfg) 40
688     option add *Listbox*Foreground $ascGlobalVect(tfg) 40
689     option add *Text*Background $ascGlobalVect(tbg) 40
690     option add *Listbox*Background $ascGlobalVect(tbg) 40
691     # option add *Background $ascGlobalVect(bg) 60
692     # option add *Foreground $ascGlobalVect(fg) 60
693     # # initialize read/write virtual.
694     __userdata_init
695     set ascGlobalVect(w_load) "1"
696     }
697    
698     # set color/etc vectors for transients with arrays
699     proc set_Template_defaults {} {
700     global ascGlobalVect asc_tkfbox
701     global AscMonoEntry1 AscMonoEntry2 AscMonoEntry4 AscConfirm VPaned
702     global AscPopSlide ascParPageVect ascMsgVect
703     global ascListSelectBox ascListSelectB1Box
704     set asc_tkfbox(cancelled) 0
705     set AscMonoEntry1(font) $ascGlobalVect(font)
706     set AscMonoEntry2(font) $ascGlobalVect(font)
707     set AscMonoEntry4(font) $ascGlobalVect(font)
708     set AscConfirm(font) $ascGlobalVect(font)
709     set VPaned(knobcolor) white
710     set AscPopSlide(font) $ascGlobalVect(font)
711     set ascParPageVect(btn_font) $ascGlobalVect(font)
712     set ascListSelectB1Box(font) $ascGlobalVect(font)
713     set ascListSelectB1Box(grab) 1
714     set ascListSelectBox(font) $ascGlobalVect(font)
715     set ascListSelectBox(grab) 1
716     set ascMsgVect(lbl_font) $ascGlobalVect(font)
717     set ascMsgVect(btn_font) $ascGlobalVect(font)
718     }
719    
720     #
721     # proc Glob_do_GNU {}
722     #-----------------------------------------------------------------------
723     # the gnubutton callback
724     #-----------------------------------------------------------------------
725     # d_dumpfile defined in generalk.tcl, so this is silent until main loads
726     # generalk
727     proc Glob_do_GNU {} {
728     # old version
729     # global env
730     # set path "[lindex [split $env(ASCENDHELP) :] 0]/notices/startup"
731     # catch {d_dumpfile stdout $path}
732     # wm iconify .
733     ascShowInfo
734     }
735    
736     proc ascShowInfo {{force 0}} {
737     global ascGlobalVect env
738    
739     wm withdraw .
740     if {[winfo exists .itop]==1} {
741     destroy .itop
742     }
743     if {$ascGlobalVect(hideinfoforever)==1 && !$force} {
744     return
745     }
746     set f .itop.info
747     wm title . "ASCEND IV"
748     toplevel .itop
749     wm positionfrom .itop user
750     wm title .itop "ASCEND IV"
751     wm iconname .itop "ASCEND IV"
752     frame $f -highlightthickness 2 -borderwidth 2 -relief sunken
753     set t $f.text
754     text $t -yscrollcommand "$f.scroll set" -setgrid true \
755     -font {Helvetica 8} -width 80 -exportselection 0 \
756     -height 35 -wrap word -highlightthickness 0 -borderwidth 0
757     pack append $f $t {right frame center expand fill}
758     scrollbar $f.scroll -command "$t yview"
759     pack append $f $f.scroll {left frame center expand filly}
760     pack append .itop $f {bottom frame center expand fill}
761     $t tag configure center -justify center -spacing1 5m -spacing3 5m
762     $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
763     -spacing1 3m -spacing2 0 -spacing3 0
764    
765     button $t.click -text "Authors" \
766     -command "ascAuthInfo" \
767     -font {Helvetica 8} \
768     -cursor top_left_arrow
769     button $t.delete -text "Help (starts browser)" \
770     -command {Script_getting_started} \
771     -font {Helvetica 8} \
772     -cursor top_left_arrow
773     button $t.goaway -text "Dismiss" \
774     -command {destroy .itop} \
775     -font {Helvetica 8} \
776     -cursor top_left_arrow
777     button $t.die -text "Dismiss forever" \
778     -command "Global_Dismiss_Forever" \
779     -font {Helvetica 8} \
780     -cursor top_left_arrow
781     button $t.gnu_btn \
782     -bitmap "@$env(ASCENDBITMAPS)/gnu-ascend.xbm" \
783     -state normal \
784     -text {}
785    
786    
787     $t insert end " ASCEND IV\n"
788     $t insert end "Advanced System for Computations in ENgineering Design\n"
789     $t insert end "(C) Copyright 1992-1998 Carnegie Mellon University\n"
790     $t insert end "\tRelease 0.9.0, June 19, 1998\n"
791     $t insert end "\n"
792     $t insert end "Click on the buttons below if you want to see who we are. "
793     $t insert end "By using ASCEND IV you are agreeing to the terms of "
794     $t insert end "the GNU Public License and Warranty in the first Script:."
795     $t insert end "License-Warranty.tcl\n"
796     $t insert end "\n"
797     $t insert end "ASCEND was developed by the students of Art Westerberg "
798     $t insert end "from 1984 to 1998. A number of other students have also "
799     $t insert end "contributed models to the ASCEND libraries. A list "
800     $t insert end "of the known contributors (in any capacity) is here: "
801     $t window create end -window $t.click
802     $t insert end "(Please let us know if we missed you.)"
803     $t insert end "\n"
804     $t insert end "\n"
805     $t insert end "Help for getting started with ASCEND should be available "
806     $t insert end "at "
807     $t insert end "\n"
808     $t insert end " http://www.cs.cmu.edu/~ascend/pdfhelp.htm\n"
809     $t insert end "(you should be able to paste the address above with a mouse)"
810     $t insert end " where you will find links to our on-line help and link to "
811     $t insert end "our bug report form.\n\n"
812     $t insert end " E-mail: ascend+help@cs.cmu.edu\n\n"
813    
814     $t insert end " "
815     $t window create end -window $t.goaway
816     $t insert end " "
817     $t window create end -window $t.die
818     $t insert end "\n\n "
819     $t window create end -window $t.gnu_btn
820     $t insert end "\n\n"
821     $t insert end "USER DATA DIRECTORY $ascGlobalVect(userhome)"
822     $t insert end "\n\n"
823     wm deiconify .itop
824     }
825    
826     #
827     # proc Global_Dismiss_Forever {}
828     #_________________________________________________________________
829     # Save the value of hideinfoforever = 1 in the file global.a4o
830     #_________________________________________________________________
831     proc Global_Dismiss_Forever {} {
832     entertrace
833     global ascGlobalVect
834    
835     if {$ascGlobalVect(saveoptions) == 0} {
836     return
837     }
838    
839     Global hideinfoforever 1
840     View_Save_Window_Options global
841     ascShowInfo
842     return
843    
844     leavetrace
845     }
846    
847     #
848     # proc ascAuthInfo {}
849     #_________________________________________________________________
850     # pops up a tkdialog with the content of TK/WhoDunnit.tcl
851     # all merged into a single string.
852     #_________________________________________________________________
853     proc ascAuthInfo {} {
854     global env ascScripVect
855     set fileInFile [open $env(ASCENDTK)/WhoDunnit.tcl r]
856     set textValue [read $fileInFile]
857     # regsub -all \n $textValue { } textValue2
858     asctk_dialog .authinfo $ascScripVect(font) "ASCEND Authors" \
859     $textValue toolAttributes 0 OK
860     }

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