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

Annotation of /trunk/tcltk98/TK/GlobalProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


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

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