summaryrefslogtreecommitdiff
path: root/lib/tcl/xcircuit.tcl.in
blob: 3d4504bd116a64cc822005155b2181d96132b831 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
# Wishrc startup for ToolScript (xcircuit)
#
# Loads the shared object (xcircuit.so) file into Tcl, runs the
# wrapper script to generate the GUI, then runs the initialization
# routine for the XCircuit package.

global XCOps

set envlibdir [array get env "XCIRCUIT_LIB_DIR"]
if {$envlibdir == {}} {
   set XCIRCUIT_LIB_DIR LIBDIR
}
unset envlibdir

set envsrcdir [array get env "XCIRCUIT_SRC_DIR"]
if {$envsrcdir != {}} {
   set path [lindex $envsrcdir 1]
} else {
   set path SCRIPTSDIR
   set XCIRCUIT_SRC_DIR $path
}
unset envsrcdir

if {[string compare $tcl_platform(platform) "windows"] == 0} {
   set libext .dll
} else {
   set libext .so
}

set tcllibdir $path
if {![file exists ${tcllibdir}/xcircuit$libext]} {
   set tcllibdir ${path}/tcl
}
if {![file exists ${tcllibdir}/xcircuit$libext]} {
   puts stderr "Error:  Cannot find file xcircuit$libext"
}
load ${tcllibdir}/xcircuit$libext

package require Xcircuit

# It is important to make sure no magic commands overlap with Tcl built-in
# commands, because otherwise the namespace import will fail.

proc pushnamespace { name } {

   set y [namespace eval ${name} info commands ::${name}::*]
   set z [info commands]

   foreach v $y {
      regsub -all {\*} $v {\\*} i
      set x [namespace tail $i]
      if {[lsearch $z $x] < 0} { 
	 namespace import $i                       
      } else {
	 puts "Warning: ${name} command '$x' use fully-qualified name '$v'"
      }
   }
}

proc popnamespace { name } {
   set z [info commands]
   set l [expr [string length ${name}] + 5]

   while {[set v [lsearch $z ${name}_tcl_*]] >= 0} {
      set y [lindex $z $v]
      set w [string range $y $l end]
      interp alias {} ::$w {}
      rename ::$y ::$w
      puts "Info: replacing ::$w with ::$y"
   }
   namespace forget ::${name}::*
}

set auto_noexec 1	;# don't EVER call UNIX commands w/o "shell" in front

# Have we called xcircuit from tkcon?

if {[lsearch [interp aliases] tkcon] != -1} {
   set XcConsole tkcon
   wm withdraw .

   # Rename conflicting TkCon commands before pushing xcircuit's namespace

   if {[lsearch [info commands] orig_edit] < 0} { rename edit orig_edit }
} else {

   # Extend the "unknown" command-line handler to be compatible with the
   # way we have renamed certain core Tcl/Tk functions.

   rename unknown tcl_unknown
   proc unknown { args } {
      # CAD tools special:
      # Check for commands which were renamed to tcl_(command)

      set cmd [lindex $args 0]
      if {[lsearch [info commands] tcl_$cmd] >= 0} {
         set arglist [concat tcl_$cmd [lrange $args 1 end]]
         set ret [catch {eval $arglist} result]
         if {$ret == 0} {
            return $result
         } else {
            return -code $ret -errorcode $errorCode $result
         }
      }
      return [eval [concat tcl_unknown $args]]
   }
}

# Rename conflicting Tcl/Tk commands before pushing xcircuit's namespace

if {[lsearch [info commands] tcl_label] < 0} { rename label tcl_label }

# Allow commands in the xcircuit namespace to be called from the toplevel namespace

pushnamespace xcircuit

#----------------------------------------------------------------------
# Cross-Application section
#----------------------------------------------------------------------

# Check namespaces for existence of other applications
set UsingMagic 0
set UsingIRSIM 0
set UsingNetgen 0
set nlist [namespace children]
foreach i $nlist {
   switch $i {
      ::magic { set UsingMagic 1 }
      ::irsim { set UsingIRSIM 1 }
      ::netgen { set UsingNetgen 1 }
   }
}

