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

Annotation of /trunk/tcltk/TK/main.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: 16001 byte(s)
Renaming 'tcltk98' to 'tcltk', continued...
1 johnpye 571 # main.tcl
2     # by Benjamin A. Allan and Kirk A. Abbott
3     # Created: January 1994
4     # Part of ASCEND
5     # Revision: $Revision: 1.9 $
6     # Last modified on: $Date: 1998/11/22 16:04:52 $
7     # Last modified by: $Author: ballan $
8     # Revision control file: $RCSfile: main.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     # Program: main
30     # Tcl version: 7.1 (Tcl/Tk/XF)
31     # Tk version: 3.4
32     # XF version: 2.2
33     #
34    
35     # module inclusion
36     global env
37     global xfLoadPath
38     global xfLoadInfo
39     set xfLoadInfo 0
40     global tcl_platform
41     if {[string compare tcl_platform(platform) "unix"]==0} {
42     if {[info exists env(XF_LOAD_PATH)]} {
43     if {[string first $env(XF_LOAD_PATH) "/usr1/ballan/local/XF/bin:/usr1/ballan/local/xf2.2:.:$env(ASCENDTK)"] == -1} {
44     set xfLoadPath "$env(XF_LOAD_PATH):/usr1/ballan/local/XF/bin:/usr1/ballan/local/xf2.2:.:$env(ASCENDTK)"
45     } else {
46     set xfLoadPath "/usr1/ballan/local/XF/bin:/usr1/ballan/local/xf2.2:.:$env(ASCENDTK)"
47     }
48     } else {
49     set xfLoadPath "/usr1/ballan/local/XF/bin:/usr1/ballan/local/xf2.2:.:$env(ASCENDTK)"
50     }
51     } else {
52     set xfLoadPath $env(ASCENDTK)
53     }
54    
55     global argc
56     global argv
57     set tmpArgv ""
58     for {set counter 0} {$counter < $argc} {incr counter 1} {
59     switch [string tolower [lindex $argv $counter]] {
60     {-xfloadpath} {
61     incr counter 1
62     set xfLoadPath "[lindex $argv $counter]:$xfLoadPath"
63     }
64     {-xfstartup} {
65     incr counter 1
66     source [lindex $argv $counter]
67     }
68     {-xfbindfile} {
69     incr counter 1
70     set env(XF_BIND_FILE) "[lindex $argv $counter]"
71     }
72     {-xfcolorfile} {
73     incr counter 1
74     set env(XF_COLOR_FILE) "[lindex $argv $counter]"
75     }
76     {-xfcursorfile} {
77     incr counter 1
78     set env(XF_CURSOR_FILE) "[lindex $argv $counter]"
79     }
80     {-xffontfile} {
81     incr counter 1
82     set env(XF_FONT_FILE) "[lindex $argv $counter]"
83     }
84     {-xfmodelmono} {
85     if {$tk_version >= 3.0} {
86     tk colormodel . monochrome
87     }
88     }
89     {-xfmodelcolor} {
90     if {$tk_version >= 3.0} {
91     tk colormodel . color
92     }
93     }
94     {-xfloading} {
95     set xfLoadInfo 1
96     }
97     {-xfnoloading} {
98     set xfLoadInfo 0
99     }
100     {default} {
101     lappend tmpArgv [lindex $argv $counter]
102     }
103     }
104     }
105     set argv $tmpArgv
106     set argc [llength $tmpArgv]
107     unset counter
108     unset tmpArgv
109    
110    
111     # procedure to show window . taken over by Glob_do_GNU
112     # proc ShowWindow. {args}
113     proc ShowWindow. {args} {# xf ignore me 7
114    
115     StartupSrc.
116    
117     # Window manager configurations
118     # wm positionfrom . user
119     # wm sizefrom . user
120     update idletask
121     # wm iconify .
122     # wm maxsize . 85 92
123     # wm minsize . 0 0
124     # wm title . {ASCEND IV}
125    
126    
127     EndSrc.
128    
129     if {"[info procs XFEdit]" != ""} {
130     catch "XFMiscBindWidgetTree ."
131     after 2 "catch {XFEditSetShowWindows}"
132     }
133     }
134    
135     # proc StartupSrc. {args}
136     proc StartupSrc. {args} {
137     # root startup entrance
138     }
139    
140     # proc EndSrc. {}
141     proc EndSrc. {} {
142     # root startup exit
143     }
144    
145    
146     # User defined procedures
147    
148    
149     # Internal procedures
150    
151    
152    
153     # sources the rest of ascend window modules
154     # module load procedure
155     proc XFLocalIncludeModule {{moduleName ""}} {
156     global env
157     global xfLoadInfo
158     global xfLoadPath
159     global xfStatus
160     global tcl_platform
161     set pathsep ":"
162     if {![string compare $tcl_platform(platform) "windows"]} {
163     set pathsep ";"
164     }
165     foreach p [split $xfLoadPath $pathsep] {
166     if {[file exists "$p/$moduleName"]} {
167     if {![file readable "$p/$moduleName"]} {
168     puts stderr "Cannot read $p/$moduleName (permission denied)"
169     continue
170     }
171     if {$xfLoadInfo} {
172     puts stdout "Loading $p/$moduleName..."
173     }
174     source "$p/$moduleName"
175     return 1
176     }
177     # first see if we have a load command
178     if {[info exists env(XF_VERSION_SHOW)]} {
179     set xfCommand $env(XF_VERSION_SHOW)
180     regsub -all {\$xfFileName} $xfCommand $p/$moduleName xfCommand
181     if {$xfLoadInfo} {
182     puts stdout "Loading $p/$moduleName...($xfCommand)"
183     }
184     if {[catch "$xfCommand" contents]} {
185     continue
186     } else {
187     eval $contents
188     return 1
189     }
190     }
191     # # are we able to load versions from wish ?
192     # if {[catch "afbind $p/$moduleName" aso]} {
193     # # try to use xf version load command
194     # global xfVersion
195     # if {[info exists xfVersion(showDefault)]} {
196     # set xfCommand $xfVersion(showDefault)
197     # } else {
198     # # our last hope
199     # set xfCommand "vcat -q $p/$moduleName"
200     # }
201     # regsub -all {\$xfFileName} $xfCommand $p/$moduleName xfCommand
202     # if {$xfLoadInfo} {
203     # puts stdout "Loading $p/$moduleName...($xfCommand)"
204     # }
205     # if {[catch "$xfCommand" contents]} {
206     # continue
207     # } else {
208     # eval $contents
209     # return 1
210     # }
211     # } else {
212     # # yes we can load versions directly
213     # if {[catch "$aso open r" inFile]} {
214     # puts stderr "Cannot open $p/[$aso attr af_bound] (permission denied)"
215     # continue
216     # }
217     # if {$xfLoadInfo} {
218     # puts stdout "Loading $p/[$aso attr af_bound]..."
219     # }
220     # if {[catch "read \{$inFile\}" contents]} {
221     # puts stderr "Cannot read $p/[$aso attr af_bound] (permission denied)"
222     # close $inFile
223     # continue
224     # }
225     # close $inFile
226     # eval $contents
227     # return 1
228     # }
229     # }
230     puts stderr "Cannot load module $moduleName -- check your xf load path"
231     puts stderr "Specify a xf load path with the environment variable:"
232     puts stderr " XF_LOAD_PATH (e.g \"export XF_LOAD_PATH=.\")"
233     puts stderr "to quit, type 'exit'."
234     # catch "destroy ."
235     # catch "exit 0"
236     }
237    
238     # application parsing procedure
239     proc XFLocalParseAppDefs {xfAppDefFile} {
240     global xfAppDefaults
241    
242     # basically from: Michael Moore
243     if {[file exists $xfAppDefFile] &&
244     [file readable $xfAppDefFile] &&
245     "[file type $xfAppDefFile]" == "link"} {
246     catch "file type $xfAppDefFile" xfType
247     while {"$xfType" == "link"} {
248     if {[catch "file readlink $xfAppDefFile" xfAppDefFile]} {
249     return
250     }
251     catch "file type $xfAppDefFile" xfType
252     }
253     }
254     if {!("$xfAppDefFile" != "" &&
255     [file exists $xfAppDefFile] &&
256     [file readable $xfAppDefFile] &&
257     "[file type $xfAppDefFile]" == "file")} {
258     return
259     }
260     if {![catch "open $xfAppDefFile r" xfResult]} {
261     set xfAppFileContents [read $xfResult]
262     close $xfResult
263     foreach line [split $xfAppFileContents "\n"] {
264     # backup indicates how far to backup. It applies to the
265     # situation where a resource name ends in . and when it
266     # ends in *. In the second Case you want to keep the *
267     # in the widget name for pattern matching, but you want
268     # to get rid of the . if it is the end of the name.
269     set backup -2
270     set line [string trim $line]
271     if {[string index $line 0] == "#" || "$line" == ""} {
272     # skip comments and empty lines
273     continue
274     }
275     set list [split $line ":"]
276     set resource [string trim [lindex $list 0]]
277     set i [string last "." $resource]
278     set j [string last "*" $resource]
279     if {$j > $i} {
280     set i $j
281     set backup -1
282     }
283     incr i
284     set name [string range $resource $i end]
285     incr i $backup
286     set widname [string range $resource 0 $i]
287     set value [string trim [lindex $list 1]]
288     if {"$widname" != "" && "$widname" != "*"} {
289     # insert the widget and resourcename to the application
290     # defaults list.
291     if {![info exists xfAppDefaults]} {
292     set xfAppDefaults ""
293     }
294     lappend xfAppDefaults [list $widname [string tolower $name] $value]
295     }
296     }
297     }
298     }
299    
300     # application loading procedure
301     proc XFLocalLoadAppDefs {{xfClasses ""} {xfPriority "startupFile"} {xfAppDefFile ""}} {
302     global env
303    
304     if {"$xfAppDefFile" == ""} {
305     set xfFileList ""
306     if {[info exists env(XUSERFILESEARCHPATH)]} {
307     append xfFileList [split $env(XUSERFILESEARCHPATH) :]
308     }
309     if {[info exists env(XAPPLRESDIR)]} {
310     append xfFileList [split $env(XAPPLRESDIR) :]
311     }
312     if {[info exists env(XFILESEARCHPATH)]} {
313     append xfFileList [split $env(XFILESEARCHPATH) :]
314     }
315     append xfFileList " /usr/lib/X11/app-defaults"
316     append xfFileList " /usr/X11/lib/X11/app-defaults"
317    
318     foreach xfCounter1 $xfClasses {
319     foreach xfCounter2 $xfFileList {
320     set xfPathName $xfCounter2
321     if {[regsub -all "%N" "$xfPathName" "$xfCounter1" xfResult]} {
322     set xfPathName $xfResult
323     }
324     if {[regsub -all "%T" "$xfPathName" "app-defaults" xfResult]} {
325     set xfPathName $xfResult
326     }
327     if {[regsub -all "%S" "$xfPathName" "" xfResult]} {
328     set xfPathName $xfResult
329     }
330     if {[regsub -all "%C" "$xfPathName" "" xfResult]} {
331     set xfPathName $xfResult
332     }
333     if {[file exists $xfPathName] &&
334     [file readable $xfPathName] &&
335     ("[file type $xfPathName]" == "file" ||
336     "[file type $xfPathName]" == "link")} {
337     catch "option readfile $xfPathName $xfPriority"
338     if {"[info commands XFParseAppDefs]" != ""} {
339     XFParseAppDefs $xfPathName
340     } else {
341     if {"[info commands XFLocalParseAppDefs]" != ""} {
342     XFLocalParseAppDefs $xfPathName
343     }
344     }
345     } else {
346     if {[file exists $xfCounter2/$xfCounter1] &&
347     [file readable $xfCounter2/$xfCounter1] &&
348     ("[file type $xfCounter2/$xfCounter1]" == "file" ||
349     "[file type $xfCounter2/$xfCounter1]" == "link")} {
350     catch "option readfile $xfCounter2/$xfCounter1 $xfPriority"
351     if {"[info commands XFParseAppDefs]" != ""} {
352     XFParseAppDefs $xfCounter2/$xfCounter1
353     } else {
354     if {"[info commands XFLocalParseAppDefs]" != ""} {
355     XFLocalParseAppDefs $xfCounter2/$xfCounter1
356     }
357     }
358     }
359     }
360     }
361     }
362     } else {
363     # load a specific application defaults file
364     if {[file exists $xfAppDefFile] &&
365     [file readable $xfAppDefFile] &&
366     ("[file type $xfAppDefFile]" == "file" ||
367     "[file type $xfAppDefFile]" == "link")} {
368     catch "option readfile $xfAppDefFile $xfPriority"
369     if {"[info commands XFParseAppDefs]" != ""} {
370     XFParseAppDefs $xfAppDefFile
371     } else {
372     if {"[info commands XFLocalParseAppDefs]" != ""} {
373     XFLocalParseAppDefs $xfAppDefFile
374     }
375     }
376     }
377     }
378     }
379    
380     # application setting procedure
381     proc XFLocalSetAppDefs {{xfWidgetPath "."}} {
382     global xfAppDefaults
383    
384     if {![info exists xfAppDefaults]} {
385     return
386     }
387     foreach xfCounter $xfAppDefaults {
388     if {"$xfCounter" == ""} {
389     break
390     }
391     set widname [lindex $xfCounter 0]
392     if {[string match $widname ${xfWidgetPath}] ||
393     [string match "${xfWidgetPath}*" $widname]} {
394     set name [string tolower [lindex $xfCounter 1]]
395     set value [lindex $xfCounter 2]
396     # Now lets see how many tcl commands match the name
397     # pattern specified.
398     set widlist [info command $widname]
399     if {"$widlist" != ""} {
400     foreach widget $widlist {
401     # make sure this command is a widget.
402     if {![catch "winfo id $widget"] &&
403     [string match "${xfWidgetPath}*" $widget]} {
404     catch "$widget configure -$name $value"
405     }
406     }
407     }
408     }
409     }
410     }
411    
412     XFLocalIncludeModule browser.tcl
413     XFLocalIncludeModule display.tcl
414     XFLocalIncludeModule generalk.tcl
415     XFLocalIncludeModule pane.tcl
416     XFLocalIncludeModule library.tcl
417     XFLocalIncludeModule typetree.tcl
418     XFLocalIncludeModule probe.tcl
419     XFLocalIncludeModule script.tcl
420     XFLocalIncludeModule solver.tcl
421     XFLocalIncludeModule debug.tcl
422     XFLocalIncludeModule mtx.tcl
423     XFLocalIncludeModule toolbox.tcl
424     XFLocalIncludeModule util.tcl
425     XFLocalIncludeModule units.tcl
426    
427     # prepare auto loading
428     global auto_path
429     global xfLoadPath
430     foreach xfElement [eval list [split $xfLoadPath :] $auto_path] {
431     if {[file exists $xfElement/tclIndex]} {
432     lappend auto_path $xfElement
433     }
434     }
435     catch "unset auto_index"
436    
437     catch "unset auto_oldpath"
438    
439     #catch "unset auto_execs"
440    
441    
442     # initialize global variables
443     proc InitGlobals {} {
444     global {alertBox}
445     set {alertBox(activeBackground)} {}
446     set {alertBox(activeForeground)} {}
447     set {alertBox(after)} {0}
448     set {alertBox(anchor)} {nw}
449     set {alertBox(background)} {}
450     set {alertBox(button)} {0}
451     set {alertBox(font)} {}
452     set {alertBox(foreground)} {}
453     set {alertBox(justify)} {center}
454     set {alertBox(toplevelName)} {.alertBox}
455    
456     # please don't modify the following
457     # variables. They are needed by xf.
458     global {autoLoadList}
459     set {autoLoadList(browser.tcl)} {0}
460     set {autoLoadList(display.tcl)} {0}
461     set {autoLoadList(generalk.tcl)} {0}
462     set {autoLoadList(pane.tcl)} {0}
463     set {autoLoadList(library.tcl)} {0}
464     set {autoLoadList(typetree.tcl)} {0}
465     set {autoLoadList(main.tcl)} {0}
466     set {autoLoadList(probe.tcl)} {0}
467     set {autoLoadList(script.tcl)} {0}
468     set {autoLoadList(solver.tcl)} {0}
469     set {autoLoadList(debug.tcl)} {0}
470     set {autoLoadList(mtx.tcl)} {0}
471     set {autoLoadList(toolbox.tcl)} {0}
472     set {autoLoadList(util.tcl)} {0}
473     set {autoLoadList(units.tcl)} {0}
474     global {internalAliasList}
475     set {internalAliasList} {}
476     global {moduleList}
477     set {moduleList(browser.tcl)} { .browser}
478     set {moduleList(display.tcl)} { .display}
479     set {moduleList(generalk.tcl)} { Alias GetSelection MenuPopupAdd MenuPopupMotion MenuPopupPost MenuPopupRelease NoFunction OptionButtonGet OptionButtonSet SN SymbolicName Unalias cls ascclearlist ascfileread readdir updatelist ascGetSelection}
480     set {moduleList(library.tcl)} { .library}
481     set {moduleList(typetree.tcl)} { .typetree}
482     set {moduleList(main.tcl)} { .}
483     set {moduleList(probe.tcl)} { .probe}
484     set {moduleList(script.tcl)} { .script}
485     set {moduleList(solver.tcl)} { .solver}
486     set {moduleList(debug.tcl)} { .debug}
487     set {moduleList(mtx.tcl)} { .mtx}
488     set {moduleList(toolbox.tcl)} { .toolbox do_raise do_raise_lower}
489     set {moduleList(util.tcl)} { .util}
490     set {moduleList(units.tcl)} { .units}
491     global {preloadList}
492     set {preloadList(xfInternal)} {}
493     global {symbolicName}
494     set {symbolicName(root)} {.}
495     global {xfWmSetPosition}
496     set {xfWmSetPosition} {.toolbox}
497     global {xfWmSetSize}
498     set {xfWmSetSize} {.toolbox .sims .script .display .library .probe .units}
499     global {xfAppDefToplevels}
500     set {xfAppDefToplevels} {}
501     }
502    
503     # initialize global variables
504     # InitGlobals
505    
506     # display/remove toplevel windows.
507     ShowWindow.
508    
509     global xfShowWindow.browser
510     set xfShowWindow.browser 0
511    
512     global xfShowWindow.display
513     set xfShowWindow.display 0
514    
515     global xfShowWindow.library
516     set xfShowWindow.library 0
517    
518     global xfShowWindow.probe
519     set xfShowWindow.probe 0
520    
521     global xfShowWindow.script
522     set xfShowWindow.script 0
523    
524     global xfShowWindow.sims
525     set xfShowWindow.sims 0
526    
527     global xfShowWindow.solver
528     set xfShowWindow.solver 0
529    
530     global xfShowWindow.toolbox
531     set xfShowWindow.toolbox 0
532    
533     global xfShowWindow.util
534     set xfShowWindow.util 0
535    
536     global xfShowWindow.units
537     set xfShowWindow.units 0
538    
539     # load default bindings.
540     if {[info exists env(XF_BIND_FILE)] &&
541     "[info procs XFShowHelp]" == ""} {
542     source $env(XF_BIND_FILE)
543     }
544    
545     # parse and apply application defaults.
546     XFLocalLoadAppDefs Main
547     XFLocalSetAppDefs
548    
549     # eof
550     #
551    

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