diff options
Diffstat (limited to 'lib/tcl/wrapper.tcl')
| -rw-r--r-- | lib/tcl/wrapper.tcl | 488 |
1 files changed, 300 insertions, 188 deletions
diff --git a/lib/tcl/wrapper.tcl b/lib/tcl/wrapper.tcl index 20486e0..412b565 100644 --- a/lib/tcl/wrapper.tcl +++ b/lib/tcl/wrapper.tcl @@ -24,8 +24,8 @@ proc xcircuit::new_window { name } { # All the internal frames frame ${name}.menubar - frame ${name}.infobar -borderwidth 1 -bg #a07650 - frame ${name}.mainframe -borderwidth 1 -bg #a07650 + frame ${name}.infobar + frame ${name}.mainframe grid propagate ${name} false grid ${name}.menubar -sticky news -row 0 -column 0 @@ -40,7 +40,7 @@ proc xcircuit::new_window { name } { grid columnconfigure ${name} 1 -weight 1 frame ${name}.mainframe.mainarea - frame ${name}.mainframe.toolbar -bg #a07650 -borderwidth 1 + frame ${name}.mainframe.toolbar pack ${name}.mainframe.toolbar -side right -fill y pack ${name}.mainframe.mainarea -expand true -fill both @@ -48,9 +48,9 @@ proc xcircuit::new_window { name } { set drawing ${name}.mainframe.mainarea.drawing simple $drawing -bg white -commandproc "focus $drawing ; set XCOps(focus) $name" - simple ${name}.mainframe.mainarea.sbleft -width 13 -bg #a07650 - simple ${name}.mainframe.mainarea.sbbottom -height 13 -bg #a07650 - simple ${name}.mainframe.mainarea.corner -width 13 -height 13 -bg brown4 + simple ${name}.mainframe.mainarea.sbleft -width 13 + simple ${name}.mainframe.mainarea.sbbottom -height 13 + simple ${name}.mainframe.mainarea.corner -width 13 -height 13 # The drawing area and its scrollbars @@ -86,17 +86,16 @@ proc xcircuit::new_window { name } { label ${name}.message -text \ "Welcome to Xcircuit v${XCIRCUIT_VERSION} rev ${XCIRCUIT_REVISION}" \ - -background beige -justify left -anchor w + -justify left -anchor w grid ${name}.message -row 0 -column 1 -sticky news -ipadx 10 button ${name}.infobar.symb -text "Symbol" -bg gray30 -fg white button ${name}.infobar.schem -text "Schematic" -bg red -fg white button ${name}.infobar.mode -text "Wire Mode" -bg skyblue2 -fg gray20 - label ${name}.infobar.message1 -text "Editing: Page 1" \ - -background beige + label ${name}.infobar.message1 -text "Editing: Page 1" label ${name}.infobar.message2 -text "Grid 1/6 in : Snap 1/12 in" \ - -background beige -justify left -anchor w + -justify left -anchor w pack ${name}.infobar.symb ${name}.infobar.schem ${name}.infobar.message1 \ ${name}.infobar.mode -side left -ipadx 6 -fill y pack ${name}.infobar.message2 -ipadx 6 -expand true -fill both @@ -160,19 +159,23 @@ proc xcircuit::new_window { name } { # These are supposed to disable the scroll wheel on the scrollbars. . . - bind ${name}.mainframe.mainarea.sbleft <Button-4> {} - bind ${name}.mainframe.mainarea.sbleft <Button-5> {} - bind ${name}.mainframe.mainarea.sbbottom <Button-4> {} - bind ${name}.mainframe.mainarea.sbbottom <Button-5> {} - if {$tcl_platform(platform) == "windows"} { bind $name <FocusIn> \ "catch {config focus ${drawing} ; focus ${drawing}; \ set XCOps(focus) ${name} ; xcircuit::updatedialog}" + + bind ${name}.mainframe.mainarea.sbleft <MouseWheel> {} + bind ${name}.mainframe.mainarea.sbbottom <MouseWheel> {} + } else { bind $drawing <Enter> {focus %W} bind $name <FocusIn> "catch {config focus $drawing ; \ set XCOps(focus) ${name} ; xcircuit::updatedialog}" + + bind ${name}.mainframe.mainarea.sbleft <Button-4> {} + bind ${name}.mainframe.mainarea.sbleft <Button-5> {} + bind ${name}.mainframe.mainarea.sbbottom <Button-4> {} + bind ${name}.mainframe.mainarea.sbbottom <Button-5> {} } # Window-specific variable defaults (variables associated with toggle @@ -184,6 +187,7 @@ proc xcircuit::new_window { name } { set XCWinOps(${name},colorval) inherit set XCWinOps(${name},jhoriz) left set XCWinOps(${name},jvert) bottom + set XCWinOps(${name},justif) left set XCWinOps(${name},linestyle) solid set XCWinOps(${name},fillamount) 0 set XCWinOps(${name},opaque) false @@ -195,7 +199,7 @@ proc xcircuit::new_window { name } { set XCWinOps(${name},showbbox) false set XCWinOps(${name},fontfamily) Helvetica set XCWinOps(${name},fontstyle) normal - set XCWinOps(${name},fontencoding) Standard + set XCWinOps(${name},fontencoding) ISOLatin1 set XCWinOps(${name},fontlining) normal set XCWinOps(${name},fontscript) normal set XCWinOps(${name},gridstyle) "internal units" @@ -221,7 +225,7 @@ proc xcircuit::new_window { name } { set XCWinOps(${name},xposparam) false set XCWinOps(${name},yposparam) false set XCWinOps(${name},styleparam) false - set XCWinOps(${name},justparam) false + set XCWinOps(${name},anchorparam) false set XCWinOps(${name},startparam) false set XCWinOps(${name},endparam) false set XCWinOps(${name},radiusparam) false @@ -253,12 +257,25 @@ proc xcircuit::new_window { name } { #----------------------------------------------------------------- # Function bindings for the mouse scroll wheel. + # Note that Windows uses MouseWheel and direction passed as %D, + # while Linux uses Button-4 and Button-5. #----------------------------------------------------------------- - xcircuit::keybind <Button-4> { pan up 0.05 ; refresh} $drawing - xcircuit::keybind <Button-5> { pan down 0.05 ; refresh} $drawing - xcircuit::keybind <Shift-Button-4> { pan left 0.05 ; refresh} $drawing - xcircuit::keybind <Shift-Button-5> { pan right 0.05 ; refresh} $drawing + if {$tcl_platform(platform) == "windows"} { + xcircuit::keybind <MouseWheel> {if { %D/120 >= 1} \ + {pan up 0.1 ; refresh} else {pan down 0.1 ; refresh}} $drawing + xcircuit::keybind <Shift-MouseWheel> {if { %D/120 >= 1} \ + {pan left 0.1 ; refresh} else {pan right 0.1 ; refresh}} $drawing + xcircuit::keybind <Control-MouseWheel> {if { %D/120 >= 1} \ + {zoom in ; refresh} else {zoom out ; refresh}} $drawing + } else { + xcircuit::keybind <Button-4> { pan up 0.05 ; refresh} $drawing + xcircuit::keybind <Button-5> { pan down 0.05 ; refresh} $drawing + xcircuit::keybind <Shift-Button-4> { pan left 0.05 ; refresh} $drawing + xcircuit::keybind <Shift-Button-5> { pan right 0.05 ; refresh} $drawing + xcircuit::keybind <Control-Button-4> { zoom in ; refresh} $drawing + xcircuit::keybind <Control-Button-5> { zoom out ; refresh} $drawing + } #----------------------------------------------------------------- # Evaluate registered callback procedures @@ -273,6 +290,8 @@ proc xcircuit::new_window { name } { #---------------------------------------------------------------------- proc xcircuit::closewindow {name} { + global XCOps + set winlist [config windownames] if {[llength $winlist] > 1} { if {[lsearch $winlist $name] != -1} { @@ -280,6 +299,7 @@ proc xcircuit::closewindow {name} { set newwin [lindex [config windownames] 0] destroy [winfo top $name] config focus $newwin + set XCOps(focus) [winfo top $newwin] } } else { quit @@ -359,22 +379,22 @@ proc xcircuit::getinitstate {wname} { # Support procedures for tag callbacks #---------------------------------------------------------------------- -proc xcircuit::popupdialog {} { - set wstate [xcircuit::getinitstate .dialog] - xcircuit::removelists .dialog - wm deiconify .dialog - if {"$wstate" != "normal"} {centerwin .dialog} - raise .dialog - focus .dialog.textent.txt +proc xcircuit::popupdialog {{w .dialog}} { + set wstate [xcircuit::getinitstate ${w}] + xcircuit::removelists ${w} + wm deiconify ${w} + if {"$wstate" != "normal"} {centerwin ${w}} + raise ${w} + focus ${w}.textent.txt } -proc xcircuit::popupfilelist {} { - set wstate [xcircuit::getinitstate .filelist] - xcircuit::removelists .filelist - wm deiconify .filelist - centerwin .filelist - raise .filelist - focus .filelist.textent.txt +proc xcircuit::popupfilelist {{w .filelist}} { + set wstate [xcircuit::getinitstate ${w}] + xcircuit::removelists ${w} + wm deiconify ${w} + centerwin ${w} + raise ${w} + focus ${w}.textent.txt } #---------------------------------------------------------------------- @@ -420,64 +440,64 @@ proc xcircuit::setsheetsize {} { set ycm [lindex $slist 2] if {$xcm == 21.0 && $ycm == 29.7} { - set XCOps(sheetsize) a4 - .output.textent.txtf.sizb configure -text "A4" + set XCOps(sheetsize) a4 + .output.textent.txtf.sizb configure -text "A4" } elseif {$xcm == 29.7 && $ycm == 42.0} { - set XCOps(sheetsize) a3 - .output.textent.txtf.sizb configure -text "A3" + set XCOps(sheetsize) a3 + .output.textent.txtf.sizb configure -text "A3" } elseif {$xcm == 14.8 && $ycm == 18.4} { - set XCOps(sheetsize) a5 - .output.textent.txtf.sizb configure -text "A5" + set XCOps(sheetsize) a5 + .output.textent.txtf.sizb configure -text "A5" } elseif {$xcm == 25.7 && $ycm == 36.4} { - set XCOps(sheetsize) b4 - .output.textent.txtf.sizb configure -text "B4" + set XCOps(sheetsize) b4 + .output.textent.txtf.sizb configure -text "B4" } elseif {$xcm == 18.2 && $ycm == 25.7} { - set XCOps(sheetsize) b5 - .output.textent.txtf.sizb configure -text "B5" + set XCOps(sheetsize) b5 + .output.textent.txtf.sizb configure -text "B5" } else { - set XCOps(sheetsize) special - .output.textent.txtf.sizb configure -text "Special" + set XCOps(sheetsize) special + .output.textent.txtf.sizb configure -text "Special" } } elseif {$coordstyle == "in"} { set xin [lindex $slist 0] set yin [lindex $slist 2] if {$xin == 8.5 && $yin == 11.0} { - set XCOps(sheetsize) letter - .output.textent.txtf.sizb configure -text Letter + set XCOps(sheetsize) letter + .output.textent.txtf.sizb configure -text Letter } elseif {$xin == 8.5 && $yin == 14.0} { - set XCOps(sheetsize) legal - .output.textent.txtf.sizb configure -text Legal + set XCOps(sheetsize) legal + .output.textent.txtf.sizb configure -text Legal } elseif {$xin == 5.5 && $yin == 8.5} { - set XCOps(sheetsize) statement - .output.textent.txtf.sizb configure -text Statement + set XCOps(sheetsize) statement + .output.textent.txtf.sizb configure -text Statement } elseif {$xin == 11.0 && $yin == 17.0} { - set XCOps(sheetsize) tabloid - .output.textent.txtf.sizb configure -text Tabloid + set XCOps(sheetsize) tabloid + .output.textent.txtf.sizb configure -text Tabloid } elseif {$xin == 17.0 && $yin == 11.0} { - set XCOps(sheetsize) ledger - .output.textent.txtf.sizb configure -text Ledger + set XCOps(sheetsize) ledger + .output.textent.txtf.sizb configure -text Ledger } elseif {$xin == 8.5 && $yin == 13.0} { - set XCOps(sheetsize) folio - .output.textent.txtf.sizb configure -text Folio + set XCOps(sheetsize) folio + .output.textent.txtf.sizb configure -text Folio } elseif {$xin == 10.0 && $yin == 14.0} { - set XCOps(sheetsize) tenfourteen - .output.textent.txtf.sizb configure -text 10x14 + set XCOps(sheetsize) tenfourteen + .output.textent.txtf.sizb configure -text 10x14 } elseif {$xin == 7.5 && $yin == 10.0} { - set XCOps(sheetsize) executive - .output.textent.txtf.sizb configure -text Executive + set XCOps(sheetsize) executive + .output.textent.txtf.sizb configure -text Executive } elseif {$xin == 17.0 && $yin == 22.0} { - set XCOps(sheetsize) ansic - .output.textent.txtf.sizb configure -text "ANSI C" + set XCOps(sheetsize) ansic + .output.textent.txtf.sizb configure -text "ANSI C" } elseif {$xin == 22.0 && $yin == 34.0} { - set XCOps(sheetsize) ansid - .output.textent.txtf.sizb configure -text "ANSI D" + set XCOps(sheetsize) ansid + .output.textent.txtf.sizb configure -text "ANSI D" } elseif {$xin == 34.0 && $yin == 44.0} { - set XCOps(sheetsize) ansie - .output.textent.txtf.sizb configure -text "ANSI E" + set XCOps(sheetsize) ansie + .output.textent.txtf.sizb configure -text "ANSI E" } else { - set XCOps(sheetsize) special - .output.textent.txtf.sizb configure -text "Special" + set XCOps(sheetsize) special + .output.textent.txtf.sizb configure -text "Special" } } } @@ -569,6 +589,7 @@ proc xcircuit::pageupdate { {subcommand "none"} } { .output.title.field configure -text \ "PostScript output properties (Page [xcircuit::page])" set fname [xcircuit::page filename] + if {$fname == ""} {set fname [xcircuit::page label]} .output.textent.but1 configure -text Apply .output.textent.but2 configure -text Apply .output.textent.but3 configure -text Apply @@ -818,7 +839,7 @@ xcircuit::tag parameter { if {"%1" == "make"} {set cond true} else {set cond fal style {set XCWinOps($XCOps(focus),styleparam) $cond} "start angle" {set XCWinOps($XCOps(focus),startparam) $cond} "end angle" {set XCWinOps($XCOps(focus),endparam) $cond} - justification {set XCWinOps($XCOps(focus),justparam) $cond} + anchoring {set XCWinOps($XCOps(focus),anchorparam) $cond} radius {set XCWinOps($XCOps(focus),radiusparam) $cond} "minor axis" {set XCWinOps($XCOps(focus),minorparam) $cond} rotation {set XCWinOps($XCOps(focus),rotationparam) $cond} @@ -861,7 +882,7 @@ xcircuit::tag label {if {%# == 3} { } family {if {"%2" != "-all"} {set XCWinOps($XCOps(focus),fontfamily) %2}} style {set XCWinOps($XCOps(focus),fontstyle) %2} - justify { + anchor { switch -- %2 { top - bottom - @@ -869,10 +890,11 @@ xcircuit::tag label {if {%# == 3} { default {set XCWinOps($XCOps(focus),jhoriz) %2} } } + justify {set XCWinOps($XCOps(focus),justif) %2} flipinvariant {set XCWinOps($XCOps(focus),flipinvariant) %2} visible {set XCWinOps($XCOps(focus),pinvisible) %2} latex {set XCWinOps($XCOps(focus),latexmode) %2} - }} elseif {(%# == 4) && ("%1" == "justify")} { + }} elseif {(%# == 4) && ("%1" == "anchor")} { switch -- %2 { top - bottom - @@ -1157,6 +1179,18 @@ proc xcircuit::make_parameter_listbox {} { listbox .parameter.vallist -bg white listbox .parameter.parvals -bg white + # Code to get the listboxes to scroll in synchrony + bind .parameter.keylist <Button-4> {xcircuit::paramscroll -1} + bind .parameter.keylist <Button-5> {xcircuit::paramscroll 1} + bind .parameter.vallist <Button-4> {xcircuit::paramscroll -1} + bind .parameter.vallist <Button-5> {xcircuit::paramscroll 1} + bind .parameter.parvals <Button-4> {xcircuit::paramscroll -1} + bind .parameter.parvals <Button-5> {xcircuit::paramscroll 1} + # Also bind to the mouse wheel (Windows-specific, generally) + bind .parameter.keylist <MouseWheel> {xcircuit::paramscroll %D} + bind .parameter.vallist <MouseWheel> {xcircuit::paramscroll %D} + bind .parameter.parvals <MouseWheel> {xcircuit::paramscroll %D} + button .parameter.dismiss -text "Dismiss" -bg beige \ -command {wm withdraw .parameter} @@ -1206,110 +1240,150 @@ proc xcircuit::make_parameter_listbox {} { } } +#----------------------------------------------------------------- +# Scroll all listboxes in the .parameter window at the same +# time, in reponse to any one of them receiving a scroll event. +#----------------------------------------------------------------- + +proc xcircuit::paramscroll {value} { + global tcl_platform + set idx [.parameter.keylist nearest 0] + + if {$tcl_platform(platform) == "windows"} { + set idx [expr {$idx + $value / 120}] + } else { + set idx [expr {$idx + $value}] + } + + .parameter.keylist yview $idx + .parameter.vallist yview $idx + .parameter.parvals yview $idx + + # Important! This prohibits the default binding actions. + return -code break +} + # Update the dialog box, if it has been left visible # (Corrected 2/4/12: Don't delete contents except in these specific cases!) -proc xcircuit::updatedialog {} { +proc xcircuit::updatedialog {{w dialog}} { global XCOps - if {[xcircuit::getinitstate .dialog] == "normal"} { - switch -- $XCOps(dialog) { + if {[xcircuit::getinitstate .${w}] == "normal"} { + switch -- $XCOps(${w}) { linewidth { set btext [format "%g" [lindex [xcircuit::border get] 0]] - .dialog.textent.txt delete 0 end - .dialog.textent.txt insert 0 $btext + .${w}.textent.txt delete 0 end + .${w}.textent.txt insert 0 $btext } textscale { set cscale [xcircuit::label scale] - .dialog.textent.txt delete 0 end - .dialog.textent.txt insert 0 $cscale + .${w}.textent.txt delete 0 end + .${w}.textent.txt insert 0 $cscale } elementscale { set selects [xcircuit::select] if {$selects > 0} { set cscale [xcircuit::element scale] - .dialog.textent.txt delete 0 end - .dialog.textent.txt insert 0 $cscale + .${w}.textent.txt delete 0 end + .${w}.textent.txt insert 0 $cscale } } } } } -proc xcircuit::makedialogline {dframe textline} { - if {[catch {frame .dialog.${dframe} -bg beige}]} { - .dialog.${dframe}.title.field configure -text ${textline} +proc xcircuit::makedialogline {dframe textline {w dialog}} { + if {[catch {frame .${w}.${dframe} -bg beige}]} { + .${w}.${dframe}.title.field configure -text ${textline} } else { - pack .dialog.${dframe} -side top -padx 20 -pady 7 -fill x + pack .${w}.${dframe} -side top -padx 20 -pady 7 -fill x - frame .dialog.${dframe}.title -bg beige - entry .dialog.${dframe}.txt -bg white -relief sunken -width 50 + frame .${w}.${dframe}.title -bg beige + entry .${w}.${dframe}.txt -bg white -relief sunken -width 50 - pack .dialog.${dframe}.title -side top -fill x - pack .dialog.${dframe}.txt -side bottom -fill x -expand true + pack .${w}.${dframe}.title -side top -fill x + pack .${w}.${dframe}.txt -side bottom -fill x -expand true - label .dialog.${dframe}.title.field -text ${textline} -bg beige - pack .dialog.${dframe}.title.field -side left + label .${w}.${dframe}.title.field -text ${textline} -bg beige + pack .${w}.${dframe}.title.field -side left } } -proc xcircuit::removedialogline {dframe} { +proc xcircuit::removedialogline {dframe {w dialog}} { global XCOps - pack forget .dialog.${dframe} - destroy .dialog.${dframe} - set XCOps(dialog) 0 + pack forget .${w}.${dframe} + destroy .${w}.${dframe} + set XCOps(${w}) 0 } -#-------------------------------------- -# Create the simple popup prompt window -#-------------------------------------- +#-------------------------------------------- +# Create a simple popup prompt window +# With "Apply", "Okay", and "Cancel" buttons +#-------------------------------------------- -toplevel .dialog -bg beige -wm title .dialog "Dialog Box" -wm group .dialog . -wm protocol .dialog WM_DELETE_WINDOW {wm withdraw .dialog} -wm withdraw .dialog -set XCOps(dialog) 0 +proc make_simple_dialog {name} { + set window .${name} + toplevel ${window} -bg beige + wm title ${window} "Dialog Box" + wm group ${window} . + wm protocol ${window} WM_DELETE_WINDOW [subst {wm withdraw ${window}}] + wm withdraw ${window} + set XCOps(${name}) 0 -xcircuit::makedialogline textent "Select file to load:" + xcircuit::makedialogline textent "Select file to load:" ${name} -frame .dialog.bbar -bg beige -pack .dialog.bbar -side bottom -padx 20 -pady 7 -fill x + frame ${window}.bbar -bg beige + pack ${window}.bbar -side bottom -padx 20 -pady 7 -fill x -button .dialog.bbar.okay -text Okay -bg beige -command {.dialog.bbar.apply invoke ;\ - wm withdraw .dialog} -button .dialog.bbar.apply -text Apply -bg beige -button .dialog.bbar.cancel -text Cancel -bg beige -command {wm withdraw .dialog} + button ${window}.bbar.okay -text Okay -bg beige \ + -command [subst {${window}.bbar.apply invoke ;\ + wm withdraw ${window}}] + button ${window}.bbar.apply -text Apply -bg beige + button ${window}.bbar.cancel -text Cancel -bg beige -command \ + [subst {wm withdraw ${window}}] -bind .dialog.textent.txt <Return> {.dialog.bbar.apply invoke} + bind ${window}.textent.txt <Return> [subst {${window}.bbar.apply invoke}] -pack .dialog.bbar.okay -side left -ipadx 10 -pack .dialog.bbar.apply -side left -ipadx 10 -pack .dialog.bbar.cancel -side right -ipadx 10 + pack ${window}.bbar.okay -side left -ipadx 10 + pack ${window}.bbar.apply -side left -ipadx 10 + pack ${window}.bbar.cancel -side right -ipadx 10 +} #-------------------------------------- -# Create the query prompt window +# Create a query prompt window with +# "Okay" and "Cancel" buttons, and a +# "Select:" title message #-------------------------------------- -toplevel .query -bg beige -wm title .query "Query Dialog Box" -wm group .query . -wm protocol .query WM_DELETE_WINDOW {wm withdraw .query} -wm withdraw .query +proc make_query_dialog {name} { + set window .${name} + toplevel ${window} -bg beige + wm title ${window} "Query Dialog Box" + wm group ${window} . + wm protocol ${window} WM_DELETE_WINDOW [subst {wm withdraw ${window}}] + wm withdraw ${window} -frame .query.title -bg beige -frame .query.bbar -bg beige + frame ${window}.title -bg beige + frame ${window}.bbar -bg beige -pack .query.title -side top -padx 20 -pady 7 -fill x -pack .query.bbar -side bottom -padx 20 -pady 7 -fill x + pack ${window}.title -side top -padx 20 -pady 7 -fill x + pack ${window}.bbar -side bottom -padx 20 -pady 7 -fill x -label .query.title.field -text "Select:" -bg beige -pack .query.title.field -side left + label ${window}.title.field -text "Select:" -bg beige + pack ${window}.title.field -side left -button .query.bbar.okay -text Okay -bg beige -button .query.bbar.cancel -text Cancel -bg beige -command {wm withdraw .query} + button ${window}.bbar.okay -text Okay -bg beige + button ${window}.bbar.cancel -text Cancel -bg beige -command \ + [subst {wm withdraw ${window}}] -pack .query.bbar.okay -side left -ipadx 10 -pack .query.bbar.cancel -side right -ipadx 10 + pack ${window}.bbar.okay -side left -ipadx 10 + pack ${window}.bbar.cancel -side right -ipadx 10 +} + +make_query_dialog query +make_simple_dialog dialog +make_simple_dialog savetech +make_simple_dialog makesymbol #-------------------------------------------------------- # Generate all of the menu cascades @@ -1330,13 +1404,13 @@ proc xcircuit::printstring {stringlist} { return $p } -proc xcircuit::printjust {justif} { - switch [expr {$justif & 3}] { +proc xcircuit::printanchor {anchor} { + switch [expr {$anchor & 3}] { 0 {set p "left"} 1 {set p "center"} 3 {set p "right"} } - switch [expr {$justif & 12}] { + switch [expr {$anchor & 12}] { 0 {append p " bottom"} 4 {append p " middle"} 12 {append p " top"} @@ -1348,14 +1422,14 @@ proc xcircuit::labelmakeparam {} { global XCOps if {[xcircuit::select] > 0} { ;# this should be true. . . set XCOps(dialog) paramname - xcircuit::removedialogline textent2 ;# default is the selected text + xcircuit::removedialogline textent2 dialog ;# default is the selected text .dialog.bbar.apply configure -command \ [subst {xcircuit::parameter make substring \[.dialog.textent.txt get\];\ xcircuit::updateparams substring}] .dialog.textent.title.field configure -text "Parameter name:" + .dialog.textent.txt delete 0 end + xcircuit::popupdialog } - .dialog.textent.txt delete 0 end - xcircuit::popupdialog } proc xcircuit::promptmakeparam {{mode substring}} { @@ -1363,11 +1437,11 @@ proc xcircuit::promptmakeparam {{mode substring}} { set XCOps(dialog) paramdefault if {$mode == "label"} {set mode substring} - xcircuit::makedialogline textent2 "Default value:" + xcircuit::makedialogline textent2 "Default value:" dialog .dialog.bbar.apply configure -command \ [subst {xcircuit::parameter make $mode \ \[.dialog.textent.txt get\] \[.dialog.textent2.txt get\] -forward; \ - xcircuit::removedialogline textent2; \ + xcircuit::removedialogline textent2 dialog; \ xcircuit::updateparams $mode}] .dialog.textent.title.field configure -text \ "Parameter name:" @@ -1507,8 +1581,8 @@ proc xcircuit::updateparams { {mode {substring numeric expression}} } { "substring" { .parameter.vallist insert end [xcircuit::printstring $p_val] } - "justification" { - .parameter.vallist insert end [xcircuit::printjust $p_val] + "anchoring" { + .parameter.vallist insert end [xcircuit::printanchor $p_val] } default { .parameter.vallist insert end $p_val @@ -1536,16 +1610,16 @@ proc xcircuit::promptmakesymbol {{name ""}} { global XCOps set XCOps(dialog) makeobject - .dialog.bbar.apply configure -command \ + .makesymbol.bbar.apply configure -command \ {if {[string first "Page " [page label]] >= 0} { \ - page label [.dialog.textent.txt get]}; \ - xcircuit::symbol make [.dialog.textent.txt get] $XCOps(library)} - xcircuit::removedialogline textent2 - .dialog.textent.title.field configure -text "Name for new object:" - .dialog.textent.txt delete 0 end - .dialog.textent.txt insert 0 $name - xcircuit::popupdialog - xcircuit::addliblist .dialog "Place in: " + page label [.makesymbol.textent.txt get]}; \ + xcircuit::symbol make [.makesymbol.textent.txt get] $XCOps(library)} + xcircuit::removedialogline textent2 makesymbol + .makesymbol.textent.title.field configure -text "Name for new object:" + .makesymbol.textent.txt delete 0 end + .makesymbol.textent.txt insert 0 $name + xcircuit::popupdialog .makesymbol + xcircuit::addliblist .makesymbol Place in: " } #---------------------------------------------------------------------- @@ -1554,26 +1628,26 @@ proc xcircuit::prompttargettech {{name ""}} { global XCOps set XCOps(dialog) targettech - .dialog.bbar.apply configure -command { \ + .savetech.bbar.apply configure -command { \ set selects [xcircuit::select]; \ if {$selects > 0} { \ - if {[catch {set techname [.dialog.textent2.txt get]}]} {\ + if {[catch {set techname [.savetech.textent2.txt get]}]} {\ set techname $XCOps(technology)}; \ - technology objects $techname [.dialog.textent.txt get]}\ + technology objects $techname [.savetech.textent.txt get]}\ } - xcircuit::removedialogline textent2 - .dialog.textent.title.field configure -text "Objects to move:" - .dialog.textent.txt delete 0 end - .dialog.textent.txt insert 0 $name + xcircuit::removedialogline textent2 savetech + .savetech.textent.title.field configure -text "Objects to move:" + .savetech.textent.txt delete 0 end + .savetech.textent.txt insert 0 $name xcircuit::popupdialog - xcircuit::addtechlist .dialog "Target technology: " + xcircuit::addtechlist .savetech "Target technology: " # Add an additional selection to the tech menu for adding a new # technology namespace. This is relevant only to "prompttargettech". - .dialog.techself.techselect.menu add \ + .savetech.techself.techselect.menu add \ command -label "Add New Tech" -command \ - "xcircuit::makedialogline textent2 {New tech name:}" + "xcircuit::makedialogline textent2 {New tech name:}" savetech } #---------------------------------------------------------------------- @@ -1730,19 +1804,19 @@ proc xcircuit::promptsavetech {} { global XCOps set XCOps(dialog) techname - .dialog.bbar.apply configure -command \ - {xcircuit::technology save [.dialog.techself.techselect cget -text] \ - [.dialog.textent.txt get]} - .dialog.textent.title.field configure -text "Filename to save technology as:" - .dialog.textent.txt delete 0 end - xcircuit::popupdialog - xcircuit::addtechlist .dialog "Save which technology: " {(user)} true + .savetech.bbar.apply configure -command \ + {xcircuit::technology save [.savetech.techself.techselect cget -text] \ + [.savetech.textent.txt get]} + .savetech.textent.title.field configure -text "Filename to save technology as:" + .savetech.textent.txt delete 0 end + xcircuit::popupdialog .savetech + xcircuit::addtechlist .savetech "Save which technology: " {(user)} true set fname "" catch {set fname [technology filename $XCOps(technology)]} if {$fname == "(no associated file)"} { set fname $XCOps(technology).lps } - .dialog.textent.txt insert 0 $fname + .savetech.textent.txt insert 0 $fname } #---------------------------------------------------------------------- @@ -2008,7 +2082,7 @@ proc xcircuit::allcolorbuttons {window} { set colorlist [color get -all] set frame [winfo top $window] - set idx 0 + set idx 17 ;# NUMBER_OF_COLORS in xcircuit.h foreach colorrgb $colorlist { ${frame}.menubar.optionsbutton.optionsmenu.elementsmenu.colormenu \ add radio -image img_col$idx -activebackground $colorrgb \ @@ -2590,7 +2664,7 @@ proc xcircuit::makemenus {window} { $m add cascade -label "Style" -menu $m.stylemenu $m add cascade -label "Encoding" -menu $m.encodingmenu $m add cascade -label "Insert" -menu $m.insertmenu - $m add cascade -label "Justification" -menu $m.justifymenu + $m add cascade -label "Anchoring" -menu $m.anchormenu $m add command -label "Parameterize" \ -command {xcircuit::labelmakeparam} $m add command -label "Unparameterize" \ @@ -2657,21 +2731,28 @@ proc xcircuit::makemenus {window} { $m2 add command -label "Character" -command "xcircuit::label insert special" $m2 add command -label "Parameter" -command "xcircuit::prompteditparams" - set m2 [menu $m.justifymenu -tearoff 0] - $m2 add radio -label "Left Justified" -variable XCWinOps(${window},jhoriz) \ + set m2 [menu $m.anchormenu -tearoff 0] + $m2 add radio -label "Left Anchored" -variable XCWinOps(${window},jhoriz) \ + -value left -command "xcircuit::label anchor left" + $m2 add radio -label "Center Anchored" -variable XCWinOps(${window},jhoriz) \ + -value center -command "xcircuit::label anchor center" + $m2 add radio -label "Right Anchored" -variable XCWinOps(${window},jhoriz) \ + -value right -command "xcircuit::label anchor right" + $m2 add separator + $m2 add radio -label "Top Anchored" -variable XCWinOps(${window},jvert) \ + -value top -command "xcircuit::label anchor top" + $m2 add radio -label "Middle Anchored" -variable XCWinOps(${window},jvert) \ + -value middle -command "xcircuit::label anchor middle" + $m2 add radio -label "Bottom Anchored" -variable XCWinOps(${window},jvert) \ + -value bottom -command "xcircuit::label anchor bottom" + $m2 add separator + $m2 add radio -label "Left Justified" -variable XCWinOps(${window},justif) \ -value left -command "xcircuit::label justify left" - $m2 add radio -label "Center Justified" -variable XCWinOps(${window},jhoriz) \ + $m2 add radio -label "Center Justified" -variable XCWinOps(${window},justif) \ -value center -command "xcircuit::label justify center" - $m2 add radio -label "Right Justified" -variable XCWinOps(${window},jhoriz) \ + $m2 add radio -label "Right Justified" -variable XCWinOps(${window},justif) \ -value right -command "xcircuit::label justify right" $m2 add separator - $m2 add radio -label "Top Justified" -variable XCWinOps(${window},jvert) \ - -value top -command "xcircuit::label justify top" - $m2 add radio -label "Middle Justified" -variable XCWinOps(${window},jvert) \ - -value middle -command "xcircuit::label justify middle" - $m2 add radio -label "Bottom Justified" -variable XCWinOps(${window},jvert) \ - -value bottom -command "xcircuit::label justify bottom" - $m2 add separator $m2 add check -label "Flip Invariant" \ -variable XCWinOps(${window},flipinvariant) \ -onvalue true -offvalue false -command {xcircuit::label flipinvariant \ @@ -2851,11 +2932,11 @@ proc xcircuit::makemenus {window} { {if {$XCWinOps($XCOps(focus),yposparam)} \ {xcircuit::parameter make "y position"} \ {xcircuit::parameter replace "y position"}} - $m3 add check -label "Justification" -variable XCWinOps(${window},justparam) \ + $m3 add check -label "Anchoring" -variable XCWinOps(${window},anchorparam) \ -onvalue true -offvalue false -command \ - {if {$XCWinOps($XCOps(focus),justparam)} \ - {xcircuit::parameter make justification} \ - {xcircuit::parameter replace justification}} + {if {$XCWinOps($XCOps(focus),anchorparam)} \ + {xcircuit::parameter make anchoring} \ + {xcircuit::parameter replace anchoring}} $m3 add check -label "Rotation" -variable XCWinOps(${window},rotationparam) \ -onvalue true -offvalue false -command \ {if {$XCWinOps($XCOps(focus),rotationparam)} \ @@ -3051,7 +3132,7 @@ proc xcircuit::enable_mousehints {} { set XCOps(mousehints) 1 foreach window [config windownames] { set frame [winfo top $window] - xcircuit::mousehint_create $frame + catch {xcircuit::mousehint_create $frame} } } } @@ -3197,6 +3278,15 @@ proc xcircuit::makehelpwindow {} { message .help.listwin.win -width 200 -justify left -anchor n \ -relief groove -text "Click on a function for help text" + # Keep boxes aligned! + bind .help.listwin.keys <Button-4> {xcircuit::helpscroll -1} + bind .help.listwin.keys <Button-5> {xcircuit::helpscroll 1} + bind .help.listwin.func <Button-4> {xcircuit::helpscroll -1} + bind .help.listwin.func <Button-5> {xcircuit::helpscroll 1} + # Also bind to the mouse wheel (Windows-specific, generally) + bind .help.listwin.keys <MouseWheel> {xcircuit::helpscroll %D} + bind .help.listwin.func <MouseWheel> {xcircuit::helpscroll %D} + grid .help.listwin.func -row 0 -column 0 -sticky news -padx 1 -pady 1 grid .help.listwin.keys -row 0 -column 1 -sticky news -padx 1 -pady 1 grid .help.listwin.sb -row 0 -column 2 -sticky ns -padx 1 -pady 1 @@ -3209,6 +3299,28 @@ proc xcircuit::makehelpwindow {} { } #----------------------------------------------------------------- +# Scroll all listboxes in the .help.listwin window at the same +# time, in reponse to any one of them receiving a scroll event. +#----------------------------------------------------------------- + +proc xcircuit::helpscroll {value} { + global tcl_platform + set idx [.help.listwin.func nearest 0] + + if {$tcl_platform(platform) == "windows"} { + set idx [expr {$idx + $value / 120}] + } else { + set idx [expr {$idx + $value}] + } + + .help.listwin.func yview $idx + .help.listwin.keys yview $idx + + # Important! This prohibits the default binding actions. + return -code break +} + +#----------------------------------------------------------------- # Procedure to update and display the help window #----------------------------------------------------------------- |