1 #-------------------------------------------------------------------------
2 # Start of xcircuit GUI configuration file.
3 # This file is sourced by "xcircuit.tcl" (".wishrc")
4 #-------------------------------------------------------------------------
6 # This script sets up all the xcircuit windows and callback functions.
7 # The callback routines are in the shared object file xcwrap.so
10 #-------------------------------
11 # Main xcircuit drawing window
12 #-------------------------------
14 proc xcircuit
::new_window { name
} {
16 global XCIRCUIT_VERSION XCIRCUIT_REVISION XCOps XCWinOps tcl_platform
19 wm title
$name XCircuit
21 wm protocol
$name WM_DELETE_WINDOW
\
22 "xcircuit::closewindow ${name}.mainframe.mainarea.drawing"
24 # All the internal frames
28 frame ${name
}.mainframe
30 grid propagate
${name
} false
31 grid ${name
}.menubar
-sticky news
-row 0 -column 0
32 grid ${name
}.mainframe
-sticky news
-row 1 -columnspan 2
33 grid ${name
}.infobar
-sticky news
-row 2 -columnspan 2
35 grid rowconfigure
${name
} 0 -weight 0
36 grid rowconfigure
${name
} 1 -weight 1
37 grid rowconfigure
${name
} 2 -weight 0
39 grid columnconfigure
${name
} 0 -weight 0
40 grid columnconfigure
${name
} 1 -weight 1
42 frame ${name
}.mainframe.mainarea
43 frame ${name
}.mainframe.toolbar
45 pack ${name
}.mainframe.toolbar
-side right
-fill y
46 pack ${name
}.mainframe.mainarea
-expand true
-fill both
48 set drawing
${name
}.mainframe.mainarea.drawing
49 simple
$drawing -bg white
-commandproc "focus $drawing ; set XCOps(focus) $name"
51 simple
${name
}.mainframe.mainarea.sbleft
-width 13
52 simple
${name
}.mainframe.mainarea.sbbottom
-height 13
53 simple
${name
}.mainframe.mainarea.corner
-width 13 -height 13
55 # The drawing area and its scrollbars
57 grid ${name
}.mainframe.mainarea.sbleft
-row 0 -column 0 -sticky ns
58 grid ${name
}.mainframe.mainarea.sbbottom
-row 1 -column 1 -sticky ew
59 grid $drawing -row 0 -column 1 -sticky news
60 grid ${name
}.mainframe.mainarea.corner
-row 1 -column 0 -sticky news
62 grid rowconfigure
${name
}.mainframe.mainarea
0 -weight 1
63 grid columnconfigure
${name
}.mainframe.mainarea
1 -weight 1
65 # The top menu and message bar
67 menubutton ${name
}.menubar.filebutton
-text File
\
68 -menu ${name
}.menubar.filebutton.filemenu
69 menubutton ${name
}.menubar.editbutton
-text Edit
\
70 -menu ${name
}.menubar.editbutton.editmenu
71 menubutton ${name
}.menubar.textbutton
-text Text
\
72 -menu ${name
}.menubar.textbutton.textmenu
73 menubutton ${name
}.menubar.optionsbutton
-text Options
\
74 -menu ${name
}.menubar.optionsbutton.optionsmenu
75 menubutton ${name
}.menubar.windowbutton
-text Window
\
76 -menu ${name
}.menubar.windowbutton.windowmenu
77 menubutton ${name
}.menubar.netlistbutton
-text Netlist
\
78 -menu ${name
}.menubar.netlistbutton.netlistmenu
80 grid ${name
}.menubar.filebutton
${name
}.menubar.editbutton
\
81 ${name
}.menubar.textbutton
${name
}.menubar.optionsbutton
\
82 ${name
}.menubar.windowbutton
${name
}.menubar.netlistbutton
\
83 -ipadx 10 -sticky news
87 label ${name
}.
message -text \
88 "Welcome to Xcircuit v${XCIRCUIT_VERSION} rev ${XCIRCUIT_REVISION}" \
89 -justify left
-anchor w
91 grid ${name
}.
message -row 0 -column 1 -sticky news
-ipadx 10
93 button ${name
}.infobar.symb
-text "Symbol" -bg gray30
-fg white
94 button ${name
}.infobar.schem
-text "Schematic" -bg red
-fg white
95 button ${name
}.infobar.mode
-text "Wire Mode" -bg skyblue2
-fg gray20
96 label ${name
}.infobar.message1
-text "Editing: Page 1"
97 label ${name
}.infobar.message2
-text "Grid 1/6 in : Snap 1/12 in" \
98 -justify left
-anchor w
99 pack ${name
}.infobar.symb
${name
}.infobar.schem
${name
}.infobar.message1
\
100 ${name
}.infobar.mode
-side left
-ipadx 6 -fill y
101 pack ${name
}.infobar.message2
-ipadx 6 -expand true
-fill both
103 #-------------------------------------------------
104 # Mouse hint window (if mousehints are enabled)
105 #-------------------------------------------------
107 if {$XCOps(mousehints
) == 0} {
108 bind ${name
}.infobar.mode
<Button-1
> {xcircuit
::enable_mousehints}
109 } elseif
{$XCOps(mousehints
) == 1} {
110 xcircuit
::mousehint_create ${name
}
113 #-------------------------------------------------
114 # Create the menus, toolbar and associated tools
115 #-------------------------------------------------
117 xcircuit
::makemenus $name
118 xcircuit
::createtoolbar $name
119 xcircuit
::arrangetoolbar $name
120 xcircuit
::allcolorbuttons $name
121 xcircuit
::allfontbuttons $name
123 #-----------------------------------------------------------------
124 # Add key and button bindings for XCircuit commands (standard actions)
125 # These can be overridden by binding to specific keys and/or buttons.
126 #-----------------------------------------------------------------
128 bind $drawing <ButtonPress
> {standardaction
%b down
%s
}
129 bind $drawing <ButtonRelease
> {standardaction
%b up
%s
}
130 bind $drawing <KeyPress
> {standardaction
%k down
%s
}
131 bind $drawing <KeyRelease
> {standardaction
%k up
%s
}
133 # Here are some extra key functions that come with the TCL wrapper
135 bind $drawing <Key-Next
> {catch {page
[expr {[page
] + 1}]}}
136 bind $drawing <Key-Prior
> {catch {page
[expr {[page
] - 1}]}}
137 bind $drawing <Control-Key-p
> {xcircuit
::prompteditparams}
139 xcircuit
::keybind <Key-bracketleft
> {if {[select get
] == {}} \
140 {select here
; element
lower; deselect
} else {element
lower}; \
142 xcircuit
::keybind <Key-bracketright
> {if {[select get
] == {}} \
143 {select here
; element
raise; deselect
} else {element
raise}; \
146 # Bind numbers 1-9 and 0 so that they call the Tcl "page" command,
147 # and so can take advantage of the tag callback to "pageupdate".
149 xcircuit
::keybind <Key-1
> {page
1} $drawing
150 xcircuit
::keybind <Key-2
> {page
2} $drawing
151 xcircuit
::keybind <Key-3
> {page
3} $drawing
152 xcircuit
::keybind <Key-4
> {page
4} $drawing
153 xcircuit
::keybind <Key-5
> {page
5} $drawing
154 xcircuit
::keybind <Key-6
> {page
6} $drawing
155 xcircuit
::keybind <Key-7
> {page
7} $drawing
156 xcircuit
::keybind <Key-8
> {page
8} $drawing
157 xcircuit
::keybind <Key-9
> {page
9} $drawing
158 xcircuit
::keybind <Key-0
> {page
10} $drawing
160 # These are supposed to disable the scroll wheel on the scrollbars. . .
162 if {$tcl_platform(platform
) == "windows"} {
163 bind $name <FocusIn
> \
164 "catch {config focus ${drawing} ; focus ${drawing}; \
165 set XCOps(focus) ${name} ; xcircuit::updatedialog}"
167 bind ${name
}.mainframe.mainarea.sbleft
<MouseWheel
> {}
168 bind ${name
}.mainframe.mainarea.sbbottom
<MouseWheel
> {}
171 bind $drawing <Enter
> {focus %W
}
172 bind $name <FocusIn
> "catch {config focus $drawing ; \
173 set XCOps(focus) ${name} ; xcircuit::updatedialog}"
175 bind ${name
}.mainframe.mainarea.sbleft
<Button-4
> {}
176 bind ${name
}.mainframe.mainarea.sbleft
<Button-5
> {}
177 bind ${name
}.mainframe.mainarea.sbbottom
<Button-4
> {}
178 bind ${name
}.mainframe.mainarea.sbbottom
<Button-5
> {}
181 # Window-specific variable defaults (variables associated with toggle
182 # and radio buttons, etc.). Note that we really should set these
183 # defaults for the first window only, and subsequent windows should
184 # inherit values from the first window.
186 set XCWinOps
(${name
},button1
) None
187 set XCWinOps
(${name
},colorval
) inherit
188 set XCWinOps
(${name
},jhoriz
) left
189 set XCWinOps
(${name
},jvert
) bottom
190 set XCWinOps
(${name
},justif
) left
191 set XCWinOps
(${name
},linestyle
) solid
192 set XCWinOps
(${name
},fillamount
) 0
193 set XCWinOps
(${name
},opaque
) false
194 set XCWinOps
(${name
},polyedittype
) manhattan
195 set XCWinOps
(${name
},pathedittype
) tangents
196 set XCWinOps
(${name
},showgrid
) true
197 set XCWinOps
(${name
},showsnap
) true
198 set XCWinOps
(${name
},showaxes
) true
199 set XCWinOps
(${name
},showbbox
) false
200 set XCWinOps
(${name
},fontfamily
) Helvetica
201 set XCWinOps
(${name
},fontstyle
) normal
202 set XCWinOps
(${name
},fontencoding
) ISOLatin1
203 set XCWinOps
(${name
},fontlining
) normal
204 set XCWinOps
(${name
},fontscript
) normal
205 set XCWinOps
(${name
},gridstyle
) "internal units"
206 set XCWinOps
(${name
},flipinvariant
) true
207 set XCWinOps
(${name
},pinvisible
) false
208 set XCWinOps
(${name
},netlistable
) true
209 set XCWinOps
(${name
},showclipmasks
) show
210 set XCWinOps
(${name
},latexmode
) false
211 set XCWinOps
(${name
},colorscheme
) normal
212 set XCWinOps
(${name
},editinplace
) true
213 set XCWinOps
(${name
},pinpositions
) invisible
214 set XCWinOps
(${name
},pinattach
) false
215 set XCWinOps
(${name
},namespaces
) false
216 set XCWinOps
(${name
},centerobject
) true
217 set XCWinOps
(${name
},manhattandraw
) false
218 set XCWinOps
(${name
},polyclosed
) closed
219 set XCWinOps
(${name
},scaleinvariant
) invariant
220 set XCWinOps
(${name
},endcaps
) round
221 set XCWinOps
(${name
},bboxtype
) false
222 set XCWinOps
(${name
},clipmask
) false
223 set XCWinOps
(${name
},substringparam
) false
224 set XCWinOps
(${name
},numericparam
) false
225 set XCWinOps
(${name
},expressparam
) false
226 set XCWinOps
(${name
},xposparam
) false
227 set XCWinOps
(${name
},yposparam
) false
228 set XCWinOps
(${name
},styleparam
) false
229 set XCWinOps
(${name
},anchorparam
) false
230 set XCWinOps
(${name
},startparam
) false
231 set XCWinOps
(${name
},endparam
) false
232 set XCWinOps
(${name
},radiusparam
) false
233 set XCWinOps
(${name
},minorparam
) false
234 set XCWinOps
(${name
},rotationparam
) false
235 set XCWinOps
(${name
},scaleparam
) false
236 set XCWinOps
(${name
},linewidthparam
) false
237 set XCWinOps
(${name
},colorparam
) false
238 set XCWinOps
(${name
},sel_lab
) true
239 set XCWinOps
(${name
},sel_inst
) true
240 set XCWinOps
(${name
},sel_poly
) true
241 set XCWinOps
(${name
},sel_arc
) true
242 set XCWinOps
(${name
},sel_spline
) true
243 set XCWinOps
(${name
},sel_graphic
) true
244 set XCWinOps
(${name
},sel_path
) true
245 set XCWinOps
(${name
},labeltype
) Text
246 set XCWinOps
(${name
},labelimage
) img_t
247 set XCWinOps
(${name
},rotateamount
) 15
249 #-----------------------------------------------------------------
250 # The "catch" statement here allows "i" and "I" to have other bindings for
251 # normal mode (e.g., "I" for "make info label") when nothing is selected.
252 #-----------------------------------------------------------------
254 xcircuit
::keybind i
{if {[catch {xcircuit
::autoincr}]} \
255 {standardaction
%k down
%s
}} $drawing
256 xcircuit
::keybind I
{if {[catch {xcircuit
::autoincr -1}]} \
257 {standardaction
%k down
%s
}} $drawing
259 #-----------------------------------------------------------------
260 # Function bindings for the mouse scroll wheel.
261 # Note that Windows uses MouseWheel and direction passed as %D,
262 # while Linux uses Button-4 and Button-5.
263 #-----------------------------------------------------------------
265 if {$tcl_platform(platform
) == "windows"} {
266 xcircuit
::keybind <MouseWheel
> {if { %D
/120 >= 1} \
267 {pan up
0.1 ; refresh
} else {pan down
0.1 ; refresh
}} $drawing
268 xcircuit
::keybind <Shift-MouseWheel
> {if { %D
/120 >= 1} \
269 {pan left
0.1 ; refresh
} else {pan right
0.1 ; refresh
}} $drawing
270 xcircuit
::keybind <Control-MouseWheel
> {if { %D
/120 >= 1} \
271 {zoom in
; refresh
} else {zoom out
; refresh
}} $drawing
273 xcircuit
::keybind <Button-4
> { pan up
0.05 ; refresh
} $drawing
274 xcircuit
::keybind <Button-5
> { pan down
0.05 ; refresh
} $drawing
275 xcircuit
::keybind <Shift-Button-4
> { pan left
0.05 ; refresh
} $drawing
276 xcircuit
::keybind <Shift-Button-5
> { pan right
0.05 ; refresh
} $drawing
277 xcircuit
::keybind <Control-Button-4
> { zoom in
; refresh
} $drawing
278 xcircuit
::keybind <Control-Button-5
> { zoom out
; refresh
} $drawing
281 #-----------------------------------------------------------------
282 # Evaluate registered callback procedures
283 #-----------------------------------------------------------------
285 catch {eval $XCOps(callback
)}
286 catch {eval $XCWinOps(${name
}, callback
)}
289 #----------------------------------------------------------------------
291 #----------------------------------------------------------------------
293 proc xcircuit
::closewindow {name
} {
296 set winlist
[config windownames
]
297 if {[llength $winlist] > 1} {
298 if {[lsearch $winlist $name] != -1} {
300 set newwin
[lindex [config windownames
] 0]
301 destroy [winfo top
$name]
303 set XCOps
(focus) [winfo top
$newwin]
310 #----------------------------------------------------------------------
311 # Create a new window, and set it to the same page as the current one.
312 #----------------------------------------------------------------------
314 proc xcircuit
::forkwindow {} {
315 set suffix
[llength [config windownames
]]
316 set newname .xcircuit
${suffix
}
317 xcircuit
::new_window $newname
321 #----------------------------------------------------------------------
322 # Find the geometry position that centers a window on the cursor
324 #----------------------------------------------------------------------
326 proc xcircuit
::centerwin {wname
} {
327 set xmax
[expr {[winfo screenwidth
$wname] - 10}]
328 set ymax
[expr {[winfo screenheight
$wname] - 35}] ;# allow for titlebar height
329 set x
[winfo pointerx
$wname]
330 set y
[winfo pointery
$wname]
331 tkwait visibility
$wname
332 set w
[winfo width
$wname]
333 set h
[winfo height
$wname]
334 set x
[expr $x - $w / 2]
335 set y
[expr $y - $h / 2]
336 if {$x < 10} {set x
10}
337 if {$y < 10} {set y
10}
338 if {[expr {$x + $w}] > $xmax} {set x
[expr {$xmax - $w}]}
339 if {[expr {$y + $h}] > $ymax} {set y
[expr {$ymax - $h}]}
340 if {$x > 0} {set x
"+$x"}
341 if {$y > 0} {set y
"+$y"}
342 wm geometry
$wname $x$y
345 #----------------------------------------------------------------------
346 # Message handling. Assumes that windows are named
347 # 1) "pagename" where the page name is printed
348 # 2) "coordinates" where the coordinates are printed
349 # 3) "status" the general-purpose status and message line.
350 #----------------------------------------------------------------------
352 proc xcircuit
::print {wname
string} {
354 set window
$XCOps(focus)
356 switch -glob ${wname
} {
358 ${window
}.infobar.message1 configure
-text ${string}
361 ${window
}.
message configure
-text ${string}
365 ${window
}.infobar.message2 configure
-text ${string}
370 proc xcircuit
::getinitstate {wname
} {
371 if [winfo exists
$wname] {
372 set wstate
[wm state
$wname]
379 #----------------------------------------------------------------------
380 # Support procedures for tag callbacks
381 #----------------------------------------------------------------------
383 proc xcircuit
::popupdialog {{w .dialog
}} {
384 set wstate
[xcircuit
::getinitstate ${w
}]
385 xcircuit
::removelists ${w
}
387 if {"$wstate" != "normal"} {centerwin
${w
}}
389 focus ${w
}.textent.txt
392 proc xcircuit
::popupfilelist {{w .filelist
}} {
393 set wstate
[xcircuit
::getinitstate ${w
}]
394 xcircuit
::removelists ${w
}
398 focus ${w
}.textent.txt
401 #----------------------------------------------------------------------
402 # A refined "page size" that keeps a lid on the numerical precision
404 #----------------------------------------------------------------------
406 proc xcircuit
::getpagesize {} {
407 set slist
[xcircuit
::page size
]
408 set coordstyle
[lindex $slist 3]
409 if {$coordstyle == "cm"} {
410 # Round centimeter coords to the nearest 0.1
411 set xcm
[lindex $slist 0]
412 set xcm
[expr {round
($xcm * 10.0) / 10.0}]
413 set slist
[lreplace $slist 0 0 $xcm]
414 set ycm
[lindex $slist 2]
415 set ycm
[expr {round
($ycm * 10.0) / 10.0}]
416 set slist
[lreplace $slist 2 2 $ycm]
417 } elseif
{$coordstyle == "in"} {
418 # Round inch coords to the nearest 1/8
419 set xin
[lindex $slist 0]
420 set xin
[expr {round
($xin * 8.0) / 8.0}]
421 set slist
[lreplace $slist 0 0 $xin]
422 set yin
[lindex $slist 2]
423 set yin
[expr {round
($yin * 8.0) / 8.0}]
424 set slist
[lreplace $slist 2 2 $yin]
429 #----------------------------------------------------------------------
430 # This procedure configures the sheet size according to the page
431 # dimensions (if they match, within reason)
432 #----------------------------------------------------------------------
434 proc xcircuit
::setsheetsize {} {
437 set slist
[xcircuit
::getpagesize]
438 set coordstyle
[lindex $slist 3]
439 if {$coordstyle == "cm"} {
440 set xcm
[lindex $slist 0]
441 set ycm
[lindex $slist 2]
443 if {$xcm == 21.0 && $ycm == 29.7} {
444 set XCOps
(sheetsize
) a4
445 .output.textent.txtf.sizb configure
-text "A4"
446 } elseif
{$xcm == 29.7 && $ycm == 42.0} {
447 set XCOps
(sheetsize
) a3
448 .output.textent.txtf.sizb configure
-text "A3"
449 } elseif
{$xcm == 14.8 && $ycm == 18.4} {
450 set XCOps
(sheetsize
) a5
451 .output.textent.txtf.sizb configure
-text "A5"
452 } elseif
{$xcm == 25.7 && $ycm == 36.4} {
453 set XCOps
(sheetsize
) b4
454 .output.textent.txtf.sizb configure
-text "B4"
455 } elseif
{$xcm == 18.2 && $ycm == 25.7} {
456 set XCOps
(sheetsize
) b5
457 .output.textent.txtf.sizb configure
-text "B5"
459 set XCOps
(sheetsize
) special
460 .output.textent.txtf.sizb configure
-text "Special"
462 } elseif
{$coordstyle == "in"} {
463 set xin
[lindex $slist 0]
464 set yin
[lindex $slist 2]
466 if {$xin == 8.5 && $yin == 11.0} {
467 set XCOps
(sheetsize
) letter
468 .output.textent.txtf.sizb configure
-text Letter
469 } elseif
{$xin == 8.5 && $yin == 14.0} {
470 set XCOps
(sheetsize
) legal
471 .output.textent.txtf.sizb configure
-text Legal
472 } elseif
{$xin == 5.5 && $yin == 8.5} {
473 set XCOps
(sheetsize
) statement
474 .output.textent.txtf.sizb configure
-text Statement
475 } elseif
{$xin == 11.0 && $yin == 17.0} {
476 set XCOps
(sheetsize
) tabloid
477 .output.textent.txtf.sizb configure
-text Tabloid
478 } elseif
{$xin == 17.0 && $yin == 11.0} {
479 set XCOps
(sheetsize
) ledger
480 .output.textent.txtf.sizb configure
-text Ledger
481 } elseif
{$xin == 8.5 && $yin == 13.0} {
482 set XCOps
(sheetsize
) folio
483 .output.textent.txtf.sizb configure
-text Folio
484 } elseif
{$xin == 10.0 && $yin == 14.0} {
485 set XCOps
(sheetsize
) tenfourteen
486 .output.textent.txtf.sizb configure
-text 10x14
487 } elseif
{$xin == 7.5 && $yin == 10.0} {
488 set XCOps
(sheetsize
) executive
489 .output.textent.txtf.sizb configure
-text Executive
490 } elseif
{$xin == 17.0 && $yin == 22.0} {
491 set XCOps
(sheetsize
) ansic
492 .output.textent.txtf.sizb configure
-text "ANSI C"
493 } elseif
{$xin == 22.0 && $yin == 34.0} {
494 set XCOps
(sheetsize
) ansid
495 .output.textent.txtf.sizb configure
-text "ANSI D"
496 } elseif
{$xin == 34.0 && $yin == 44.0} {
497 set XCOps
(sheetsize
) ansie
498 .output.textent.txtf.sizb configure
-text "ANSI E"
500 set XCOps
(sheetsize
) special
501 .output.textent.txtf.sizb configure
-text "Special"
506 #----------------------------------------------------------------------
507 # This procedure configures the output properties window according to
508 # the page mode (full or encapsulated)
509 #----------------------------------------------------------------------
511 proc xcircuit
::setpstype {mode
} {
514 {eps
} { .output.textent.butp configure
-text "Embedded (EPS)"
515 grid remove .output.textent.but7
516 grid remove .output.textent.butf
517 grid remove .output.textent.txtf
519 {full
} {.output.textent.butp configure
-text "Full Page"
520 grid .output.textent.but7
-row 6 -column 3 -pady 5 -ipadx 10
521 grid .output.textent.butf
-row 5 -column 2 -padx 10
522 grid .output.textent.txtf
-row 6 -column 2 -sticky ew
-padx 10
525 set XCOps
(pstype
) $mode
526 xcircuit
::page encapsulation
$mode
529 #----------------------------------------------------------------------
531 proc xcircuit
::dolinks {} {
533 set ilinks
[xcircuit
::page links independent
]
535 set XCOps
(imultiple
) 1
537 set XCOps
(imultiple
) 0
539 if {$ilinks == 1} { set plural
""} else { set plural
"s"}
540 .output.title.imulti configure
-text "$ilinks schematic$plural"
542 if {$XCOps(dmultiple
) == 1} {
543 set dlinks
[xcircuit
::page links dependent
]
547 if {$dlinks == 1} { set plural
""} else { set plural
"s"}
548 .output.title.dmulti configure
-text "$dlinks subcircuit$plural"
551 #----------------------------------------------------------------------
553 proc xcircuit
::setlinksmenu {} {
554 set m .output.textent.butl.linksmenu
556 $m add radio
-label "None" -variable XCOps
(links
) -command \
557 {.output.textent.butl configure
-text None
; \
558 xcircuit
::page filename {}}
559 if {![catch {set plist
[xcircuit
::page list]}]} {
562 set pfile
[xcircuit
::page $p filename]
563 if {"$pfile" != ""} {
564 lappend fnames
$pfile
567 foreach f
[lsort -uniq $fnames] {
568 $m add radio
-label $f -variable XCOps
(links
) \
569 -command ".output.textent.butl configure -text $f ; \
570 xcircuit::page filename $f"
573 .output.textent.butl configure
-text "(change)"
576 #----------------------------------------------------------------------
578 proc xcircuit
::pageupdate { {subcommand
"none"} } {
580 if {[info level
] <= 1} {
581 switch -- $subcommand {
583 .output.bbar.okay configure
-text "Done"
584 .output.bbar.okay configure
-command {wm withdraw .output
}
587 xcircuit
::newpagebutton [xcircuit
::page label]
590 .output.title.field configure
-text \
591 "PostScript output properties (Page [xcircuit::page])"
592 set fname
[xcircuit
::page filename]
593 .output.textent.but1 configure
-text Apply
594 .output.textent.but2 configure
-text Apply
595 .output.textent.but3 configure
-text Apply
596 .output.textent.but4 configure
-text Apply
597 .output.textent.but5 configure
-text Apply
598 .output.textent.but7 configure
-text Apply
599 .output.textent.txt1 delete
0 end
600 .output.textent.txt1 insert
0 $fname
601 .output.textent.txt2 delete
0 end
602 .output.textent.txt2 insert
0 [xcircuit
::page label]
603 .output.textent.txt3 delete
0 end
604 set stext
[format "%g" [xcircuit
::page scale]]
605 .output.textent.txt3 insert
0 $stext
606 .output.textent.txt4 delete
0 end
607 set wtext
[format "%g" [xcircuit
::page width
]]
608 .output.textent.txt4 insert
0 $wtext
609 .output.textent.txt4 insert end
" "
610 .output.textent.txt4 insert end
[xcircuit
::coordstyle get
]
611 .output.textent.txt5 delete
0 end
612 set htext
[format "%g" [xcircuit
::page height
]]
613 .output.textent.txt5 insert
0 $htext
614 .output.textent.txt5 insert end
" "
615 .output.textent.txt5 insert end
[xcircuit
::coordstyle get
]
616 .output.textent.txtf.txtp delete
0 end
617 .output.textent.txtf.txtp insert
0 [xcircuit
::getpagesize]
618 xcircuit
::setpstype [xcircuit
::page encapsulation
]
619 set XCOps
(orient
) [xcircuit
::page orientation
]
620 if {$XCOps(orient
) == 0} {
621 .output.textent.buto configure
-text Portrait
623 .output.textent.buto configure
-text Landscape
626 xcircuit
::setlinksmenu
627 xcircuit
::setsheetsize
629 set XCOps
(autofit
) [xcircuit
::page fit
]
630 if {[string match
*.
* $fname] == 0} {append fname .ps
}
631 if {[glob -nocomplain ${fname
}] == {}} {
632 .output.bbar.okay configure
-text "Write File"
634 .output.bbar.okay configure
-text "Overwrite File"
636 .output.bbar.okay configure
-command \
637 {.output.textent.but1 invoke
; \
638 .output.textent.but2 invoke
; \
639 if {$XCOps(autofit
)} {xcircuit
::page fit true
}; \
640 if {$XCOps(dmultiple
) == 1} {xcircuit
::page save
} else { \
641 xcircuit
::page saveonly
}; wm withdraw .output
}
647 #----------------------------------------------------------------------
648 # Update the GUI based on the schematic class of the current page
649 # This is called internally from the xcircuit code and the function
650 # must be defined, even if it is a null proc.
651 #----------------------------------------------------------------------
653 proc xcircuit
::setsymschem {} {
655 set window
$XCOps(focus)
657 if {[info level
] <= 1} {
658 set schemtype
[xcircuit
::schematic type
]
659 set symschem
[xcircuit
::schematic get
]
660 set m
${window
}.menubar.netlistbutton.netlistmenu
661 switch -- $schemtype {
665 ${window
}.infobar.schem configure
-background red
-foreground white
666 if {$symschem == {}} {
667 ${window
}.infobar.symb configure
-background gray70
\
669 $m entryconfigure
6 -label "Make Matching Symbol" \
670 -command {xcircuit
::promptmakesymbol [page
label]}
671 $m entryconfigure
7 -label "Associate With Symbol" \
672 -command {xcircuit
::symbol associate
}
674 ${window
}.infobar.symb configure
-background white
-foreground black
675 $m entryconfigure
6 -label "Go To Symbol" \
676 -command {xcircuit
::symbol go
}
677 $m entryconfigure
7 -label "Disassociate Symbol" \
678 -command {xcircuit
::symbol disassociate
}
684 ${window
}.infobar.symb configure
-foreground white
685 if {$symschem == {}} {
686 ${window
}.infobar.schem configure
-background gray70
-foreground \
688 $m entryconfigure
6 -label "Make Matching Schematic" \
689 -command {xcircuit
::schematic make
}
690 $m entryconfigure
7 -label "Associate With Schematic" \
691 -command {xcircuit
::schematic associate
}
693 ${window
}.infobar.schem configure
-background white
-foreground black
694 $m entryconfigure
6 -label "Go To Schematic" \
695 -command {xcircuit
::schematic go
}
696 $m entryconfigure
7 -label "Disassociate Schematic" \
697 -command {xcircuit
::schematic disassociate
}
701 switch -- $schemtype {
703 ${window
}.infobar.symb configure
-background red
706 ${window
}.infobar.symb configure
-background green4
;# bboxcolor
709 ${window
}.infobar.symb configure
-background blue2
715 #----------------------------------------------------------------------
716 # Set the coordinate style to inches from cm and vice versa.
717 # This routine avoids switching from fractional to decimal inches
718 # and vice versa if we are already in one of the two inches modes.
720 # with no argument, or argument "get", returns the "short" name
721 # ("cm" or "in") of the style.
722 #----------------------------------------------------------------------
724 proc xcircuit
::coordstyle { { mode get
} } {
725 global XCOps XCWinOps
726 set curstyle
[xcircuit
::config coordstyle
]
729 switch -- $curstyle {
731 xcircuit
::config coordstyle
"decimal inches"
738 switch -- $curstyle {
742 xcircuit
::config coordstyle
"centimeters"
748 switch -- $curstyle {
760 #----------------------------------------------------------------------
762 proc xcircuit
::raiseconsole {} {
764 set window
$XCOps(focus)
767 xcircuit
::consoleontop
768 set cidx
[${window
}.menubar.filebutton.filemenu index
*Console
]
769 ${window
}.menubar.filebutton.filemenu entryconfigure
\
770 $cidx -label "No Console" -command {xcircuit
::lowerconsole}
773 #----------------------------------------------------------------------
775 proc xcircuit
::lowerconsole {} {
777 set window
$XCOps(focus)
779 xcircuit
::consoledown
780 set cidx
[${window
}.menubar.filebutton.filemenu index
*Console
]
781 ${window
}.menubar.filebutton.filemenu entryconfigure
\
782 $cidx -label "Tcl Console" -command {xcircuit
::raiseconsole}
785 #----------------------------------------------------------------------
786 # Command tags---these let the command-line entry functions update the
787 # Tk windows, so that the Tk window structure doesn't need to be hard-
788 # coded into the source.
789 #----------------------------------------------------------------------
791 xcircuit
::tag page
{xcircuit
::pageupdate %1 ; xcircuit
::updateparams}
792 xcircuit
::tag promptsavepage
{xcircuit
::pageupdate ;
793 set wstate
[xcircuit
::getinitstate .output
] ; wm deiconify .output
;
794 if {"$wstate" != "normal"} {xcircuit
::centerwin .output
} ; raise .output
}
795 xcircuit
::tag loadfont
{xcircuit
::newfontbutton %r
}
796 xcircuit
::tag color
{ if {"%1" == "set"} {
797 set XCWinOps
($XCOps(focus),colorval
) %2; set iname img_co
;
798 if {"%2" != "inherit"} {append iname l
%2} ;
799 $XCOps(focus).mainframe.toolbar.bco configure
-image $iname} }
800 xcircuit
::tag border
{if {%# == 2} {
802 dashed
{ set XCWinOps
($XCOps(focus),linestyle
) dashed
}
803 dotted
{ set XCWinOps
($XCOps(focus),linestyle
) dotted
}
804 unbordered
{ set XCWinOps
($XCOps(focus),linestyle
) unbordered
}
805 solid
{ set XCWinOps
($XCOps(focus),linestyle
) solid
}
806 square
{ set XCWinOps
($XCOps(focus),endcaps
) square
}
807 round
{ set XCWinOps
($XCOps(focus),endcaps
) round
}
808 closed
{ set XCWinOps
($XCOps(focus),polyclosed
) closed
}
809 unclosed
{ set XCWinOps
($XCOps(focus),polyclosed
) unclosed
}
810 }} elseif
{%# == 3} {
812 bbox
{ set XCWinOps
($XCOps(focus),bboxtype
) %2}
813 clipmask
{ set XCWinOps
($XCOps(focus),clipmask
) %2}
815 xcircuit
::tag fill
{ foreach i
%N
{ switch -- "$i" {
816 opaque
{ set XCWinOps
($XCOps(focus),opaque
) true
}
817 transparent
{ set XCWinOps
($XCOps(focus),opaque
) false
} 0 - unfilled
818 {set XCWinOps
($XCOps(focus),fillamount
) 0;
819 $XCOps(focus).mainframe.toolbar.bfi configure
-image img_fi
}
820 solid
{set XCWinOps
($XCOps(focus),fillamount
) 100;
821 $XCOps(focus).mainframe.toolbar.bfi configure
-image img_stip100
}
822 default {set XCWinOps
($XCOps(focus),fillamount
) $i;
823 $XCOps(focus).mainframe.toolbar.bfi configure
-image img_stip
$i} } } }
825 xcircuit
::tag select
{if {%N
> 1} {xcircuit
::updateparams; xcircuit
::updatedialog}}
826 xcircuit
::tag unselect
{xcircuit
::updateparams; xcircuit
::updatedialog}
827 xcircuit
::tag schematic
{xcircuit
::setsymschem}
828 xcircuit
::tag symbol
{xcircuit
::setsymschem}
830 xcircuit
::tag parameter
{ if {"%1" == "make"} {set cond true
} else {set cond false
}
834 delete
{xcircuit
::updateparams}
836 replace
{switch -- "%2" {
837 "x position" {set XCWinOps
($XCOps(focus),xposparam
) $cond}
838 "y position" {set XCWinOps
($XCOps(focus),yposparam
) $cond}
839 style
{set XCWinOps
($XCOps(focus),styleparam
) $cond}
840 "start angle" {set XCWinOps
($XCOps(focus),startparam
) $cond}
841 "end angle" {set XCWinOps
($XCOps(focus),endparam
) $cond}
842 anchoring
{set XCWinOps
($XCOps(focus),anchorparam
) $cond}
843 radius
{set XCWinOps
($XCOps(focus),radiusparam
) $cond}
844 "minor axis" {set XCWinOps
($XCOps(focus),minorparam
) $cond}
845 rotation
{set XCWinOps
($XCOps(focus),rotationparam
) $cond}
846 scale {set XCWinOps
($XCOps(focus),scaleparam
) $cond}
847 linewidth
{set XCWinOps
($XCOps(focus),linewidthparam
) $cond}
848 color
{set XCWinOps
($XCOps(focus),colorparam
) $cond}
849 default {xcircuit
::updateparams}
851 default {if {%# == 4} {xcircuit::updateparams}}
854 xcircuit
::tag config
{if {%# == 3} {
856 colorscheme
{set XCWinOps
($XCOps(focus),colorscheme
) [config colorscheme
];
858 bbox
{set XCWinOps
($XCOps(focus),showbbox
) [config bbox
]}
859 editinplace
{set XCWinOps
($XCOps(focus),editinplace
) [config editinplace
]}
860 pinpositions
{set XCWinOps
($XCOps(focus),pinpositions
) [config pinpositions
]}
861 pinattach
{set XCWinOps
($XCOps(focus),pinattach
) [config pinattach
]}
862 technologies
{set XCWinOps
($XCOps(focus),namespaces
) [config technologies
]}
863 hold
{set XCOps
(hold
) [config hold
]}
864 grid {catch {set XCWinOps
($XCOps(focus),showgrid
) [config
grid]}}
865 snap
{catch {set XCWinOps
($XCOps(focus),showsnap
) [config snap
]}}
866 axes
{set XCWinOps
($XCOps(focus),showaxes
) [config axes
]}
867 centering
{set XCWinOps
($XCOps(focus),centerobject
) [config centering
]}
868 manhattan
{set XCWinOps
($XCOps(focus),manhattandraw
) [config manhattan
]}
869 coordstyle
{set XCWinOps
($XCOps(focus),gridstyle
) [config coordstyle
]}
870 boxedit
{set XCWinOps
($XCOps(focus),polyedittype
) [config boxedit
]}
871 pathedit
{set XCWinOps
($XCOps(focus),pathedittype
) [config pathedit
]}
872 technologies
{set XCWinOps
($XCOps(focus),showtech
) [config technologies
]}
873 }} elseif
{(%# == 4) && ("%1" == "filter")} {
874 set XCWinOps
($XCOps(focus),sel_
%2) [config filter
%2]
877 xcircuit
::tag label {if {%# == 3} {
880 set XCWinOps
($XCOps(focus),fontencoding
) %2
881 xcircuit
::newencodingbutton %2
883 family
{if {"%2" != "-all"} {set XCWinOps
($XCOps(focus),fontfamily
) %2}}
884 style
{set XCWinOps
($XCOps(focus),fontstyle
) %2}
889 middle
{set XCWinOps
($XCOps(focus),jvert
) %2}
890 default {set XCWinOps
($XCOps(focus),jhoriz
) %2}
893 justify
{set XCWinOps
($XCOps(focus),justif
) %2}
894 flipinvariant
{set XCWinOps
($XCOps(focus),flipinvariant
) %2}
895 visible
{set XCWinOps
($XCOps(focus),pinvisible
) %2}
896 latex
{set XCWinOps
($XCOps(focus),latexmode
) %2}
897 }} elseif
{(%# == 4) && ("%1" == "anchor")} {
901 middle
{set XCWinOps
($XCOps(focus),jvert
) %2 ;
902 set XCWinOps
($XCOps(focus),jhoriz
) %3}
903 default {set XCWinOps
($XCOps(focus),jhoriz
) %2 ;
904 set XCWinOps
($XCOps(focus),jvert
) %3}
908 #------------------------------
909 # Create the file-list window
910 #------------------------------
912 # First, set the variables associated with toggle and radio buttons
915 toplevel .filelist
-bg beige
916 wm title .filelist
"File List Window"
918 wm protocol .filelist WM_DELETE_WINDOW
{wm withdraw .filelist
}
919 wm withdraw .filelist
921 frame .filelist.listwin
922 frame .filelist.textent
-bg beige
923 frame .filelist.bbar
-bg beige
925 pack .filelist.listwin
-side top
-padx 20 -pady 7 -expand true
-fill both
926 pack .filelist.textent
-side top
-padx 20 -pady 7 -fill x
927 pack .filelist.bbar
-side bottom
-padx 20 -pady 7 -fill x
929 simple .filelist.listwin.win
-bg white
930 simple .filelist.listwin.sb
-width 13 -bg beige
932 grid .filelist.listwin.win
-row 0 -column 0 -sticky news
-padx 1 -pady 1
933 grid .filelist.listwin.sb
-row 0 -column 1 -sticky ns
-padx 1 -pady 1
935 grid columnconfigure .filelist.listwin
0 -weight 1 -minsize 100
936 grid rowconfigure .filelist.listwin
0 -weight 1 -minsize 100
938 frame .filelist.textent.title
-bg beige
939 pack .filelist.textent.title
-side top
-fill x
941 label .filelist.textent.title.field
-text "Select file to load:" -bg beige
942 label .filelist.textent.title.chklabel
-text "Filter" -bg beige
943 checkbutton .filelist.textent.title.filter
-bg beige
-variable XCOps
(filter
) \
944 -command {event generate .filelist.listwin.win
<ButtonPress
> -button 3 ; \
945 event generate .filelist.listwin.win
<ButtonRelease
> -button 3}
947 entry .filelist.textent.txt
-bg white
-relief sunken
-width 50
949 pack .filelist.textent.title.filter
-side right
950 pack .filelist.textent.title.chklabel
-side right
951 pack .filelist.textent.title.field
-side left
952 pack .filelist.textent.txt
-side bottom
-fill x
-expand true
954 button .filelist.bbar.okay
-text Okay
-bg beige
955 button .filelist.bbar.cancel
-text Cancel
-bg beige
-command {wm withdraw .filelist
}
957 pack .filelist.bbar.okay
-side left
-ipadx 10
958 pack .filelist.bbar.cancel
-side right
-ipadx 10
960 # Allow <return> to update or accept entry
961 bind .filelist.textent.txt
<Return
> \
962 {event generate .filelist.listwin.win
<ButtonPress
> -button 2 ; \
963 event generate .filelist.listwin.win
<ButtonRelease
> -button 2}
965 #--------------------------------------
966 # Create the output generating window
967 #--------------------------------------
969 # First, set the variables associated with toggle and radio buttons
971 set XCOps
(imultiple
) 0
972 set XCOps
(dmultiple
) 0 ;# don't save subcircuits with different filenames
973 if {[catch {set XCOps
(technology
)}]} {set XCOps
(technology
) "(user)"}
974 if {[catch {set XCOps
(library
)}]} {set XCOps
(library
) "User Library"}
976 toplevel .output
-bg beige
977 wm title .output
"PostScript Output Properties"
979 wm protocol .output WM_DELETE_WINDOW
{wm withdraw .output
}
982 frame .output.title
-bg beige
983 frame .output.textent
-bg beige
984 frame .output.bbar
-bg beige
986 pack .output.title
-side top
-padx 20 -pady 7 -fill x
987 pack .output.textent
-side top
-padx 20 -pady 7 -fill x
988 pack .output.bbar
-side bottom
-padx 20 -pady 7 -fill x
990 label .output.title.field
-text "PostScript output properties (Page 1):" -bg tan
991 checkbutton .output.title.imulti
-text "1 schematic" -bg beige
\
992 -variable XCOps
(imultiple
) \
993 -command {xcircuit
::dolinks ; \
994 if {$XCOps(imultiple
) == 1} {.output.textent.txt1
\
995 delete
0 end
; .output.textent.but1 configure
-text Apply
; xcircuit
::page \
996 filename {}; focus .output.textent.txt1
; xcircuit
::dolinks }}
997 checkbutton .output.title.dmulti
-text "0 subcircuits" -bg beige
\
998 -variable XCOps
(dmultiple
) \
999 -command {xcircuit
::dolinks ; .output.textent.but1 configure
-text Apply
; \
1000 if {$XCOps(dmultiple
) == 1} {xcircuit
::page filename {}; \
1001 .output.textent.txt1 delete
0 end
; focus .output.textent.txt1
}; \
1004 pack .output.title.dmulti
-side right
-padx 5
1005 pack .output.title.imulti
-side right
-padx 5
1007 pack .output.title.field
-side left
1009 label .output.textent.lab1
-text "Filename:" -bg beige
1010 label .output.textent.lab2
-text "Page label:" -bg beige
1011 label .output.textent.lab3
-text "Scale:" -bg beige
1012 label .output.textent.lab4
-text "Width:" -bg beige
1013 label .output.textent.lab5
-text "Height:" -bg beige
1014 label .output.textent.lab6
-text "Orientation:" -bg beige
1015 label .output.textent.lab7
-text "Mode:" -bg beige
1016 label .output.textent.lab8
-text "Link to:" -bg beige
1018 entry .output.textent.txt1
-bg white
-relief sunken
-width 20
1019 entry .output.textent.txt2
-bg white
-relief sunken
-width 20
1020 entry .output.textent.txt3
-bg white
-relief sunken
-width 20
1021 entry .output.textent.txt4
-bg white
-relief sunken
-width 20
1022 entry .output.textent.txt5
-bg white
-relief sunken
-width 20
1024 menubutton .output.textent.buto
-text Portrait
-bg beige
\
1025 -menu .output.textent.buto.orientmenu
1026 menubutton .output.textent.butp
-text "Embedded (EPS)" -bg beige
\
1027 -menu .output.textent.butp.psmenu
1028 menubutton .output.textent.butl
-text "(change)" -bg beige
\
1029 -menu .output.textent.butl.linksmenu
1031 checkbutton .output.textent.butf
-text "Auto-fit" -bg beige
\
1032 -variable XCOps
(autofit
) -onvalue true
-offvalue false
\
1033 -command {xcircuit
::page fit
$XCOps(autofit
)}
1034 frame .output.textent.txtf
-bg beige
1035 menubutton .output.textent.txtf.sizb
-text "Sizes" -bg beige
\
1036 -menu .output.textent.txtf.sizb.sizemenu
1037 entry .output.textent.txtf.txtp
-bg white
-relief sunken
-width 14
1039 pack .output.textent.txtf.txtp
-side left
-fill y
1040 pack .output.textent.txtf.sizb
-side left
1042 button .output.textent.but1
-text Apply
-bg beige
\
1043 -command {xcircuit
::page filename [.output.textent.txt1 get
]
1044 if {[llength [xcircuit
::page label]] > 1} {
1045 xcircuit
::page label [file root
[.output.textent.txt1 get
]]};\
1046 .output.textent.but1 configure
-text Okay
}
1047 button .output.textent.but2
-text Apply
-bg beige
\
1048 -command {xcircuit
::page label [.output.textent.txt2 get
];\
1049 .output.textent.but2 configure
-text Okay
}
1050 button .output.textent.but3
-text Apply
-bg beige
\
1051 -command {xcircuit
::page scale [.output.textent.txt3 get
];\
1052 .output.textent.but3 configure
-text Okay
}
1053 button .output.textent.but4
-text Apply
-bg beige
\
1054 -command {xcircuit
::page width
[.output.textent.txt4 get
];\
1055 .output.textent.but4 configure
-text Okay
}
1056 button .output.textent.but5
-text Apply
-bg beige
\
1057 -command {xcircuit
::page height
[.output.textent.txt5 get
];\
1058 .output.textent.but5 configure
-text Okay
}
1059 button .output.textent.but7
-text Apply
-bg beige
\
1060 -command {xcircuit
::page size
[.output.textent.txtf.txtp get
];\
1061 .output.textent.but7 configure
-text Okay
}
1063 bind .output.textent.txt1
<Return
> {.output.textent.but1 invoke
}
1064 bind .output.textent.txt2
<Return
> {.output.textent.but2 invoke
}
1065 bind .output.textent.txt3
<Return
> {.output.textent.but3 invoke
}
1066 bind .output.textent.txt4
<Return
> {.output.textent.but4 invoke
}
1067 bind .output.textent.txt5
<Return
> {.output.textent.but5 invoke
}
1069 grid .output.textent.lab1
-row 0 -column 0 -sticky w
1070 grid .output.textent.lab2
-row 1 -column 0 -sticky w
1071 grid .output.textent.lab3
-row 2 -column 0 -sticky w
1072 grid .output.textent.lab4
-row 3 -column 0 -sticky w
1073 grid .output.textent.lab5
-row 4 -column 0 -sticky w
1074 grid .output.textent.lab6
-row 5 -column 0 -sticky w
1075 grid .output.textent.lab7
-row 6 -column 0 -sticky w
1076 grid .output.textent.lab8
-row 7 -column 0 -sticky w
1078 grid .output.textent.txt1
-row 0 -column 1 -columnspan 2 -sticky ew
-padx 10
1079 grid .output.textent.txt2
-row 1 -column 1 -columnspan 2 -sticky ew
-padx 10
1080 grid .output.textent.txt3
-row 2 -column 1 -columnspan 2 -sticky ew
-padx 10
1081 grid .output.textent.txt4
-row 3 -column 1 -columnspan 2 -sticky ew
-padx 10
1082 grid .output.textent.txt5
-row 4 -column 1 -columnspan 2 -sticky ew
-padx 10
1083 grid .output.textent.buto
-row 5 -column 1 -sticky w
-padx 10
1084 grid .output.textent.butp
-row 6 -column 1 -sticky w
-padx 10
1085 grid .output.textent.butl
-row 7 -column 1 -sticky w
-padx 10
1087 grid .output.textent.but1
-row 0 -column 3 -pady 5 -ipadx 10
1088 grid .output.textent.but2
-row 1 -column 3 -pady 5 -ipadx 10
1089 grid .output.textent.but3
-row 2 -column 3 -pady 5 -ipadx 10
1090 grid .output.textent.but4
-row 3 -column 3 -pady 5 -ipadx 10
1091 grid .output.textent.but5
-row 4 -column 3 -pady 5 -ipadx 10
1093 grid columnconfigure .output.textent
2 -weight 1
1095 button .output.bbar.okay
-text Okay
-bg beige
-command {xcircuit
::page save
; \
1096 wm withdraw .output
}
1097 button .output.bbar.cancel
-text Cancel
-bg beige
-command {wm withdraw .output
}
1099 # Setup simple choice menus for page type and orientation
1100 # First, set the variables associated with the radio buttons. . .
1102 set XCOps
(pstype
) eps
1104 set m
[menu .output.textent.buto.orientmenu
-tearoff 0]
1105 $m add radio
-label "Portrait" -variable XCOps
(orient
) -value 0 -command \
1106 {.output.textent.buto configure
-text Portrait
; \
1107 xcircuit
::page orientation
0}
1108 $m add radio
-label "Landscape" -variable XCOps
(orient
) -value 90 -command \
1109 {.output.textent.buto configure
-text Landscape
; \
1110 xcircuit
::page orientation
90}
1112 set m
[menu .output.textent.butp.psmenu
-tearoff 0]
1113 $m add radio
-label "Embedded (EPS)" -variable XCOps
(pstype
) -value eps
-command \
1114 {xcircuit
::setpstype eps
}
1115 $m add radio
-label "Full Page" -variable XCOps
(pstype
) -value full
-command \
1116 {xcircuit
::setpstype full
}
1118 menu .output.textent.butl.linksmenu
-tearoff 0
1119 xcircuit
::setlinksmenu
1121 pack .output.bbar.okay
-side left
-ipadx 10
1122 pack .output.bbar.cancel
-side right
-ipadx 10
1124 set m
[menu .output.textent.txtf.sizb.sizemenu
-tearoff 0]
1125 $m add radio
-label "Letter (ANSI A)" -variable XCOps
(sheetsize
) \
1126 -value letter
-command \
1127 { xcircuit
::coordstyle inches
; xcircuit
::page size
"8.5 x 11.0 in"}
1128 $m add radio
-label "Legal" -variable XCOps
(sheetsize
) -value legal
-command \
1129 { xcircuit
::coordstyle inches
; xcircuit
::page size
"8.5 x 14.0 in"}
1130 $m add radio
-label "Statement" -variable XCOps
(sheetsize
) -value statement
\
1132 { xcircuit
::coordstyle inches
; xcircuit
::page size
"5.5 x 8.5 in"}
1133 $m add radio
-label "Tabloid (ANSI B)" -variable XCOps
(sheetsize
) \
1134 -value tabloid
-command \
1135 { xcircuit
::coordstyle inches
; xcircuit
::page size
"11.0 x 17.0 in"}
1136 $m add radio
-label "Ledger" -variable XCOps
(sheetsize
) -value ledger
-command \
1137 { xcircuit
::coordstyle inches
; xcircuit
::page size
"17.0 x 11.0 in"}
1138 $m add radio
-label "Folio" -variable XCOps
(sheetsize
) -value folio
-command \
1139 { xcircuit
::coordstyle inches
; xcircuit
::page size
"8.5 x 13.0 in"}
1140 $m add radio
-label "Quarto" -variable XCOps
(sheetsize
) -value quarto
-command \
1141 { xcircuit
::coordstyle inches
; xcircuit
::page size
"8.472 x 10.833 in"}
1142 $m add radio
-label "10x14" -variable XCOps
(sheetsize
) -value tenfourteen
-command \
1143 { xcircuit
::coordstyle inches
; xcircuit
::page size
"10.0 x 14.0 in"}
1144 $m add radio
-label "Executive" -variable XCOps
(sheetsize
) -value executive
-command \
1145 { xcircuit
::coordstyle inches
; xcircuit
::page size
"7.5 x 10.0 in"}
1146 $m add radio
-label "ANSI C" -variable XCOps
(sheetsize
) -value ansic
-command \
1147 { xcircuit
::coordstyle inches
; xcircuit
::page size
"17.0 x 22.0 in"}
1148 $m add radio
-label "ANSI D" -variable XCOps
(sheetsize
) -value ansid
-command \
1149 { xcircuit
::coordstyle inches
; xcircuit
::page size
"22.0 x 34.0 in"}
1150 $m add radio
-label "ANSI E" -variable XCOps
(sheetsize
) -value ansie
-command \
1151 { xcircuit
::coordstyle inches
; xcircuit
::page size
"34.0 x 44.0 in"}
1152 $m add radio
-label "A3" -variable XCOps
(sheetsize
) -value a3
-command \
1153 { xcircuit
::coordstyle centimeters
; xcircuit
::page size
"29.7 x 42.0 cm"}
1154 $m add radio
-label "A4" -variable XCOps
(sheetsize
) -value a4
-command \
1155 { xcircuit
::coordstyle centimeters
; xcircuit
::page size
"21.0 x 29.7 cm"}
1156 $m add radio
-label "A5" -variable XCOps
(sheetsize
) -value a5
-command \
1157 { xcircuit
::coordstyle centimeters
; xcircuit
::page size
"14.82 x 18.43 cm"}
1158 $m add radio
-label "B4" -variable XCOps
(sheetsize
) -value b4
-command \
1159 { xcircuit
::coordstyle centimeters
; xcircuit
::page size
"25.7 x 36.4 cm"}
1160 $m add radio
-label "B5" -variable XCOps
(sheetsize
) -value b5
-command \
1161 { xcircuit
::coordstyle centimeters
; xcircuit
::page size
"18.2 x 25.7 cm"}
1162 $m add radio
-label "Special" -variable XCOps
(sheetsize
) -value special
}
1164 #-----------------------------------------------------------------
1165 # Clear the selection listbox. Create it if it does not exist.
1166 #-----------------------------------------------------------------
1168 proc xcircuit
::make_parameter_listbox {} {
1169 if {[catch {wm state .parameter
}]} {
1170 toplevel .parameter
-bg beige
1171 wm group .parameter .
1172 wm withdraw .parameter
1174 label .parameter.title
-text "Parameters" -bg beige
1175 label .parameter.keytitle
-text "Key" -bg beige
1176 label .parameter.valtitle
-text "Value" -bg beige
1178 listbox .parameter.keylist
-bg white
1179 listbox .parameter.vallist
-bg white
1180 listbox .parameter.parvals
-bg white
1182 # Code to get the listboxes to scroll in synchrony
1183 bind .parameter.keylist
<Button-4
> {xcircuit
::paramscroll -1}
1184 bind .parameter.keylist
<Button-5
> {xcircuit
::paramscroll 1}
1185 bind .parameter.vallist
<Button-4
> {xcircuit
::paramscroll -1}
1186 bind .parameter.vallist
<Button-5
> {xcircuit
::paramscroll 1}
1187 bind .parameter.parvals
<Button-4
> {xcircuit
::paramscroll -1}
1188 bind .parameter.parvals
<Button-5
> {xcircuit
::paramscroll 1}
1189 # Also bind to the mouse wheel (Windows-specific, generally)
1190 bind .parameter.keylist
<MouseWheel
> {xcircuit
::paramscroll %D
}
1191 bind .parameter.vallist
<MouseWheel
> {xcircuit
::paramscroll %D
}
1192 bind .parameter.parvals
<MouseWheel
> {xcircuit
::paramscroll %D
}
1194 button .parameter.dismiss
-text "Dismiss" -bg beige
\
1195 -command {wm withdraw .parameter
}
1197 menubutton .parameter.delete
-text "Delete..." -bg beige
\
1198 -menu .parameter.delete.deleteparam
1199 menu .parameter.delete.deleteparam
-tearoff 0
1201 menubutton .parameter.create
-text "New..." -bg beige
\
1202 -menu .parameter.create.newparam
1203 menu .parameter.create.newparam
-tearoff 0
1204 .parameter.create.newparam add command
-label "Substring" -command \
1205 "xcircuit::promptmakeparam substring"
1206 .parameter.create.newparam add command
-label "Numeric" -command \
1207 "xcircuit::promptmakeparam numeric"
1208 .parameter.create.newparam add command
-label "Expression" -command \
1209 "xcircuit::promptmakeparam expression"
1211 labelframe .parameter.valedit
-text "Edit value" -bg beige
1212 entry .parameter.valedit.
entry -textvariable new_paramval
-bg white
1213 button .parameter.valedit.apply
-text "Apply" -bg beige
1215 pack .parameter.valedit.
entry -side left
-fill x
-expand true
-padx 2
1216 pack .parameter.valedit.apply
-side top
1218 grid .parameter.title
-row 0 -column 0 -columnspan 2 -sticky news
1219 grid .parameter.keytitle
-row 1 -column 0 -sticky news
1220 grid .parameter.keylist
-row 2 -column 0 -sticky news
1221 grid .parameter.valtitle
-row 1 -column 1 -sticky news
1222 grid .parameter.vallist
-row 2 -column 1 -sticky news
1223 grid .parameter.parvals
-row 2 -column 1 -sticky news
1225 grid .parameter.valedit
-row 3 -column 0 -columnspan 2 -padx 2 \
1228 grid .parameter.create
-row 4 -column 1 -sticky ns
1229 grid .parameter.delete
-row 4 -column 0 -sticky ns
1230 grid .parameter.dismiss
-row 5 -column 0 -columnspan 2 -sticky ns
1232 grid rowconfigure .parameter
2 -weight 1
1233 grid columnconfigure .parameter
0 -weight 1
1234 grid columnconfigure .parameter
1 -weight 2
1236 raise .parameter.vallist
1238 bind .parameter
<Escape
> {wm withdraw .parameter
}
1239 bind .parameter.valedit.
entry <Return
> {.parameter.valedit.apply invoke
}
1243 #-----------------------------------------------------------------
1244 # Scroll all listboxes in the .parameter window at the same
1245 # time, in reponse to any one of them receiving a scroll event.
1246 #-----------------------------------------------------------------
1248 proc xcircuit
::paramscroll {value
} {
1250 set idx
[.parameter.keylist nearest
0]
1252 if {$tcl_platform(platform
) == "windows"} {
1253 set idx
[expr {$idx + $value / 120}]
1255 set idx
[expr {$idx + $value}]
1258 .parameter.keylist yview
$idx
1259 .parameter.vallist yview
$idx
1260 .parameter.parvals yview
$idx
1262 # Important! This prohibits the default binding actions.
1266 # Update the dialog box, if it has been left visible
1267 # (Corrected 2/4/12: Don't delete contents except in these specific cases!)
1269 proc xcircuit
::updatedialog {{w dialog
}} {
1271 if {[xcircuit
::getinitstate .
${w
}] == "normal"} {
1272 switch -- $XCOps(${w
}) {
1274 set btext
[format "%g" [lindex [xcircuit
::border get
] 0]]
1275 .
${w
}.textent.txt delete
0 end
1276 .
${w
}.textent.txt insert
0 $btext
1279 set cscale
[xcircuit
::label scale]
1280 .
${w
}.textent.txt delete
0 end
1281 .
${w
}.textent.txt insert
0 $cscale
1284 set selects
[xcircuit
::select]
1286 set cscale
[xcircuit
::element scale]
1287 .
${w
}.textent.txt delete
0 end
1288 .
${w
}.textent.txt insert
0 $cscale
1295 proc xcircuit
::makedialogline {dframe textline
{w dialog
}} {
1296 if {[catch {frame .
${w
}.
${dframe
} -bg beige
}]} {
1297 .
${w
}.
${dframe
}.title.field configure
-text ${textline
}
1299 pack .
${w
}.
${dframe
} -side top
-padx 20 -pady 7 -fill x
1301 frame .
${w
}.
${dframe
}.title
-bg beige
1302 entry .
${w
}.
${dframe
}.txt
-bg white
-relief sunken
-width 50
1304 pack .
${w
}.
${dframe
}.title
-side top
-fill x
1305 pack .
${w
}.
${dframe
}.txt
-side bottom
-fill x
-expand true
1307 label .
${w
}.
${dframe
}.title.field
-text ${textline
} -bg beige
1308 pack .
${w
}.
${dframe
}.title.field
-side left
1312 proc xcircuit
::removedialogline {dframe
{w dialog
}} {
1314 pack forget .
${w
}.
${dframe
}
1315 destroy .
${w
}.
${dframe
}
1319 #--------------------------------------------
1320 # Create a simple popup prompt window
1321 # With "Apply", "Okay", and "Cancel" buttons
1322 #--------------------------------------------
1324 proc make_simple_dialog
{name
} {
1326 toplevel ${window
} -bg beige
1327 wm title
${window
} "Dialog Box"
1328 wm group
${window
} .
1329 wm protocol
${window
} WM_DELETE_WINDOW
[subst {wm withdraw
${window
}}]
1330 wm withdraw
${window
}
1331 set XCOps
(${name
}) 0
1333 xcircuit
::makedialogline textent
"Select file to load:" ${name
}
1335 frame ${window
}.bbar
-bg beige
1336 pack ${window
}.bbar
-side bottom
-padx 20 -pady 7 -fill x
1338 button ${window
}.bbar.okay
-text Okay
-bg beige
\
1339 -command [subst {${window
}.bbar.apply invoke
;\
1340 wm withdraw
${window
}}]
1341 button ${window
}.bbar.apply
-text Apply
-bg beige
1342 button ${window
}.bbar.cancel
-text Cancel
-bg beige
-command \
1343 [subst {wm withdraw
${window
}}]
1345 bind ${window
}.textent.txt
<Return
> [subst {${window
}.bbar.apply invoke
}]
1347 pack ${window
}.bbar.okay
-side left
-ipadx 10
1348 pack ${window
}.bbar.apply
-side left
-ipadx 10
1349 pack ${window
}.bbar.cancel
-side right
-ipadx 10
1352 #--------------------------------------
1353 # Create a query prompt window with
1354 # "Okay" and "Cancel" buttons, and a
1355 # "Select:" title message
1356 #--------------------------------------
1358 proc make_query_dialog
{name
} {
1360 toplevel ${window
} -bg beige
1361 wm title
${window
} "Query Dialog Box"
1362 wm group
${window
} .
1363 wm protocol
${window
} WM_DELETE_WINDOW
[subst {wm withdraw
${window
}}]
1364 wm withdraw
${window
}
1366 frame ${window
}.title
-bg beige
1367 frame ${window
}.bbar
-bg beige
1369 pack ${window
}.title
-side top
-padx 20 -pady 7 -fill x
1370 pack ${window
}.bbar
-side bottom
-padx 20 -pady 7 -fill x
1372 label ${window
}.title.field
-text "Select:" -bg beige
1373 pack ${window
}.title.field
-side left
1375 button ${window
}.bbar.okay
-text Okay
-bg beige
1376 button ${window
}.bbar.cancel
-text Cancel
-bg beige
-command \
1377 [subst {wm withdraw
${window
}}]
1379 pack ${window
}.bbar.okay
-side left
-ipadx 10
1380 pack ${window
}.bbar.cancel
-side right
-ipadx 10
1383 make_query_dialog query
1384 make_simple_dialog dialog
1385 make_simple_dialog savetech
1386 make_simple_dialog makesymbol
1388 #--------------------------------------------------------
1389 # Generate all of the menu cascades
1390 # Most commands reference XCircuit internal routines
1391 #--------------------------------------------------------
1393 # Supporting procedures
1395 proc xcircuit
::printstring {stringlist
} {
1397 foreach i
$stringlist {
1398 switch -- [lindex $i 0] {
1399 Text
{append p
[lindex $i 1]}
1401 Quarter
{append p
" "}
1407 proc xcircuit
::printanchor {anchor
} {
1408 switch [expr {$anchor & 3}] {
1413 switch [expr {$anchor & 12}] {
1414 0 {append p
" bottom"}
1415 4 {append p
" middle"}
1416 12 {append p
" top"}
1421 proc xcircuit
::labelmakeparam {} {
1423 if {[xcircuit
::select] > 0} { ;# this should be true. . .
1424 set XCOps
(dialog
) paramname
1425 xcircuit
::removedialogline textent2 dialog
;# default is the selected text
1426 .dialog.bbar.apply configure
-command \
1427 [subst {xcircuit
::parameter make substring
\[.dialog.textent.txt get
\];\
1428 xcircuit
::updateparams substring
}]
1429 .dialog.textent.title.field configure
-text "Parameter name:"
1430 .dialog.textent.txt delete
0 end
1431 xcircuit
::popupdialog
1435 proc xcircuit
::promptmakeparam {{mode substring
}} {
1438 set XCOps
(dialog
) paramdefault
1439 if {$mode == "label"} {set mode substring
}
1440 xcircuit
::makedialogline textent2
"Default value:" dialog
1441 .dialog.bbar.apply configure
-command \
1442 [subst {xcircuit
::parameter make
$mode \
1443 \[.dialog.textent.txt get
\] \[.dialog.textent2.txt get
\] -forward; \
1444 xcircuit
::removedialogline textent2 dialog
; \
1445 xcircuit
::updateparams $mode}]
1446 .dialog.textent.title.field configure
-text \
1448 .dialog.textent.txt delete
0 end
1449 xcircuit
::popupdialog
1452 #----------------------------------------------------------------------
1453 # This procedure generates a new index number for list selection
1454 # inside a parameter, using "regsub" and "subst" to replace the
1455 # old index with the new one. This procedure depends on the
1456 # existance of the listbox widget ".paramlist.plist".
1457 #----------------------------------------------------------------------
1459 proc xcircuit
::renewparam {key y args
} {
1460 set newidx
[.parameter.parvals nearest
$y]
1461 set current
[join [xcircuit
::parameter get
$key ${args
} -verbatim]]
1462 regsub {(.
*lindex +{.
*} +)([0-9]+)(.
*)} $current {\1$newidx\3} tmpkey
1463 set newkey
[subst -nocommands -nobackslashes "$tmpkey"]
1464 xcircuit
::parameter set $key $newkey $args
1467 #----------------------------------------------------------------------
1468 # Prompt for a new value of a parameter. Do some sophisticated checking
1469 # for parameters that declare a list of possible options, and handle
1470 # that situation separately.
1471 #----------------------------------------------------------------------
1473 proc xcircuit
::changeparamvalue {key current args
} {
1475 .parameter.valedit.
entry delete
0 end
1476 if {[xcircuit
::parameter type
$key -forward] == "expression"} {
1478 # Use regexp processing to find if there is some part of the expression
1479 # that chooses a single fixed value from a list. If so, generate a
1480 # listbox to present the choices in the list.
1482 set loccurnt
[join [xcircuit
::parameter get
$key ${args
} -verbatim]]
1483 if {[regexp {.
*lindex +{(.
*)} +[0-9]+.
*} $loccurnt qall sellist
] > 0} {
1484 .parameter.parvals delete
0 end
1485 raise .parameter.parvals
1487 foreach item
$sellist {
1488 .parameter.parvals insert end
$item
1491 #Abort the parameter value selection
1492 bind .parameter.parvals
<ButtonRelease-3
> {raise .parameter.vallist
}
1494 bind .parameter.parvals
<ButtonRelease-1
> [subst {xcircuit
::renewparam \
1496 .parameter.keylist configure
-state normal
;\
1497 xcircuit
::updateparams ;\
1498 raise .parameter.vallist
}]
1500 .parameter.valedit.
entry delete
0 end
1501 .parameter.valedit.
entry insert
0 $loccurnt
1504 # If the parameter is an expression but not a choice-list type, then
1505 # we had better print the verbatim entry, or people will just get
1506 # confused when the value becomes "invalid result:..."
1507 .parameter.valedit.
entry insert
0 $loccurnt
1510 .parameter.valedit.
entry insert
0 $current
1512 focus .parameter.valedit.
entry
1513 .parameter.valedit.apply configure
\
1514 -command [subst {xcircuit
::parameter set \
1515 $key \[.parameter.valedit.
entry get
\] \
1516 ${args
}; xcircuit
::updateparams}]
1519 #----------------------------------------------------------------------
1521 proc xcircuit
::updateparams { {mode
{substring numeric expression
}} } {
1523 if {[catch {wm state .parameter
}]} {return}
1525 # Avoid infinite recursion if a parameter invokes updateparams
1526 # (e.g., any "page" command in a parameter will do this!)
1528 if {$mode != "force"} {
1529 if {[info level
] > 1} {return}
1531 set mode
{substring numeric expression
}
1534 while {[.parameter.keylist size
] > 0} {.parameter.keylist delete
0}
1535 while {[.parameter.vallist size
] > 0} {.parameter.vallist delete
0}
1537 .parameter.delete.deleteparam delete
0 last
1539 if {$mode == "none"} {
1540 set dlist
[xcircuit
::parameter get
-forward]
1544 set dlist
[concat $dlist [parameter get
$i -forward]]
1548 # Ensure that the parvals list is not present
1549 if {[select
] == 0} { lower .parameter.parvals
}
1551 # All selections will be lost, so make sure that the value field is clear
1552 .parameter.valedit.
entry delete
0 end
1553 .parameter.valedit.apply configure
-command {}
1555 bind .parameter.vallist
<ButtonRelease-1
> {
1556 set kidx
[.parameter.keylist nearest
%y
]; \
1557 xcircuit
::changeparamvalue \
1558 [.parameter.keylist get
$kidx] [.parameter.vallist get
$kidx] \
1561 ;#The insertion of parameters should only be applicable in "text" mode
1562 bind .parameter.keylist
<ButtonRelease-1
> {
1563 set kidx
[.parameter.keylist nearest
%y
]; \
1564 if {[string last
"text" [xcircuit
::eventmode]] >= 0} {
1565 label insert parameter
[.parameter.keylist get
$kidx]
1569 if {[catch {set oname
[xcircuit
::object name
]}]} {
1570 .parameter.title configure
-text "Parameters"
1572 .parameter.title configure
-text "Parameters of $oname"
1575 set p_name
[lindex $i 0]
1576 set p_val
[lindex $i 1]
1577 .parameter.delete.deleteparam add command
-label $p_name -command \
1578 "xcircuit::parameter delete $p_name -forward"
1579 .parameter.keylist insert end
$p_name
1580 switch -- [xcircuit
::parameter type
$p_name -forward] {
1582 .parameter.vallist insert end
[xcircuit
::printstring $p_val]
1585 .parameter.vallist insert end
[xcircuit
::printanchor $p_val]
1588 .parameter.vallist insert end
$p_val
1594 #----------------------------------------------------------------------
1596 proc xcircuit
::prompteditparams {} {
1597 set wstate
[xcircuit
::getinitstate .parameter
]
1598 xcircuit
::make_parameter_listbox
1599 xcircuit
::updateparams force
1600 if {"$wstate" != "normal"} {
1601 wm deiconify .parameter
1602 xcircuit
::centerwin .parameter
1607 #----------------------------------------------------------------------
1609 proc xcircuit
::promptmakesymbol {{name
""}} {
1612 set XCOps
(dialog
) makeobject
1613 .makesymbol.bbar.apply configure
-command \
1614 {if {[string first
"Page " [page
label]] >= 0} { \
1615 page
label [.makesymbol.textent.txt get
]}; \
1616 xcircuit
::symbol make
[.makesymbol.textent.txt get
] $XCOps(library
)}
1617 xcircuit
::removedialogline textent2 makesymbol
1618 .makesymbol.textent.title.field configure
-text "Name for new object:"
1619 .makesymbol.textent.txt delete
0 end
1620 .makesymbol.textent.txt insert
0 $name
1621 xcircuit
::popupdialog .makesymbol
1622 xcircuit
::addliblist .makesymbol Place in
: "
1625 #----------------------------------------------------------------------
1627 proc xcircuit::prompttargettech {{name ""}} {
1630 set XCOps(dialog) targettech
1631 .savetech.bbar.apply configure -command { \
1632 set selects [xcircuit::select]; \
1633 if {$selects > 0} { \
1634 if {[catch {set techname [.savetech.textent2.txt get]}]} {\
1635 set techname $XCOps(technology)}; \
1636 technology objects $techname [.savetech.textent.txt get]}\
1638 xcircuit::removedialogline textent2 savetech
1639 .savetech.textent.title.field configure -text "Objects to move
:"
1640 .savetech.textent.txt delete 0 end
1641 .savetech.textent.txt insert 0 $name
1642 xcircuit::popupdialog
1643 xcircuit::addtechlist .savetech "Target technology
: "
1645 # Add an additional selection to the tech menu for adding a new
1646 # technology namespace. This is relevant only to "prompttargettech
".
1648 .savetech.techself.techselect.menu add \
1649 command -label "Add New Tech
" -command \
1650 "xcircuit
::makedialogline textent2
{New tech name
:}" savetech
1653 #----------------------------------------------------------------------
1655 proc xcircuit::promptelementsize {} {
1657 if {![catch {set cscale [xcircuit::element scale]}]} {
1658 set XCOps(dialog) elementscale
1659 .dialog.bbar.apply configure -command \
1660 {xcircuit::element scale [.dialog.textent.txt get]}
1661 .dialog.textent.title.field configure -text "Element
scale:"
1662 .dialog.textent.txt delete 0 end
1663 .dialog.textent.txt insert 0 $cscale
1664 xcircuit::popupdialog
1668 #----------------------------------------------------------------------
1670 proc xcircuit::promptborderwidth {} {
1672 .dialog.textent.txt delete 0 end
1673 set XCOps(dialog) linewidth
1674 set elist [xcircuit::select get]
1675 if {[llength $elist] == 0} {
1676 .dialog.bbar.apply configure -command \
1677 [subst {config focus [config focus] ;\
1678 xcircuit::border set \[.dialog.textent.txt get\]}]
1679 .dialog.textent.title.field configure -text "Default linewidth
scale:"
1680 set btext [format "%g
" [xcircuit::border get]]
1681 .dialog.textent.txt insert 0 $btext
1683 .dialog.bbar.apply configure -command \
1684 [subst {config focus [config focus] ;\
1685 xcircuit::border set \[.dialog.textent.txt get \]}]
1686 .dialog.textent.title.field configure -text "Element linewidth
:"
1687 set btext [format "%g
" [lindex [xcircuit::border get] 0]]
1688 .dialog.textent.txt insert 0 $btext
1690 xcircuit::popupdialog
1693 #----------------------------------------------------------------------
1695 proc xcircuit::promptlinewidth {} {
1697 set XCOps(dialog) linescale
1698 .dialog.bbar.apply configure -command \
1699 [subst {config focus [config focus] ;\
1700 xcircuit::config linewidth \[.dialog.textent.txt get \]}]
1701 .dialog.textent.title.field configure -text "Page linewidth scaling
:"
1702 .dialog.textent.txt delete 0 end
1703 set ltext [format "%g
" [xcircuit::config linewidth]]
1704 .dialog.textent.txt insert 0 $ltext
1705 xcircuit::popupdialog
1708 #----------------------------------------------------------------------
1710 proc xcircuit::promptdrawingscale {} {
1712 set XCOps(dialog) drawingscale
1713 .dialog.bbar.apply configure -command \
1714 {xcircuit::config drawingscale [.dialog.textent.txt get]}
1715 .dialog.textent.title.field configure -text "Drawing
scale:"
1716 .dialog.textent.txt delete 0 end
1717 .dialog.textent.txt insert 0 [xcircuit::config drawingscale]
1718 xcircuit::popupdialog
1721 #----------------------------------------------------------------------
1723 proc xcircuit::promptgridspace {} {
1724 .dialog.bbar.apply configure -command \
1725 {xcircuit::config grid spacing [.dialog.textent.txt get]}
1726 .dialog.textent.title.field configure -text "Grid spacing
:"
1727 .dialog.textent.txt delete 0 end
1728 .dialog.textent.txt insert 0 [xcircuit::config grid space]
1729 xcircuit::popupdialog
1732 #----------------------------------------------------------------------
1734 proc xcircuit::promptsnapspace {} {
1736 set XCOps(dialog) snapspace
1737 .dialog.bbar.apply configure -command \
1738 {xcircuit::config snap spacing [.dialog.textent.txt get]}
1739 .dialog.textent.title.field configure -text "Snap spacing
:"
1740 .dialog.textent.txt delete 0 end
1741 .dialog.textent.txt insert 0 [xcircuit::config snap space]
1742 xcircuit::popupdialog
1745 #----------------------------------------------------------------------
1747 proc xcircuit::promptmakeobject {} {
1749 if {[xcircuit::select] > 0} {
1750 set XCOps(dialog) makeobject
1751 .dialog.bbar.apply configure -command \
1752 {if {[select get] != {}} {\
1753 if {[.dialog.textent.txt get] == ""} {\
1754 .dialog.textent.title.field configure -text "Please enter a name
" }\
1755 elseif {[catch {xcircuit::object handle [.dialog.textent.txt get]}]} {\
1756 xcircuit::object make [.dialog.textent.txt get] $XCOps(library)}\
1757 else {.dialog.textent.title.field configure -text \
1758 "Name already used. Choose another name
" ; .dialog.textent.txt \
1760 .dialog.textent.title.field configure -text "Name
for new object
"
1761 .dialog.textent.txt delete 0 end
1762 if {$XCOps(technology) != "(user
)"} {
1763 .dialog.textent.txt insert 0 "${XCOps
(technology
)}::"
1765 xcircuit::popupdialog
1766 xcircuit::addtechlist .dialog "Technology
: " {(user)} prefix
1767 xcircuit::addliblist .dialog "Place in
: "
1772 #----------------------------------------------------------------------
1774 proc xcircuit::promptreplaceobject {} {
1776 if {[xcircuit::select] > 0} {
1777 set XCOps(dialog) replaceobject
1778 .dialog.bbar.apply configure -command \
1779 {xcircuit::element selected object [.dialog.textent.txt get]}
1780 .dialog.textent.title.field configure -text "Name of replacement object
"
1781 .dialog.textent.txt delete 0 end
1782 xcircuit::popupdialog
1786 #----------------------------------------------------------------------
1788 proc xcircuit::promptloadlibrary {} {
1791 .filelist.bbar.okay configure -command \
1792 {xcircuit::library [.filelist.libself.libselect cget -text] load \
1793 [.filelist.textent.txt get]; wm withdraw .filelist}
1794 .filelist.listwin.win configure -data "lps
"
1795 .filelist.textent.title.field configure -text "Select technology
file to
load:"
1796 .filelist.textent.txt delete 0 end
1797 xcircuit::popupfilelist
1798 xcircuit::addliblist .filelist "Load to which library page
: "
1801 #----------------------------------------------------------------------
1803 proc xcircuit::promptsavetech {} {
1806 set XCOps(dialog) techname
1807 .savetech.bbar.apply configure -command \
1808 {xcircuit::technology save [.savetech.techself.techselect cget -text] \
1809 [.savetech.textent.txt get]}
1810 .savetech.textent.title.field configure -text "Filename to save technology as
:"
1811 .savetech.textent.txt delete 0 end
1812 xcircuit::popupdialog .savetech
1813 xcircuit::addtechlist .savetech "Save which technology
: " {(user)} true
1815 catch {set fname [technology filename $XCOps(technology)]}
1816 if {$fname == "(no associated
file)"} {
1817 set fname $XCOps(technology).lps
1819 .savetech.textent.txt insert 0 $fname
1822 #----------------------------------------------------------------------
1824 proc xcircuit::promptaddlibrary {} {
1826 set XCOps(dialog) libname
1827 .dialog.bbar.apply configure -command \
1828 {xcircuit::library make [.dialog.textent.txt get]}
1829 .dialog.textent.title.field configure -text "Name of new library page
:"
1830 .dialog.textent.txt delete 0 end
1831 xcircuit::popupdialog
1834 #----------------------------------------------------------------------
1836 proc xcircuit::promptloadfile {} {
1837 .filelist.bbar.okay configure -command \
1838 {xcircuit::page load [.filelist.textent.txt get] -replace \
1839 [.filelist.techself.techselect cget -text] \
1840 -target $XCOps(library); wm withdraw .filelist}
1841 .filelist.listwin.win configure -data "ps eps
"
1842 .filelist.textent.title.field configure -text "Select
file to
load:"
1843 .filelist.textent.txt delete 0 end
1844 xcircuit::popupfilelist
1845 xcircuit::addtechlist .filelist "Replace from
: " {(user) all none}
1846 xcircuit::addliblist .filelist "Target library
: "
1849 #----------------------------------------------------------------------
1851 proc xcircuit::promptimportspice {} {
1852 .filelist.bbar.okay configure -command \
1853 {xcircuit::page import spice \
1854 [.filelist.textent.txt get]; wm withdraw .filelist}
1855 .filelist.listwin.win configure -data "spice spc spi ckt sp cir
"
1856 .filelist.textent.title.field configure -text "Select SPICE
file to import
:"
1857 .filelist.textent.txt delete 0 end
1858 xcircuit::popupfilelist
1861 #----------------------------------------------------------------------
1863 proc xcircuit::promptimportfile {} {
1864 .filelist.bbar.okay configure -command \
1865 {xcircuit::page import xcircuit \
1866 [.filelist.textent.txt get]; wm withdraw .filelist}
1867 .filelist.listwin.win configure -data "ps eps
"
1868 .filelist.textent.title.field configure -text "Select
file to import
:"
1869 xcircuit::popupfilelist
1872 #----------------------------------------------------------------------
1874 proc xcircuit::promptimportbackground {} {
1875 .filelist.bbar.okay configure -command \
1876 {xcircuit::page import background \
1877 [.filelist.textent.txt get]; wm withdraw .filelist}
1878 .filelist.listwin.win configure -data "ps eps
"
1879 .filelist.textent.title.field configure -text "Select
file to use as background
:"
1880 .filelist.textent.txt delete 0 end
1881 xcircuit::popupfilelist
1884 #----------------------------------------------------------------------
1885 # Convert a graphic image using ImageMagick "convert
" (if available)
1886 #----------------------------------------------------------------------
1888 proc xcircuit::convertgraphic {filename} {
1889 set fileext [file extension $filename]
1890 set fileroot [file rootname $filename]
1892 switch -- $fileext {
1897 exec convert $filename ${fileroot}.ppm
1904 exec convert -density 300x300 $filename ${fileroot}.ppm
1907 xcircuit::graphic make ${fileroot}.ppm {0 0} 1;
1908 if {$temp == true} {
1909 file delete ${fileroot}.ppm
1913 #----------------------------------------------------------------------
1915 proc xcircuit::promptimportgraphic {} {
1916 if {![catch {exec convert -version}]} {
1917 .filelist.bbar.okay configure -command \
1918 {xcircuit::convertgraphic [.filelist.textent.txt get];
1919 refresh; wm withdraw .filelist}
1920 .filelist.listwin.win configure -data "pnm ppm gif jpg png
"
1922 .filelist.bbar.okay configure -command \
1923 {xcircuit::graphic make [.filelist.textent.txt get] {0 0} 1;
1924 refresh; wm withdraw .filelist}
1925 .filelist.listwin.win configure -data "pnm ppm
"
1927 .filelist.textent.title.field configure -text "Select graphic
image file:"
1928 .filelist.textent.txt delete 0 end
1929 xcircuit::popupfilelist
1932 #----------------------------------------------------------------------
1934 proc xcircuit::promptexecscript {} {
1935 .filelist.bbar.okay configure -command \
1936 {source [.filelist.textent.txt get]; wm withdraw .filelist}
1937 .filelist.listwin.win configure -data "tcl xcircuitrc
"
1938 .filelist.textent.title.field configure -text "Select script to execute
:"
1939 xcircuit::popupfilelist
1942 #----------------------------------------------------------------------
1944 proc xcircuit::prompttextsize {} {
1946 set XCOps(dialog) textscale
1947 .dialog.bbar.apply configure -command \
1948 {xcircuit::label scale [.dialog.textent.txt get]}
1949 .dialog.textent.title.field configure -text "Text
scale:"
1950 .dialog.textent.txt delete 0 end
1951 set stext [format "%g
" [xcircuit::label scale]]
1952 .dialog.textent.txt insert 0 $stext
1953 xcircuit::popupdialog
1956 #----------------------------------------------------------------------
1957 # add a library list widget to a dialog box
1958 #----------------------------------------------------------------------
1960 proc xcircuit::addliblist {w {prompt "Target
: "}} {
1964 label ${w}.libself.title -text $prompt -bg beige
1966 set liblist [library directory list]
1968 menubutton ${w}.libself.libselect -menu ${w}.libself.libselect.menu -relief groove
1969 menu ${w}.libself.libselect.menu -tearoff 0
1970 foreach j $liblist {
1971 ${w}.libself.libselect.menu add \
1972 radio -label "$j" -variable XCOps(library) -value \
1973 "$j" -command "${w
}.libself.libselect configure
-text {$j}"
1975 ${w}.libself.libselect configure -text $XCOps(library)
1977 pack ${w}.libself.title -side left
1978 pack ${w}.libself.libselect -side left
1979 pack ${w}.libself -side top -anchor w -padx 20
1982 #----------------------------------------------------------------------
1983 # Add a technology list widget to a dialog box
1985 # If "update" is "true
", then a selection of a technology in the list
1986 # will update the text entry window contents with the corresponding
1987 # filename. If "update" is "prefix
", then a selection of a technology
1988 # in the list will update the text entry window contents with the
1989 # technology namespace prefix corresponding to the selected technology.
1990 # If "update" is "false
", then selecting the technology will set the
1991 # global variable XCOps(technology) but will not alter the window
1993 #----------------------------------------------------------------------
1995 proc xcircuit::addtechlist {w {prompt "Technology
: "} {endlist {}} {update {false}}} {
1999 label ${w}.techself.title -text $prompt -bg beige
2001 set techlist [technology list]
2002 foreach j $endlist { lappend techlist $j }
2004 menubutton ${w}.techself.techselect -menu ${w}.techself.techselect.menu -relief groove
2005 menu ${w}.techself.techselect.menu -tearoff 0
2006 foreach j $techlist {
2007 if {$update == true} {
2009 catch {set fname [technology filename "$j"]}
2011 ${w}.techself.techselect.menu add \
2012 radio -label "$j" -variable XCOps(technology) -value \
2013 "$j" -command "${w
}.techself.techselect configure
-text {$j} ; \
2014 ${w
}.textent.txt delete
0 end
; ${w
}.textent.txt insert
0 {$fname}"
2015 } elseif {$update == "prefix
"} {
2016 if {$j != {} && $j != "(user
)"} {
2021 ${w}.techself.techselect.menu add \
2022 radio -label "$j" -variable XCOps(technology) -value \
2023 "$j" -command [subst {${w}.techself.techselect configure -text {$j} ; \
2024 set pfixend \[string last :: \[${w}.textent.txt get\]\] ; \
2025 if {\$pfixend < 0} {set pfixend 0} else {incr pfixend 2} ; \
2026 ${w}.textent.txt delete 0 \$pfixend ; \
2027 ${w}.textent.txt insert 0 {$tpfix}}]
2029 ${w}.techself.techselect.menu add \
2030 radio -label "$j" -variable XCOps(technology) -value \
2031 "$j" -command "${w
}.techself.techselect configure
-text {$j}"
2034 ${w}.techself.techselect configure -text $XCOps(technology)
2036 pack ${w}.techself.title -side left
2037 pack ${w}.techself.techselect -side left
2038 pack ${w}.techself -side right -anchor w -padx 20
2041 #----------------------------------------------------------------------
2043 proc xcircuit::removelists {w} {
2047 pack forget ${w}.libself
2048 destroy ${w}.libself
2051 pack forget ${w}.techself
2052 destroy ${w}.techself
2056 #----------------------------------------------------------------------
2057 # newcolorbutton is called internally to xcircuit---don't mess with it!
2058 #----------------------------------------------------------------------
2060 proc xcircuit::newcolorbutton {r g b idx} {
2061 global XCWinOps XCIRCUIT_LIB_DIR
2063 set colorrgb [format "#%04X%04X%04X" $r $g $b]
2064 image create
bitmap img_col
$idx -foreground $colorrgb -file \
2065 ${XCIRCUIT_LIB_DIR
}/pixmaps
/solid.xbm
2067 foreach window
[config windownames
] {
2068 set frame [winfo top
$window]
2069 ${frame}.menubar.optionsbutton.optionsmenu.elementsmenu.colormenu
\
2070 add radio
-image img_col
$idx -activebackground $colorrgb \
2071 -variable XCWinOps
(${frame},colorval
) -value $idx -command \
2072 "xcircuit::color set $idx"
2076 #----------------------------------------------------------------------
2077 # Regenerate the list of color buttons for a new window
2078 #----------------------------------------------------------------------
2080 proc xcircuit
::allcolorbuttons {window
} {
2083 set colorlist
[color get
-all]
2084 set frame [winfo top
$window]
2085 set idx
18 ;# NUMBER_OF_COLORS in colordefs.h
2086 foreach colorrgb
$colorlist {
2087 ${frame}.menubar.optionsbutton.optionsmenu.elementsmenu.colormenu
\
2088 add radio
-image img_col
$idx -activebackground $colorrgb \
2089 -variable XCWinOps
(${frame},colorval
) -value $idx -command \
2090 "xcircuit::color set $idx"
2095 #----------------------------------------------------------------------
2097 proc xcircuit
::picknewcolor {} {
2098 if {[catch {set colorrgb
[tk_chooseColor]}]} {
2099 set colorrgb
[tkColorDialog
]
2101 xcircuit
::color add
$colorrgb
2104 #----------------------------------------------------------------------
2106 proc xcircuit
::newencodingbutton {encodingname
} {
2109 foreach window
[config windownames
] {
2110 set frame [winfo top
$window]
2111 if {[catch {${frame}.menubar.textbutton.textmenu.encodingmenu
\
2112 index
$encodingname} result
]} {
2113 ${frame}.menubar.textbutton.textmenu.encodingmenu add radio
-label \
2114 $encodingname -command "xcircuit::label encoding $encodingname" \
2115 -variable XCWinOps
(${frame},fontencoding
) -value $encodingname
2120 #----------------------------------------------------------------------
2122 proc xcircuit
::newfontbutton {familyname
} {
2125 foreach window
[config windownames
] {
2126 set frame [winfo top
$window]
2127 if {[catch {${frame}.menubar.textbutton.textmenu.fontmenu
\
2128 index
$familyname} result
]} {
2129 ${frame}.menubar.textbutton.textmenu.fontmenu add radio
-label \
2130 $familyname -command "xcircuit::label family $familyname" \
2131 -variable XCWinOps
(${frame},fontfamily
) -value $familyname
2136 #----------------------------------------------------------------------
2137 # Regenerate the list of known font families for a new window
2138 #----------------------------------------------------------------------
2140 proc xcircuit
::allfontbuttons {window
} {
2143 set familylist
[label family
-all]
2144 set frame [winfo top
$window]
2145 while {$familylist != {}} {
2146 set familyname
[lindex $familylist 0]
2147 ${frame}.menubar.textbutton.textmenu.fontmenu add radio
-label \
2148 $familyname -command "xcircuit::label family $familyname" \
2149 -variable XCWinOps
(${frame},fontfamily
) -value $familyname
2150 # Remove all such entries (this works like "lsort -unique" but doesn't
2151 # scramble the list entries).
2152 set familylist
[lsearch -all -inline -not $familylist $familyname]
2156 #----------------------------------------------------------------------
2158 proc xcircuit
::newlibrarybutton {libname
} {
2159 if {[catch {.librarymenu index
$libname} result
]} {
2160 set libidx
[.librarymenu index end
]
2161 if {$libidx <= 1} {set libidx
[expr $libidx + 1]}
2162 .librarymenu insert
$libidx command
-label $libname -command \
2163 "xcircuit::library \"$libname\" goto"
2167 #----------------------------------------------------------------------
2169 proc xcircuit
::newpagebutton {pagename
{pageno
0}} {
2170 if {[catch {.pagemenu index
$pagename} result
]} {
2171 set target
$pagename
2172 if {$pageno > 0} { set target
$pageno }
2173 .pagemenu add command
-label $pagename -command \
2174 "xcircuit::page \"$target\" goto"
2178 #----------------------------------------------------------------------
2180 proc xcircuit
::renamelib {libno libname
} {
2181 set target
[expr $libno + 1]
2182 .librarymenu entryconfigure
$target -label $libname -command \
2183 "xcircuit::library \"$libname\" goto"
2186 #----------------------------------------------------------------------
2188 proc xcircuit
::renamepage {pageno pagename
} {
2189 set target
[expr $pageno + 1]
2190 .pagemenu entryconfigure
$target -label $pagename -command \
2191 "xcircuit::page \"$pagename\" goto"
2194 #----------------------------------------------------------------------
2196 proc xcircuit
::promptnewfont {} {
2198 set XCOps
(dialog
) fontname
2199 .dialog.bbar.apply configure
-command \
2200 {xcircuit
::loadfont [.dialog.textent.txt get
]}
2201 .dialog.textent.title.field configure
-text "Font name:"
2202 .dialog.textent.txt delete
0 end
2203 xcircuit
::popupdialog
2206 #----------------------------------------------------------------------
2208 proc xcircuit
::promptkern {} {
2210 set XCOps
(dialog
) kernamount
2211 .dialog.bbar.apply configure
-command \
2212 {xcircuit
::label insert kern
[.dialog.textent.txt get
]}
2213 .dialog.textent.title.field configure
-text "Kern amount:"
2214 .dialog.textent.txt delete
0 end
2215 xcircuit
::popupdialog
2218 #----------------------------------------------------------------------
2220 proc xcircuit
::promptmargin {} {
2222 set XCOps
(dialog
) marginamount
2223 .dialog.bbar.apply configure
-command \
2224 {xcircuit
::label insert margin
[.dialog.textent.txt get
]}
2225 .dialog.textent.title.field configure
-text "Margin amount:"
2226 .dialog.textent.txt delete
0 end
2227 xcircuit
::popupdialog
2230 #----------------------------------------------------------------------
2232 proc xcircuit
::maketoolimages {} {
2233 global XCOps XCIRCUIT_LIB_DIR
2234 set XCOps
(tools
) [list pn w b a s t mv cp e d2 cw ccw fx fy r pu2 po2 mk pz
\
2235 uj co bd fi pm pa li yp pl z4 z5 i
]
2237 if [catch {set XCOps
(scale)}] {set XCOps
(scale) 1.0}
2238 set gsize
[expr {int
($XCOps(scale) * 20)}]
2239 set gscale
[expr {int
($XCOps(scale))}]
2241 for {set i
0} {$i < [llength $XCOps(tools
)]} {incr i
1} {
2242 set bname
[lindex $XCOps(tools
) $i]
2243 image create
photo stdimage
-file ${XCIRCUIT_LIB_DIR
}/pixmaps
/${bname
}.gif
2244 image create
photo img_
${bname
} -width $gsize -height $gsize
2245 img_
${bname
} copy stdimage
-zoom $gscale
2249 #----------------------------------------------------------------------
2251 proc xcircuit
::modebutton {widget
} {
2252 global XCOps XCWinOps
2253 set window
$XCOps(focus)
2255 for {set i
0} {$i < [llength $XCOps(tools
)]} {incr i
1} {
2256 set bname
[lindex $XCOps(tools
) $i]
2257 ${window
}.mainframe.toolbar.b
${bname
} configure
-relief raised
\
2258 -highlightbackground gray90
-background gray90
2260 $widget configure
-relief solid
-highlightbackground green3
-background green3
2261 if {$XCWinOps(${window
},button1
) == "Rotate"} {
2262 ${window
}.infobar.mode configure
-text "$XCWinOps(${window},button1) \
2263 $XCWinOps(${window},rotateamount) Mode"
2265 ${window
}.infobar.mode configure
-text "$XCWinOps(${window},button1) Mode"
2269 #----------------------------------------------------------------------
2271 proc xcircuit
::button1action {button cursor action
{value
{}}} {
2272 global XCOps XCWinOps
2274 set window
$XCOps(focus).mainframe.mainarea.drawing
2275 catch {bindkey
$window Button1
$XCWinOps($XCOps(focus),button1
) forget
}
2278 bindkey
$window Button1
$action
2280 bindkey
$window Button1
$action $value
2282 set XCWinOps
($XCOps(focus),button1
) $action
2283 xcircuit
::modebutton $button
2284 catch {cursor
$cursor}
2285 catch {xcircuit
::automousehint $window}
2288 #----------------------------------------------------------------------
2290 proc xcircuit
::createtoolbar {window
} {
2291 global XCOps XCWinOps XCIRCUIT_LIB_DIR
2293 set tooltips
[list "pan window" "draw wire" "draw box" \
2294 "draw arc" "draw spline" "enter text" \
2295 "move element" "copy element" "edit element" "delete element" \
2296 "rotate 15 degrees clockwise" "rotate 15 degrees counterclockwise" \
2297 "flip horizontal" "flip vertical" "rescale" "push (edit object)" \
2298 "pop (return from object edit)" "make an object from selection" \
2299 "join elements into polygon or path" "separate path into elements" \
2300 "set color" "set border and line properties" "set fill properties" \
2301 "parameterize properties" "parameter selection" \
2302 "go to next library" "go to library directory" \
2303 "go to page directory" "zoom in" "zoom out" "pop up help window"]
2304 set toolactions
[list \
2305 {xcircuit
::button1action %W hand Pan
6} \
2306 {xcircuit
::button1action %W cross Wire
} \
2307 {xcircuit
::button1action %W cross Box
} \
2308 {xcircuit
::button1action %W circle Arc
} \
2309 {if {[select
]} {spline make
} else { \
2310 xcircuit
::button1action %W arrow Spline
}} \
2311 {xcircuit
::button1action %W
text $XCWinOps($XCOps(focus),labeltype
) ; \
2312 $XCOps(focus).mainframe.toolbar.bt configure
-image \
2313 $XCWinOps($XCOps(focus),labelimage
)} \
2314 {if {[select
]} {move selected
} else { \
2315 xcircuit
::button1action %W arrow Move
}} \
2316 {if {[select
]} {copy selected
} else { \
2317 xcircuit
::button1action %W copy Copy
}} \
2318 {if {[select
] == 1} {edit selected
} else { \
2319 xcircuit
::button1action %W edit Edit
}} \
2320 {if {[select
]} {delete selected
} else { \
2321 xcircuit
::button1action %W scissors Delete
}} \
2322 {if {[select
]} {rotate
$XCWinOps($XCOps(focus),rotateamount
)} else {\
2323 xcircuit
::button1action %W rotate Rotate
\
2324 $XCWinOps($XCOps(focus),rotateamount
)}} \
2325 {if {[select
]} {rotate
-$XCWinOps($XCOps(focus),rotateamount
)} else {\
2326 xcircuit
::button1action %W rotate Rotate
\
2327 -$XCWinOps($XCOps(focus),rotateamount
)}} \
2328 {if {[select
]} {flip horizontal
} else { \
2329 xcircuit
::button1action %W rotate
"Flip X"}} \
2330 {if {[select
]} {flip vertical
} else { \
2331 xcircuit
::button1action %W rotate
"Flip Y"}} \
2332 {if {[select
]} {xcircuit
::promptelementsize} else { \
2333 xcircuit
::button1action %W arrow Rescale
}} \
2334 {if {[select
] == 1} {push selected
} else { \
2335 xcircuit
::button1action %W question Push
}} \
2337 {if {[select
]} {xcircuit
::promptmakeobject} else { \
2338 xcircuit
::button1action %W question
"Select Save"}} \
2339 {if {[select
]} {path
join selected
} else { \
2340 xcircuit
::button1action %W arrow Join
}} \
2341 {if {[select
] == 1} {path unjoin selected
} else { \
2342 xcircuit
::button1action %W arrow Unjoin
}} \
2343 {tk_popup $XCOps(focus).colormenu
[expr {[winfo rootx
\
2344 $XCOps(focus).mainframe.toolbar.bco
] \
2345 - [winfo width
$XCOps(focus).colormenu
]}] \
2346 [expr {[winfo rooty
$XCOps(focus).mainframe.toolbar.bco
] \
2347 - [winfo height
$XCOps(focus).colormenu
] / 2}] } \
2348 {tk_popup $XCOps(focus).bordermenu
[expr {[winfo rootx
\
2349 $XCOps(focus).mainframe.toolbar.bbd
] \
2350 - [winfo width
$XCOps(focus).bordermenu
]}] \
2351 [expr {[winfo rooty
$XCOps(focus).mainframe.toolbar.bbd
] \
2352 - [winfo height
$XCOps(focus).bordermenu
] / 2}] } \
2353 {tk_popup $XCOps(focus).fillmenu
[expr {[winfo rootx
\
2354 $XCOps(focus).mainframe.toolbar.bfi
] \
2355 - [winfo width
$XCOps(focus).fillmenu
]}] \
2356 [expr {[winfo rooty
$XCOps(focus).mainframe.toolbar.bfi
] \
2357 - [winfo height
$XCOps(focus).fillmenu
] / 2}] } \
2358 {tk_popup $XCOps(focus).parammenu
[expr {[winfo rootx
\
2359 $XCOps(focus).mainframe.toolbar.bpm
] \
2360 - [winfo width
$XCOps(focus).parammenu
]}] \
2361 [expr {[winfo rooty
$XCOps(focus).mainframe.toolbar.bpm
] \
2362 - [winfo height
$XCOps(focus).parammenu
] / 2}] } \
2363 {xcircuit
::prompteditparams} \
2365 {library directory
} {page directory
} \
2366 {zoom
1.5; refresh
} {zoom
[expr {1 / 1.5}]; refresh
} \
2367 {xcircuit
::helpwindow} ]
2369 # Make the tool images if they have not yet been created.
2370 if [catch {set XCOps
(tools
)}] {xcircuit
::maketoolimages}
2372 for {set i
0} {$i < [llength $XCOps(tools
)]} {incr i
1} {
2373 set bname
[lindex $XCOps(tools
) $i]
2374 set btip
[lindex $tooltips $i]
2375 regsub -all -- %W
[lindex $toolactions $i] \
2376 ${window
}.mainframe.toolbar.b
${bname
} bcmd
2377 button ${window
}.mainframe.toolbar.b
${bname
} -image img_
${bname
} -command \
2379 bind ${window
}.mainframe.toolbar.b
${bname
} <Enter
> \
2380 [subst {${window
}.infobar.message2 configure
-text "$btip"}]
2381 bind ${window
}.mainframe.toolbar.b
${bname
} <Leave
> \
2382 [subst {${window
}.infobar.message2 configure
-text ""}]
2385 # pack the first button so we can query its height for arrangement.
2386 # this assumes that the height of each button is the same!
2387 set bname
[lindex $XCOps(tools
) 0]
2388 place ${window
}.mainframe.toolbar.b
${bname
} -x 0 -y 0
2392 #----------------------------------------------------------------------
2394 proc xcircuit
::arrangetoolbar {window
} {
2397 set numtools
[llength $XCOps(tools
)]
2398 for {set i
0} {$i < $numtools} {incr i
1} {
2399 set bname
[lindex $XCOps(tools
) $i]
2400 place forget
${window
}.mainframe.toolbar.b
${bname
}
2402 set bname
[lindex $XCOps(tools
) 0]
2403 set bheight
[winfo height
${window
}.mainframe.toolbar.b
${bname
}]
2404 set bwidth
[winfo width
${window
}.mainframe.toolbar.b
${bname
}]
2405 set wheight
[winfo height
${window
}.mainframe
]
2406 set nrows
[expr {$wheight / $bheight}]
2407 ${window
}.mainframe.toolbar configure
-width [expr {$bwidth}]
2410 for {set i
0} {$i < [llength $XCOps(tools
)]} {incr i
; incr j
} {
2414 ${window
}.mainframe.toolbar configure
-width [expr {($k + 1) * $bwidth}]
2416 set bname
[lindex $XCOps(tools
) $i]
2417 place ${window
}.mainframe.toolbar.b
${bname
} \
2418 -x [expr {$k * $bwidth}] \
2419 -y [expr {$j * $bheight}]
2423 #----------------------------------------------------------------------
2425 proc xcircuit
::toolbar {value
} {
2427 set window
$XCOps(focus)
2432 pack forget
${window
}.mainframe.mainarea
2433 pack ${window
}.mainframe.toolbar
-side right
-fill y
-padx 2
2434 pack ${window
}.mainframe.mainarea
-expand true
-fill both
2435 set midx
[${window
}.menubar.optionsbutton.optionsmenu
\
2436 index
"Enable Toolbar"]
2437 ${window
}.menubar.optionsbutton.optionsmenu entryconfigure
$midx \
2438 -command {xcircuit
::toolbar disable
} -label \
2443 pack forget
${window
}.mainframe.toolbar
2444 set midx
[${window
}.menubar.optionsbutton.optionsmenu
\
2445 index
"Disable Toolbar"]
2446 ${window
}.menubar.optionsbutton.optionsmenu entryconfigure
$midx \
2447 -command {xcircuit
::toolbar enable
} -label \
2453 #----------------------------------------------------------------------
2454 # These variables are associated with toggle and radio buttons
2455 # but must be the same for all windows.
2456 #----------------------------------------------------------------------
2458 set XCOps
(sheetsize
) letter
2459 set XCOps
(spiceend
) true
2460 set XCOps
(forcenets
) true
2461 set XCOps
(hold
) true
2463 set XCOps
(focus) .xcircuit
2465 #----------------------------------------------------------------------
2466 # Create stipple images
2467 #----------------------------------------------------------------------
2469 image create
bitmap img_stip0
-foreground white
-background black
-file \
2470 ${XCIRCUIT_LIB_DIR
}/pixmaps
/solid.xbm
2471 image create
bitmap img_stip12
-foreground black
-background white
-file \
2472 ${XCIRCUIT_LIB_DIR
}/pixmaps
/stip12.xbm
2473 image create
bitmap img_stip25
-foreground black
-background white
-file \
2474 ${XCIRCUIT_LIB_DIR
}/pixmaps
/stip25.xbm
2475 image create
bitmap img_stip38
-foreground black
-background white
-file \
2476 ${XCIRCUIT_LIB_DIR
}/pixmaps
/stip38.xbm
2477 image create
bitmap img_stip50
-foreground black
-background white
-file \
2478 ${XCIRCUIT_LIB_DIR
}/pixmaps
/stip50.xbm
2479 image create
bitmap img_stip62
-foreground black
-background white
-file \
2480 ${XCIRCUIT_LIB_DIR
}/pixmaps
/stip62.xbm
2481 image create
bitmap img_stip75
-foreground black
-background white
-file \
2482 ${XCIRCUIT_LIB_DIR
}/pixmaps
/stip75.xbm
2483 image create
bitmap img_stip88
-foreground black
-background white
-file \
2484 ${XCIRCUIT_LIB_DIR
}/pixmaps
/stip88.xbm
2485 image create
bitmap img_stip100
-foreground black
-background white
-file \
2486 ${XCIRCUIT_LIB_DIR
}/pixmaps
/solid.xbm
2488 #----------------------------------------------------------------------
2489 # alternate label type images (info, global, and pin labels)
2490 #----------------------------------------------------------------------
2492 image create
photo img_ti
-file ${XCIRCUIT_LIB_DIR
}/pixmaps
/ti.gif
2493 image create
photo img_tg
-file ${XCIRCUIT_LIB_DIR
}/pixmaps
/tg.gif
2494 image create
photo img_tp
-file ${XCIRCUIT_LIB_DIR
}/pixmaps
/tp.gif
2496 #----------------------------------------------------------------------
2498 proc xcircuit
::makemenus {window
} {
2501 set m
[menu ${window
}.menubar.filebutton.filemenu
-tearoff 0]
2502 $m add command
-label "New Window" -command {xcircuit
::forkwindow}
2503 $m add command
-label "Close Window" -command \
2504 "xcircuit::closewindow ${window}.mainframe.mainarea.drawing"
2506 $m add command
-label "Read XCircuit File" -command {xcircuit
::promptloadfile}
2507 if {![catch {set XCOps
(module
,files
)}]} {
2508 $m add command
-label "Write All..." -command {xcircuit
::promptwriteall}
2510 $m add command
-label "Format Page Output" -command {xcircuit
::promptsavepage}
2512 $m add command
-label "Load Dependencies" -command \
2513 {while {[page links
load -replace $XCOps(technology
) \
2514 -target $XCOps(library
)]} {}}
2515 $m add cascade
-label "Import" -menu $m.importmenu
2516 $m add cascade
-label "Export" -menu $m.exportmenu
2518 $m add command
-label "Execute Script" -command {xcircuit
::promptexecscript}
2519 if {[file tail
[info nameofexecutable
]] != "xcircexec"} {
2520 $m add command
-label "Tcl Console" -command {xcircuit
::raiseconsole}
2523 if {![catch {set XCOps
(module
,library
)}]} {
2524 $m add command
-label "Library Manager" -command {xcircuit
::raisemanager}
2526 $m add command
-label "New Library Page" -command {xcircuit
::promptaddlibrary}
2527 $m add command
-label "Load Technology (.lps)" -command {xcircuit
::promptloadlibrary}
2528 $m add command
-label "Save Technology (.lps)" -command {xcircuit
::promptsavetech}
2531 $m add command
-label "Clear Page" -command {xcircuit
::page reset
}
2533 $m add command
-label "Quit" -command {quit
}
2535 # Sub-menu for Import functions
2537 set m2
[menu $m.importmenu
-tearoff 0]
2538 $m2 add command
-label "Import XCircuit File" -command {xcircuit
::promptimportfile}
2539 $m2 add command
-label "Import background PS" -command \
2540 {xcircuit
::promptimportbackground}
2541 $m2 add command
-label "Import graphic image" -command \
2542 {xcircuit
::promptimportgraphic}
2543 if {![catch {set XCOps
(module
,edif
)}]} {
2544 $m2 add command
-label "Read EDIF file" -command {xcircuit
::promptreadedif}
2546 if {![catch {set XCOps
(module
,synopsys
)}]} {
2547 $m2 add command
-label "Read Synopsys library" -command {xcircuit
::promptreadsynopsys}
2549 if {![catch {set XCOps
(module
,matgen
)}]} {
2550 $m2 add command
-label "Import Matlab PS" -command {xcircuit
::promptimportmatlab}
2552 if {![catch {set XCIRCUIT_ASG
}]} {
2553 $m2 add command
-label "Import SPICE Deck" -command \
2554 {xcircuit
::promptimportspice}
2556 if {![catch {set XCOps
(module
,text)}]} {
2557 $m2 add command
-label "Import text" -command {xcircuit
::promptimporttext}
2560 # Sub-menu for Export functions
2562 set m2
[menu $m.exportmenu
-tearoff 0]
2563 $m2 add command
-label "Export SVG" -command {svg
-fullscale}
2565 set m
[menu ${window
}.menubar.editbutton.editmenu
-tearoff 0]
2566 $m add command
-label "Undo" -command {undo
}
2567 $m add command
-label "Redo" -command {redo
}
2569 $m add command
-label "Delete" -command \
2570 "${window}.mainframe.toolbar.bd2 invoke"
2571 $m add command
-label "Copy" -command \
2572 "${window}.mainframe.toolbar.bcp invoke"
2573 $m add command
-label "Move" -command \
2574 "${window}.mainframe.toolbar.bmv invoke"
2575 $m add command
-label "Edit" -command \
2576 "${window}.mainframe.toolbar.be invoke"
2577 $m add cascade
-label "Rotate/Flip" -menu $m.rotmenu
2578 $m add command
-label "Deselect" -command {deselect selected
}
2579 $m add cascade
-label "Select Filter" -menu $m.selmenu
2580 $m add command
-label "Push Selected" -command \
2581 "${window}.mainframe.toolbar.pu2 invoke"
2582 $m add command
-label "Pop Hierarchy" -command {pop
}
2584 $m add command
-label "Change Technology" -command \
2585 {xcircuit
::prompttargettech [element selected object
]}
2587 $m add command
-label "Make User Object" -command \
2588 "${window}.mainframe.toolbar.bmk invoke"
2589 $m add command
-label "Make Arc" -command \
2590 "${window}.mainframe.toolbar.ba invoke"
2591 $m add command
-label "Make Box" -command \
2592 "${window}.mainframe.toolbar.bb invoke"
2593 $m add command
-label "Make Spline" -command \
2594 "${window}.mainframe.toolbar.bs invoke"
2595 $m add command
-label "Make Wire" -command \
2596 "${window}.mainframe.toolbar.bw invoke"
2597 $m add command
-label "Replace" -command {xcircuit
::promptreplaceobject}
2598 $m add command
-label "Join" -command \
2599 "${window}.mainframe.toolbar.bpz invoke"
2600 $m add command
-label "Unjoin" -command \
2601 "${window}.mainframe.toolbar.buj invoke"
2602 $m add command
-label "Raise/Lower" -command {element exchange
}
2604 set m2
[menu $m.rotmenu
-tearoff 0]
2605 $m2 add command
-label "Flip Horizontal" -command \
2606 "${window}.mainframe.toolbar.bfx invoke"
2607 $m2 add command
-label "Flip Vertical" -command \
2608 "${window}.mainframe.toolbar.bfy invoke"
2609 $m2 add command
-label "Rescale" -command \
2610 "${window}.mainframe.toolbar.r invoke"
2612 $m2 add command
-label "Rotate CW 90" -command \
2613 {set XCWinOps
($XCOps(focus),rotateamount
) 90; \
2614 $XCOps(focus).mainframe.toolbar.bcw invoke
}
2615 $m2 add command
-label "Rotate CW 45" -command \
2616 {set XCWinOps
($XCOps(focus),rotateamount
) 45; \
2617 $XCOps(focus).mainframe.toolbar.bcw invoke
}
2618 $m2 add command
-label "Rotate CW 30" -command \
2619 {set XCWinOps
($XCOps(focus),rotateamount
) 30; \
2620 $XCOps(focus).mainframe.toolbar.bcw invoke
}
2621 $m2 add command
-label "Rotate CW 15" -command \
2622 {set XCWinOps
($XCOps(focus),rotateamount
) 15; \
2623 $XCOps(focus).mainframe.toolbar.bcw invoke
}
2624 $m2 add command
-label "Rotate CW 5" -command \
2625 {set XCWinOps
($XCOps(focus),rotateamount
) 5; \
2626 $XCOps(focus).mainframe.toolbar.bcw invoke
}
2627 $m2 add command
-label "Rotate CW 1" -command \
2628 {set XCWinOps
($XCOps(focus),rotateamount
) 1; \
2629 $XCOps(focus).mainframe.toolbar.bcw invoke
}
2631 $m2 add command
-label "Rotate CCW 90" -command \
2632 {set XCWinOps
($XCOps(focus),rotateamount
) 90; \
2633 $XCOps(focus).mainframe.toolbar.bccw invoke
}
2634 $m2 add command
-label "Rotate CCW 45" -command \
2635 {set XCWinOps
($XCOps(focus),rotateamount
) 45; \
2636 $XCOps(focus).mainframe.toolbar.bccw invoke
}
2637 $m2 add command
-label "Rotate CCW 30" -command \
2638 {set XCWinOps
($XCOps(focus),rotateamount
) 30; \
2639 $XCOps(focus).mainframe.toolbar.bccw invoke
}
2640 $m2 add command
-label "Rotate CCW 15" -command \
2641 {set XCWinOps
($XCOps(focus),rotateamount
) 15; \
2642 $XCOps(focus).mainframe.toolbar.bccw invoke
}
2643 $m2 add command
-label "Rotate CCW 5" -command \
2644 {set XCWinOps
($XCOps(focus),rotateamount
) 5; \
2645 $XCOps(focus).mainframe.toolbar.bccw invoke
}
2646 $m2 add command
-label "Rotate CCW 1" -command \
2647 {set XCWinOps
($XCOps(focus),rotateamount
) 1; \
2648 $XCOps(focus).mainframe.toolbar.bccw invoke
}
2650 set m2
[menu $m.selmenu
-tearoff 0]
2651 $m2 add command
-label "Disable selection" -command {element select hide
}
2652 $m2 add command
-label "Remove all disabled" -command {element select allow
}
2654 $m2 add check
-label "Labels" -variable XCWinOps
(${window
},sel_lab
) \
2655 -onvalue true
-offvalue false
-command \
2656 {xcircuit
::config filter
label $XCWinOps($XCOps(focus),sel_lab
)}
2657 $m2 add check
-label "Objects" -variable XCWinOps
(${window
},sel_inst
) \
2658 -onvalue true
-offvalue false
-command \
2659 {xcircuit
::config filter instance
$XCWinOps($XCOps(focus),sel_inst
)}
2660 $m2 add check
-label "Polygons" -variable XCWinOps
(${window
},sel_poly
) \
2661 -onvalue true
-offvalue false
-command \
2662 {xcircuit
::config filter polygon
$XCWinOps($XCOps(focus),sel_poly
)}
2663 $m2 add check
-label "Arcs" -variable XCWinOps
(${window
},sel_arc
) \
2664 -onvalue true
-offvalue false
-command \
2665 {xcircuit
::config filter arc
$XCWinOps($XCOps(focus),sel_arc
)}
2666 $m2 add check
-label "Splines" -variable XCWinOps
(${window
},sel_spline
) \
2667 -onvalue true
-offvalue false
-command \
2668 {xcircuit
::config filter spline
$XCWinOps($XCOps(focus),sel_spline
)}
2669 $m2 add check
-label "Paths" -variable XCWinOps
(${window
},sel_path
) \
2670 -onvalue true
-offvalue false
-command \
2671 {xcircuit
::config filter path
$XCWinOps($XCOps(focus),sel_path
)}
2672 $m2 add check
-label "Graphic Images" -variable XCWinOps
(${window
},sel_graphic
) \
2673 -onvalue true
-offvalue false
-command \
2674 {xcircuit
::config filter graphic
$XCWinOps($XCOps(focus),sel_graphic
)}
2676 set m
[menu ${window
}.menubar.textbutton.textmenu
-tearoff 0]
2677 $m add command
-label "Text Size" -command {xcircuit
::prompttextsize}
2678 $m add cascade
-label "Font" -menu $m.fontmenu
2679 $m add cascade
-label "Style" -menu $m.stylemenu
2680 $m add cascade
-label "Encoding" -menu $m.encodingmenu
2681 $m add cascade
-label "Insert" -menu $m.insertmenu
2682 $m add cascade
-label "Anchoring" -menu $m.anchormenu
2683 $m add command
-label "Parameterize" \
2684 -command {xcircuit
::labelmakeparam}
2685 $m add command
-label "Unparameterize" \
2686 -command {xcircuit
::parameter replace substring
}
2688 $m add check
-label "LaTeX mode" -variable XCWinOps
(${window
},latexmode
) \
2689 -onvalue true
-offvalue false
-command {xcircuit
::label latex
\
2690 $XCWinOps($XCOps(focus),latexmode
)}
2691 if {![catch {set XCOps
(module
,text)}]} {
2693 $m add command
-label "Modify Text..." -command {xcircuit
::textmod}
2696 $m add command
-label "Make Text" -command \
2697 {set XCWinOps
($XCOps(focus),labeltype
) "Text"; set \
2698 XCWinOps
($XCOps(focus),labelimage
) img_t
; \
2699 $XCOps(focus).mainframe.toolbar.bt invoke
}
2701 set m2
[menu $m.fontmenu
-tearoff 0]
2702 $m2 add command
-label "Add New Font" -command {xcircuit
::promptnewfont}
2705 set m2
[menu $m.stylemenu
-tearoff 0]
2706 $m2 add radio
-label "Normal" -variable XCWinOps
(${window
},fontstyle
) \
2707 -value normal
-command "xcircuit::label style normal"
2708 $m2 add radio
-label "Bold" -variable XCWinOps
(${window
},fontstyle
) \
2709 -value bold
-command "xcircuit::label style bold"
2710 $m2 add radio
-label "Italic" -variable XCWinOps
(${window
},fontstyle
) \
2711 -value italic
-command "xcircuit::label style italic"
2712 $m2 add radio
-label "BoldItalic" -variable XCWinOps
(${window
},fontstyle
) \
2713 -value bolditalic
-command "xcircuit::label style bolditalic"
2715 $m2 add radio
-label "Subscript" -variable XCWinOps
(${window
},fontscript
) \
2716 -value subscript
-command "xcircuit::label insert subscript"
2717 $m2 add radio
-label "Superscript" -variable XCWinOps
(${window
},fontscript
) \
2718 -value superscript
-command "xcircuit::label insert superscript"
2719 $m2 add radio
-label "Normalscript" -variable XCWinOps
(${window
},fontscript
) \
2720 -value normal
-command "xcircuit::label insert normalscript"
2722 $m2 add radio
-label "Underline" -variable XCWinOps
(${window
},fontlining
) \
2723 -value underline
-command "xcircuit::label insert underline"
2724 $m2 add radio
-label "Overline" -variable XCWinOps
(${window
},fontlining
) \
2725 -value overline
-command "xcircuit::label insert overline"
2726 $m2 add radio
-label "No Line" -variable XCWinOps
(${window
},fontlining
) \
2727 -value normal
-command "xcircuit::label insert noline"
2729 set m2
[menu $m.encodingmenu
-tearoff 0]
2730 $m2 add radio
-label "Standard" -variable XCWinOps
(${window
},fontencoding
) \
2731 -value Standard
-command "xcircuit::label encoding Standard"
2732 $m2 add radio
-label "ISOLatin1" -variable XCWinOps
(${window
},fontencoding
) \
2733 -value ISOLatin1
-command "xcircuit::label encoding ISOLatin1"
2735 set m2
[menu $m.insertmenu
-tearoff 0]
2736 $m2 add command
-label "Tab stop" -command "xcircuit::label insert stop"
2737 $m2 add command
-label "Tab forward" -command "xcircuit::label insert forward"
2738 $m2 add command
-label "Tab backward" -command "xcircuit::label insert backward"
2739 $m2 add command
-label "Margin stop" -command {if {[lindex [xcircuit
::label \
2740 substring
] 1] <= 1} {xcircuit
::promptmargin} else \
2741 {xcircuit
::label insert margin
}}
2742 $m2 add command
-label "Carriage Return" -command "xcircuit::label insert return"
2743 $m2 add command
-label "1/2 space" -command "xcircuit::label insert halfspace"
2744 $m2 add command
-label "1/4 space" -command "xcircuit::label insert quarterspace"
2745 $m2 add command
-label "Kern" -command "xcircuit::promptkern"
2746 $m2 add command
-label "Character" -command "xcircuit::label insert special"
2747 $m2 add command
-label "Parameter" -command "xcircuit::prompteditparams"
2749 set m2
[menu $m.anchormenu
-tearoff 0]
2750 $m2 add radio
-label "Left Anchored" -variable XCWinOps
(${window
},jhoriz
) \
2751 -value left
-command "xcircuit::label anchor left"
2752 $m2 add radio
-label "Center Anchored" -variable XCWinOps
(${window
},jhoriz
) \
2753 -value center
-command "xcircuit::label anchor center"
2754 $m2 add radio
-label "Right Anchored" -variable XCWinOps
(${window
},jhoriz
) \
2755 -value right
-command "xcircuit::label anchor right"
2757 $m2 add radio
-label "Top Anchored" -variable XCWinOps
(${window
},jvert
) \
2758 -value top
-command "xcircuit::label anchor top"
2759 $m2 add radio
-label "Middle Anchored" -variable XCWinOps
(${window
},jvert
) \
2760 -value middle
-command "xcircuit::label anchor middle"
2761 $m2 add radio
-label "Bottom Anchored" -variable XCWinOps
(${window
},jvert
) \
2762 -value bottom
-command "xcircuit::label anchor bottom"
2764 $m2 add radio
-label "Left Justified" -variable XCWinOps
(${window
},justif
) \
2765 -value left
-command "xcircuit::label justify left"
2766 $m2 add radio
-label "Center Justified" -variable XCWinOps
(${window
},justif
) \
2767 -value center
-command "xcircuit::label justify center"
2768 $m2 add radio
-label "Right Justified" -variable XCWinOps
(${window
},justif
) \
2769 -value right
-command "xcircuit::label justify right"
2771 $m2 add check
-label "Flip Invariant" \
2772 -variable XCWinOps
(${window
},flipinvariant
) \
2773 -onvalue true
-offvalue false
-command {xcircuit
::label flipinvariant
\
2774 $XCWinOps($XCOps(focus),flipinvariant
)}
2776 set m
[menu ${window
}.menubar.optionsbutton.optionsmenu
-tearoff 0]
2777 $m add check
-label "Alt Colors" -variable XCWinOps
(${window
},colorscheme
) \
2778 -onvalue inverse
-offvalue normal
-command {xcircuit
::config \
2779 colorscheme
$XCWinOps($XCOps(focus),colorscheme
)}
2780 $m add check
-label "Show Bounding Box" -variable XCWinOps
(${window
},showbbox
) \
2781 -onvalue visible
-offvalue invisible
-command \
2782 {xcircuit
::config bbox
$XCWinOps($XCOps(focus),showbbox
)}
2783 $m add check
-label "Edit In Place" -variable XCWinOps
(${window
},editinplace
) \
2784 -onvalue true
-offvalue false
-command {xcircuit
::config editinplace
\
2785 $XCWinOps($XCOps(focus),editinplace
)}
2786 $m add check
-label "Show Pin Positions" \
2787 -variable XCWinOps
(${window
},pinpositions
) \
2788 -onvalue visible
-offvalue invisible
-command \
2789 {xcircuit
::config pinpositions
$XCWinOps($XCOps(focus),pinpositions
)}
2790 $m add check
-label "Wires Stay Attached to Pins" \
2791 -variable XCWinOps
(${window
},pinattach
) \
2792 -onvalue true
-offvalue false
-command \
2793 {xcircuit
::config pinattach
$XCWinOps($XCOps(focus),pinattach
)}
2794 $m add check
-label "Show Clipmask Outlines" \
2795 -variable XCWinOps
(${window
},showclipmasks
) \
2796 -onvalue show
-offvalue hide
-command \
2797 {xcircuit
::config clipmasks
$XCWinOps($XCOps(focus),showclipmasks
)}
2798 $m add check
-label "Show Technology Namespaces" \
2799 -variable XCWinOps
(${window
},namespaces
) \
2800 -onvalue true
-offvalue false
-command \
2801 {xcircuit
::config technologies
$XCWinOps($XCOps(focus),namespaces
)}
2803 $m add command
-label "Disable Toolbar" -command {xcircuit
::toolbar disable
}
2804 $m add check
-label "Allow HOLD Mode" -variable XCOps
(hold
) -onvalue true
\
2805 -offvalue false
-command {xcircuit
::config hold
$XCOps(hold
)}
2806 $m add cascade
-label "Grid" -menu $m.gridmenu
2807 $m add cascade
-label "Snap-to" -menu $m.snapmenu
2808 $m add cascade
-label "Linewidth" -menu $m.linemenu
2809 $m add cascade
-label "Elements" -menu $m.elementsmenu
2811 $m add command
-label "Help!" -command {xcircuit
::helpwindow}
2813 set m2
[menu $m.gridmenu
-tearoff 0]
2814 $m2 add check
-label "Grid" -variable XCWinOps
(${window
},showgrid
) \
2815 -onvalue true
-offvalue false
\
2816 -command {xcircuit
::config grid $XCWinOps($XCOps(focus),showgrid
); refresh
}
2817 $m2 add check
-label "Axes" -variable XCWinOps
(${window
},showaxes
) \
2818 -onvalue true
-offvalue false
\
2819 -command {xcircuit
::config axes
$XCWinOps($XCOps(focus),showaxes
); refresh
}
2820 $m2 add command
-label "Grid Spacing" -command {xcircuit
::promptgridspace}
2821 $m2 add cascade
-label "Grid type/display" -menu $m2.gridsubmenu
2823 set m3
[menu $m2.gridsubmenu
-tearoff 0]
2824 $m3 add radio
-label "Decimal Inches" -variable XCWinOps
(${window
},gridstyle
) \
2825 -value "decimal inches" \
2826 -command {xcircuit
::config coordstyle
"decimal inches"}
2827 $m3 add radio
-label "Fractional Inches" -variable XCWinOps
(${window
},gridstyle
) \
2828 -value "fractional inches" \
2829 -command {xcircuit
::config coordstyle
"fractional inches"}
2830 $m3 add radio
-label "Centimeters" -variable XCWinOps
(${window
},gridstyle
) \
2831 -value "centimeters" -command {xcircuit
::config coordstyle
"centimeters"}
2832 $m3 add radio
-label "Internal Units" -variable XCWinOps
(${window
},gridstyle
) \
2833 -value "internal units" -command \
2834 {xcircuit
::config coordstyle
"internal units"}
2836 $m3 add command
-label "Drawing Scale" -command {xcircuit
::promptdrawingscale}
2838 set m2
[menu $m.snapmenu
-tearoff 0]
2839 $m2 add check
-label "Snap-to" -variable XCWinOps
(${window
},showsnap
) \
2841 -offvalue false
-command {xcircuit
::config snap
\
2842 $XCWinOps($XCOps(focus),showsnap
); refresh
}
2843 $m2 add command
-label "Snap Spacing" -command {xcircuit
::promptsnapspace}
2845 set m2
[menu $m.linemenu
-tearoff 0]
2846 $m2 add command
-label "Wire Linewidth" -command {xcircuit
::promptborderwidth}
2847 $m2 add command
-label "Global Linewidth" -command {xcircuit
::promptlinewidth}
2849 set m2
[menu $m.elementsmenu
-tearoff 0]
2850 $m2 add cascade
-label "Border" -menu $m2.bordermenu
2851 $m2 add cascade
-label "Fill" -menu $m2.fillmenu
2852 $m2 add cascade
-label "Color" -menu $m2.colormenu
2854 $m2 add cascade
-label "Parameters" -menu $m2.parammenu
2855 $m2 add command
-label "Scale" -command {xcircuit
::promptelementsize}
2856 $m2 add check
-label "Center Object" -variable XCWinOps
(${window
},centerobject
) \
2857 -onvalue true
-offvalue false
-command {xcircuit
::config centering
\
2858 $XCWinOps($XCOps(focus),centerobject
)}
2859 $m2 add check
-label "Instance Scale-invariant Linewidth" \
2860 -variable XCWinOps
(${window
},scaleinvariant
) \
2861 -onvalue invariant
-offvalue variant
-command {xcircuit
::instance linewidth
\
2862 $XCWinOps($XCOps(focus),scaleinvariant
)}
2863 $m2 add check
-label "Manhattan Draw" \
2864 -variable XCWinOps
(${window
},manhattandraw
) \
2865 -onvalue true
-offvalue false
-command {xcircuit
::config manhattan
\
2866 $XCWinOps($XCOps(focus),manhattandraw
)}
2867 $m2 add check
-label "Link Curve Tangents" \
2868 -variable XCWinOps
(${window
},pathedittype
) \
2869 -onvalue tangents
-offvalue normal
-command {xcircuit
::config pathedit
\
2870 $XCWinOps($XCOps(focus),pathedittype
)}
2871 $m2 add cascade
-label "Polygon Edit" -menu $m2.polyeditmenu
2873 set m3
[menu $m2.bordermenu
-tearoff 0]
2874 $m3 add command
-label "Linewidth" -command {xcircuit
::promptborderwidth}
2876 $m3 add radio
-label "Solid" -variable XCWinOps
(${window
},linestyle
) \
2877 -value solid
-command {xcircuit
::border solid
}
2878 $m3 add radio
-label "Dashed" -variable XCWinOps
(${window
},linestyle
) \
2879 -value dashed
-command {xcircuit
::border dashed
}
2880 $m3 add radio
-label "Dotted" -variable XCWinOps
(${window
},linestyle
) \
2881 -value dotted
-command {xcircuit
::border dotted
}
2882 $m3 add radio
-label "Unbordered" -variable XCWinOps
(${window
},linestyle
) \
2883 -value unbordered
-command {xcircuit
::border unbordered
}
2885 $m3 add check
-label "Closed" -variable XCWinOps
(${window
},polyclosed
) \
2886 -onvalue closed
-offvalue unclosed
-command \
2887 {xcircuit
::border $XCWinOps($XCOps(focus),polyclosed
)}
2888 $m3 add check
-label "Square Endcaps" -variable XCWinOps
(${window
},endcaps
) \
2889 -onvalue square
-offvalue round
-command {xcircuit
::border \
2890 $XCWinOps($XCOps(focus),endcaps
)}
2891 $m3 add check
-label "Bounding Box" -variable XCWinOps
(${window
},bboxtype
) \
2892 -onvalue true
-offvalue false
-command {xcircuit
::border bbox
\
2893 $XCWinOps($XCOps(focus),bboxtype
)}
2894 $m3 add check
-label "Clipmask" -variable XCWinOps
(${window
},clipmask
) \
2895 -onvalue true
-offvalue false
-command {xcircuit
::border clipmask
\
2896 $XCWinOps($XCOps(focus),clipmask
)}
2897 $m3 add check
-label "Manhattan Draw" -variable XCWinOps
(${window
},manhattandraw
) \
2898 -onvalue true
-offvalue false
-command {xcircuit
::config manhattan
\
2899 $XCWinOps($XCOps(focus),manhattandraw
)}
2900 $m3 add check
-label "Manhattan Edit" \
2901 -variable XCWinOps
(${window
},polyedittype
) \
2902 -onvalue manhattan
-offvalue normal
\
2903 -command {xcircuit
::config boxedit
\
2904 $XCWinOps($XCOps(focus),polyedittype
)}
2906 set m3
[menu $m2.fillmenu
-tearoff 0]
2907 $m3 add radio
-image img_stip100
-variable XCWinOps
(${window
},fillamount
) \
2908 -value 100 -command {xcircuit
::fill 100 opaque
}
2909 $m3 add radio
-image img_stip88
-variable XCWinOps
(${window
},fillamount
) \
2910 -value 88 -command {xcircuit
::fill 88 opaque
}
2911 $m3 add radio
-image img_stip75
-variable XCWinOps
(${window
},fillamount
) \
2912 -value 75 -command {xcircuit
::fill 75 opaque
}
2913 $m3 add radio
-image img_stip62
-variable XCWinOps
(${window
},fillamount
) \
2914 -value 62 -command {xcircuit
::fill 62 opaque
}
2915 $m3 add radio
-image img_stip50
-variable XCWinOps
(${window
},fillamount
) \
2916 -value 50 -command {xcircuit
::fill 50 opaque
}
2917 $m3 add radio
-image img_stip38
-variable XCWinOps
(${window
},fillamount
) \
2918 -value 38 -command {xcircuit
::fill 38 opaque
}
2919 $m3 add radio
-image img_stip25
-variable XCWinOps
(${window
},fillamount
) \
2920 -value 25 -command {xcircuit
::fill 25 opaque
}
2921 $m3 add radio
-image img_stip12
-variable XCWinOps
(${window
},fillamount
) \
2922 -value 12 -command {xcircuit
::fill 12 opaque
}
2923 $m3 add radio
-image img_stip0
-variable XCWinOps
(${window
},fillamount
) \
2924 -value 0 -command {xcircuit
::fill 0 transparent
}
2926 $m3 add radio
-label "Opaque" -variable XCWinOps
(${window
},opaque
) \
2927 -value true
-command {xcircuit
::fill opaque
}
2928 $m3 add radio
-label "Transparent" -variable XCWinOps
(${window
},opaque
) \
2929 -value false
-command {xcircuit
::fill transparent
}
2931 set m3
[menu $m2.colormenu
-tearoff 0]
2932 $m3 add command
-label "Add New Color" -command {xcircuit
::picknewcolor}
2934 $m3 add radio
-label "Inherit Color" -variable XCWinOps
(${window
},colorval
) \
2935 -value inherit
-command {color
set inherit
}
2937 set m3
[menu $m2.parammenu
-tearoff 0]
2938 $m3 add command
-label "Manage Parameters" -command {xcircuit
::prompteditparams}
2940 $m3 add check
-label "X Position" -variable XCWinOps
(${window
},xposparam
) \
2941 -onvalue true
-offvalue false
-command \
2942 {if {$XCWinOps($XCOps(focus),xposparam
)} \
2943 {xcircuit
::parameter make
"x position"} \
2944 {xcircuit
::parameter replace
"x position"}}
2945 $m3 add check
-label "Y Position" -variable XCWinOps
(${window
},yposparam
) \
2946 -onvalue true
-offvalue false
-command \
2947 {if {$XCWinOps($XCOps(focus),yposparam
)} \
2948 {xcircuit
::parameter make
"y position"} \
2949 {xcircuit
::parameter replace
"y position"}}
2950 $m3 add check
-label "Anchoring" -variable XCWinOps
(${window
},anchorparam
) \
2951 -onvalue true
-offvalue false
-command \
2952 {if {$XCWinOps($XCOps(focus),anchorparam
)} \
2953 {xcircuit
::parameter make anchoring
} \
2954 {xcircuit
::parameter replace anchoring
}}
2955 $m3 add check
-label "Rotation" -variable XCWinOps
(${window
},rotationparam
) \
2956 -onvalue true
-offvalue false
-command \
2957 {if {$XCWinOps($XCOps(focus),rotationparam
)} \
2958 {xcircuit
::parameter make rotation
} \
2959 {xcircuit
::parameter replace rotation
}}
2960 $m3 add check
-label "Style" -variable XCWinOps
(${window
},styleparam
) \
2961 -onvalue true
-offvalue false
-command \
2962 {if {$XCWinOps($XCOps(focus),styleparam
)} \
2963 {xcircuit
::parameter make style
} \
2964 {xcircuit
::parameter replace style
}}
2965 $m3 add check
-label "Scale" -variable XCWinOps
(${window
},scaleparam
) \
2966 -onvalue true
-offvalue false
-command \
2967 {if {$XCWinOps($XCOps(focus),scaleparam
)} \
2968 {xcircuit
::parameter make
scale} \
2969 {xcircuit
::parameter replace
scale}}
2970 $m3 add check
-label "Linewidth" -variable XCWinOps
(${window
},linewidthparam
) \
2971 -onvalue true
-offvalue false
-command \
2972 {if {$XCWinOps($XCOps(focus),linewidthparam
)} \
2973 {xcircuit
::parameter make linewidth
} \
2974 {xcircuit
::parameter replace linewidth
}}
2975 $m3 add check
-label "Color" -variable XCWinOps
(${window
},colorparam
) \
2976 -onvalue true
-offvalue false
-command \
2977 {if {$XCWinOps($XCOps(focus),colorparam
)} \
2978 {xcircuit
::parameter make color
} \
2979 {xcircuit
::parameter replace color
}}
2980 $m3 add check
-label "Start Angle" -variable XCWinOps
(${window
},startparam
) \
2981 -onvalue true
-offvalue false
-command \
2982 {if {$XCWinOps($XCOps(focus),startparam
)} \
2983 {xcircuit
::parameter make
"start angle"} \
2984 {xcircuit
::parameter replace
"start angle"}}
2985 $m3 add check
-label "End Angle" -variable XCWinOps
(${window
},endparam
) \
2986 -onvalue true
-offvalue false
-command \
2987 {if {$XCWinOps($XCOps(focus),endparam
)} \
2988 {xcircuit
::parameter make
"end angle"} \
2989 {xcircuit
::parameter replace
"end angle"}}
2990 $m3 add check
-label "Radius" -variable XCWinOps
(${window
},radiusparam
) \
2991 -onvalue true
-offvalue false
-command \
2992 {if {$XCWinOps($XCOps(focus),radiusparam
)} \
2993 {xcircuit
::parameter make radius
} \
2994 {xcircuit
::parameter replace radius
}}
2995 $m3 add check
-label "Minor Axis" -variable XCWinOps
(${window
},minorparam
) \
2996 -onvalue true
-offvalue false
-command \
2997 {if {$XCWinOps($XCOps(focus),minorparam
)} \
2998 {xcircuit
::parameter make
"minor axis"} \
2999 {xcircuit
::parameter replace
"minor axis"}}
3001 set m3
[menu $m2.polyeditmenu
-tearoff 0]
3002 $m3 add radio
-label "Manhattan Box Edit" \
3003 -variable XCWinOps
(${window
},polyedittype
) \
3004 -value manhattan
-command {xcircuit
::config boxedit manhattan
}
3005 $m3 add radio
-label "Rhomboid X" -variable XCWinOps
(${window
},polyedittype
) \
3006 -value rhomboidx
-command {xcircuit
::config boxedit rhomboidx
}
3007 $m3 add radio
-label "Rhomboid Y" -variable XCWinOps
(${window
},polyedittype
) \
3008 -value rhomboidy
-command {xcircuit
::config boxedit rhomboidy
}
3009 $m3 add radio
-label "Rhomboid A" -variable XCWinOps
(${window
},polyedittype
) \
3010 -value rhomboida
-command {xcircuit
::config boxedit rhomboida
}
3011 $m3 add radio
-label "Normal" -variable XCWinOps
(${window
},polyedittype
) \
3012 -value normal
-command {xcircuit
::config boxedit normal
}
3014 set m
[menu ${window
}.menubar.windowbutton.windowmenu
-tearoff 0]
3015 $m add command
-label "Zoom In" -command {zoom
1.5; refresh
}
3016 $m add command
-label "Zoom Out" -command {zoom
[expr {1 / 1.5}]; refresh
}
3017 $m add command
-label "Pan" -command {$XCOps(focus).mainframe.toolbar.bp invoke
}
3018 $m add command
-label "Full View" -command {zoom view
; refresh
}
3019 $m add command
-label "Refresh" -command {refresh
}
3021 $m add command
-label "Library Directory" -command {xcircuit
::library directory
}
3022 $m add cascade
-label "Goto Library" -menu $m.librarymenu
3024 $m add command
-label "Page Directory" -command {xcircuit
::page directory
}
3025 $m add cascade
-label "Goto Page" -menu $m.pagemenu
3027 set m
[menu ${window
}.menubar.netlistbutton.netlistmenu
-tearoff 0]
3028 $m add command
-label "Make Pin" -command \
3029 {set XCWinOps
($XCOps(focus),labeltype
) "Pin Label"; set \
3030 XCWinOps
($XCOps(focus),labelimage
) img_tp
; \
3031 $XCOps(focus).mainframe.toolbar.bt invoke
}
3032 $m add command
-label "Make Info Pin" -command \
3033 {set XCWinOps
($XCOps(focus),labeltype
) "Info Label"; set \
3034 XCWinOps
($XCOps(focus),labelimage
) img_ti
; \
3035 $XCOps(focus).mainframe.toolbar.bt invoke
}
3036 $m add command
-label "Make Global Pin" -command \
3037 {set XCWinOps
($XCOps(focus),labeltype
) "Pin Global"; set \
3038 XCWinOps
($XCOps(focus),labelimage
) img_tg
; \
3039 $XCOps(focus).mainframe.toolbar.bt invoke
}
3040 $m add cascade
-label "Convert Label To..." -menu $m.pinmenu
3041 $m add check
-label "Pin Visibility" -variable XCWinOps
(${window
},pinvisible
) \
3042 -onvalue true
-offvalue false
-command {xcircuit
::label visible
\
3043 $XCWinOps($XCOps(focus),pinvisible
)}
3044 $m add check
-label "Netlistable Instance" \
3045 -variable XCWinOps
(${window
},netlistable
) \
3046 -onvalue true
-offvalue false
-command {xcircuit
::instance netlist
\
3047 $XCWinOps($XCOps(focus),netlistable
)}
3048 $m add command
-label "Make Matching Symbol" -command \
3049 {xcircuit
::promptmakesymbol [page
label]}
3050 $m add command
-label "Associate With Symbol" -command \
3051 {xcircuit
::symbol associate
}
3052 $m add command
-label "Highlight Connectivity" -command \
3053 {xcircuit
::netlist highlight
}
3054 $m add command
-label "Auto-number Components" -command \
3055 {xcircuit
::netlist autonumber
}
3056 $m add command
-label "Un-number Components" -command \
3057 {xcircuit
::netlist autonumber
-forget}
3059 $m add check
-label "SPICE .end statement" -variable XCOps
(spiceend
) \
3060 -onvalue true
-offvalue false
3061 $m add check
-label "Always regenerate netlists" -variable XCOps
(forcenets
) \
3062 -onvalue true
-offvalue false
3064 $m add command
-label "Write SPICE netlist" -command \
3065 {if {$XCOps(forcenets
)} {xcircuit
::netlist update}; \
3066 xcircuit
::netlist write spice spc
$XCOps(spiceend
)}
3067 $m add command
-label "Write flattened SPICE" -command \
3068 {if {$XCOps(forcenets
)} {xcircuit
::netlist update}; \
3069 xcircuit
::netlist write flatspice fspc
}
3070 $m add command
-label "Write sim" -command \
3071 {if {$XCOps(forcenets
)} {xcircuit
::netlist update}; \
3072 xcircuit
::netlist write flatsim sim
}
3073 $m add command
-label "Write pcb" -command \
3074 {if {$XCOps(forcenets
)} {xcircuit
::netlist update}; \
3075 xcircuit
::netlist write pcb pcbnet
}
3077 set m2
[menu $m.pinmenu
-tearoff 0]
3078 $m2 add command
-label "Normal label" -command {xcircuit
::label type normal
}
3079 $m2 add command
-label "Local Pin" -command {xcircuit
::label type pin
}
3080 $m2 add command
-label "Global Pin" -command {xcircuit
::label type
global}
3081 $m2 add command
-label "Info label" -command {xcircuit
::label type
info}
3083 #---------------------------------------------------------------------------
3084 # Create the cloned menu links used by the toolbar
3085 #---------------------------------------------------------------------------
3087 ${window
}.menubar.optionsbutton.optionsmenu.elementsmenu.parammenu
\
3088 clone
${window
}.parammenu
3089 ${window
}.menubar.optionsbutton.optionsmenu.elementsmenu.colormenu
\
3090 clone
${window
}.colormenu
3091 ${window
}.menubar.optionsbutton.optionsmenu.elementsmenu.bordermenu
\
3092 clone
${window
}.bordermenu
3093 ${window
}.menubar.optionsbutton.optionsmenu.elementsmenu.fillmenu
\
3094 clone
${window
}.fillmenu
3096 .librarymenu clone
${window
}.menubar.windowbutton.windowmenu.librarymenu
3097 .pagemenu clone
${window
}.menubar.windowbutton.windowmenu.pagemenu
3100 #-----------------------------------------------------------------
3101 # Wrapper procedure to (re)bind a key to a Tcl procedure (Ed Casas 9/4/03)
3102 # With no arguments, prints a list of bindings to stdout. Key
3103 # bindings should use "keyaction" to check for text mode, so that
3104 # rebinding of keys does not prevent text entry. Button bindings
3105 # do not need this restriction.
3106 #-----------------------------------------------------------------
3108 proc xcircuit
::keybind { {key
{}} {proc {}} {window
{}} } {
3111 if { $window == {} } { set window
$XCOps(focus).mainframe.mainarea.drawing
}
3113 switch -glob -- $key {
3115 puts stdout
"XCircuit standard key bindings:"
3116 puts stdout
"Key Binding"
3117 puts stdout
"-------------------------------------"
3118 set kpairs
[xcircuit
::bindkey]
3120 set pkey
[lindex $i 0]
3121 set pval
[lindex $i 1]
3122 puts stdout
"$pkey $pval"
3127 bind ${window
} $key $proc
3130 bind ${window
} $key "if \{!\[xcircuit::keyaction %k %s\]\} \{ $proc \}"
3135 #-----------------------------------------------------------------
3136 # Enable mouse hints in the window
3137 #-----------------------------------------------------------------
3139 # James Vernon's mouse button hints
3141 if {[catch {source $XCIRCUIT_SRC_DIR/mousehint.tcl
}]} {
3142 set XCOps
(mousehints
) -1
3144 set XCOps
(mousehints
) 0
3147 proc xcircuit
::enable_mousehints {} {
3150 if {$XCOps(mousehints
) == 0} {
3151 set XCOps
(mousehints
) 1
3152 foreach window
[config windownames
] {
3153 set frame [winfo top
$window]
3154 xcircuit
::mousehint_create $frame
3159 #-----------------------------------------------------------------
3160 # Final setup stuff before exiting back to interpreter
3161 #-----------------------------------------------------------------
3163 # This gets rid of the original "wish", in favor of our own window
3165 if {[string range
[wm title .
] 0 3] == "wish"} {
3169 #----------------------------------------------------------------------
3170 # Library and Page menus (common to all windows)
3171 #----------------------------------------------------------------------
3173 menu .librarymenu
-tearoff 0
3174 .librarymenu add command
-label "New Library Page" -command \
3175 {xcircuit
::promptaddlibrary}
3176 .librarymenu add separator
3178 menu .pagemenu
-tearoff 0
3179 .pagemenu add command
-label "Add New Page" -command {xcircuit
::page make
}
3180 .pagemenu add separator
3182 #----------------------------------------------------------------------
3183 # Source other Tcl scripts, if they exist in the $XCIRCUIT_SRC_DIR path
3184 # and add the capabilities to the GUI.
3185 #----------------------------------------------------------------------
3187 # "Write All" feature
3189 catch {source $XCIRCUIT_SRC_DIR/files.tcl
}
3191 # Library manager widget
3193 catch {source $XCIRCUIT_SRC_DIR/library.tcl
}
3195 # Fancy "Make Matching Symbol" feature
3197 catch {source $XCIRCUIT_SRC_DIR/symbol.tcl
}
3201 catch {source $XCIRCUIT_SRC_DIR/xchelp.tcl
}
3205 catch {source $XCIRCUIT_SRC_DIR/edif.tcl
}
3207 # Synopsys symbol library file parser
3209 catch {source $XCIRCUIT_SRC_DIR/synopsys.tcl
}
3211 # System Clipboard paste into labels
3213 catch {source $XCIRCUIT_SRC_DIR/selection.tcl
}
3215 # Regexp label substitutions and auto-increment feature
3217 catch {source $XCIRCUIT_SRC_DIR/text.tcl
}
3219 # Wim Vereecken's Matlab PostScript import function
3221 catch {source $XCIRCUIT_SRC_DIR/matgen.tcl
}
3223 #----------------------------------------------------------------------
3224 # Create the initial window.
3225 #----------------------------------------------------------------------
3227 xcircuit
::new_window $XCOps(focus)
3229 #----------------------------------------------------------------------
3230 # Add buttons for the pre-allocated pages
3231 #----------------------------------------------------------------------
3233 xcircuit
::newpagebutton "Page 1" 1
3234 xcircuit
::newpagebutton "Page 2" 2
3235 xcircuit
::newpagebutton "Page 3" 3
3236 xcircuit
::newpagebutton "Page 4" 4
3237 xcircuit
::newpagebutton "Page 5" 5
3238 xcircuit
::newpagebutton "Page 6" 6
3239 xcircuit
::newpagebutton "Page 7" 7
3240 xcircuit
::newpagebutton "Page 8" 8
3241 xcircuit
::newpagebutton "Page 9" 9
3242 xcircuit
::newpagebutton "Page 10" 10
3244 #----------------------------------------------------------------------
3245 # Add buttons for the pre-allocated libraries
3246 #----------------------------------------------------------------------
3248 xcircuit
::newlibrarybutton "User Library"
3250 #-----------------------------------------------------------------
3251 # New key bindings should pass through this function so that key
3252 # strokes are captured correctly for label editing.
3253 #----------------------------------------------------------------------
3255 proc xcircuit
::keyaction {keycode
{keystate
0}} {
3256 switch -- [eventmode
] {
3260 standardaction
$keycode down
$keystate
3267 #-----------------------------------------------------------------
3269 proc scrollboth
{ lists args
} {
3271 eval {$l yview
} $args
3275 #-----------------------------------------------------------------
3276 # Procedure to generate the help window
3277 #-----------------------------------------------------------------
3279 proc xcircuit
::makehelpwindow {} {
3280 toplevel .help
-bg beige
3284 frame .help.title
-bg beige
3287 pack .help.title
-side top
-fill x
3288 pack .help.listwin
-side top
-fill both
-expand true
3290 label .help.title.field
-text "XCircuit Help" -bg beige
3291 button .help.title.dbut
-text "Dismiss" -bg beige
-command {wm withdraw .help
}
3292 pack .help.title.field
-side left
-padx 10
3293 pack .help.title.dbut
-side right
-ipadx 10
3295 listbox .help.listwin.func
-yscrollcommand ".help.listwin.sb set" \
3296 -setgrid 1 -height 20
3297 listbox .help.listwin.keys
-yscrollcommand ".help.listwin.sb set" \
3298 -setgrid 1 -height 20
3299 scrollbar .help.listwin.sb
-orient vertical
-command \
3300 [list scrollboth
[list .help.listwin.func .help.listwin.keys
]]
3301 message .help.listwin.win
-width 200 -justify left
-anchor n
\
3302 -relief groove
-text "Click on a function for help text"
3304 # Keep boxes aligned!
3305 bind .help.listwin.keys
<Button-4
> {xcircuit
::helpscroll -1}
3306 bind .help.listwin.keys
<Button-5
> {xcircuit
::helpscroll 1}
3307 bind .help.listwin.func
<Button-4
> {xcircuit
::helpscroll -1}
3308 bind .help.listwin.func
<Button-5
> {xcircuit
::helpscroll 1}
3309 # Also bind to the mouse wheel (Windows-specific, generally)
3310 bind .help.listwin.keys
<MouseWheel
> {xcircuit
::helpscroll %D
}
3311 bind .help.listwin.func
<MouseWheel
> {xcircuit
::helpscroll %D
}
3313 grid .help.listwin.func
-row 0 -column 0 -sticky news
-padx 1 -pady 1
3314 grid .help.listwin.keys
-row 0 -column 1 -sticky news
-padx 1 -pady 1
3315 grid .help.listwin.sb
-row 0 -column 2 -sticky ns
-padx 1 -pady 1
3316 grid .help.listwin.win
-row 0 -column 3 -sticky news
-padx 1 -pady 1
3318 grid columnconfigure .help.listwin
1 -weight 1 -minsize 100
3319 grid rowconfigure .help.listwin
0 -weight 1 -minsize 100
3321 bind .help.listwin.func
<ButtonRelease-1
> "xcircuit::printhelp"
3324 #-----------------------------------------------------------------
3325 # Scroll all listboxes in the .help.listwin window at the same
3326 # time, in reponse to any one of them receiving a scroll event.
3327 #-----------------------------------------------------------------
3329 proc xcircuit
::helpscroll {value
} {
3331 set idx
[.help.listwin.func nearest
0]
3333 if {$tcl_platform(platform
) == "windows"} {
3334 set idx
[expr {$idx + $value / 120}]
3336 set idx
[expr {$idx + $value}]
3339 .help.listwin.func yview
$idx
3340 .help.listwin.keys yview
$idx
3342 # Important! This prohibits the default binding actions.
3346 #-----------------------------------------------------------------
3347 # Procedure to update and display the help window
3348 #-----------------------------------------------------------------
3350 proc xcircuit
::helpwindow {} {
3352 # Create the help window if it doesn't exist
3353 if {[catch {wm state .help
}]} {
3354 xcircuit
::makehelpwindow
3356 set wstate
[xcircuit
::getinitstate .help
]
3358 .help.listwin.func delete
0 end
3359 .help.listwin.keys delete
0 end
3361 set k
[lsort -dictionary [xcircuit
::bindkey]]
3363 .help.listwin.func insert end
"Function"
3364 .help.listwin.keys insert end
"Keys"
3365 .help.listwin.func insert end
""
3366 .help.listwin.keys insert end
""
3369 set pkeys
[xcircuit
::bindkey -func $i]
3370 .help.listwin.func insert end
"$i"
3371 .help.listwin.keys insert end
"$pkeys"
3374 if {"$wstate" != "normal"} {
3376 xcircuit
::centerwin .help
3381 #-----------------------------------------------------------------
3382 # Prevent "Tab" from removing focus from the window during text edits,
3383 # but allow it to take its normal meaning at other times.
3384 #-----------------------------------------------------------------
3387 switch -- [eventmode
] {
3391 default {tk::TabToWindow [tk_focusNext %W
]}
3395 bind all
<<PrevWindow
>> {
3396 switch -- [eventmode
] {
3400 default {tk::TabToWindow [tk_focusPrev %W
]}
3404 #-----------------------------------------------------------------
3405 # Wait for the drawing area to become visible, and set the focus on it.
3406 # Invoke the "wire" button so we have a default button1 action.
3407 #-----------------------------------------------------------------
3409 tkwait visibility
$XCOps(focus).mainframe.mainarea.drawing
3410 focus -force $XCOps(focus).mainframe.mainarea.drawing
3412 #-----------------------------------------------------------------
3413 # This pops down the interpreter window, if the "console.tcl" script was run.
3414 #-----------------------------------------------------------------
3416 catch xcircuit
::consoledown
3418 #-----------------------------------------------------------------
3419 # End of GUI configuration file. Xcircuit continues to load the xcircuit
3420 # startup configuration files.
3421 #-----------------------------------------------------------------