# Setup IRSIM assuming that the Tcl version is installed.
# We do not need to rename procedure irsim to NULL because it is
# redefined in a script, which simply overwrites the original.

proc irsim { args } {
   global CAD_ROOT
   set irsimscript [glob -nocomplain ${CAD_ROOT}/irsim/tcl/irsim.tcl]
   if { ${irsimscript} == {} } {
      puts stderr "\"irsim\" requires Tcl-based IRSIM version 9.6 or newer."
      puts stderr "Could not find script \"irsim.tcl\".  If IRSIM is installed in a"
      puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
      puts stderr "\"source <path>/irsim.tcl\" before doing \"irsim\"."
   } else {
      source $irsimscript
      eval {irsim} $args
   }
}

# Setup Magic assuming that the Tcl version is installed.

proc magic { args } {
   global CAD_ROOT
   set magicscript [glob -nocomplain ${CAD_ROOT}/magic/tcl/magic.tcl]
   if { ${magicscript} == {} } {
      puts stderr "\"magic\" requires Tcl-based Magic version 7.2 or newer."
      puts stderr "Could not find script \"magic.tcl\".  If Magic is installed in a"
      puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
      puts stderr "\"source <path>/magic.tcl\"."
   } else {
      set argv $args
      set argc [llength $args]
      uplevel #0 source $magicscript
   }
}

# Setup Netgen assuming that the Tcl version is installed.

proc netgen { args } {  
   global CAD_ROOT
   set netgenscript [glob -nocomplain ${CAD_ROOT}/netgen/tcl/netgen.tcl]
   if { ${netgenscript} == {} } {
      puts stderr "\"netgen\" requires Tcl-based Netgen version 1.2 or newer."
      puts stderr "Could not find script \"netgen.tcl\".  If Netgen is installed in a"
      puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
      puts stderr "\"source <path>/netgen.tcl\"."
   } else {
      set argv $args
      set argc [llength $args]
      source $netgenscript
   }
}

# Source the default resources file

source ${tcllibdir}/resource.tcl

# Sourcing of individual resource overrides

set envhomedir [array get env "HOME"]
if {$envhomedir != {}} {
   set homepath [lindex $envhomedir 1]
   set homedefaults ${homepath}/.Xdefaults
   if {[file exists $homedefaults]} {
      if {[catch {option readfile $homedefaults userDefault}]} {
	 puts stderr "Warning:  Error parsing file $homedefaults"
      }
   }
   unset homedefaults
   unset homepath
}
unset envhomedir

# Run the xcircuit start function

if {[string length $argv] == 0} {
   # Source the GUI-generating script
   source ${tcllibdir}/wrapper.tcl
   xcircuit::start .xcircuit
} else {
   set do_wrapper true
   set argafter {xcircuit::start}
   for {set i 0} {$i < $argc} {incr i 1} {
      set x [lindex $argv $i]
      switch -regexp -- $x {
	 ^-now {
	   set do_wrapper false
	 }
	 ^-r {
	   set XCOps(library) "all"
	 }
	 ^-noc {
	   # this option already handled---absorb it and do nothing.
	 }
	 default {
	   lappend argafter $x
	 }
      }
   }
   
   # Set up for interactive or filter (batch) mode processing
   if {$do_wrapper} {
      # Source the GUI-generating script
      source ${tcllibdir}/wrapper.tcl
      set argafter [linsert $argafter 1 .xcircuit]
   } else {
      simple .xcdummy -exitproc "quitnocheck"
      set XCOps(window) .xcdummy
   }
   unset x i do_wrapper
   eval $argafter		;# xcircuit::start .xcircuit ${argv}
}
unset tcllibdir

# The GUI wrapper iconfies the window while generating it
catch {wm deiconify $XCOps(toplevel)}

# Invoke the "wire" button by default
catch {$XCOps(focus).mainframe.toolbar.bw invoke}

# Xcircuit start function drops back to interpreter after initialization & setup

if {[string range [wm title .] 0 3] == "wish"} {
   wm withdraw .
}

if {[string range [wm title .] 0 8] == "xcircexec"} {
   wm withdraw .
}