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

Contents of /trunk/tcltk/tk/main.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2022 - (show annotations) (download) (as text)
Wed Apr 29 06:20:28 2009 UTC (10 years, 9 months ago) by jpye
File MIME type: text/x-tcl
File size: 16001 byte(s)
Rename generic/interface to interface and TK to tk.
1 # 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