diff options
Diffstat (limited to 'library')
63 files changed, 1857 insertions, 1336 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl index 0dd04a1..a4147c3 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -22,7 +22,7 @@ namespace eval ::tk::dialog::error { option add *ErrorDialog*background systemAlertBackgroundActive \ widgetDefault option add *ErrorDialog*info.text.background \ - systemTextBackgroundColor widgetDefault + systemTextBackgroundColor widgetDefault option add *ErrorDialog*Button.highlightBackground \ systemAlertBackgroundActive widgetDefault } @@ -63,9 +63,9 @@ proc ::tk::dialog::error::SaveToLog {text} { set filename [tk_getSaveFile -title [mc "Select Log File"] \ -filetypes $types -defaultextension .log -parent .bgerrorDialog] if {$filename ne {}} { - set f [open $filename w] - puts -nonewline $f $text - close $f + set f [open $filename w] + puts -nonewline $f $text + close $f } return } @@ -131,7 +131,7 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} { set maxRows 5 foreach line [split $err \n] { if {$lines > $maxRows - 1} { - # No more lines. Append to previous line. + # No more lines. Append to previous line. append displayedErr { ...} break } @@ -143,7 +143,7 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} { append displayedErr "[string range $line 0 $maxLine-3]..." break } elseif {$lines > $maxRows - 2} { - # Last line, but no break or newline. Room to add 4 chars. + # Last line, but no break or newline. Room to add 4 chars. append displayedErr "${line}" } else { append displayedErr "${line}\n" @@ -255,7 +255,7 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} { # order to ensure that it's seen if {[lindex [wm stackorder .] end] ne "$dlg"} { wm attributes $dlg -topmost 1 - } + } } # 9. Wait for the user to respond, then restore the focus and diff --git a/library/choosedir.tcl b/library/choosedir.tcl index c583215..b7225b6 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -28,9 +28,9 @@ proc ::tk::dialog::file::chooseDir:: {args} { Config $dataName $args if {$data(-parent) eq "."} { - set w .$dataName + set w .$dataName } else { - set w $data(-parent).$dataName + set w $data(-parent).$dataName } # (re)create the dialog box if necessary diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 0a7f65b..25e1b1f 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -65,9 +65,9 @@ proc tclParseConfigSpec {w specs flags argList} { # 2: set the default values # if {"DONTSETDEFAULTS" ni $flags} { - foreach cmdsw [array names cmd] { + foreach cmdsw [array names cmd] { set data($cmdsw) $def($cmdsw) - } + } } # 3: parse the argument list @@ -149,7 +149,7 @@ proc ::tk::FocusGroup_BindIn {t w cmd} { variable ::tk::Priv if {![info exists Priv(fg,$t)]} { return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \ - "focus group \"$t\" doesn't exist" + "focus group \"$t\" does not exist" } set FocusIn($t,$w) $cmd } @@ -166,7 +166,7 @@ proc ::tk::FocusGroup_BindOut {t w cmd} { variable ::tk::Priv if {![info exists Priv(fg,$t)]} { return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \ - "focus group \"$t\" doesn't exist" + "focus group \"$t\" does not exist" } set FocusOut($t,$w) $cmd } diff --git a/library/console.tcl b/library/console.tcl index d882136..8eda872 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -38,7 +38,7 @@ interp alias {} EvalAttached {} consoleinterp eval # This procedure constructs and configures the console windows. # # Arguments: -# None. +# None. proc ::tk::ConsoleInit {} { if {![consoleinterp eval {set tcl_interactive}]} { @@ -722,7 +722,7 @@ Tk $::tk_patchLevel" } # ::tk::console::Fontchooser* -- -# Let the user select the console font (TIP 324). +# Let the user select the console font (TIP 324). proc ::tk::console::FontchooserToggle {} { if {[tk fontchooser configure -visible]} { @@ -795,8 +795,8 @@ proc ::tk::console::TagProc w { # # Arguments: # w - console text widget -# c1 - first char of pair -# c2 - second char of pair +# c1 - first char of pair +# c2 - second char of pair # # Calls: ::tk::console::Blink @@ -887,9 +887,9 @@ proc ::tk::console::MatchQuote {w {lim 1.0}} { # # Arguments: # w - console text widget -# i1 - start index to blink region -# i2 - end index of blink region -# dur - duration in usecs to blink for +# i1 - start index to blink region +# i2 - end index of blink region +# dur - duration in usecs to blink for # # Outputs: # blinks selected characters in $w @@ -921,7 +921,7 @@ proc ::tk::console::ConstrainBuffer {w size} { # # Arguments: # ARGS: w - text widget in which to expand str -# type - type of expansion (path / proc / variable) +# type - type of expansion (path / proc / variable) # # Calls: ::tk::console::Expand(Pathname|Procname|Variable) # @@ -1121,7 +1121,7 @@ proc ::tk::console::ExpandVariable str { # # Arguments: # l - list to find best unique match in -# e - currently best known unique match +# e - currently best known unique match # # Returns: longest unique match in the list diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl index de9e854..6ae5479 100644 --- a/library/demos/fontchoose.tcl +++ b/library/demos/fontchoose.tcl @@ -20,7 +20,7 @@ catch {font create FontchooseDemoFont {*}[font actual TkDefaultFont]} # The font chooser needs to be configured and then shown. proc SelectFont {parent} { tk fontchooser configure -font FontchooseDemoFont \ - -command ApplyFont -parent $parent + -command ApplyFont -parent $parent tk fontchooser show } @@ -33,9 +33,9 @@ proc ApplyFont {font} { # bind $w <<TkFontchooserVisibility>> { if {[tk fontchooser configure -visible]} { - %W.f.font state disabled + %W.f.font state disabled } else { - %W.f.font state !disabled + %W.f.font state !disabled } } diff --git a/library/demos/goldberg.tcl b/library/demos/goldberg.tcl index 5a5b462..5323cce 100644 --- a/library/demos/goldberg.tcl +++ b/library/demos/goldberg.tcl @@ -1923,7 +1923,7 @@ proc scl {lst} { proc PlacedDialog {w msg {labelFnt {Helvetica 10}}} { if {[grab current] ne {}} { - return + return } destroy $w @@ -1954,7 +1954,7 @@ proc PlacedDialog {w msg {labelFnt {Helvetica 10}}} { proc ClosePlacedDialog {w} { set tl [winfo toplevel $w] if {![winfo exists $::PlacedDialogOldFocus]} { - set ::PlacedDialogOldFocus $tl + set ::PlacedDialogOldFocus $tl } focus $::PlacedDialogOldFocus set ::PlacedDialogOldFocus {} diff --git a/library/demos/images/Tcl.svg b/library/demos/images/Tcl.svg index 2c18ec1..05dd9a4 100644 --- a/library/demos/images/Tcl.svg +++ b/library/demos/images/Tcl.svg @@ -40,10 +40,10 @@ id="metadata2314"> <rdf:RDF> <cc:Work - rdf:about=""> - <dc:format>image/svg+xml</dc:format> - <dc:type - rdf:resource="http://purl.org/dc/dcmitype/StillImage" /> + rdf:about=""> + <dc:format>image/svg+xml</dc:format> + <dc:type + rdf:resource="http://purl.org/dc/dcmitype/StillImage" /> </cc:Work> </rdf:RDF> </metadata> @@ -53,23 +53,23 @@ id="layer1" transform="translate(-311.79308,-365.73272)"> <g - style="opacity:1;display:inline" - id="g2244" - transform="translate(308.95998,366.42022)"> + style="opacity:1;display:inline" + id="g2244" + transform="translate(308.95998,366.42022)"> <path - id="path4426" - d="M 445.52492,372.22514 C 445.90652,395.55723 445.21415,418.63757 425.02492,440.56889 L 424.27492,441.41264 L 425.39992,441.41264 L 433.64992,441.53764 C 420.24442,469.42405 411.52244,497.23134 392.24367,525.00639 L 391.55617,526.00639 L 392.74367,525.78764 L 402.93117,523.85014 C 395.71427,542.16045 383.37359,554.28293 369.99367,558.35014 C 366.31107,506.78151 392.04593,461.26308 413.89992,415.88139 C 413.92002,415.83965 413.94233,415.79813 413.96242,415.75639 L 413.14992,415.19389 C 377.36425,455.2074 361.23872,511.6427 355.14992,558.19389 C 343.02146,551.34666 338.97913,542.28079 334.86867,529.94389 L 343.33742,533.50639 L 344.21242,533.88139 L 344.02492,532.94389 C 337.58858,504.32416 347.5814,483.78143 357.27492,456.78764 L 364.24367,461.44389 L 365.05617,462.00639 L 365.02492,461.03764 C 364.47892,439.10645 379.24595,417.08983 398.83742,397.44389 L 401.55617,404.72514 L 401.93117,405.69389 L 402.46242,404.78764 L 408.43117,394.85014 L 408.46242,394.78764 C 418.31429,381.21812 428.72988,376.80082 445.52492,372.22514 z " - style="fill:#c3b15f;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" - transform="translate(-324.02492,-364.63139)" /> + id="path4426" + d="M 445.52492,372.22514 C 445.90652,395.55723 445.21415,418.63757 425.02492,440.56889 L 424.27492,441.41264 L 425.39992,441.41264 L 433.64992,441.53764 C 420.24442,469.42405 411.52244,497.23134 392.24367,525.00639 L 391.55617,526.00639 L 392.74367,525.78764 L 402.93117,523.85014 C 395.71427,542.16045 383.37359,554.28293 369.99367,558.35014 C 366.31107,506.78151 392.04593,461.26308 413.89992,415.88139 C 413.92002,415.83965 413.94233,415.79813 413.96242,415.75639 L 413.14992,415.19389 C 377.36425,455.2074 361.23872,511.6427 355.14992,558.19389 C 343.02146,551.34666 338.97913,542.28079 334.86867,529.94389 L 343.33742,533.50639 L 344.21242,533.88139 L 344.02492,532.94389 C 337.58858,504.32416 347.5814,483.78143 357.27492,456.78764 L 364.24367,461.44389 L 365.05617,462.00639 L 365.02492,461.03764 C 364.47892,439.10645 379.24595,417.08983 398.83742,397.44389 L 401.55617,404.72514 L 401.93117,405.69389 L 402.46242,404.78764 L 408.43117,394.85014 L 408.46242,394.78764 C 418.31429,381.21812 428.72988,376.80082 445.52492,372.22514 z " + style="fill:#c3b15f;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" + transform="translate(-324.02492,-364.63139)" /> <path - sodipodi:nodetypes="ccccccccccccccccccccccc" - id="path7600" - d="M 121.54988,7.5808058 C 104.81215,12.147023 94.270242,16.613077 84.4375,30.15625 L 84.40625,30.21875 L 78.4375,40.15625 L 77.90625,41.0625 L 77.53125,40.09375 L 74.8125,32.8125 C 55.22103,52.45844 40.454,74.47506 41,96.40625 L 41.03125,97.375 L 40.21875,96.8125 L 33.25,92.15625 C 23.55648,119.15004 13.56366,139.69277 20,168.3125 L 20.1875,169.25 L 19.3125,168.875 L 10.9375,165.34375 C 10.96447,165.51523 11.003113,165.67421 11.03125,165.84375 C 15.080346,177.9015 19.176955,186.81713 31.125,193.5625 C 31.596616,189.95681 32.122231,186.27456 32.71875,182.5625 C 18.12816,148.39836 30.79293,123.2814 36.5625,100.6875 L 45.4375,105.8125 C 44.211577,84.657017 56.63174,61.842112 72.78125,41.9375 L 77.46875,50.1875 C 89.477498,25.486664 98.97512,15.57175 121.54988,7.5808058 z " - style="opacity:1;fill:#eff1cb;fill-opacity:1;fill-rule:evenodd;stroke:#eff1cb;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" /> + sodipodi:nodetypes="ccccccccccccccccccccccc" + id="path7600" + d="M 121.54988,7.5808058 C 104.81215,12.147023 94.270242,16.613077 84.4375,30.15625 L 84.40625,30.21875 L 78.4375,40.15625 L 77.90625,41.0625 L 77.53125,40.09375 L 74.8125,32.8125 C 55.22103,52.45844 40.454,74.47506 41,96.40625 L 41.03125,97.375 L 40.21875,96.8125 L 33.25,92.15625 C 23.55648,119.15004 13.56366,139.69277 20,168.3125 L 20.1875,169.25 L 19.3125,168.875 L 10.9375,165.34375 C 10.96447,165.51523 11.003113,165.67421 11.03125,165.84375 C 15.080346,177.9015 19.176955,186.81713 31.125,193.5625 C 31.596616,189.95681 32.122231,186.27456 32.71875,182.5625 C 18.12816,148.39836 30.79293,123.2814 36.5625,100.6875 L 45.4375,105.8125 C 44.211577,84.657017 56.63174,61.842112 72.78125,41.9375 L 77.46875,50.1875 C 89.477498,25.486664 98.97512,15.57175 121.54988,7.5808058 z " + style="opacity:1;fill:#eff1cb;fill-opacity:1;fill-rule:evenodd;stroke:#eff1cb;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" /> <path - style="fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" - d="M 126.9375,-0.6875 L 126.40625,-0.59375 C 106.72165,2.83976 87.4508,10.07244 79,27.375 L 75.4375,21.15625 L 75.125,20.59375 L 74.65625,21.0625 C 64.96254,30.33838 54.55574,42.35306 46.875,54.15625 C 39.66528,65.23562 34.88327,76.07934 35.40625,84.375 L 30.375,78.09375 L 29.875,77.46875 L 29.53125,78.1875 C 23.40732,91.41649 17.22694,107.69157 13.53125,122.625 C 10.02725,136.78385 8.77244,149.67206 12.03125,157.78125 L 3.75,152.96875 L 3.0625,152.5625 L 3,153.375 C 1.44089,176.99202 11.0382,188.26833 22.0625,199.15625 L 12.875,201.4375 L 11.03125,201.90625 L 12.875,202.40625 C 18.14953,203.83558 23.15023,205.44485 26.625,208.125 C 30.09977,210.80515 32.09598,214.49082 31.5,220.375 L 31.5,220.40625 L 31.5,245.90625 L 31.5,246.0625 L 31.59375,246.1875 L 43.09375,262.6875 L 44,264 L 44,262.40625 L 44,223.53125 C 45.52181,216.98735 47.30807,212.4833 49.875,209.5 C 52.44193,206.5167 55.78211,204.98483 60.5625,204.40625 L 62.28125,204.1875 L 60.71875,203.46875 L 54.65625,200.59375 C 69.11174,191.89001 85.3013,170.55445 89.5625,150.28125 L 89.75,149.46875 L 88.96875,149.6875 L 81.46875,151.71875 C 88.13174,145.46249 94.84392,133.06721 101.21875,118.625 C 107.9798,103.3078 114.29247,85.96032 119.46875,72.09375 L 119.75,71.34375 L 118.96875,71.40625 L 113.1875,71.8125 C 120.3346,64.22669 124.30703,51.6996 126.25,38.46875 C 128.27227,24.69793 128.13035,10.1977 127,-0.15625 L 126.9375,-0.6875 z M 121.5,7.59375 C 121.8816,30.92584 121.18923,54.00618 101,75.9375 L 100.25,76.78125 L 101.375,76.78125 L 109.625,76.90625 C 96.2195,104.79266 87.49752,132.59995 68.21875,160.375 L 67.53125,161.375 L 68.71875,161.15625 L 78.90625,159.21875 C 71.68935,177.52906 59.34867,189.65154 45.96875,193.71875 C 42.28615,142.15012 68.02101,96.63169 89.875,51.25 C 89.8951,51.20826 89.91741,51.16674 89.9375,51.125 L 89.125,50.5625 C 53.33933,90.57601 37.2138,147.01131 31.125,193.5625 C 18.99654,186.71527 14.95421,177.6494 10.84375,165.3125 L 19.3125,168.875 L 20.1875,169.25 L 20,168.3125 C 13.56366,139.69277 23.55648,119.15004 33.25,92.15625 L 40.21875,96.8125 L 41.03125,97.375 L 41,96.40625 C 40.454,74.47506 55.22103,52.45844 74.8125,32.8125 L 77.53125,40.09375 L 77.90625,41.0625 L 78.4375,40.15625 L 84.40625,30.21875 L 84.4375,30.15625 C 94.28937,16.58673 104.70496,12.16943 121.5,7.59375 z " - id="path2177" /> + style="fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" + d="M 126.9375,-0.6875 L 126.40625,-0.59375 C 106.72165,2.83976 87.4508,10.07244 79,27.375 L 75.4375,21.15625 L 75.125,20.59375 L 74.65625,21.0625 C 64.96254,30.33838 54.55574,42.35306 46.875,54.15625 C 39.66528,65.23562 34.88327,76.07934 35.40625,84.375 L 30.375,78.09375 L 29.875,77.46875 L 29.53125,78.1875 C 23.40732,91.41649 17.22694,107.69157 13.53125,122.625 C 10.02725,136.78385 8.77244,149.67206 12.03125,157.78125 L 3.75,152.96875 L 3.0625,152.5625 L 3,153.375 C 1.44089,176.99202 11.0382,188.26833 22.0625,199.15625 L 12.875,201.4375 L 11.03125,201.90625 L 12.875,202.40625 C 18.14953,203.83558 23.15023,205.44485 26.625,208.125 C 30.09977,210.80515 32.09598,214.49082 31.5,220.375 L 31.5,220.40625 L 31.5,245.90625 L 31.5,246.0625 L 31.59375,246.1875 L 43.09375,262.6875 L 44,264 L 44,262.40625 L 44,223.53125 C 45.52181,216.98735 47.30807,212.4833 49.875,209.5 C 52.44193,206.5167 55.78211,204.98483 60.5625,204.40625 L 62.28125,204.1875 L 60.71875,203.46875 L 54.65625,200.59375 C 69.11174,191.89001 85.3013,170.55445 89.5625,150.28125 L 89.75,149.46875 L 88.96875,149.6875 L 81.46875,151.71875 C 88.13174,145.46249 94.84392,133.06721 101.21875,118.625 C 107.9798,103.3078 114.29247,85.96032 119.46875,72.09375 L 119.75,71.34375 L 118.96875,71.40625 L 113.1875,71.8125 C 120.3346,64.22669 124.30703,51.6996 126.25,38.46875 C 128.27227,24.69793 128.13035,10.1977 127,-0.15625 L 126.9375,-0.6875 z M 121.5,7.59375 C 121.8816,30.92584 121.18923,54.00618 101,75.9375 L 100.25,76.78125 L 101.375,76.78125 L 109.625,76.90625 C 96.2195,104.79266 87.49752,132.59995 68.21875,160.375 L 67.53125,161.375 L 68.71875,161.15625 L 78.90625,159.21875 C 71.68935,177.52906 59.34867,189.65154 45.96875,193.71875 C 42.28615,142.15012 68.02101,96.63169 89.875,51.25 C 89.8951,51.20826 89.91741,51.16674 89.9375,51.125 L 89.125,50.5625 C 53.33933,90.57601 37.2138,147.01131 31.125,193.5625 C 18.99654,186.71527 14.95421,177.6494 10.84375,165.3125 L 19.3125,168.875 L 20.1875,169.25 L 20,168.3125 C 13.56366,139.69277 23.55648,119.15004 33.25,92.15625 L 40.21875,96.8125 L 41.03125,97.375 L 41,96.40625 C 40.454,74.47506 55.22103,52.45844 74.8125,32.8125 L 77.53125,40.09375 L 77.90625,41.0625 L 78.4375,40.15625 L 84.40625,30.21875 L 84.4375,30.15625 C 94.28937,16.58673 104.70496,12.16943 121.5,7.59375 z " + id="path2177" /> </g> </g> </svg> diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl index 76b6a4f..8da89ba 100644 --- a/library/demos/knightstour.tcl +++ b/library/demos/knightstour.tcl @@ -27,11 +27,11 @@ package require tk proc ValidMoves {square} { set moves {} foreach pair {{-1 -2} {-2 -1} {-2 1} {-1 2} {1 2} {2 1} {2 -1} {1 -2}} { - set col [expr {($square % 8) + [lindex $pair 0]}] - set row [expr {($square / 8) + [lindex $pair 1]}] - if {$row >= 0 && $row < 8 && $col >= 0 && $col < 8} { - lappend moves [expr {$row * 8 + $col}] - } + set col [expr {($square % 8) + [lindex $pair 0]}] + set row [expr {($square / 8) + [lindex $pair 1]}] + if {$row >= 0 && $row < 8 && $col >= 0 && $col < 8} { + lappend moves [expr {$row * 8 + $col}] + } } return $moves } @@ -41,9 +41,9 @@ proc CheckSquare {square} { variable visited set moves 0 foreach test [ValidMoves $square] { - if {[lsearch -exact -integer $visited $test] < 0} { - incr moves - } + if {[lsearch -exact -integer $visited $test] < 0} { + incr moves + } } return $moves } @@ -55,17 +55,17 @@ proc Next {square} { set minimum 9 set nextSquare -1 foreach testSquare [ValidMoves $square] { - if {[lsearch -exact -integer $visited $testSquare] < 0} { - set count [CheckSquare $testSquare] - if {$count < $minimum} { - set minimum $count - set nextSquare $testSquare - } elseif {$count == $minimum} { - # to remove the enhancement to Warnsdorff's rule - # remove the next line: - set nextSquare [Edgemost $nextSquare $testSquare] - } - } + if {[lsearch -exact -integer $visited $testSquare] < 0} { + set count [CheckSquare $testSquare] + if {$count < $minimum} { + set minimum $count + set nextSquare $testSquare + } elseif {$count == $minimum} { + # to remove the enhancement to Warnsdorff's rule + # remove the next line: + set nextSquare [Edgemost $nextSquare $testSquare] + } + } } return $nextSquare } @@ -98,23 +98,23 @@ proc MovePiece {dlg last square} { lappend visited $square set next [Next $square] if {$next ne -1} { - variable aid [after $delay [list MovePiece $dlg $square $next]] + variable aid [after $delay [list MovePiece $dlg $square $next]] } else { - $dlg.tf.b1 configure -state normal - if {[llength $visited] == 64} { - variable initial - if {$initial == $square} { - $dlg.f.txt insert end "Closed tour!" - } else { - $dlg.f.txt insert end "Success" - if {$continuous} { - after [expr {$delay * 2}] [namespace code \ - [list Tour $dlg [expr {int(rand() * 64)}]]] - } - } - } else { - $dlg.f.txt insert end "FAILED!" - } + $dlg.tf.b1 configure -state normal + if {[llength $visited] == 64} { + variable initial + if {$initial == $square} { + $dlg.f.txt insert end "Closed tour!" + } else { + $dlg.f.txt insert end "Success" + if {$continuous} { + after [expr {$delay * 2}] [namespace code \ + [list Tour $dlg [expr {int(rand() * 64)}]]] + } + } + } else { + $dlg.f.txt insert end "FAILED!" + } } } @@ -124,11 +124,11 @@ proc Tour {dlg {square {}}} { $dlg.f.txt delete 1.0 end $dlg.tf.b1 configure -state disabled for {set n 0} {$n < 64} {incr n} { - $dlg.f.c itemconfigure $n -state disabled -outline black + $dlg.f.c itemconfigure $n -state disabled -outline black } if {$square eq {}} { - set coords [lrange [$dlg.f.c coords knight] 0 1] - set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}] + set coords [lrange [$dlg.f.c coords knight] 0 1] + set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}] } variable initial $square after idle [list MovePiece $dlg $initial $initial] @@ -157,9 +157,9 @@ proc DragStart {w x y} { proc DragMotion {w x y} { variable dragging if {[info exists dragging]} { - $w move selected [expr {$x - [lindex $dragging 0]}] \ - [expr {$y - [lindex $dragging 1]}] - variable dragging [list $x $y] + $w move selected [expr {$x - [lindex $dragging 0]}] \ + [expr {$y - [lindex $dragging 1]}] + variable dragging [list $x $y] } } proc DragEnd {w x y} { @@ -177,7 +177,7 @@ proc CreateGUI {} { set f [ttk::frame $dlg.f] set c [canvas $f.c -width 192p -height 192p] text $f.txt -width 12 -height 1 -padx 3p \ - -yscrollcommand [list $f.vs set] -font TkFixedFont + -yscrollcommand [list $f.vs set] -font TkFixedFont ttk::scrollbar $f.vs -command [list $f.txt yview] variable speed 1400 @@ -185,41 +185,41 @@ proc CreateGUI {} { variable continuous 0 ttk::frame $dlg.tf ttk::checkbutton $dlg.tf.cc -text Repeat \ - -variable [namespace which -variable continuous] + -variable [namespace which -variable continuous] ttk::scale $dlg.tf.sc -from 0 -to 1992 -command [list SetDelay] \ - -variable [namespace which -variable speed] + -variable [namespace which -variable speed] ttk::label $dlg.tf.ls -text Speed ttk::button $dlg.tf.b1 -text Start -command [list Tour $dlg] ttk::button $dlg.tf.b2 -text Exit -command [list Exit $dlg] set square 0 for {set row 7} {$row >= 0} {incr row -1} { - for {set col 0} {$col < 8} {incr col} { - if {(($col & 1) ^ ($row & 1))} { - set fill tan3 ; set dfill tan4 - } else { - set fill bisque ; set dfill bisque3 - } - set coords [list [expr {$col * 24 + 3}]p \ + for {set col 0} {$col < 8} {incr col} { + if {(($col & 1) ^ ($row & 1))} { + set fill tan3 ; set dfill tan4 + } else { + set fill bisque ; set dfill bisque3 + } + set coords [list [expr {$col * 24 + 3}]p \ [expr {$row * 24 + 3}]p \ - [expr {$col * 24 + 24}]p \ + [expr {$col * 24 + 24}]p \ [expr {$row * 24 + 24}]p] - $c create rectangle $coords -fill $fill -disabledfill $dfill \ - -width 1.5p -state disabled -outline black - } + $c create rectangle $coords -fill $fill -disabledfill $dfill \ + -width 1.5p -state disabled -outline black + } } if {[tk windowingsystem] ne "x11"} { - catch {eval font create KnightFont -size 18} - $c create text 0 0 -font KnightFont -text "♞" \ - -anchor nw -tags knight -fill black -activefill "#600000" + catch {eval font create KnightFont -size 18} + $c create text 0 0 -font KnightFont -text "♞" \ + -anchor nw -tags knight -fill black -activefill "#600000" } else { - # On X11 we cannot reliably tell if the ♞ glyph is available - # so just use a polygon - set pts { - 2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16 - 2 17 4 14 5 15 3 17 5 17 9 14 10 15 5 21 - } - $c create polygon $pts -tag knight -offset 8 \ - -fill black -activefill "#600000" + # On X11 we cannot reliably tell if the ♞ glyph is available + # so just use a polygon + set pts { + 2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16 + 2 17 4 14 5 15 3 17 5 17 9 14 10 15 5 21 + } + $c create polygon $pts -tag knight -offset 8 \ + -fill black -activefill "#600000" set scaleFactor [expr {$tk::scalingPct / 100.0}] $c scale knight 0 0 $scaleFactor $scaleFactor } @@ -248,7 +248,7 @@ proc CreateGUI {} { } grid $dlg.tf - - - - - -sticky ew if {[info exists ::widgetDemo]} { - grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew + grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew } grid rowconfigure $dlg 0 -weight 1 diff --git a/library/demos/labelframe.tcl b/library/demos/labelframe.tcl index 08e8a23..0f400ed 100644 --- a/library/demos/labelframe.tcl +++ b/library/demos/labelframe.tcl @@ -40,7 +40,7 @@ grid $w.f -row 0 -column 0 -pady 2m -padx 2m foreach value {1 2 3 4} { radiobutton $w.f.b$value -text "This is value $value" \ - -variable lfdummy -value $value + -variable lfdummy -value $value pack $w.f.b$value -side top -fill x -pady 1.5p } @@ -49,18 +49,18 @@ foreach value {1 2 3 4} { proc lfEnableButtons {w} { foreach child [winfo children $w] { - if {$child == "$w.cb"} continue - if {$::lfdummy2} { - $child configure -state normal - } else { - $child configure -state disabled - } + if {$child == "$w.cb"} continue + if {$::lfdummy2} { + $child configure -state normal + } else { + $child configure -state disabled + } } } labelframe $w.f2 -pady 1.5p -padx 1.5p checkbutton $w.f2.cb -text "Use this option." -variable lfdummy2 \ - -command "lfEnableButtons $w.f2" -padx 0 + -command "lfEnableButtons $w.f2" -padx 0 $w.f2 configure -labelwidget $w.f2.cb grid $w.f2 -row 0 -column 1 -pady 2m -padx 2m diff --git a/library/demos/mac_styles.tcl b/library/demos/mac_styles.tcl index 3fff03c..1d1b6d1 100644 --- a/library/demos/mac_styles.tcl +++ b/library/demos/mac_styles.tcl @@ -123,7 +123,7 @@ pack [ttk::radiobutton $radio.r2 -text "Radio 2" -variable .radioVar -value 2] - set triangle [ttk::checkbutton $buttonFrame.triangle -style Item -variable TriangleVar] bind $triangle <Button-1> {toggleTriangle %W} set bonjour [ttk::button $buttonFrame.bonjour -style ImageButton -text Bonjour \ - -image {bonjour pressed bonjour1}] + -image {bonjour pressed bonjour1}] set feather [ttk::button $buttonFrame.feather -style ImageButton -text Tk \ -image {tkfeather pressed tkfeather1}] set gradient [ttk::frame $buttonFrame.gradient] @@ -245,16 +245,16 @@ if { [wm attributes $w -isdark] } { } proc beLight {f w} { wm attributes $w -appearance aqua - $f.dark state !selected - $f.light state selected - after 10 $f.light state !hover + # A small delay is needed for the appearance change to complete. + after 10 [list $f.dark state !selected] + after 10 [list $f.light state selected] } proc beDark {f w} { wm attributes $w -appearance darkaqua - $f.light state !selected - $f.dark state selected - after 10 $f.dark state !hover + # A small delay is needed for the appearance change to complete. + after 10 [list $f.light state !selected] + after 10 [list $f.dark state selected] } $w.notebook add $appearanceFrame -text "Appearance" diff --git a/library/demos/mac_wm.tcl b/library/demos/mac_wm.tcl index 105c12c..eba4f03 100644 --- a/library/demos/mac_wm.tcl +++ b/library/demos/mac_wm.tcl @@ -46,23 +46,23 @@ proc launch {name windowInfo class} { # titled if {$class == "nswindow"} { ttk::checkbutton $f.stylemask.titled -text titled -variable $name.titled \ - -command [list setbit $name $f.stylemask.titled titled] + -command [list setbit $name $f.stylemask.titled titled] $f.stylemask.titled state selected grid $f.stylemask.titled -row 0 -column 0 -sticky w } # closable ttk::checkbutton $f.stylemask.closable -text closable -variable $name.closable \ - -command [list setbit $name $f.stylemask.closable closable] + -command [list setbit $name $f.stylemask.closable closable] $f.stylemask.closable state selected grid $f.stylemask.closable -row 1 -column 0 -sticky w # miniaturizableable ttk::checkbutton $f.stylemask.miniaturizable -text miniaturizable \ -variable $name.miniaturizable \ - -command [list setbit $name $f.stylemask.miniaturizable miniaturizable] + -command [list setbit $name $f.stylemask.miniaturizable miniaturizable] if {$class == "nswindow"} { - $f.stylemask.miniaturizable state selected + $f.stylemask.miniaturizable state selected } else { - $f.stylemask.miniaturizable state !alternate + $f.stylemask.miniaturizable state !alternate } grid $f.stylemask.miniaturizable -row 2 -column 0 -sticky w # resizable @@ -124,10 +124,10 @@ proc setbit {win cb bitname} { set bits [wm attributes $win -stylemask] set index [lsearch $bits $bitname] if {$index >= 0 && !$state} { - set bits [lreplace $bits $index $index] + set bits [lreplace $bits $index $index] } if {$index < 0 && $state} { - lappend bits $bitname + lappend bits $bitname } wm attributes $win -stylemask $bits } @@ -192,8 +192,8 @@ proc launchModernWindow {} { frame .mod.left -width 220 -height 400 -background systemWindowBackgroundColor catch { font create leftFont -family .AppleSystemUIFont -size 11 - font create rightFont -family .AppleSystemUIFont -size 16 - font create codeFont -family Courier -size 16 + font create rightFont -family .AppleSystemUIFont -size 16 + font create codeFont -family Courier -size 16 } grid [ttk::label .mod.left.spacer -padding {220 30 0 0}] -row 0 -column 0 grid [ttk::radiobutton .mod.left.about -text About -style SidebarButton \ diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl index a60a00f..5335490 100644 --- a/library/demos/mclist.tcl +++ b/library/demos/mclist.tcl @@ -157,14 +157,14 @@ proc SortBy {tree col direction} { set mclistGrid 0 proc tglGrid {} { if {$::mclistGrid} { - .mclist.tree configure -stripe 1 - foreach col [.mclist.tree cget -columns] { - .mclist.tree column $col -separator 1 - } + .mclist.tree configure -stripe 1 + foreach col [.mclist.tree cget -columns] { + .mclist.tree column $col -separator 1 + } } else { - .mclist.tree configure -stripe 0 - foreach col [.mclist.tree cget -columns] { - .mclist.tree column $col -separator 0 - } + .mclist.tree configure -stripe 0 + foreach col [.mclist.tree cget -columns] { + .mclist.tree column $col -separator 0 + } } } diff --git a/library/demos/nl.msg b/library/demos/nl.msg index dc80c15..60ca47c 100644 --- a/library/demos/nl.msg +++ b/library/demos/nl.msg @@ -66,15 +66,15 @@ ::msgcat::mcset nl "Listboxes" "Keuzelijsten" ::msgcat::mcset nl "The 50 states" "De 50 staten van de VS" ::msgcat::mcset nl "Colors: change the color scheme for the application" \ - "Kleuren: verander het kleurenschema voor het programma" + "Kleuren: verander het kleurenschema voor het programma" ::msgcat::mcset nl "A collection of famous and infamous sayings" \ - "Beroemde en beruchte citaten en gezegden" + "Beroemde en beruchte citaten en gezegden" ::msgcat::mcset nl "Entries and Spin-boxes" "Invulvelden en Spinboxen" ::msgcat::mcset nl "Entries without scrollbars" "Invulvelden zonder schuifbalk" ::msgcat::mcset nl "Entries with scrollbars" "Invulvelden met schuifbalk" ::msgcat::mcset nl "Validated entries and password fields" \ - "Invulvelden met controle of wachtwoorden" + "Invulvelden met controle of wachtwoorden" ::msgcat::mcset nl "Spin-boxes" "Spinboxen" ::msgcat::mcset nl "Simple Rolodex-like form" "Simpel kaartsysteem" diff --git a/library/demos/states.tcl b/library/demos/states.tcl index 4e14fd5..e25ee81 100644 --- a/library/demos/states.tcl +++ b/library/demos/states.tcl @@ -23,9 +23,9 @@ labelframe $w.justif -text Justification foreach c {Left Center Right} { set lower [string tolower $c] radiobutton $w.justif.$lower -text $c -variable just \ - -relief flat -value $lower -anchor w \ - -command "$w.frame.list configure -justify \$just" \ - -tristatevalue "multi" + -relief flat -value $lower -anchor w \ + -command "$w.frame.list configure -justify \$just" \ + -tristatevalue "multi" pack $w.justif.$lower -side left -pady 1.5p -fill x } pack $w.justif diff --git a/library/demos/systray.tcl b/library/demos/systray.tcl index 6954143..3406f0c 100644 --- a/library/demos/systray.tcl +++ b/library/demos/systray.tcl @@ -26,10 +26,10 @@ $iconmenu add command -label "Status" -command { puts "status icon clicked" } $iconmenu add command -label "Exit" -command exit pack [label $w.l -text "This demonstration showcases - the tk systray and tk sysnotify commands. - Running this demo creates the systray icon. - Clicking the buttons below modifies and destroys the icon - and displays the notification."] + the tk systray and tk sysnotify commands. + Running this demo creates the systray icon. + Clicking the buttons below modifies and destroys the icon + and displays the notification."] image create photo book -data R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAACwAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IMQCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc0yv+DVSEUuFxIAOw== @@ -45,20 +45,20 @@ pack $w.f $w.b3 -fill x -padx 3p -pady 3p proc create {} { global trayIconExists if {$trayIconExists} { - tk_messageBox -message "Systray icon already exists" - return + tk_messageBox -message "Systray icon already exists" + return } tk systray create -image book -text "Systray sample" \ - -button1 {puts "foo"} \ - -button3 {tk_popup $iconmenu [winfo pointerx .] [winfo pointery .]} + -button1 {puts "foo"} \ + -button3 {tk_popup $iconmenu [winfo pointerx .] [winfo pointery .]} set trayIconExists true } proc modify {} { global trayIconExists if {!$trayIconExists} { - tk_messageBox -message "Please create systray icon first" - return + tk_messageBox -message "Please create systray icon first" + return } image create photo page -data R0lGODlhCwAPAKIAAP//////AMDAwICAgAAA/wAAAAAAAAAAACwAAAAACwAPAAADMzi6CzAugiAgDGE68aB0RXgRJBFVX0SNpQlUWfahQOvSsgrX7eZJMlQMWBEYj8iQchlKAAA7 tk systray configure -image page @@ -70,8 +70,8 @@ proc modify {} { proc notify {} { global trayIconExists if {!$trayIconExists} { - tk_messageBox -message "Please create systray icon first" - return + tk_messageBox -message "Please create systray icon first" + return } tk sysnotify "Alert" "This is an alert" } @@ -79,8 +79,8 @@ proc notify {} { proc remove {} { global trayIconExists if {!$trayIconExists} { - tk_messageBox -message "Systray icon was already destroyed" - return + tk_messageBox -message "Systray icon was already destroyed" + return } tk systray destroy set trayIconExists false diff --git a/library/demos/text.tcl b/library/demos/text.tcl index 130a4a5..189cb2d 100644 --- a/library/demos/text.tcl +++ b/library/demos/text.tcl @@ -30,11 +30,11 @@ pack $w.text -expand yes -fill both # TIP 324 Demo: [tk fontchooser] proc fontchooserToggle {} { tk fontchooser [expr {[tk fontchooser configure -visible] ? - "hide" : "show"}] + "hide" : "show"}] } proc fontchooserVisibility {w} { $w configure -text [expr {[tk fontchooser configure -visible] ? - "Hide Font Dialog" : "Show Font Dialog"}] + "Hide Font Dialog" : "Show Font Dialog"}] } proc fontchooserFocus {w} { tk fontchooser configure -font [$w cget -font] \ diff --git a/library/demos/ttkpane.tcl b/library/demos/ttkpane.tcl index 749f940..87c7b6d 100644 --- a/library/demos/ttkpane.tcl +++ b/library/demos/ttkpane.tcl @@ -67,7 +67,7 @@ set testzones { set zones {} foreach zone $testzones { if {![catch {clock format 0 -timezone $zone}]} { - lappend zones $zone + lappend zones $zone } } if {[llength $zones] < 2} { lappend zones -0200 :GMT :UTC +0200 } diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index b974456..ddfc30e 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -353,6 +353,6 @@ proc textSplitWindow {textW} { $w.pane add $t -stretch always } } else { - return + return } } diff --git a/library/demos/widget b/library/demos/widget index d2dff1c..5e3373c 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -31,26 +31,26 @@ if {[tk windowingsystem] eq "x11"} { if {"defaultFont" ni [font names]} { # TIP #145 defines some standard named fonts if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} { - # FIX ME: the following technique of cloning the font to copy it works - # fine but means that if the system font is changed by Tk - # cannot update the copied font. font alias might be useful - # here -- or fix the app to use TkDefaultFont etc. - font create mainFont {*}[font configure TkDefaultFont] - font create fixedFont {*}[font configure TkFixedFont] - font create boldFont {*}[font configure TkDefaultFont] -weight bold - font create titleFont {*}[font configure TkDefaultFont] -weight bold - font create statusFont {*}[font configure TkDefaultFont] - font create varsFont {*}[font configure TkDefaultFont] + # FIX ME: the following technique of cloning the font to copy it works + # fine but means that if the system font is changed by Tk + # cannot update the copied font. font alias might be useful + # here -- or fix the app to use TkDefaultFont etc. + font create mainFont {*}[font configure TkDefaultFont] + font create fixedFont {*}[font configure TkFixedFont] + font create boldFont {*}[font configure TkDefaultFont] -weight bold + font create titleFont {*}[font configure TkDefaultFont] -weight bold + font create statusFont {*}[font configure TkDefaultFont] + font create varsFont {*}[font configure TkDefaultFont] if {[tk windowingsystem] eq "aqua"} { font configure titleFont -size 17 } } else { - font create mainFont -family Helvetica -size 12 - font create fixedFont -family Courier -size 10 - font create boldFont -family Helvetica -size 12 -weight bold - font create titleFont -family Helvetica -size 18 -weight bold - font create statusFont -family Helvetica -size 10 - font create varsFont -family Helvetica -size 14 + font create mainFont -family Helvetica -size 12 + font create fixedFont -family Courier -size 10 + font create boldFont -family Helvetica -size 12 -weight bold + font create titleFont -family Helvetica -size 18 -weight bold + font create statusFont -family Helvetica -size 10 + font create varsFont -family Helvetica -size 14 } } @@ -142,7 +142,7 @@ if {[tk windowingsystem] ne "aqua"} { -command {tkAboutDialog} -accelerator [mc "<F1>"] bind . <F1> {tkAboutDialog} .menuBar.file add sep - if {[string match win* [tk windowingsystem]]} { + if {[tk windowingsystem] eq "win32"} { # Windows doesn't usually have a Meta key ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ -command {exit} -accelerator [mc "Ctrl+Q"] diff --git a/library/demos/windowicons.tcl b/library/demos/windowicons.tcl index 0c1e0c0..13c514d 100644 --- a/library/demos/windowicons.tcl +++ b/library/demos/windowicons.tcl @@ -99,7 +99,7 @@ image create photo icon2 icon2 copy icon -zoom [expr {$tk::scalingPct / 100}] pack [button $w.i -text "Set Window Icon to Globe" -image icon2 \ - -compound top -command {wm iconphoto . icon}] -fill x -padx 3p + -compound top -command {wm iconphoto . icon}] -fill x -padx 3p pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge . 3}] \ -fill x -padx 3p pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge . 11}] \ diff --git a/library/dialog.tcl b/library/dialog.tcl index 16ba128..f5a771a 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -149,9 +149,9 @@ proc ::tk_dialog {w title text bitmap default args} { # 7. Set a grab and claim the focus too. if {$default >= 0} { - set focus $w.button$default + set focus $w.button$default } else { - set focus $w + set focus $w } tk::SetFocusGrab $w $focus diff --git a/library/entry.tcl b/library/entry.tcl index b344a63..bdd9fda 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -308,12 +308,12 @@ proc ::tk::EntryEndIMEMarkedText {w} { bind Entry <Button-2> { if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x + ::tk::EntryScanMark %W %x } } bind Entry <B2-Motion> { if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x + ::tk::EntryScanDrag %W %x } } @@ -415,7 +415,7 @@ proc ::tk::EntryMouseSelect {w x} { } } if {$Priv(mouseMoved)} { - $w icursor $cur + $w icursor $cur } update idletasks } diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 3aaa6b7..c53d1d6 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -14,10 +14,10 @@ namespace eval ::tk::fontchooser { set S(W) .__tk__fontchooser set S(fonts) [lsort -dictionary -unique [font families]] set S(styles) [list \ - [::msgcat::mc Regular] \ - [::msgcat::mc Italic] \ - [::msgcat::mc Bold] \ - [::msgcat::mc {Bold Italic}] \ + [::msgcat::mc Regular] \ + [::msgcat::mc Italic] \ + [::msgcat::mc Bold] \ + [::msgcat::mc {Bold Italic}] \ ] set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} set S(strike) 0 @@ -34,7 +34,7 @@ proc ::tk::fontchooser::Canonical {} { variable S foreach style $S(styles) { - lappend S(styles,lcase) [string tolower $style] + lappend S(styles,lcase) [string tolower $style] } set S(sizes,lcase) $S(sizes) set S(sampletext) [::msgcat::mc "AaBbYyZz01"] @@ -42,11 +42,11 @@ proc ::tk::fontchooser::Canonical {} { # Canonical versions of font families, styles, etc. for easier searching set S(fonts,lcase) {} foreach font $S(fonts) { - lappend S(fonts,lcase) [string tolower $font] + lappend S(fonts,lcase) [string tolower $font] } set S(styles,lcase) {} foreach style $S(styles) { - lappend S(styles,lcase) [string tolower $style] + lappend S(styles,lcase) [string tolower $style] } } @@ -56,18 +56,18 @@ proc ::tk::fontchooser::Setup {} { Canonical ::ttk::style layout FontchooserFrame { - Entry.field -sticky news -border true -children { - FontchooserFrame.padding -sticky news - } + Entry.field -sticky news -border true -children { + FontchooserFrame.padding -sticky news + } } bind [winfo class .] <<ThemeChanged>> \ - [list +ttk::style layout FontchooserFrame \ - [ttk::style layout FontchooserFrame]] + [list +ttk::style layout FontchooserFrame \ + [ttk::style layout FontchooserFrame]] namespace ensemble create -map { - show ::tk::fontchooser::Show - hide ::tk::fontchooser::Hide - configure ::tk::fontchooser::Configure + show ::tk::fontchooser::Show + hide ::tk::fontchooser::Hide + configure ::tk::fontchooser::Configure } } ::tk::fontchooser::Setup @@ -78,19 +78,19 @@ proc ::tk::fontchooser::Show {} { Canonical if {![winfo exists $S(W)]} { - Create - wm transient $S(W) [winfo toplevel $S(-parent)] - tk::PlaceWindow $S(W) widget $S(-parent) - if {[string trim $S(-title)] eq ""} { - wm title $S(W) [::msgcat::mc "Font"] - } else { - wm title $S(W) $S(-title) - } + Create + wm transient $S(W) [winfo toplevel $S(-parent)] + tk::PlaceWindow $S(W) widget $S(-parent) + if {[string trim $S(-title)] eq ""} { + wm title $S(W) [::msgcat::mc "Font"] + } else { + wm title $S(W) $S(-title) + } } set S(fonts) [lsort -dictionary -unique [font families]] set S(fonts,lcase) {} foreach font $S(fonts) { - lappend S(fonts,lcase) [string tolower $font] + lappend S(fonts,lcase) [string tolower $font] } wm deiconify $S(W) } @@ -104,57 +104,57 @@ proc ::tk::fontchooser::Configure {args} { variable S set specs { - {-parent "" "" . } - {-title "" "" ""} - {-font "" "" ""} - {-command "" "" ""} + {-parent "" "" . } + {-title "" "" ""} + {-font "" "" ""} + {-command "" "" ""} } if {[llength $args] == 0} { - set result {} - foreach spec $specs { - foreach {name xx yy default} $spec break - lappend result $name \ - [expr {[info exists S($name)] ? $S($name) : $default}] - } - lappend result -visible \ - [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] - return $result + set result {} + foreach spec $specs { + foreach {name xx yy default} $spec break + lappend result $name \ + [expr {[info exists S($name)] ? $S($name) : $default}] + } + lappend result -visible \ + [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + return $result } if {[llength $args] == 1} { - set option [lindex $args 0] - if {[string equal $option "-visible"]} { - return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] - } elseif {[info exists S($option)]} { - return $S($option) - } - return -code error -errorcode [list TK LOOKUP OPTION $option] \ - "bad option \"$option\": must be\ - -command, -font, -parent, -title or -visible" + set option [lindex $args 0] + if {[string equal $option "-visible"]} { + return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + } elseif {[info exists S($option)]} { + return $S($option) + } + return -code error -errorcode [list TK LOOKUP OPTION $option] \ + "bad option \"$option\": must be\ + -command, -font, -parent, -title or -visible" } set cache [dict create -parent $S(-parent) -title $S(-title) \ - -font $S(-font) -command $S(-command)] + -font $S(-font) -command $S(-command)] set r [tclParseConfigSpec [namespace which -variable S] $specs DONTSETDEFAULTS $args] if {![winfo exists $S(-parent)]} { - set code [list TK LOOKUP WINDOW $S(-parent)] - set err "bad window path name \"$S(-parent)\"" - array set S $cache - return -code error -errorcode $code $err + set code [list TK LOOKUP WINDOW $S(-parent)] + set err "bad window path name \"$S(-parent)\"" + array set S $cache + return -code error -errorcode $code $err } if {[winfo exists $S(W)]} { - if {{-font} in $args} { - Init $S(-font) - event generate $S(-parent) <<TkFontchooserFontChanged>> - } - - if {[string trim $S(-title)] eq {}} { - wm title $S(W) [::msgcat::mc Font] - } else { - wm title $S(W) $S(-title) - } - $S(W).ok configure -state $S(nstate) - $S(W).apply configure -state $S(nstate) + if {{-font} in $args} { + Init $S(-font) + event generate $S(-parent) <<TkFontchooserFontChanged>> + } + + if {[string trim $S(-title)] eq {}} { + wm title $S(W) [::msgcat::mc Font] + } else { + wm title $S(W) $S(-title) + } + $S(W).ok configure -state $S(nstate) + $S(W).apply configure -state $S(nstate) } return $r } @@ -163,144 +163,144 @@ proc ::tk::fontchooser::Create {} { variable S set windowName __tk__fontchooser if {$S(-parent) eq "."} { - set S(W) .$windowName + set S(W) .$windowName } else { - set S(W) $S(-parent).$windowName + set S(W) $S(-parent).$windowName } # Now build the dialog if {![winfo exists $S(W)]} { - toplevel $S(W) -class TkFontDialog - if {[package provide tcltest] ne {}} { - set ::tk_dialog $S(W) - } - wm withdraw $S(W) - wm title $S(W) $S(-title) - wm transient $S(W) [winfo toplevel $S(-parent)] - - set outer [::ttk::frame $S(W).outer -padding {7.5p 7.5p}] - ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"] - ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"] - ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] - ttk::entry $S(W).efont -width 18 \ - -textvariable [namespace which -variable S](font) - ttk::entry $S(W).estyle -width 10 \ - -textvariable [namespace which -variable S](style) - ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \ - -width 3 -validate key -validatecommand {regexp -- {^-*[0-9]*$} %P} - - ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](fonts) - ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](styles) - ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \ - -selectmode browse -activestyle none \ - -listvariable [namespace which -variable S](sizes) - - set WE $S(W).effects - ::ttk::labelframe $WE -text [::msgcat::mc "Effects"] - ::tk::AmpWidget ::ttk::checkbutton $WE.strike \ - -variable [namespace which -variable S](strike) \ - -text [::msgcat::mc "Stri&keout"] \ - -command [namespace code [list Click strike]] - ::tk::AmpWidget ::ttk::checkbutton $WE.under \ - -variable [namespace which -variable S](under) \ - -text [::msgcat::mc "&Underline"] \ - -command [namespace code [list Click under]] - - set bbox [::ttk::frame $S(W).bbox] - ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\ - -command [namespace code [list Done 1]] - ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \ - -command [namespace code [list Done 0]] - ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \ - -command [namespace code [list Apply]] - wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]] - - # Calculate minimum sizes - ttk::scrollbar $S(W).tmpvs - set scroll_width [winfo reqwidth $S(W).tmpvs] - destroy $S(W).tmpvs - set minsize(gap) [::tk::ScaleNum 10] - set minsize(bbox) [winfo reqwidth $S(W).ok] - set minsize(fonts) \ - [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] - set minsize(styles) \ - [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}] - set minsize(sizes) \ - [expr {[font measure TkDefaultFont "-99"] + $scroll_width}] - set min [expr {$minsize(gap) * 4}] - foreach {what width} [array get minsize] { - incr min $width - } - wm minsize $S(W) $min [::tk::ScaleNum 260] - - bind $S(W) <Return> [namespace code [list Done 1]] - bind $S(W) <Escape> [namespace code [list Done 0]] - bind $S(W) <Map> [namespace code [list Visibility %W 1]] - bind $S(W) <Unmap> [namespace code [list Visibility %W 0]] - bind $S(W) <Destroy> [namespace code [list Visibility %W 0]] - bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]] - bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]] - bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]] - bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A] - bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont] - bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle] - bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize] - bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]] - bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke] - bind $WE.under <<AltUnderlined>> [list $WE.under invoke] - - set WS $S(W).sample - ::ttk::labelframe $WS -text [::msgcat::mc "Sample"] - ::ttk::label $WS.sample -relief sunken -anchor center \ - -textvariable [namespace which -variable S](sampletext) - set S(sample) $WS.sample - grid $WS.sample -sticky news -padx 4.5p -pady 3p - grid rowconfigure $WS 0 -weight 1 - grid columnconfigure $WS 0 -weight 1 - grid propagate $WS 0 - - grid $S(W).ok -in $bbox -sticky new -pady {0 1.5p} - grid $S(W).cancel -in $bbox -sticky new -pady 1.5p - grid $S(W).apply -in $bbox -sticky new -pady 1.5p - grid columnconfigure $bbox 0 -weight 1 - - grid $WE.strike -sticky w -padx 7.5p - grid $WE.under -sticky w -padx 7.5p -pady {0 22.5p} - grid columnconfigure $WE 1 -weight 1 - - grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w - grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew - grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news - grid $WE x $WS - - x ^ -in $outer -sticky news -pady {11p 22.5p} - grid configure $bbox -sticky n - grid rowconfigure $outer 2 -weight 1 - grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) - grid columnconfigure $outer {0 2 4} -weight 1 - grid columnconfigure $outer 0 -minsize $minsize(fonts) - grid columnconfigure $outer 2 -minsize $minsize(styles) - grid columnconfigure $outer 4 -minsize $minsize(sizes) - grid columnconfigure $outer 6 -minsize $minsize(bbox) - - grid $outer -sticky news - grid rowconfigure $S(W) 0 -weight 1 - grid columnconfigure $S(W) 0 -weight 1 - - Init $S(-font) - - trace add variable [namespace which -variable S](size) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](style) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](font) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](strike) \ - write [namespace code [list Tracer]] - trace add variable [namespace which -variable S](under) \ - write [namespace code [list Tracer]] + toplevel $S(W) -class TkFontDialog + if {[package provide tcltest] ne {}} { + set ::tk_dialog $S(W) + } + wm withdraw $S(W) + wm title $S(W) $S(-title) + wm transient $S(W) [winfo toplevel $S(-parent)] + + set outer [::ttk::frame $S(W).outer -padding {7.5p 7.5p}] + ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"] + ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"] + ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] + ttk::entry $S(W).efont -width 18 \ + -textvariable [namespace which -variable S](font) + ttk::entry $S(W).estyle -width 10 \ + -textvariable [namespace which -variable S](style) + ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \ + -width 3 -validate key -validatecommand {regexp -- {^-*[0-9]*$} %P} + + ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](fonts) + ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](styles) + ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](sizes) + + set WE $S(W).effects + ::ttk::labelframe $WE -text [::msgcat::mc "Effects"] + ::tk::AmpWidget ::ttk::checkbutton $WE.strike \ + -variable [namespace which -variable S](strike) \ + -text [::msgcat::mc "Stri&keout"] \ + -command [namespace code [list Click strike]] + ::tk::AmpWidget ::ttk::checkbutton $WE.under \ + -variable [namespace which -variable S](under) \ + -text [::msgcat::mc "&Underline"] \ + -command [namespace code [list Click under]] + + set bbox [::ttk::frame $S(W).bbox] + ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\ + -command [namespace code [list Done 1]] + ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \ + -command [namespace code [list Done 0]] + ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \ + -command [namespace code [list Apply]] + wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]] + + # Calculate minimum sizes + ttk::scrollbar $S(W).tmpvs + set scroll_width [winfo reqwidth $S(W).tmpvs] + destroy $S(W).tmpvs + set minsize(gap) [::tk::ScaleNum 10] + set minsize(bbox) [winfo reqwidth $S(W).ok] + set minsize(fonts) \ + [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] + set minsize(styles) \ + [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}] + set minsize(sizes) \ + [expr {[font measure TkDefaultFont "-99"] + $scroll_width}] + set min [expr {$minsize(gap) * 4}] + foreach {what width} [array get minsize] { + incr min $width + } + wm minsize $S(W) $min [::tk::ScaleNum 260] + + bind $S(W) <Return> [namespace code [list Done 1]] + bind $S(W) <Escape> [namespace code [list Done 0]] + bind $S(W) <Map> [namespace code [list Visibility %W 1]] + bind $S(W) <Unmap> [namespace code [list Visibility %W 0]] + bind $S(W) <Destroy> [namespace code [list Visibility %W 0]] + bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]] + bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]] + bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]] + bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A] + bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont] + bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle] + bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize] + bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]] + bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke] + bind $WE.under <<AltUnderlined>> [list $WE.under invoke] + + set WS $S(W).sample + ::ttk::labelframe $WS -text [::msgcat::mc "Sample"] + ::ttk::label $WS.sample -relief sunken -anchor center \ + -textvariable [namespace which -variable S](sampletext) + set S(sample) $WS.sample + grid $WS.sample -sticky news -padx 4.5p -pady 3p + grid rowconfigure $WS 0 -weight 1 + grid columnconfigure $WS 0 -weight 1 + grid propagate $WS 0 + + grid $S(W).ok -in $bbox -sticky new -pady {0 1.5p} + grid $S(W).cancel -in $bbox -sticky new -pady 1.5p + grid $S(W).apply -in $bbox -sticky new -pady 1.5p + grid columnconfigure $bbox 0 -weight 1 + + grid $WE.strike -sticky w -padx 7.5p + grid $WE.under -sticky w -padx 7.5p -pady {0 22.5p} + grid columnconfigure $WE 1 -weight 1 + + grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w + grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew + grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news + grid $WE x $WS - - x ^ -in $outer -sticky news -pady {11p 22.5p} + grid configure $bbox -sticky n + grid rowconfigure $outer 2 -weight 1 + grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) + grid columnconfigure $outer {0 2 4} -weight 1 + grid columnconfigure $outer 0 -minsize $minsize(fonts) + grid columnconfigure $outer 2 -minsize $minsize(styles) + grid columnconfigure $outer 4 -minsize $minsize(sizes) + grid columnconfigure $outer 6 -minsize $minsize(bbox) + + grid $outer -sticky news + grid rowconfigure $S(W) 0 -weight 1 + grid columnconfigure $S(W) 0 -weight 1 + + Init $S(-font) + + trace add variable [namespace which -variable S](size) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](style) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](font) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](strike) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](under) \ + write [namespace code [list Tracer]] } Init $S(-font) @@ -319,7 +319,7 @@ proc ::tk::fontchooser::Done {ok} { variable S if {! $ok} { - set S(result) "" + set S(result) "" } trace remove variable S(size) write [namespace code [list Tracer]] trace remove variable S(style) write [namespace code [list Tracer]] @@ -328,10 +328,10 @@ proc ::tk::fontchooser::Done {ok} { trace remove variable S(under) write [namespace code [list Tracer]] destroy $S(W) if {$ok} { - if {$S(-command) ne ""} { - uplevel #0 $S(-command) [list $S(result)] - } - event generate $S(-parent) <<TkFontchooserFontChanged>> + if {$S(-command) ne ""} { + uplevel #0 $S(-command) [list $S(result)] + } + event generate $S(-parent) <<TkFontchooserFontChanged>> } } @@ -343,9 +343,9 @@ proc ::tk::fontchooser::Done {ok} { proc ::tk::fontchooser::Apply {} { variable S if {$S(-command) ne ""} { - if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} { - ::bgerror $err - } + if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} { + ::bgerror $err + } } event generate $S(-parent) <<TkFontchooserFontChanged>> } @@ -361,25 +361,25 @@ proc ::tk::fontchooser::Init {{defaultFont ""}} { variable S if {$S(first) || $defaultFont ne ""} { - Canonical - if {$defaultFont eq ""} { - set defaultFont [[entry .___e] cget -font] - destroy .___e - } - array set F [font actual $defaultFont] - set S(font) $F(-family) - set S(style) [::msgcat::mc "Regular"] - set S(size) $F(-size) - set S(strike) $F(-overstrike) - set S(under) $F(-underline) - if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { - set S(style) [::msgcat::mc "Bold Italic"] - } elseif {$F(-weight) eq "bold"} { - set S(style) [::msgcat::mc "Bold"] - } elseif {$F(-slant) eq "italic"} { - set S(style) [::msgcat::mc "Italic"] - } - set S(first) 0 + Canonical + if {$defaultFont eq ""} { + set defaultFont [[entry .___e] cget -font] + destroy .___e + } + array set F [font actual $defaultFont] + set S(font) $F(-family) + set S(style) [::msgcat::mc "Regular"] + set S(size) $F(-size) + set S(strike) $F(-overstrike) + set S(under) $F(-underline) + if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { + set S(style) [::msgcat::mc "Bold Italic"] + } elseif {$F(-weight) eq "bold"} { + set S(style) [::msgcat::mc "Bold"] + } elseif {$F(-slant) eq "italic"} { + set S(style) [::msgcat::mc "Italic"] + } + set S(first) 0 } } @@ -393,11 +393,11 @@ proc ::tk::fontchooser::Init {{defaultFont ""}} { proc ::tk::fontchooser::Click {who} { variable S if {$who eq "font"} { - set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]] + set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]] } elseif {$who eq "style"} { - set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]] + set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]] } elseif {$who eq "size"} { - set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]] + set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]] } } @@ -412,38 +412,38 @@ proc ::tk::fontchooser::Tracer {var1 var2 op} { variable S # We don't need to process strike and under if {$var2 ni [list strike under]} { - # Make selection in listbox - set value [string tolower $S($var2)] - $S(W).l${var2}s selection clear 0 end - set n [lsearch -exact $S(${var2}s,lcase) $value] - $S(W).l${var2}s selection set $n - if {$n >= 0} { - set S($var2) [lindex $S(${var2}s) $n] - $S(W).e$var2 icursor end - $S(W).e$var2 selection clear - if {[set i [lsearch $S(bad) $var2]] >= 0} { - set S(bad) [lreplace $S(bad) $i $i] - } - } else { - # No match, try prefix - set n [lsearch -glob $S(${var2}s,lcase) "$value*"] - if {$var2 ne "size" || !([regexp -- {^(-[0-9]+|[0-9]+)$} $value] && $value >= -4096 && $value <= 4096)} { - if {[lsearch $S(bad) $var2] < 0} { - lappend S(bad) $var2 - } - } else { - if {[set i [lsearch $S(bad) $var2]] >= 0} { - set S(bad) [lreplace $S(bad) $i $i] - } - } - } - $S(W).l${var2}s see $n + # Make selection in listbox + set value [string tolower $S($var2)] + $S(W).l${var2}s selection clear 0 end + set n [lsearch -exact $S(${var2}s,lcase) $value] + $S(W).l${var2}s selection set $n + if {$n >= 0} { + set S($var2) [lindex $S(${var2}s) $n] + $S(W).e$var2 icursor end + $S(W).e$var2 selection clear + if {[set i [lsearch $S(bad) $var2]] >= 0} { + set S(bad) [lreplace $S(bad) $i $i] + } + } else { + # No match, try prefix + set n [lsearch -glob $S(${var2}s,lcase) "$value*"] + if {$var2 ne "size" || !([regexp -- {^(-[0-9]+|[0-9]+)$} $value] && $value >= -4096 && $value <= 4096)} { + if {[lsearch $S(bad) $var2] < 0} { + lappend S(bad) $var2 + } + } else { + if {[set i [lsearch $S(bad) $var2]] >= 0} { + set S(bad) [lreplace $S(bad) $i $i] + } + } + } + $S(W).l${var2}s see $n } if {[llength $S(bad)] == 0} { - set S(nstate) normal - Update + set S(nstate) normal + Update } else { - set S(nstate) disabled + set S(nstate) disabled } $S(W).ok configure -state $S(nstate) $S(W).apply configure -state $S(nstate) @@ -458,19 +458,19 @@ proc ::tk::fontchooser::Update {} { set S(result) [list $S(font) $S(size)] if {$S(style) eq [::msgcat::mc "Bold"]} { - lappend S(result) bold + lappend S(result) bold } if {$S(style) eq [::msgcat::mc "Italic"]} { - lappend S(result) italic + lappend S(result) italic } if {$S(style) eq [::msgcat::mc "Bold Italic"]} { - lappend S(result) bold italic + lappend S(result) bold italic } if {$S(strike)} { - lappend S(result) overstrike + lappend S(result) overstrike } if {$S(under)} { - lappend S(result) underline + lappend S(result) underline } $S(sample) configure -font $S(result) @@ -484,7 +484,7 @@ proc ::tk::fontchooser::Update {} { proc ::tk::fontchooser::Visibility {w visible} { variable S if {$w eq $S(W)} { - event generate $S(-parent) <<TkFontchooserVisibility>> + event generate $S(-parent) <<TkFontchooserVisibility>> } } @@ -496,17 +496,17 @@ proc ::tk::fontchooser::Visibility {w visible} { proc ::tk::fontchooser::ttk_slistbox {w args} { set f [ttk::frame $w -style FontchooserFrame -padding 1.5p] if {[catch { - listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args - ttk::scrollbar $f.vs -command [list $f.list yview] - $f.list configure -yscrollcommand [list $f.vs set] - grid $f.list $f.vs -sticky news - grid rowconfigure $f 0 -weight 1 - grid columnconfigure $f 0 -weight 1 - interp hide {} $w - interp alias {} $w {} $f.list + listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args + ttk::scrollbar $f.vs -command [list $f.list yview] + $f.list configure -yscrollcommand [list $f.vs set] + grid $f.list $f.vs -sticky news + grid rowconfigure $f 0 -weight 1 + grid columnconfigure $f 0 -weight 1 + interp hide {} $w + interp alias {} $w {} $f.list } err opt]} { - destroy $f - return -options $opt $err + destroy $f + return -options $opt $err } return $w } diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl index fd249a0..5dc6f5a 100644 --- a/library/iconbadges.tcl +++ b/library/iconbadges.tcl @@ -219,9 +219,8 @@ if {[tk windowingsystem] eq "x11"} { return -code error "can't use \"$::tk::icons::base_icon($win)\" as iconphoto: not a photo image" } - if {!([string is integer $badgenumber] && $badgenumber > 0) - && [string match $badgenumber "!"] == 0 - && $badgenumber ne ""} { + if {!([string is integer -strict $badgenumber] && $badgenumber > 0) + && $badgenumber ne "!" && $badgenumber ne ""} { return -code error "can't use \"$badgenumber\" as icon badge" } @@ -244,7 +243,7 @@ if {[tk windowingsystem] eq "x11"} { set badge ::tk::icons::9plus-badge } - } + } overlay copy $::tk::icons::base_icon($win) overlay copy $badge -from 0 0 18 18 -to 18 0 diff --git a/library/iconlist.tcl b/library/iconlist.tcl index efcd63b..f0c5362 100644 --- a/library/iconlist.tcl +++ b/library/iconlist.tcl @@ -453,9 +453,9 @@ package require tk bind $canvas <Return> [namespace code {my ReturnKey}] bind $canvas <Key> [namespace code {my KeyPress %A}] bind $canvas <Alt-Key> {# nothing} - bind $canvas <Meta-Key> {# nothing} - bind $canvas <Control-Key> {# nothing} - bind $canvas <Command-Key> {# nothing} + bind $canvas <Meta-Key> {# nothing} + bind $canvas <Control-Key> {# nothing} + bind $canvas <Command-Key> {# nothing} bind $canvas <Fn-Key> {# nothing} bind $canvas <FocusIn> [namespace code {my FocusIn}] diff --git a/library/listbox.tcl b/library/listbox.tcl index d611801..a86f273 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -14,7 +14,7 @@ # tk::Priv elements used in this file: # # afterId - Token returned by "after" for autoscanning. -# listboxPrev - The last element to be selected or deselected +# listboxPrev - The last element to be selected or deselected # during a selection operation. # listboxSelection - All of the items that were selected before the # current selection operation (such as a mouse @@ -163,7 +163,7 @@ bind Listbox <<SelectAll>> { bind Listbox <<SelectNone>> { if {[%W cget -selectmode] ne "browse"} { %W selection clear 0 end - tk::FireListboxSelectEvent %W + tk::FireListboxSelectEvent %W } } @@ -188,15 +188,14 @@ bind Listbox <Shift-Option-MouseWheel> { tk::MouseWheel %W x %D -12.0 units } bind Listbox <TouchpadScroll> { - if {%# %% 5 != 0} { - return - } - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { - %W xview scroll [expr {-$deltaX}] units - } - if {$deltaY != 0} { - %W yview scroll [expr {-$deltaY}] units + if {%# %% 5 == 0} { + lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) + if {$tk::Priv(deltaX) != 0} { + %W xview scroll [expr {-$tk::Priv(deltaX)}] units + } + if {$tk::Priv(deltaY) != 0} { + %W yview scroll [expr {-$tk::Priv(deltaY)}] units + } } } @@ -443,7 +442,7 @@ proc ::tk::ListboxDataExtend {w el} { if {$mode eq "extended"} { $w activate $el $w see $el - if {[$w selection includes anchor]} { + if {[$w selection includes anchor]} { ListboxMotion $w $el } } elseif {$mode eq "multiple"} { @@ -518,6 +517,6 @@ proc ::tk::ListboxSelectAll w { proc ::tk::FireListboxSelectEvent w { if {[$w cget -state] eq "normal"} { - event generate $w <<ListboxSelect>> + event generate $w <<ListboxSelect>> } } diff --git a/library/menu.tcl b/library/menu.tcl index 57dc963..50319ef 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -408,7 +408,7 @@ proc ::tk::MenuUnpost menu { # # Arguments: # w - The name of the menubutton widget. -# upDown - "down" means button 1 is pressed, "up" means +# upDown - "down" means button 1 is pressed, "up" means # it isn't. # rootx, rooty - Coordinates of mouse, in (virtual?) root window. @@ -1199,18 +1199,18 @@ if {[tk windowingsystem] eq "aqua"} { incr x [expr {[winfo width $button]}] } default { # flush - if {[$button cget -indicatoron]} { - if {$cx ne ""} { - set x [expr {$cx - [winfo reqwidth $menu] / 2}] - set l [font metrics [$menu cget -font] -linespace] - set y [expr {$cy - $l/2 - 2}] - } else { - incr x [expr {([winfo width $button] - \ + if {[$button cget -indicatoron]} { + if {$cx ne ""} { + set x [expr {$cx - [winfo reqwidth $menu] / 2}] + set l [font metrics [$menu cget -font] -linespace] + set y [expr {$cy - $l/2 - 2}] + } else { + incr x [expr {([winfo width $button] - \ [winfo reqwidth $menu])/ 2}] - } - } else { - incr y [winfo height $button] - } + } + } else { + incr y [winfo height $button] + } } } PostOverPoint $menu $x $y $entry diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 3757019..cb39a1c 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -147,11 +147,11 @@ proc ::tk::MessageBox {args} { set specs { {-default "" "" ""} {-detail "" "" ""} - {-icon "" "" "info"} - {-message "" "" ""} - {-parent "" "" .} - {-title "" "" " "} - {-type "" "" "ok"} + {-icon "" "" "info"} + {-message "" "" ""} + {-parent "" "" .} + {-title "" "" " "} + {-type "" "" "ok"} } tclParseConfigSpec $w $specs "" $args @@ -297,7 +297,7 @@ proc ::tk::MessageBox {args} { if {$windowingsystem eq "aqua"} { ::tk::unsupported::MacWindowStyle style $w moveableModal {} } elseif {$windowingsystem eq "x11"} { - wm attributes $w -type dialog + wm attributes $w -type dialog } ttk::frame $w.bot @@ -325,18 +325,18 @@ proc ::tk::MessageBox {args} { label $w.bitmap -bitmap $data(-icon) -background $bg } else { switch $data(-icon) { - error { - ttk::label $w.bitmap -image ::tk::icons::error - } - info { - ttk::label $w.bitmap -image ::tk::icons::information - } - question { - ttk::label $w.bitmap -image ::tk::icons::question - } - default { - ttk::label $w.bitmap -image ::tk::icons::warning - } + error { + ttk::label $w.bitmap -image ::tk::icons::error + } + info { + ttk::label $w.bitmap -image ::tk::icons::information + } + question { + ttk::label $w.bitmap -image ::tk::icons::question + } + default { + ttk::label $w.bitmap -image ::tk::icons::warning + } } } } @@ -382,16 +382,16 @@ proc ::tk::MessageBox {args} { } grid configure $w.$name -pady 7 } - incr i + incr i # create the binding for the key accelerator, based on the underline # - # set underIdx [$w.$name cget -under] - # if {$underIdx >= 0} { - # set key [string index [$w.$name cget -text] $underIdx] - # bind $w <Alt-[string tolower $key]> [list $w.$name invoke] - # bind $w <Alt-[string toupper $key]> [list $w.$name invoke] - # } + # set underIdx [$w.$name cget -under] + # if {$underIdx >= 0} { + # set key [string index [$w.$name cget -text] $underIdx] + # bind $w <Alt-[string tolower $key]> [list $w.$name invoke] + # bind $w <Alt-[string toupper $key]> [list $w.$name invoke] + # } } bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A] diff --git a/library/msgs/el.msg b/library/msgs/el.msg index 0336326..3a669b3 100644 --- a/library/msgs/el.msg +++ b/library/msgs/el.msg @@ -21,17 +21,17 @@ namespace eval ::tk { ::msgcat::mcset el "Delete" "Διαγραφή" ::msgcat::mcset el "Details >>" "Λεπτομέρειες >>" ::msgcat::mcset el "Directory \"%1\$s\" does not exist." \ - "Ο κατάλογος \"%1\$s\" δεν υπάρχει." + "Ο κατάλογος \"%1\$s\" δεν υπάρχει." ::msgcat::mcset el "&Directory:" "&Κατάλογος:" ::msgcat::mcset el "Error: %1\$s" "Λάθος: %1\$s" ::msgcat::mcset el "Exit" "Έξοδος" ::msgcat::mcset el \ - "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \ - "Το αρχείο \"%1\$s\" ήδη υπάρχει.\nΘέλετε να επικαλυφθεί;" + "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \ + "Το αρχείο \"%1\$s\" ήδη υπάρχει.\nΘέλετε να επικαλυφθεί;" ::msgcat::mcset el "File \"%1\$s\" already exists.\n\n" \ - "Το αρχείο \"%1\$s\" ήδη υπάρχει.\n\n" + "Το αρχείο \"%1\$s\" ήδη υπάρχει.\n\n" ::msgcat::mcset el "File \"%1\$s\" does not exist." \ - "Το αρχείο \"%1\$s\" δεν υπάρχει." + "Το αρχείο \"%1\$s\" δεν υπάρχει." ::msgcat::mcset el "File &name:" "Ό&νομα αρχείου:" ::msgcat::mcset el "File &names:" "Ό&νομα αρχείων:" ::msgcat::mcset el "Files of &type:" "Αρχεία του &τύπου:" @@ -43,7 +43,7 @@ namespace eval ::tk { ::msgcat::mcset el "Hide Console" "Απόκρυψη κονσόλας" ::msgcat::mcset el "&Ignore" "Αγνόηση" ::msgcat::mcset el "Invalid file name \"%1\$s\"." \ - "Άκυρο όνομα αρχείου \"%1\$s\"." + "Άκυρο όνομα αρχείου \"%1\$s\"." ::msgcat::mcset el "Log Files" "Αρχεία Καταγραφής" ::msgcat::mcset el "&No" "Όχι" ::msgcat::mcset el "&OK" "Εντάξει" @@ -52,19 +52,19 @@ namespace eval ::tk { ::msgcat::mcset el "Open" "Άνοιγμα" ::msgcat::mcset el "&Open" "Άνοιγμα" ::msgcat::mcset el "Open Multiple Files" \ - "Άνοιγμα πολλαπλών αρχείων" + "Άνοιγμα πολλαπλών αρχείων" ::msgcat::mcset el "P&aste" "Επικόλληση" ::msgcat::mcset el "Quit" "Έξοδος" ::msgcat::mcset el "&Red" "Κόκκινο" ::msgcat::mcset el "Replace existing file?" \ - "Επικάλυψη υπάρχοντος αρχείου;" + "Επικάλυψη υπάρχοντος αρχείου;" ::msgcat::mcset el "&Retry" "Προσπάθησε ξανά" ::msgcat::mcset el "&Save" "Αποθήκευση" ::msgcat::mcset el "Save As" "Αποθήκευση σαν" ::msgcat::mcset el "Save To Log" "Αποθήκευση στο αρχείο καταγραφής" ::msgcat::mcset el "Select Log File" "Επιλογή αρχείου καταγραφής" ::msgcat::mcset el "Select a file to source" \ - "Επιλέξτε αρχείο για εκτέλεση" + "Επιλέξτε αρχείο για εκτέλεση" ::msgcat::mcset el "&Selection:" "Επιλογή:" ::msgcat::mcset el "Skip Messages" "Αποφυγήμηνυμάτων" ::msgcat::mcset el "&Source..." "Εκτέλεση..." diff --git a/library/palette.tcl b/library/palette.tcl index 90b499b..43dccc5 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -189,6 +189,9 @@ proc ::tk_setPalette {args} { # which contains color information. Each element # is named after a widget configuration option, and # each value is the value for that option. +# Return Value: +# A list of commands which can be run to update +# the defaults database when exec'ed. proc ::tk::RecolorTree {w colors} { upvar $colors c @@ -200,11 +203,14 @@ proc ::tk::RecolorTree {w colors} { foreach dbOption [array names c] { set option -[string tolower $dbOption] set class [string replace $dbOption 0 0 [string toupper \ - [string index $dbOption 0]]] + [string index $dbOption 0]]] + # Make sure this option is valid for this window. if {![catch {$w configure $option} value]} { - # if the option database has a preference for this - # dbOption, then use it, otherwise use the defaults - # for the widget. + # Update the option for this window. + $w configure $option $c($dbOption) + # Retrieve a default value for this option. First check + # the option database. If it is not in the database use + # the value for the temporary prototype widget. set defaultcolor [option get $w $dbOption $class] if {$defaultcolor eq "" || \ ([info exists prototype] && \ @@ -214,16 +220,15 @@ proc ::tk::RecolorTree {w colors} { if {$defaultcolor ne ""} { set defaultcolor [winfo rgb . $defaultcolor] } - set chosencolor [lindex $value 4] - if {$chosencolor ne ""} { - set chosencolor [winfo rgb . $chosencolor] + # If the color requested for this option differs from + # the default, append a command to update the default. + set requestcolor [lindex $value 4] + if {$requestcolor ne ""} { + set requestcolor [winfo rgb . $requestcolor] } - if {[string match $defaultcolor $chosencolor]} { - # Change the option database so that future windows will get - # the same colors. + if {![string match $defaultcolor $requestcolor]} { append result ";\noption add [list \ *[winfo class $w].$dbOption $c($dbOption) 60]" - $w configure $option $c($dbOption) } } } @@ -245,19 +250,19 @@ proc ::tk::RecolorTree {w colors} { proc ::tk::Darken {color percent} { if {$percent < 0} { - return #000000 + return #000000 } elseif {$percent > 200} { - return #ffffff + return #ffffff } elseif {$percent <= 100} { - lassign [winfo rgb . $color] r g b - set r [expr {($r/256)*$percent/100}] - set g [expr {($g/256)*$percent/100}] - set b [expr {($b/256)*$percent/100}] + lassign [winfo rgb . $color] r g b + set r [expr {($r/256)*$percent/100}] + set g [expr {($g/256)*$percent/100}] + set b [expr {($b/256)*$percent/100}] } elseif {$percent > 100} { - lassign [winfo rgb . $color] r g b - set r [expr {255 - ((65535-$r)/256)*(200-$percent)/100}] - set g [expr {255 - ((65535-$g)/256)*(200-$percent)/100}] - set b [expr {255 - ((65535-$b)/256)*(200-$percent)/100}] + lassign [winfo rgb . $color] r g b + set r [expr {255 - ((65535-$r)/256)*(200-$percent)/100}] + set g [expr {255 - ((65535-$g)/256)*(200-$percent)/100}] + set b [expr {255 - ((65535-$b)/256)*(200-$percent)/100}] } return [format #%02x%02x%02x $r $g $b] } diff --git a/library/panedwindow.tcl b/library/panedwindow.tcl index d3dfabc..4dfd671 100644 --- a/library/panedwindow.tcl +++ b/library/panedwindow.tcl @@ -188,7 +188,7 @@ proc ::tk::panedwindow::Cursor {w} { proc ::tk::panedwindow::Leave {w} { variable ::tk::Priv if {[info exists Priv($w,panecursor)]} { - $w configure -cursor $Priv($w,panecursor) - unset Priv($w,panecursor) + $w configure -cursor $Priv($w,panecursor) + unset Priv($w,panecursor) } } diff --git a/library/print.tcl b/library/print.tcl index 1a7f710..76cf16f 100644 --- a/library/print.tcl +++ b/library/print.tcl @@ -76,7 +76,7 @@ namespace eval ::tk::print { #Next, set values. Some are taken from the printer, #some are sane defaults. - if {[info exists printer_name] && $printer_name ne ""} { + if {[info exists printer_name] && $printer_name ne ""} { set printargs(hDC) $printer_name set printargs(pw) $paper_width set printargs(pl) $paper_height @@ -652,271 +652,606 @@ namespace eval ::tk::print { _init_print_canvas } #end win32 procedures +} + +# Begin X11 procedures. They depends on Cups being installed. +# X11 procedures abstracts print management with a "cups" ensemble command + +# cups defaultprinter returns the default printer +# cups getprinters returns a dictionary of printers along +# with printer info +# cups print $printer $data ?$options? +# print the data (binary) on a given printer +# with the provided (supported) options: +# -colormode -copies -format -margins +# -media -nup -orientation +# -prettyprint -title -tzoom + +# Some output configuration that on other platforms is managed through +# the printer driver/dialog is configured through the canvas postscript command. +if {[tk windowingsystem] eq "x11"} { + if {[info commands ::tk::print::cups] eq ""} { + namespace eval ::tk::print::cups { + # Pure Tcl cups ensemble command implementation + variable pcache + } + + proc ::tk::print::cups::defaultprinter {} { + set default {} + regexp {: ([^[:space:]]+)$} [exec lpstat -d] _ default + return $default + } + + proc ::tk::print::cups::getprinters {} { + variable pcache + # Test for existence of lpstat command to obtain the list of + # printers. + # Return an error if not found. + set res {} + try { + set printers [lsort -unique [split [exec lpstat -e] \n]] + foreach printer $printers { + set options [Parseoptions [exec lpoptions -p $printer]] + dict set res $printer $options + } + } trap {POSIX ENOENT} {e o} { + # no such command in PATH + set cmd [lindex [dict get $o -errorstack ] 1 2] + return -code error "Unable to obtain the list of printers.\ + Command \"$cmd\" not found.\ + Please install the CUPS package for your system." + } trap {CHILDSTATUS} {} { + # command returns a non-0 exit status. Wrong print system? + set cmd [lindex [dict get $o -errorstack ] 1 2] + return -code error "Command \"$cmd\" return with errors" + } + return [set pcache $res] + } + + # Parseoptions + # Parse lpoptions -d output. It has three forms + # option-key + # option-key=option-value + # option-key='option value with spaces' + # Arguments: + # data - data to process. + # + proc ::tk::print::cups::Parseoptions {data} { + set res {} + set re {[^ =]+|[^ ]+='[^']+'|[^ ]+=[^ ']+} + foreach tok [regexp -inline -all $re $data] { + lassign [split $tok "="] k v + dict set res $k [string trim $v "'"] + } + return $res + } + + proc ::tk::print::cups::print {printer data args} { + variable pcache + if {$printer ni [dict keys $pcache]} { + return -code error "unknown printer or class \"$printer\"" + } + set title "Tk print job" + set options { + -colormode -copies -format -margins -media -nup -orientation + -prettyprint -title -tzoom + } + while {[llength $args]} { + set opt [tcl::prefix match $options [lpop args 0]] + switch $opt { + -colormode { + set opts {auto monochrome color} + set val [tcl::prefix match $opts [lpop args 0]] + lappend printargs -o print-color-mode=$val + } + -copies { + set val [lpop args 0] + if {![string is integer -strict $val] || + $val < 0 || $val > 100 + } { + # save paper !! + return -code error "copies must be an integer\ + between 0 and 100" + } + lappend printargs -o copies=$val + } + -format { + set opts {auto pdf postscript text} + set val [tcl::prefix match $opts [lpop args 0]] + # lpr uses auto always + } + -margins { + set val [lpop args 0] + if {[llength $val] != 4 || + ![string is integer -strict [lindex $val 0]] || + ![string is integer -strict [lindex $val 1]] || + ![string is integer -strict [lindex $val 2]] || + ![string is integer -strict [lindex $val 3]] + } { + return -code error "margins must be a list of 4\ + integers: top left bottom right" + } + lappend printargs -o page-top=[lindex $val 0] + lappend printargs -o page-left=[lindex $val 1] + lappend printargs -o page-bottom=[lindex $val 2] + lappend printargs -o page-right=[lindex $val 3] + } + -media { + set opts {a4 legal letter} + set val [tcl::prefix match $opts [lpop args 0]] + lappend printargs -o media=$val + } + -nup { + set val [lpop args 0] + if {$val ni {1 2 4 6 9 16}} { + return -code error "number-up must be 1, 2, 4, 6, 9 or\ + 16" + } + lappend printargs -o number-up=$val + } + -orientation { + set opts {portrait landscape} + set val [tcl::prefix match $opts [lpop args 0]] + if {$val eq "landscape"} + lappend printargs -o landscape=true + } + -prettyprint { + lappend printargs -o prettyprint=true + # prettyprint mess with these default values if set + # so we force them. + # these will be overriden if set after this point + if {[lsearch $printargs {cpi=*}] == -1} { + lappend printargs -o cpi=10.0 + lappend printargs -o lpi=6.0 + } + } + -title { + set title [lpop args 0] + } + -tzoom { + set val [lpop args 0] + if {![string is double -strict $val] || + $val < 0.5 || $val > 2.0 + } { + return -code error "text zoom must be a number between\ + 0.5 and 2.0" + } + # CUPS text filter defaults to lpi=6 and cpi=10 + lappend printargs -o cpi=[expr {10.0 / $val}] + lappend printargs -o lpi=[expr {6.0 / $val}] + } + default { + # shouldn't happen + } + } + } + # build our options + lappend printargs -T $title + lappend printargs -P $printer + # open temp file + set fd [file tempfile fname tk_print] + chan configure $fd -translation binary + chan puts $fd $data + chan close $fd + # add -r to automatically delete temp files + exec lpr {*}$printargs -r $fname & + } - #begin X11 procedures + namespace eval ::tk::print::cups { + namespace export defaultprinter getprinters print + namespace ensemble create + } + };# ::tk::print::cups + + namespace eval ::tk::print { + + variable mcmap + set mcmap(media) [dict create \ + [mc "Letter"] letter \ + [mc "Legal"] legal \ + [mc "A4"] a4] + set mcmap(orient) [dict create \ + [mc "Portrait"] portrait \ + [mc "Landscape"] landscape] + set mcmap(color) [dict create \ + [mc "RGB"] color \ + [mc "Grayscale"] gray] + + # available print options + variable optlist + set optlist(printer) {} + set optlist(media) [dict keys $mcmap(media)] + set optlist(orient) [dict keys $mcmap(orient)] + set optlist(color) [dict keys $mcmap(color)] + set optlist(number-up) {1 2 4 6 9 16} - # X11 procedures wrap standard Unix shell commands such as lp/lpr and - # lpstat for printing. Some output configuration that on other platforms - # is managed through the printer driver/dialog is configured through the - # canvas postscript command. + # selected options + variable option + set option(printer) {} + # Initialize with sane defaults. + set option(copies) 1 + set option(media) [mc "A4"] + # Canvas options + set option(orient) [mc "Portrait"] + set option(color) [mc "RGB"] + set option(czoom) 100 + # Text options. + # See libcupsfilter's cfFilterTextToPDF() and cups-filters's texttopdf + # known options: + # prettyprint, wrap, columns, lpi, cpi + set option(number-up) 1 + set option(tzoom) 100; # we derive lpi and cpi from this value + set option(pprint) 0 ; # pretty print + set option(margin-top) 20 ; # ~ 7mm (~ 1/4") + set option(margin-left) 20 ; # ~ 7mm (~ 1/4") + set option(margin-right) 20 ; # ~ 7mm (~ 1/4") + set option(margin-bottom) 20 ; # ~ 7mm (~ 1/4") + + # array to collect printer information + variable pinfo + array set pinfo {} + + # a map for printer state -> human readable message + variable statemap + dict set statemap 3 [mc "Idle"] + dict set statemap 4 [mc "Printing"] + dict set statemap 5 [mc "Printer stopped"] + } - if {[tk windowingsystem] eq "x11"} { - variable printcmd {} + # ttk version of [tk_optionMenu] + # var should be a full qualified varname + proc ::tk::print::ttk_optionMenu {w var args} { + ttk::menubutton $w -textvariable $var -menu $w.menu + menu $w.menu + foreach option $args { + $w.menu add command \ + -label $option \ + -command [list set $var $option] + } + # return the same value as tk_optionMenu + return $w.menu + } - # print options + # _setprintenv + # Set the print environtment - list of printers, state and options. + # Arguments: + # none. + # + proc ::tk::print::_setprintenv {} { + variable option variable optlist + variable pinfo + set optlist(printer) {} - set optlist(paper) [list [mc "Letter"] [mc "Legal"] [mc "A4"]] - set optlist(orient) [list [mc "Portrait"] [mc "Landscape"]] - set optlist(color) [list [mc "Grayscale"] [mc "RGB"]] - set optlist(zoom) {100 90 80 70 60 50 40 30 20 10} + dict for {printer options} [cups getprinters] { + lappend optlist(printer) $printer + set pinfo($printer) $options + } - # selected options - variable sel - array set sel { - printer {} - copies {} - paper {} - orient {} - color {} - zoom {} + # It's an error to not have any printer configured + if {[llength $optlist(printer)] == 0} { + return -code error "No installed printers found.\ + Please check or update your CUPS installation." } + # If no printer is selected, check for the default one + # If none found, use the first one from the list + if {$option(printer) eq ""} { + set option(printer) [cups defaultprinter] + if {$option(printer) eq ""} { + set option(printer) [lindex $optlist(printer) 0] + } + } + } + + # _print + # Main printer dialog. + # Select printer, set options, and fire print command. + # Arguments: + # w - widget with contents to print. + # + proc ::tk::print::_print {w} { + variable optlist + variable option + variable pinfo + variable statemap + # default values for dialog widgets option add *Printdialog*TLabel.anchor e option add *Printdialog*TMenubutton.Menu.tearOff 0 option add *Printdialog*TMenubutton.width 12 option add *Printdialog*TSpinbox.width 12 - # this is tempting to add, but it's better to leave it to user's taste + # this is tempting to add, but it's better to leave it to + # user's taste. # option add *Printdialog*Menu.background snow - # returns the full qualified var name - proc myvar {varname} { - set fqvar [uplevel 1 [list namespace which -variable $varname]] - # assert var existence - if {$fqvar eq ""} { - return -code error "Wrong varname \"$varname\"" - } - return $fqvar - } - - # ttk version of [tk_optionMenu] - # var should be a full qualified varname - proc ttk_optionMenu {w var args} { - ttk::menubutton $w \ - -textvariable $var \ - -menu $w.menu - menu $w.menu - foreach option $args { - $w.menu add command \ - -label $option \ - -command [list set $var $option] - } - # return the same value as tk_optionMenu - return $w.menu - } - - # _setprintenv - # Set the print environtment - print command, and list of printers. - # Arguments: - # none. - - proc _setprintenv {} { - variable printcmd - variable optlist - - #Test for existence of lpstat command to obtain list of printers. Return error - #if not found. - - catch {exec lpstat -a} msg - set notfound "command not found" - if {[string first $notfound $msg] >= 0} { - error "Unable to obtain list of printers. Please install the CUPS package \ - for your system." - return - } - set notfound "No destinations added" - if {[string first $notfound $msg] != -1} { - error "Please check or update your CUPS installation." - return + set class [winfo class $w] + if {$class ni {Text Canvas}} { + return -code error "printing windows of class \"$class\"\ + is not supported" + } + # Should this be called with every invocaton? + # Yes. It allows dynamic discovery of newly added printers + # whithout having to restart the app + _setprintenv + + set p ._print + destroy $p + + # Copy the current values to a dialog's temporary variable. + # This allow us to cancel the dialog discarding any changes + # made to the options + namespace eval dlg {variable option} + array set dlg::option [array get option] + set var [namespace which -variable dlg::option] + + # The toplevel of our dialog + toplevel $p -class Printdialog + place [ttk::frame $p.background] -x 0 -y 0 -relwidth 1.0 -relheight 1.0 + wm title $p [mc "Print"] + wm resizable $p 0 0 + wm attributes $p -type dialog + wm transient $p [winfo toplevel $w] + + # The printer to use + set pf [ttk::frame $p.printerf] + pack $pf -side top -fill x -expand no -padx 9p -pady 9p + + ttk::label $pf.printerl -text "[mc "Printer"]" + set tv [ttk::treeview $pf.prlist -height 5 \ + -columns {printer location state} \ + -show headings \ + -selectmode browse] + $tv configure \ + -yscrollcommand [namespace code [list _scroll $pf.sy]] \ + -xscrollcommand [namespace code [list _scroll $pf.sx]] + ttk::scrollbar $pf.sy -command [list $tv yview] + ttk::scrollbar $pf.sx -command [list $tv xview] -orient horizontal + $tv heading printer -text [mc "Printer"] + $tv heading location -text [mc "Location"] + $tv heading state -text [mc "State"] + $tv column printer -width 200 -stretch 0 + $tv column location -width 100 -stretch 0 + $tv column state -width 250 -stretch 0 + + foreach printer $optlist(printer) { + set location [dict getdef $pinfo($printer) printer-location ""] + set nstate [dict getdef $pinfo($printer) printer-state 0] + set state [dict getdef $statemap $nstate ""] + switch -- $nstate { + 3 - 4 { + set accepting [dict getdef $pinfo($printer) \ + printer-is-accepting-jobs ""] + if {$accepting ne ""} { + append state ". " [mc "Printer is accepting jobs"] + } + } + 5 { + set reason [dict getdef $pinfo($printer) \ + printer-state-reasons ""] + if {$reason ne ""} { + append state ". (" $reason ")" + } + } } - - # Select print command. We prefer lpr, but will fall back to lp if - # necessary. - if {[auto_execok lpr] ne ""} { - set printcmd lpr - } else { - set printcmd lp + set id [$tv insert {} end \ + -values [list $printer $location $state]] + if {$option(printer) eq $printer} { + $tv selection set $id } + } - #Build list of printers - set printers {} - set printdata [exec lpstat -a] - foreach item [split $printdata \n] { - lappend printers [lindex [split $item] 0] - } - # filter out duplicates - set optlist(printer) [lsort -unique $printers] + grid $pf.printerl -sticky w + grid $pf.prlist $pf.sy -sticky news + grid $pf.sx -sticky ew + grid remove $pf.sy $pf.sx + bind $tv <<TreeviewSelect>> [namespace code {_onselect %W}] + + # Start of printing options + set of [ttk::labelframe $p.optionsframe -text [mc "Options"]] + pack $of -fill x -padx 9p -pady {0 9p} -ipadx 2p -ipady 2p + + # COPIES + ttk::label $of.copiesl -text "[mc "Copies"] :" + ttk::spinbox $of.copies -textvariable ${var}(copies) \ + -from 1 -to 1000 + grid $of.copiesl $of.copies -sticky ew -padx 2p -pady 2p + $of.copies state readonly + + # PAPER SIZE + ttk::label $of.medial -text "[mc "Paper"] :" + ttk_optionMenu $of.media ${var}(media) {*}$optlist(media) + grid $of.medial $of.media -sticky ew -padx 2p -pady 2p + + if {$class eq "Canvas"} { + # additional options for Canvas output + # SCALE + ttk::label $of.percentl -text "[mc "Scale"] :" + ttk::spinbox $of.percent -textvariable ${var}(czoom) \ + -from 5 -to 500 -increment 5 + grid $of.percentl $of.percent -sticky ew -padx 2p -pady 2p + $of.percent state readonly + + # ORIENT + ttk::label $of.orientl -text "[mc "Orientation"] :" + ttk_optionMenu $of.orient ${var}(orient) {*}$optlist(orient) + grid $of.orientl $of.orient -sticky ew -padx 2p -pady 2p + + # COLOR + ttk::label $of.colorl -text "[mc "Output"] :" + ttk_optionMenu $of.color ${var}(color) {*}$optlist(color) + grid $of.colorl $of.color -sticky ew -padx 2p -pady 2p + } elseif {$class eq "Text"} { + # additional options for Text output + # NUMBER-UP + ttk::label $of.nupl -text "[mc "Pages per sheet"] :" + ttk_optionMenu $of.nup ${var}(number-up) {*}$optlist(number-up) + grid $of.nupl $of.nup -sticky ew -padx 2p -pady 2p + + # TEXT SCALE + ttk::label $of.tzooml -text "[mc "Text scale"] :" + ttk::spinbox $of.tzoom -textvariable ${var}(tzoom) \ + -from 50 -to 200 -increment 5 + grid $of.tzooml $of.tzoom -sticky ew -padx 2p -pady 2p + $of.tzoom state readonly + + # PRETTY PRINT (banner on top) + ttk::checkbutton $of.pprint -onvalue 1 -offvalue 0 \ + -text [mc "Pretty print"] \ + -variable ${var}(pprint) + grid $of.pprint - -sticky ew -padx 2p -pady 2p } - # _print - # Main printer dialog. Select printer, set options, and - # fire print command. - # Arguments: - # w - widget with contents to print. - # + # The buttons frame. + set bf [ttk::frame $p.buttonf] + pack $bf -fill x -expand no -side bottom -padx 9p -pady {0 9p} - proc _print {w} { - # TODO: revise padding - variable optlist - variable sel - - # should this be called with every invocaton? - _setprintenv - if {$sel(printer) eq "" && [llength $optlist(printer)] > 0} { - set sel(printer) [lindex $optlist(printer) 0] - } - - set p ._print - catch {destroy $p} - - # copy the current values to a dialog's temorary variable - # this allow us to cancel the dialog discarding any changes - # made to the options - namespace eval dlg {variable sel} - array set dlg::sel [array get sel] - - # The toplevel of our dialog - toplevel $p -class Printdialog - place [ttk::frame $p.background] -x 0 -y 0 -relwidth 1.0 -relheight 1.0 - wm title $p [mc "Print"] - wm resizable $p 0 0 - wm attributes $p -type dialog - - # The printer to use - set pf [ttk::frame $p.printerf] - pack $pf -side top -fill x -expand no -padx 9p -pady 9p - - ttk::label $pf.printerl -text "[mc "Printer"] :" - ttk::combobox $pf.printer \ - -textvariable [myvar dlg::sel](printer) \ - -state readonly \ - -values $optlist(printer) - pack $pf.printerl -side left -padx {0 4.5p} - pack $pf.printer -side left - - # Start of printing options - set of [ttk::labelframe $p.optionsframe -text [mc "Options"]] - pack $of -fill x -padx 9p -pady {0 9p} -ipadx 2p -ipady 2p - - # COPIES - ttk::label $of.copiesl -text "[mc "Copies"] :" - ttk::spinbox $of.copies -from 1 -to 1000 \ - -textvariable [myvar dlg::sel](copies) - grid $of.copiesl $of.copies -sticky ew -padx 2p -pady 2p - - # PAPER SIZE - ttk::label $of.paperl -text "[mc "Paper"] :" - ttk_optionMenu $of.paper [myvar dlg::sel](paper) {*}$optlist(paper) - grid $of.paperl $of.paper -sticky ew -padx 2p -pady 2p - - # additional options for canvas output - if {[winfo class $w] eq "Canvas"} { - # SCALE - ttk::label $of.percentl -text "[mc "Scale"] :" - ttk_optionMenu $of.percent [myvar dlg::sel](zoom) {*}$optlist(zoom) - grid $of.percentl $of.percent -sticky ew -padx 2p -pady 2p - - # ORIENT - ttk::label $of.orientl -text "[mc "Orientation"] :" - ttk_optionMenu $of.orient [myvar dlg::sel](orient) {*}$optlist(orient) - grid $of.orientl $of.orient -sticky ew -padx 2p -pady 2p - - # COLOR - ttk::label $of.colorl -text "[mc "Output"] :" - ttk_optionMenu $of.color [myvar dlg::sel](color) {*}$optlist(color) - grid $of.colorl $of.color -sticky ew -padx 2p -pady 2p - } - - # The buttons frame. - set bf [ttk::frame $p.buttonf] - pack $bf -fill x -expand no -side bottom -padx 9p -pady {0 9p} - - ttk::button $bf.print -text [mc "Print"] \ - -command [namespace code [list _runprint $w $p]] - ttk::button $bf.cancel -text [mc "Cancel"] \ - -command [namespace code [list _cancel $p]] - pack $bf.print -side right - pack $bf.cancel -side right -padx {0 4.5p} - #Center the window as a dialog. - ::tk::PlaceWindow $p - } - - proc _cancel {p} { - namespace delete dlg - destroy $p - } - - # _runprint - - # Execute the print command--print the file. - # Arguments: - # w - widget with contents to print. - # - proc _runprint {w p} { - variable printcmd - variable sel + ttk::button $bf.print -text [mc "Print"] \ + -command [namespace code [list _runprint $w $class $p]] + ttk::button $bf.cancel -text [mc "Cancel"] \ + -command [list destroy $p] + pack $bf.print -side right + pack $bf.cancel -side right -padx {0 4.5p} - # copy the values back from the dialog - array set sel [array get dlg::sel] - namespace delete dlg + # cleanup binding + bind $bf <Destroy> [namespace code [list _cleanup $p]] - #First, generate print file. - if {[winfo class $w] eq "Text"} { - set file [makeTempFile tk_text.txt [$w get 1.0 end]] - } + # Center the window as a dialog. + ::tk::PlaceWindow $p + } - if {[winfo class $w] eq "Canvas"} { - if {$sel(color) eq [mc "RGB"]} { - set colormode color - } else { - set colormode gray - } + # _onselect + # Updates the selected printer when treeview selection changes. + # Arguments: + # tv - treeview pathname. + # + proc ::tk::print::_onselect {tv} { + variable dlg::option + set id [$tv selection] + if {$id eq ""} { + # is this even possible? + set option(printer) "" + } else { + set option(printer) [$tv set $id printer] + } + } - if {$sel(orient) eq [mc "Landscape"]} { - set willrotate "1" - } else { - set willrotate "0" - } + # _scroll + # Implements autoscroll for the printers view + # + proc ::tk::print::_scroll {sbar from to} { + if {$from == 0.0 && $to == 1.0} { + grid remove $sbar + } else { + grid $sbar + $sbar set $from $to + } + } - #Scale based on size of widget, not size of paper. - set printwidth [expr {$sel(zoom) / 100.00 * [winfo width $w]}] - set file [makeTempFile tk_canvas.ps] - $w postscript -file $file -colormode $colormode \ - -rotate $willrotate -pagewidth $printwidth - } + # _cleanup + # Perform cleanup when the dialog is destroyed. + # Arguments: + # p - print dialog pathname (not used). + # + proc ::tk::print::_cleanup {p} { + namespace delete dlg + } - #Build list of args to pass to print command. - set printargs {} - if {$printcmd eq "lpr"} { - lappend printargs -P $sel(printer) -# $sel(copies) - } else { - lappend printargs -d $sel(printer) -n $sel(copies) + # _runprint - + # Execute the print command--print the file. + # Arguments: + # w - widget with contents to print. + # class - class of the widget to print (Canvas or Text). + # p - print dialog pathname. + # + proc ::tk::print::_runprint {w class p} { + variable option + variable mcmap + + # copy the values back from the dialog + array set option [array get dlg::option] + + # get (back) name of media from the translated one + set media [dict get $mcmap(media) $option(media)] + set printargs {} + lappend printargs -title "[tk appname]: Tk window $w" + lappend printargs -copies $option(copies) + lappend printargs -media $media + + if {$class eq "Canvas"} { + set colormode [dict get $mcmap(color) $option(color)] + set rotate 0 + if {[dict get $mcmap(orient) $option(orient)] eq "landscape"} { + set rotate 1 } - - # launch the job in the background - after 0 [list exec $printcmd {*}$printargs -o PageSize=$sel(paper) $file] - destroy $p + # Scale based on size of widget, not size of paper. + # TODO: is this correct?? + set printwidth [expr { + $option(czoom) / 100.0 * [winfo width $w] + }] + set data [encoding convertto iso8859-1 [$w postscript \ + -colormode $colormode -rotate $rotate -pagewidth $printwidth]] + } elseif {$class eq "Text"} { + set tzoom [expr {$option(tzoom) / 100.0}] + if {$option(tzoom) != 100} { + lappend printargs -tzoom $tzoom + } + if {$option(pprint)} { + lappend printargs -prettyprint + } + if {$option(number-up) != 1} { + lappend printargs -nup $option(number-up) + } + # these are hardcoded. Should we allow the user to control + # margins? + lappend printargs -margins [list \ + $option(margin-top) $option(margin-left) \ + $option(margin-bottom) $option(margin-right) ] + # get the data in shape. Cupsfilter's text filter wraps lines + # at character level, not words, so we do it by ourselves. + # compute usable page width in inches + set pw [dict get {a4 8.27 legal 8.5 letter 8.5} $media] + set pw [expr { + $pw - ($option(margin-left) + $option(margin-right)) / 72.0 + }] + # set the wrap length at 98% of computed page width in chars + # the 9.8 constant is the product 10.0 (default cpi) * 0.95 + set wl [expr {int( 9.8 * $pw / $tzoom )}] + set data [encoding convertto utf-8 [_wrapLines [$w get 1.0 end] $wl]] } - # Initialize with sane defaults. - set sel(copies) 1 - set sel(paper) [mc "A4"] - set sel(orient) [mc "Portrait"] - set sel(color) [mc "RGB"] - set sel(zoom) 100 + # launch the job in the background + after idle [namespace code \ + [list cups print $option(printer) $data {*}$printargs]] + destroy $p + } + + # _wrapLines - + # wrap long lines into lines of at most length wl at word boundaries + # Arguments: + # str - string to be wrapped + # wl - wrap length + # + proc ::tk::print::_wrapLines {str wl} { + # This is a really simple algorithm: it breaks a line on space or tab + # character, collapsing them only at the breaking point. + # Leading space is left as-is. + # For a full fledged line breaking algorithm see + # Unicode® Standard Annex #14 "Unicode Line Breaking Algorithm" + set res {} + incr wl -1 + set re [format {((?:^|[^[:blank:]]).{0,%d})(?:[[:blank:]]|$)} $wl] + foreach line [split $str \n] { + lappend res {*}[lmap {_ l} [regexp -all -inline -- $re $line] { + set l + }] + } + return [join $res \n] } - #end X11 procedures +} +#end X11 procedures +namespace eval ::tk::print { #begin macOS Aqua procedures if {[tk windowingsystem] eq "aqua"} { # makePDF - diff --git a/library/scale.tcl b/library/scale.tcl index 74d6449..e2b5941 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -143,10 +143,10 @@ proc ::tk::ScaleButtonDown {w x y} { set coords [$w coords] set Priv(deltaX) [expr {$x - [lindex $coords 0]}] set Priv(deltaY) [expr {$y - [lindex $coords 1]}] - switch -exact -- $Priv($w,relief) { - "raised" { $w configure -sliderrelief sunken } - "ridge" { $w configure -sliderrelief groove } - } + switch -exact -- $Priv($w,relief) { + "raised" { $w configure -sliderrelief sunken } + "ridge" { $w configure -sliderrelief groove } + } } } @@ -179,8 +179,8 @@ proc ::tk::ScaleEndDrag {w} { variable ::tk::Priv set Priv(dragging) 0 if {[info exists Priv($w,relief)]} { - $w configure -sliderrelief $Priv($w,relief) - unset Priv($w,relief) + $w configure -sliderrelief $Priv($w,relief) + unset Priv($w,relief) } } @@ -209,8 +209,8 @@ proc ::tk::ScaleIncrement {w dir big repeat} { # the -command script lasts longer than -repeatdelay set clockms [clock milliseconds] if {$repeat eq "again" && - [expr {$clockms - $Priv(clockms)}] > [expr {[$w cget -repeatinterval] * 1.1}]} { - set Priv(clockms) $clockms + [expr {$clockms - $Priv(clockms)}] > [expr {[$w cget -repeatinterval] * 1.1}]} { + set Priv(clockms) $clockms set Priv(afterId) [after [$w cget -repeatinterval] \ [list tk::ScaleIncrement $w $dir $big again]] return @@ -228,20 +228,20 @@ proc ::tk::ScaleIncrement {w dir big repeat} { set inc [$w cget -resolution] } if {([$w cget -from] > [$w cget -to]) ^ ($dir eq "up")} { - if {$inc > 0} { - set inc [expr {-$inc}] - } + if {$inc > 0} { + set inc [expr {-$inc}] + } } else { - if {$inc < 0} { - set inc [expr {-$inc}] - } + if {$inc < 0} { + set inc [expr {-$inc}] + } } # this will run the -command script (if any) during the redrawing # of the scale at idle time $w set [expr {[$w get] + $inc}] if {$repeat eq "again"} { - set Priv(clockms) $clockms + set Priv(clockms) $clockms set Priv(afterId) [after [$w cget -repeatinterval] \ [list tk::ScaleIncrement $w $dir $big again]] } elseif {$repeat eq "initial"} { diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 9e210f6..960eb44 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -145,12 +145,12 @@ bind Scrollbar <Shift-Option-MouseWheel> { tk::ScrollByUnits %W hv %D -12.0 } bind Scrollbar <TouchpadScroll> { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0 && [%W cget -orient] eq "horizontal"} { - tk::ScrollbarScrollByPixels %W h $deltaX + lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) + if {$tk::Priv(deltaX) != 0 && [%W cget -orient] eq "horizontal"} { + tk::ScrollbarScrollByPixels %W h $tk::Priv(deltaX) } - if {$deltaY != 0 && [%W cget -orient] eq "vertical"} { - tk::ScrollbarScrollByPixels %W v $deltaY + if {$tk::Priv(deltaY) != 0 && [%W cget -orient] eq "vertical"} { + tk::ScrollbarScrollByPixels %W v $tk::Priv(deltaY) } } @@ -477,7 +477,7 @@ proc ::tk::ScrollTopBottom {w x y} { proc ::tk::ScrollButton2Down {w x y} { variable ::tk::Priv if {![winfo exists $w]} { - return + return } set element [$w identify $x $y] if {[string match {arrow[12]} $element]} { @@ -493,8 +493,8 @@ proc ::tk::ScrollButton2Down {w x y} { update idletasks if {[winfo exists $w]} { - $w configure -activerelief sunken - $w activate slider - ScrollStartDrag $w $x $y + $w configure -activerelief sunken + $w activate slider + ScrollStartDrag $w $x $y } } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 4303141..54eb709 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -347,19 +347,19 @@ proc ::tk::spinbox::ArrowPress {w x y} { variable ::tk::Priv if {[$w cget -state] ne "disabled" && \ - [string match "button*" $Priv(element)]} { - $w selection element $Priv(element) - set Priv(repeated) 0 - set Priv(relief) [$w cget -$Priv(element)relief] - catch {after cancel $Priv(afterId)} - set delay [$w cget -repeatdelay] - if {$delay > 0} { - set Priv(afterId) [after $delay \ - [list ::tk::spinbox::Invoke $w $Priv(element)]] - } - if {[info exists Priv(outsideElement)]} { - unset Priv(outsideElement) - } + [string match "button*" $Priv(element)]} { + $w selection element $Priv(element) + set Priv(repeated) 0 + set Priv(relief) [$w cget -$Priv(element)relief] + catch {after cancel $Priv(afterId)} + set delay [$w cget -repeatdelay] + if {$delay > 0} { + set Priv(afterId) [after $delay \ + [list ::tk::spinbox::Invoke $w $Priv(element)]] + } + if {[info exists Priv(outsideElement)]} { + unset Priv(outsideElement) + } } } diff --git a/library/systray.tcl b/library/systray.tcl index 56cfbf9..eae3183 100644 --- a/library/systray.tcl +++ b/library/systray.tcl @@ -196,7 +196,7 @@ namespace eval ::tk::sysnotify:: { # Fade the window into view. proc _fadeIn {w} { variable defaults - if {![winfo exists $w]} {return} + if {![winfo exists $w]} {return} if {[set alpha [option get $w alpha ""]] eq ""} { set alpha [dict get $defaults alpha] } @@ -214,7 +214,7 @@ namespace eval ::tk::sysnotify:: { # Fade out and destroy window. proc _fadeOut {w} { - if {![winfo exists $w]} {return} + if {![winfo exists $w]} {return} set before [wm attributes $w -alpha] set new [expr { $before - 0.02 }] wm attributes $w -alpha $new @@ -432,16 +432,16 @@ proc ::tk::systray::_check_options {argsList singleOk} { set len [llength $argsList] while {[llength $argsList] > 0} { - set opt [lindex $argsList 0] - if {![dict exists $_options $opt]} { - tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ + set opt [lindex $argsList 0] + if {![dict exists $_options $opt]} { + tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ "unknown option \"$opt\": must be -image, -text, -button1 or -button3" - } - if {[llength $argsList] == 1 && !($len == 1 && $singleOk)} { - tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ + } + if {[llength $argsList] == 1 && !($len == 1 && $singleOk)} { + tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ "missing value for option \"$opt\"" - } - set argsList [lrange $argsList 2 end] + } + set argsList [lrange $argsList 2 end] } } @@ -479,5 +479,5 @@ proc ::tk::sysnotify::sysnotify {title message} { #Thanks to Christian Gollwitzer for the guidance here namespace ensemble configure tk -map \ [dict merge [namespace ensemble configure tk -map] \ - {systray ::tk::systray sysnotify ::tk::sysnotify::sysnotify}] + {systray ::tk::systray sysnotify ::tk::sysnotify::sysnotify}] diff --git a/library/text.tcl b/library/text.tcl index 15bdef2..2e4417c 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -469,12 +469,12 @@ bind Text <Shift-Option-MouseWheel> { tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels } bind Text <TouchpadScroll> { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { - %W xview scroll [tk::ScaleNum [expr {-$deltaX}]] pixels + lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) + if {$tk::Priv(deltaX) != 0} { + %W xview scroll [tk::ScaleNum [expr {-$tk::Priv(deltaX)}]] pixels } - if {$deltaY != 0} { - %W yview scroll [tk::ScaleNum [expr {-$deltaY}]] pixels + if {$tk::Priv(deltaY) != 0} { + %W yview scroll [tk::ScaleNum [expr {-$tk::Priv(deltaY)}]] pixels } } @@ -498,7 +498,7 @@ proc ::tk::TextClosestGap {w x y} { # [a9cf210a42] to properly handle selecting and moving the mouse # out of the widget. if {$y < [lindex [$w dlineinfo $pos] 1] || - $x - [lindex $bbox 0] < [lindex $bbox 2]/2} { + $x - [lindex $bbox 0] < [lindex $bbox 2]/2} { return $pos } $w index "$pos + 1 char" @@ -552,14 +552,14 @@ proc ::tk::TextButton1 {w x y} { # Arguments: # w - The text window in which the button was pressed. # x - Mouse x position. -# y - Mouse y position. +# y - Mouse y position. set ::tk::Priv(textanchoruid) 0 proc ::tk::TextAnchor {w} { variable Priv if {![info exists Priv(textanchor,$w)]} { - set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)] + set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)] } return $Priv(textanchor,$w) } @@ -665,7 +665,7 @@ proc ::tk::TextKeyExtend {w index} { # # Arguments: # w - The text window. -# x, y - Position of the mouse. +# x, y - Position of the mouse. proc ::tk::TextPasteSelection {w x y} { $w mark set insert [TextClosestGap $w $x $y] @@ -759,9 +759,9 @@ proc ::tk::TextKeySelect {w new} { } $w mark set $anchorname insert } else { - if {[catch {$w index $anchorname}]} { - $w mark set $anchorname insert - } + if {[catch {$w index $anchorname}]} { + $w mark set $anchorname insert + } if {[$w compare $new < $anchorname]} { set first $new set last $anchorname @@ -904,8 +904,8 @@ proc ::tk::TextUpDownLine {w n} { "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"] set Priv(prevPos) $new if {[$w compare $new == "end display lineend"] \ - || [$w compare $new == "insert display linestart"]} { - set Priv(textPosOrig) $new + || [$w compare $new == "insert display linestart"]} { + set Priv(textPosOrig) $new } return $new } @@ -1045,8 +1045,8 @@ proc ::tk_textCopy w { proc ::tk_textCut w { if {![catch {set data [$w get sel.first sel.last]}]} { - # make <<Cut>> an atomic operation on the Undo stack, - # i.e. separate it from other delete operations on either side + # make <<Cut>> an atomic operation on the Undo stack, + # i.e. separate it from other delete operations on either side set oldSeparator [$w cget -autoseparators] if {([$w cget -state] eq "normal") && $oldSeparator} { $w edit separator @@ -1217,9 +1217,9 @@ proc ::tk::TextUndoRedoProcessMarks {w} { # only consider the temporary marks set by an undo/redo action foreach mark [$w mark names] { - if {[string range $mark 0 11] eq "tk::undoMark"} { - lappend undoMarks $mark - } + if {[string range $mark 0 11] eq "tk::undoMark"} { + lappend undoMarks $mark + } } # transform marks into indices @@ -1248,8 +1248,8 @@ proc ::tk::TextUndoRedoProcessMarks {w} { } set Rmarks [lrange $undoMarks $n [llength $undoMarks]] foreach Lmark $Lmarks Rmark $Rmarks { - lappend indices [$w index $Lmark] [$w index $Rmark] - $w mark unset $Lmark $Rmark + lappend indices [$w index $Lmark] [$w index $Rmark] + $w mark unset $Lmark $Rmark } # process ranges to: @@ -1259,36 +1259,36 @@ proc ::tk::TextUndoRedoProcessMarks {w} { set indices {} for {set i 0} {$i < $nUndoMarks} {incr i 2} { - set il1 [lindex $ind $i] - set ir1 [lindex $ind [expr {$i + 1}]] - lappend indices $il1 $ir1 - - for {set j [expr {$i + 2}]} {$j < $nUndoMarks} {incr j 2} { - set il2 [lindex $ind $j] - set ir2 [lindex $ind [expr {$j + 1}]] - - if {[$w compare $il2 > $ir1]} { - # second range starts after the end of first range - # -> further second ranges do not need to be considered - # because ranges were sorted by increasing first index - set j $nUndoMarks - } else { - if {[$w compare $ir2 > $ir1]} { - # second range overlaps first range - # -> merge them into a single range - set indices [lreplace $indices end-1 end] - lappend indices $il1 $ir2 - } else { - # second range is fully included in first range - # -> ignore it - } - # in both cases above, the second range shall be - # trimmed out from the list of ranges - set ind [lreplace $ind $j [expr {$j + 1}]] - incr j -2 - incr nUndoMarks -2 - } - } + set il1 [lindex $ind $i] + set ir1 [lindex $ind [expr {$i + 1}]] + lappend indices $il1 $ir1 + + for {set j [expr {$i + 2}]} {$j < $nUndoMarks} {incr j 2} { + set il2 [lindex $ind $j] + set ir2 [lindex $ind [expr {$j + 1}]] + + if {[$w compare $il2 > $ir1]} { + # second range starts after the end of first range + # -> further second ranges do not need to be considered + # because ranges were sorted by increasing first index + set j $nUndoMarks + } else { + if {[$w compare $ir2 > $ir1]} { + # second range overlaps first range + # -> merge them into a single range + set indices [lreplace $indices end-1 end] + lappend indices $il1 $ir2 + } else { + # second range is fully included in first range + # -> ignore it + } + # in both cases above, the second range shall be + # trimmed out from the list of ranges + set ind [lreplace $ind $j [expr {$j + 1}]] + incr j -2 + incr nUndoMarks -2 + } + } } return $indices diff --git a/library/tk.tcl b/library/tk.tcl index 7741fd0..8bc0ca6 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -11,7 +11,7 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Verify that we have Tk binary and script components from the same release -package require -exact tk 9.0b3 +package require -exact tk 9.0.1 # Create a ::tk namespace namespace eval ::tk { @@ -428,7 +428,7 @@ switch -exact -- [tk windowingsystem] { event add <<Cut>> <Control-x> <Shift-Delete> <Control-Lock-X> event add <<Copy>> <Control-c> <Control-Insert> <Control-Lock-C> event add <<Paste>> <Control-v> <Shift-Insert> <Control-Lock-V> - event add <<Undo>> <Control-z> <Control-Lock-Z> + event add <<Undo>> <Control-z> <Control-Lock-Z> event add <<Redo>> <Control-y> <Control-Lock-Y> event add <<SelectAll>> <Control-/> <Control-a> <Control-Lock-A> diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 39d0f3e..35e4a3c 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -24,7 +24,7 @@ namespace eval ::tk::dialog::file { # Based on Vimix/16/actions/go-up.svg # See https://github.com/vinceliuice/vimix-icon-theme - set updirImageData { + variable updirImageData { <?xml version="1.0" encoding="UTF-8"?> <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> <path d="m7 14v-9l-4 4-1-1 6-6 6 6-1 1-4-4v9z" fill="#000000"/> @@ -45,7 +45,7 @@ namespace eval ::tk::dialog::file { } # Based on https://icons8.com/icon/JXYalxb9XWWd/folder - set folderImageData { + variable folderImageData { <?xml version="1.0" encoding="UTF-8"?> <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> <path d="m0.5 13.5v-12h4.293l2 2h8.707v10z" fill="#59afff"/> @@ -56,7 +56,7 @@ namespace eval ::tk::dialog::file { } # Based on https://icons8.com/icon/mEF_vyjYlnE3/file - set fileImageData { + variable fileImageData { <?xml version="1.0" encoding="UTF-8"?> <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> <path d="m2 1h8l4 4v11h-12z" fill="#808080"/> @@ -650,7 +650,7 @@ proc ::tk::dialog::file::Update {w} { # ::tk::dialog::file::SetPathSilently -- # -# Sets data(selectPath) without invoking the trace procedure +# Sets data(selectPath) without invoking the trace procedure # proc ::tk::dialog::file::SetPathSilently {w path} { upvar ::tk::dialog::file::[winfo name $w] data diff --git a/library/ttk/altTheme.tcl b/library/ttk/altTheme.tcl index 2d1b6b9..1dfb5b2 100644 --- a/library/ttk/altTheme.tcl +++ b/library/ttk/altTheme.tcl @@ -6,12 +6,12 @@ namespace eval ttk::theme::alt { variable colors array set colors { - -frame "#d9d9d9" + -frame "#d9d9d9" -window "#ffffff" -alternate "#f0f0f0" - -darker "#c3c3c3" + -darker "#c3c3c3" -border "#414141" - -activebg "#ececec" + -activebg "#ececec" -disabledfg "#a3a3a3" -selectbg "#4a6984" -selectfg "#ffffff" @@ -21,18 +21,18 @@ namespace eval ttk::theme::alt { ttk::style theme settings alt { ttk::style configure "." \ - -background $colors(-frame) \ - -foreground black \ + -background $colors(-frame) \ + -foreground black \ -troughcolor $colors(-darker) \ -bordercolor $colors(-border) \ - -selectbackground $colors(-selectbg) \ - -selectforeground $colors(-selectfg) \ - -font TkDefaultFont + -selectbackground $colors(-selectbg) \ + -selectforeground $colors(-selectfg) \ + -font TkDefaultFont ttk::style map "." -background \ [list disabled $colors(-frame) active $colors(-activebg)] ttk::style map "." -foreground [list disabled $colors(-disabledfg)] - ttk::style map "." -embossed [list disabled 1] + ttk::style map "." -embossed [list disabled 1] ttk::style configure TButton \ -anchor center -width -11 -padding 0.75p \ @@ -49,12 +49,12 @@ namespace eval ttk::theme::alt { -indicatormargin {0 1.5p 3p 1.5p} -padding 1.5p ttk::style map TCheckbutton -indicatorcolor \ [list pressed $colors(-frame) \ - alternate $colors(-altindicator) \ - disabled $colors(-frame)] + alternate $colors(-altindicator) \ + disabled $colors(-frame)] ttk::style map TRadiobutton -indicatorcolor \ [list pressed $colors(-frame) \ - alternate $colors(-altindicator) \ - disabled $colors(-frame)] + alternate $colors(-altindicator) \ + disabled $colors(-frame)] ttk::style configure TMenubutton \ -width -11 -padding 2.25p -arrowsize 3.75p -relief raised @@ -100,7 +100,8 @@ namespace eval ttk::theme::alt { ttk::style configure Item \ -indicatormargins {1.5p 1.5p 3p 1.5p} ttk::style configure Treeview -background $colors(-window) \ - -stripedbackground $colors(-alternate) -indent 15p + -stripedbackground $colors(-alternate) -indent 15p \ + -focuswidth 1 -focuscolor $colors(-selectbg) ttk::setTreeviewRowHeight ttk::style configure Treeview.Separator \ -background $colors(-alternate) @@ -119,3 +120,34 @@ namespace eval ttk::theme::alt { -barsize 22.5p -thickness 11.25p } } + +# ttk::theme::alt::configureNotebookStyle -- +# +# Sets theme-specific option values for the ttk::notebook style $style and the +# style $style.Tab. Invoked by ::ttk::configureNotebookStyle. + +proc ttk::theme::alt::configureNotebookStyle {style} { + set tabPos [ttk::style lookup $style -tabposition {} nw] + switch -- [string index $tabPos 0] { + n { + ttk::style configure $style -tabmargins {1.5p 1.5p 0.75p 0} + ttk::style map $style.Tab -expand {selected {1.5p 1.5p 0.75p 0}} + } + s { + ttk::style configure $style -tabmargins {1.5p 0 0.75p 1.5p} + ttk::style map $style.Tab -expand {selected {1.5p 0 0.75p 1.5p}} + } + w { + ttk::style configure $style -tabmargins {1.5p 1.5p 0 0.75p} + ttk::style map $style.Tab -expand {selected {1.5p 1.5p 0 0.75p}} + } + e { + ttk::style configure $style -tabmargins {0 1.5p 1.5p 0.75p} + ttk::style map $style.Tab -expand {selected {0 1.5p 1.5p 0.75p}} + } + default { + ttk::style configure $style -tabmargins {1.5p 1.5p 0.75p 0} + ttk::style map $style.Tab -expand {selected {1.5p 1.5p 0.75p 0}} + } + } +} diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl index a631376..dfefbbd 100644 --- a/library/ttk/aquaTheme.tcl +++ b/library/ttk/aquaTheme.tcl @@ -30,8 +30,8 @@ namespace eval ttk::theme::aqua { ttk::style map TButton \ -foreground { pressed white - {alternate !pressed !background} white - disabled systemDisabledControlTextColor} + {alternate !pressed !background} white + disabled systemDisabledControlTextColor} # Menubutton ttk::style configure TMenubutton -anchor center -padding {2 0 0 2} @@ -152,7 +152,7 @@ namespace eval ttk::theme::aqua { ttk::style configure Treeview -rowheight 18 \ -background systemControlBackgroundColor \ -stripedbackground systemControlAlternatingRowColor \ - -foreground systemTextColor \ + -foreground systemTextColor \ -fieldbackground systemTextBackgroundColor ttk::style map Treeview \ -background { diff --git a/library/ttk/button.tcl b/library/ttk/button.tcl index a14a53b..541a0f2 100644 --- a/library/ttk/button.tcl +++ b/library/ttk/button.tcl @@ -18,10 +18,10 @@ namespace eval ttk::button {} -bind TButton <Enter> { %W instate !disabled {%W state active} } +bind TButton <Enter> { %W instate !disabled {%W state active} } bind TButton <Leave> { %W state !active } bind TButton <space> { ttk::button::activate %W } -bind TButton <<Invoke>> { ttk::button::activate %W } +bind TButton <<Invoke>> { ttk::button::activate %W } bind TButton <Button-1> \ { %W instate !disabled { ttk::clickToFocus %W; %W state pressed } } @@ -39,8 +39,8 @@ ttk::copyBindings TButton TRadiobutton # ...plus a few more: -bind TRadiobutton <Up> { ttk::button::RadioTraverse %W -1 } -bind TRadiobutton <Down> { ttk::button::RadioTraverse %W +1 } +bind TRadiobutton <Up> { ttk::button::RadioTraverse %W -1 } +bind TRadiobutton <Down> { ttk::button::RadioTraverse %W +1 } # bind TCheckbutton <+> { %W select } # bind TCheckbutton <minus> { %W deselect } @@ -58,7 +58,7 @@ proc ttk::button::activate {w} { } # RadioTraverse -- up/down keyboard traversal for radiobutton groups. -# Set focus to previous/next radiobutton in a group. +# Set focus to previous/next radiobutton in a group. # A radiobutton group consists of all the radiobuttons with # the same parent and -variable; this is a pretty good heuristic # that works most of the time. diff --git a/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl index be72290..0674b81 100644 --- a/library/ttk/clamTheme.tcl +++ b/library/ttk/clamTheme.tcl @@ -9,13 +9,13 @@ namespace eval ttk::theme::clam { variable colors array set colors { -disabledfg "#999999" - -frame "#dcdad5" - -window "#ffffff" + -frame "#dcdad5" + -window "#ffffff" -dark "#cfcdc8" - -darker "#bab5ab" + -darker "#bab5ab" -darkest "#9e9a91" -lighter "#eeebe7" - -lightest "#ffffff" + -lightest "#ffffff" -selectbg "#4a6984" -selectfg "#ffffff" -altindicator "#5895bc" @@ -115,7 +115,7 @@ namespace eval ttk::theme::clam { ttk::style configure TSpinbox -arrowsize 7.5p -padding {1.5p 0 7.5p 0} ttk::style map TSpinbox \ -background [list readonly $colors(-frame)] \ - -arrowcolor [list disabled $colors(-disabledfg)] \ + -arrowcolor [list disabled $colors(-disabledfg)] \ -bordercolor [list focus $colors(-selectbg)] ttk::style configure TNotebook.Tab -padding {4.5p 1.5p 4.5p 1.5p} @@ -138,7 +138,8 @@ namespace eval ttk::theme::clam { -background [list disabled $colors(-frame)\ selected $colors(-selectbg)] \ -foreground [list disabled $colors(-disabledfg) \ - selected $colors(-selectfg)] + selected $colors(-selectfg)] \ + -bordercolor [list focus $colors(-selectbg)] ttk::style configure TLabelframe \ -labeloutside true -labelmargins {0 0 0 3p} \ @@ -156,3 +157,34 @@ namespace eval ttk::theme::clam { ttk::style configure Sash -sashthickness 4.5p -gripsize 15p } } + +# ttk::theme::clam::configureNotebookStyle -- +# +# Sets theme-specific option values for the ttk::notebook tab style $style.Tab. +# Invoked by ::ttk::configureNotebookStyle. + +proc ttk::theme::clam::configureNotebookStyle {style} { + set tabPos [ttk::style lookup $style -tabposition {} nw] + switch -- [string index $tabPos 0] { + n { + ttk::style configure $style.Tab -padding {4.5p 1.5p 4.5p 1.5p} + ttk::style map $style.Tab -padding {selected {4.5p 3p 4.5p 1.5p}} + } + s { + ttk::style configure $style.Tab -padding {4.5p 1.5p 4.5p 1.5p} + ttk::style map $style.Tab -padding {selected {4.5p 1.5p 4.5p 3p }} + } + w { + ttk::style configure $style.Tab -padding {1.5p 4.5p 1.5p 4.5p} + ttk::style map $style.Tab -padding {selected {3p 4.5p 1.5p 4.5p}} + } + e { + ttk::style configure $style.Tab -padding {1.5p 4.5p 1.5p 4.5p} + ttk::style map $style.Tab -padding {selected {1.5p 4.5p 3p 4.5p}} + } + default { + ttk::style configure $style.Tab -padding {4.5p 1.5p 4.5p 1.5p} + ttk::style map $style.Tab -padding {selected {4.5p 3p 4.5p 1.5p}} + } + } +} diff --git a/library/ttk/classicTheme.tcl b/library/ttk/classicTheme.tcl index 7964034..b65dfac 100644 --- a/library/ttk/classicTheme.tcl +++ b/library/ttk/classicTheme.tcl @@ -123,7 +123,17 @@ namespace eval ttk::theme::classic { # # Toolbar buttons: # - ttk::style configure Toolbutton -padding 1.5p -relief flat -shiftrelief 2 + ttk::style layout Toolbutton { + Toolbutton.focus -children { + Toolbutton.border -children { + Toolbutton.padding -children { + Toolbutton.label + } + } + } + } + ttk::style configure Toolbutton -padding 1.5p -relief flat \ + -shiftrelief 2 -focussolid 1 ttk::style map Toolbutton -relief \ {disabled flat selected sunken pressed sunken active raised} ttk::style map Toolbutton -background \ diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 1b9d4cb..b225277 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -42,13 +42,13 @@ namespace eval ttk::combobox { ttk::copyBindings TEntry TCombobox -bind TCombobox <Down> { ttk::combobox::Post %W } -bind TCombobox <Escape> { ttk::combobox::Unpost %W } +bind TCombobox <Down> { ttk::combobox::Post %W } +bind TCombobox <Escape> { ttk::combobox::Unpost %W } -bind TCombobox <Button-1> { ttk::combobox::Press "" %W %x %y } +bind TCombobox <Button-1> { ttk::combobox::Press "" %W %x %y } bind TCombobox <Shift-Button-1> { ttk::combobox::Press "s" %W %x %y } -bind TCombobox <Double-Button-1> { ttk::combobox::Press "2" %W %x %y } -bind TCombobox <Triple-Button-1> { ttk::combobox::Press "3" %W %x %y } +bind TCombobox <Double-Button-1> { ttk::combobox::Press "2" %W %x %y } +bind TCombobox <Triple-Button-1> { ttk::combobox::Press "3" %W %x %y } bind TCombobox <B1-Motion> { ttk::combobox::Drag %W %x } bind TCombobox <Motion> { ttk::combobox::Motion %W %x %y } @@ -57,13 +57,13 @@ bind TCombobox <Shift-MouseWheel> { # Ignore the event } bind TCombobox <TouchpadScroll> { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) # TouchpadScroll events fire about 60 times per second. - if {$deltaY != 0 && %# %% 15 == 0} { - ttk::combobox::Scroll %W [expr {$deltaY > 0 ? -1 : 1}] + if {$tk::Priv(deltaY) != 0 && %# %% 15 == 0} { + ttk::combobox::Scroll %W [expr {$tk::Priv(deltaY) > 0 ? -1 : 1}] } } -bind TCombobox <<TraverseIn>> { ttk::combobox::TraverseIn %W } +bind TCombobox <<TraverseIn>> { ttk::combobox::TraverseIn %W } ### Combobox listbox bindings. # @@ -129,9 +129,9 @@ proc ttk::combobox::Press {mode w x y} { focus $w if {$State(entryPress)} { switch -- $mode { - s { ttk::entry::Shift-Press $w $x ; # Shift } - 2 { ttk::entry::Select $w $x word ; # Double click} - 3 { ttk::entry::Select $w $x line ; # Triple click } + s { ttk::entry::Shift-Press $w $x ; # Shift } + 2 { ttk::entry::Select $w $x word ; # Double click} + 3 { ttk::entry::Select $w $x line ; # Triple click } "" - default { ttk::entry::Press $w $x } } @@ -158,7 +158,7 @@ proc ttk::combobox::Motion {w x y} { variable State ttk::saveCursor $w State(userConfCursor) [ttk::cursor text] if { [$w identify $x $y] eq "textarea" - && [$w instate {!readonly !disabled}] + && [$w instate {!readonly !disabled}] } { ttk::setCursor $w text } else { @@ -356,7 +356,7 @@ proc ttk::combobox::ConfigureListbox {cb} { set values [$cb cget -values] set current [$cb current] if {$current < 0} { - set current 0 ;# no current entry, highlight first one + set current 0 ;# no current entry, highlight first one } set Values($cb) $values $popdown.l selection clear 0 end @@ -367,10 +367,10 @@ proc ttk::combobox::ConfigureListbox {cb} { if {$height > [$cb cget -height]} { set height [$cb cget -height] grid $popdown.sb - grid configure $popdown.l -padx {1 0} + grid configure $popdown.l -padx {1 0} } else { grid remove $popdown.sb - grid configure $popdown.l -padx 1 + grid configure $popdown.l -padx 1 } $popdown.l configure -height $height } @@ -380,7 +380,7 @@ proc ttk::combobox::ConfigureAquaMenu {cb width} { set values [$cb cget -values] set current [$cb current] if {$current < 0} { - set current 0 ;# no current entry, highlight first one + set current 0 ;# no current entry, highlight first one } $cb.popdown.menu delete 0 end $cb.spacer configure -width [expr {$width - 40}] -height 1 @@ -444,7 +444,7 @@ proc ttk::combobox::AquaPlacePopdown {cb popdown} { set style [$cb cget -style] set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}] foreach var {x y w h} delta $postoffset { - incr $var $delta + incr $var $delta } wm geometry $popdown ${w}x${h}+${x}+${y} return [list $x $y $w $h] diff --git a/library/ttk/cursors.tcl b/library/ttk/cursors.tcl index 9d1e1ae..f185276 100644 --- a/library/ttk/cursors.tcl +++ b/library/ttk/cursors.tcl @@ -47,19 +47,19 @@ namespace eval ttk { none none standard left_ptr - text xterm + text xterm link hand2 crosshair crosshair busy watch forbidden pirate - hresize sb_h_double_arrow - vresize sb_v_double_arrow + hresize sb_h_double_arrow + vresize sb_v_double_arrow - nresize top_side - sresize bottom_side - wresize left_side - eresize right_side + nresize top_side + sresize bottom_side + wresize left_side + eresize right_side nwresize top_left_corner neresize top_right_corner swresize bottom_left_corner @@ -82,13 +82,13 @@ namespace eval ttk { busy wait forbidden no - vresize size_ns - nresize size_ns + vresize size_ns + nresize size_ns sresize size_ns wresize size_we eresize size_we - hresize size_we + hresize size_we nwresize size_nw_se swresize size_ne_sw @@ -101,18 +101,18 @@ namespace eval ttk { "aqua" { array set Cursors { standard arrow - text ibeam - link pointinghand + text ibeam + link pointinghand crosshair crosshair - busy watch + busy watch forbidden notallowed - hresize resizeleftright - vresize resizeupdown - nresize resizeup - sresize resizedown - wresize resizeleft - eresize resizeright + hresize resizeleftright + vresize resizeupdown + nresize resizeup + sresize resizedown + wresize resizeleft + eresize resizeright } } } @@ -138,12 +138,12 @@ proc ttk::cursor {name} { proc ttk::setCursor {w name} { variable Cursors if {[info exists Cursors($name)]} { - set cursorname $Cursors($name) + set cursorname $Cursors($name) } else { - set cursorname $name + set cursorname $name } if {[$w cget -cursor] ne $cursorname} { - $w configure -cursor $cursorname + $w configure -cursor $cursorname } } @@ -157,10 +157,10 @@ proc ttk::setCursor {w name} { proc ttk::saveCursor {w saveVar excludeList} { upvar $saveVar sv if {![info exists sv]} { - set sv [$w cget -cursor] + set sv [$w cget -cursor] } if {[$w cget -cursor] ni $excludeList} { - set sv [$w cget -cursor] + set sv [$w cget -cursor] } } diff --git a/library/ttk/defaults.tcl b/library/ttk/defaults.tcl index 226bd39..3f6320e 100644 --- a/library/ttk/defaults.tcl +++ b/library/ttk/defaults.tcl @@ -10,11 +10,11 @@ namespace eval ttk::theme::default { -foreground "#000000" -window "#ffffff" -alternate "#e8e8e8" - -text "#000000" + -text "#000000" -activebg "#ececec" -selectbg "#4a6984" -selectfg "#ffffff" - -darker "#c3c3c3" + -darker "#c3c3c3" -disabledfg "#a3a3a3" -indicator "#4a6984" -disabledindicator "#a3a3a3" @@ -85,14 +85,14 @@ proc ttk::theme::default::reconfigureDefaultTheme {} { ttk::style theme settings default { ttk::style configure "." \ - -borderwidth 1 \ - -background $colors(-frame) \ - -foreground $colors(-foreground) \ - -troughcolor $colors(-darker) \ - -font TkDefaultFont \ + -borderwidth 1 \ + -background $colors(-frame) \ + -foreground $colors(-foreground) \ + -troughcolor $colors(-darker) \ + -font TkDefaultFont \ -selectbackground $colors(-selectbg) \ -selectforeground $colors(-selectfg) \ - -insertwidth 1 \ + -insertwidth 1 \ -insertcolor $colors(-foreground) \ -focuscolor $colors(-text) @@ -189,7 +189,8 @@ proc ttk::theme::default::reconfigureDefaultTheme {} { -stripedbackground $colors(-alternate) \ -fieldbackground $colors(-window) \ -foreground $colors(-text) \ - -indent 15p + -indent 15p \ + -focuswidth 1 -focuscolor $colors(-selectbg) ttk::setTreeviewRowHeight ttk::style configure Treeview.Separator \ -background $colors(-alternate) @@ -203,7 +204,7 @@ proc ttk::theme::default::reconfigureDefaultTheme {} { ttk::style layout ComboboxPopdownFrame { ComboboxPopdownFrame.border -sticky nswe } - ttk::style configure ComboboxPopdownFrame \ + ttk::style configure ComboboxPopdownFrame \ -borderwidth 1 -relief solid # @@ -211,12 +212,13 @@ proc ttk::theme::default::reconfigureDefaultTheme {} { # ttk::style layout Toolbutton { Toolbutton.border -children { - Toolbutton.padding -children { - Toolbutton.label + Toolbutton.focus -children { + Toolbutton.padding -children { + Toolbutton.label + } } } } - ttk::style configure Toolbutton \ -padding 1.5p -relief flat ttk::style map Toolbutton -relief \ diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 3d2ef90..813ae91 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -60,21 +60,21 @@ option add *TEntry.cursor [ttk::cursor text] widgetDefault ## Clipboard events: # -bind TEntry <<Cut>> { ttk::entry::Cut %W } -bind TEntry <<Copy>> { ttk::entry::Copy %W } -bind TEntry <<Paste>> { ttk::entry::Paste %W } -bind TEntry <<Clear>> { ttk::entry::Clear %W } +bind TEntry <<Cut>> { ttk::entry::Cut %W } +bind TEntry <<Copy>> { ttk::entry::Copy %W } +bind TEntry <<Paste>> { ttk::entry::Paste %W } +bind TEntry <<Clear>> { ttk::entry::Clear %W } ## Button1 bindings: # Used for selection and navigation. # -bind TEntry <Button-1> { ttk::entry::Press %W %x } +bind TEntry <Button-1> { ttk::entry::Press %W %x } bind TEntry <Shift-Button-1> { ttk::entry::Shift-Press %W %x } -bind TEntry <Double-Button-1> { ttk::entry::Select %W %x word } -bind TEntry <Triple-Button-1> { ttk::entry::Select %W %x line } +bind TEntry <Double-Button-1> { ttk::entry::Select %W %x word } +bind TEntry <Triple-Button-1> { ttk::entry::Select %W %x line } bind TEntry <B1-Motion> { ttk::entry::Drag %W %x } -bind TEntry <B1-Leave> { ttk::entry::DragOut %W %m } +bind TEntry <B1-Leave> { ttk::entry::DragOut %W %m } bind TEntry <B1-Enter> { ttk::entry::DragIn %W } bind TEntry <ButtonRelease-1> { ttk::entry::Release %W } @@ -87,37 +87,37 @@ bind TEntry <<ToggleSelection>> { # Note: ButtonRelease-2 # is mapped to <<PasteSelection>> in tk.tcl. # -bind TEntry <Button-2> { ttk::entry::ScanMark %W %x } -bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } +bind TEntry <Button-2> { ttk::entry::ScanMark %W %x } +bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x } bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x } ## Keyboard navigation bindings: # bind TEntry <<PrevChar>> { ttk::entry::Move %W prevchar } -bind TEntry <<NextChar>> { ttk::entry::Move %W nextchar } +bind TEntry <<NextChar>> { ttk::entry::Move %W nextchar } bind TEntry <<PrevWord>> { ttk::entry::Move %W prevword } bind TEntry <<NextWord>> { ttk::entry::Move %W nextword } bind TEntry <<LineStart>> { ttk::entry::Move %W home } bind TEntry <<LineEnd>> { ttk::entry::Move %W end } -bind TEntry <<SelectPrevChar>> { ttk::entry::Extend %W prevchar } +bind TEntry <<SelectPrevChar>> { ttk::entry::Extend %W prevchar } bind TEntry <<SelectNextChar>> { ttk::entry::Extend %W nextchar } bind TEntry <<SelectPrevWord>> { ttk::entry::Extend %W prevword } bind TEntry <<SelectNextWord>> { ttk::entry::Extend %W selectnextword } bind TEntry <<SelectLineStart>> { ttk::entry::Extend %W home } bind TEntry <<SelectLineEnd>> { ttk::entry::Extend %W end } -bind TEntry <<SelectAll>> { %W selection range 0 end } -bind TEntry <<SelectNone>> { %W selection clear } +bind TEntry <<SelectAll>> { %W selection range 0 end } +bind TEntry <<SelectNone>> { %W selection clear } -bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end } +bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end } ## Edit bindings: # -bind TEntry <Key> { ttk::entry::Insert %W %A } +bind TEntry <Key> { ttk::entry::Insert %W %A } bind TEntry <Delete> { ttk::entry::Delete %W } -bind TEntry <BackSpace> { ttk::entry::Backspace %W } +bind TEntry <BackSpace> { ttk::entry::Backspace %W } # Ignore all Alt, Meta, Control, Command, and Fn keypresses unless explicitly bound. # Otherwise, the <Key> class binding will fire and insert the character. @@ -125,11 +125,11 @@ bind TEntry <BackSpace> { ttk::entry::Backspace %W } # bind TEntry <Alt-Key> {# nothing} bind TEntry <Meta-Key> {# nothing} -bind TEntry <Control-Key> {# nothing} -bind TEntry <Escape> {# nothing} -bind TEntry <Return> {# nothing} -bind TEntry <KP_Enter> {# nothing} -bind TEntry <Tab> {# nothing} +bind TEntry <Control-Key> {# nothing} +bind TEntry <Escape> {# nothing} +bind TEntry <Return> {# nothing} +bind TEntry <KP_Enter> {# nothing} +bind TEntry <Tab> {# nothing} bind TEntry <Command-Key> {# nothing} bind TEntry <Fn-Key> {# nothing} @@ -227,7 +227,7 @@ proc ttk::entry::Cut {w} { # ## ClosestGap -- Find closest boundary between characters. -# Returns the index of the character just after the boundary. +# Returns the index of the character just after the boundary. # proc ttk::entry::ClosestGap {w x} { set pos [$w index @$x] @@ -323,7 +323,7 @@ proc ttk::entry::PrevChar {w start} { proc ttk::entry::RelIndex {w where {index insert}} { switch -- $where { prevchar { PrevChar $w $index } - nextchar { NextChar $w $index } + nextchar { NextChar $w $index } prevword { PrevWord $w $index } nextword { NextWord $w $index } selectnextword { SelectNextWord $w $index } @@ -485,7 +485,7 @@ proc ttk::entry::DragOut {w mode} { } ## <B1-Enter> binding -# Suspend autoscroll. +# Suspend autoscroll. # proc ttk::entry::DragIn {w} { ttk::CancelRepeat @@ -496,7 +496,7 @@ proc ttk::entry::DragIn {w} { proc ttk::entry::Release {w} { variable State set State(selectMode) none - ttk::CancelRepeat ;# suspend autoscroll + ttk::CancelRepeat ;# suspend autoscroll } ## AutoScroll diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl index 5138c89..4c4c207 100644 --- a/library/ttk/fonts.tcl +++ b/library/ttk/fonts.tcl @@ -20,7 +20,7 @@ # # Windows: # The default system font changed from "MS Sans Serif" to "Tahoma" -# in Windows XP/Windows 2000. +# in Windows XP/Windows 2000. # # MS documentation says to use "Tahoma 8" in Windows 2000/XP, # although many MS programs still use "MS Sans Serif 8" @@ -67,20 +67,20 @@ if {!$tip145} {apply {{} { global tcl_platform switch -- [tk windowingsystem] { win32 { - # In safe interps there is no osVersion element. + # In safe interps there is no osVersion element. if {[info exists tcl_platform(osVersion)]} { - if {$tcl_platform(osVersion) >= 5.0} { - set family "Tahoma" - } else { - set family "MS Sans Serif" - } - } else { - if {[lsearch -exact [font families] Tahoma] >= 0} { - set family "Tahoma" - } else { - set family "MS Sans Serif" - } - } + if {$tcl_platform(osVersion) >= 5.0} { + set family "Tahoma" + } else { + set family "MS Sans Serif" + } + } else { + if {[lsearch -exact [font families] Tahoma] >= 0} { + set family "Tahoma" + } else { + set family "MS Sans Serif" + } + } set size 8 font configure TkDefaultFont -family $family -size $size diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl index 8ef8937..10bbe5a 100644 --- a/library/ttk/menubutton.tcl +++ b/library/ttk/menubutton.tcl @@ -47,12 +47,12 @@ namespace eval ttk { bind TMenubutton <Enter> { %W instate !disabled {%W state active } } bind TMenubutton <Leave> { %W state !active } bind TMenubutton <space> { ttk::menubutton::Popdown %W } -bind TMenubutton <<Invoke>> { ttk::menubutton::Popdown %W } +bind TMenubutton <<Invoke>> { ttk::menubutton::Popdown %W } if {[tk windowingsystem] eq "x11"} { - bind TMenubutton <Button-1> { ttk::menubutton::Pulldown %W } + bind TMenubutton <Button-1> { ttk::menubutton::Pulldown %W } bind TMenubutton <ButtonRelease-1> { ttk::menubutton::TransferGrab %W } - bind TMenubutton <B1-Leave> { ttk::menubutton::TransferGrab %W } + bind TMenubutton <B1-Leave> { ttk::menubutton::TransferGrab %W } } else { bind TMenubutton <Button-1> \ { %W state pressed ; ttk::menubutton::Popdown %W } @@ -138,7 +138,7 @@ if {[tk windowingsystem] eq "aqua"} { # if we go offscreen to the top, show as 'below' if {$y < [winfo vrooty $mb]} { set y [expr {[winfo vrooty $mb] + [winfo rooty $mb]\ - + [winfo reqheight $mb]}] + + [winfo reqheight $mb]}] } } below { diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index 1d59d1e..fedb1be 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -170,7 +170,7 @@ proc ttk::notebook::enableTraversal {nb} { # bind $top <Control-Next> {+ttk::notebook::TLCycleTab %W 1} bind $top <Control-Prior> {+ttk::notebook::TLCycleTab %W -1} - bind $top <Control-Tab> {+ttk::notebook::TLCycleTab %W 1} + bind $top <Control-Tab> {+ttk::notebook::TLCycleTab %W 1} bind $top <Control-Shift-Tab> {+ttk::notebook::TLCycleTab %W -1} catch { bind $top <Control-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} @@ -199,7 +199,7 @@ proc ttk::notebook::Cleanup {nb} { set top [winfo toplevel $nb] if {[info exists TLNotebooks($top)]} { set index [lsearch -exact $TLNotebooks($top) $nb] - set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index] + set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index] } } diff --git a/library/ttk/panedwindow.tcl b/library/ttk/panedwindow.tcl index d5e25cd..131c07c 100644 --- a/library/ttk/panedwindow.tcl +++ b/library/ttk/panedwindow.tcl @@ -8,20 +8,20 @@ namespace eval ttk::panedwindow { pressed 0 pressX - pressY - - sash - + sash - sashPos - } } ## Bindings: # -bind TPanedwindow <Button-1> { ttk::panedwindow::Press %W %x %y } +bind TPanedwindow <Button-1> { ttk::panedwindow::Press %W %x %y } bind TPanedwindow <B1-Motion> { ttk::panedwindow::Drag %W %x %y } -bind TPanedwindow <ButtonRelease-1> { ttk::panedwindow::Release %W %x %y } +bind TPanedwindow <ButtonRelease-1> { ttk::panedwindow::Release %W %x %y } -bind TPanedwindow <Motion> { ttk::panedwindow::SetCursor %W %x %y } -bind TPanedwindow <Enter> { ttk::panedwindow::SetCursor %W %x %y } -bind TPanedwindow <Leave> { ttk::panedwindow::ResetCursor %W } +bind TPanedwindow <Motion> { ttk::panedwindow::SetCursor %W %x %y } +bind TPanedwindow <Enter> { ttk::panedwindow::SetCursor %W %x %y } +bind TPanedwindow <Leave> { ttk::panedwindow::ResetCursor %W } ## Sash movement: # @@ -33,10 +33,10 @@ proc ttk::panedwindow::Press {w x y} { set State(pressed) 0 return } - set State(pressed) 1 - set State(pressX) $x - set State(pressY) $y - set State(sash) $sash + set State(pressed) 1 + set State(pressX) $x + set State(pressY) $y + set State(sash) $sash set State(sashPos) [$w sashpos $sash] } @@ -44,8 +44,8 @@ proc ttk::panedwindow::Drag {w x y} { variable State if {!$State(pressed)} { return } switch -glob -- [$w cget -orient] { - h* { set delta [expr {$x - $State(pressX)}] } - v* { set delta [expr {$y - $State(pressY)}] } + h* { set delta [expr {$x - $State(pressX)}] } + v* { set delta [expr {$y - $State(pressY)}] } } $w sashpos $State(sash) [expr {$State(sashPos) + $delta}] } @@ -62,7 +62,7 @@ proc ttk::panedwindow::ResetCursor {w} { variable State ttk::saveCursor $w State(userConfCursor) \ - [list [ttk::cursor hresize] [ttk::cursor vresize]] + [list [ttk::cursor hresize] [ttk::cursor vresize]] if {!$State(pressed)} { ttk::setCursor $w $State(userConfCursor) @@ -73,7 +73,7 @@ proc ttk::panedwindow::SetCursor {w x y} { variable State ttk::saveCursor $w State(userConfCursor) \ - [list [ttk::cursor hresize] [ttk::cursor vresize]] + [list [ttk::cursor hresize] [ttk::cursor vresize]] set cursor $State(userConfCursor) if {[llength [$w identify $x $y]]} { diff --git a/library/ttk/scale.tcl b/library/ttk/scale.tcl index a97440d..1b6882a 100644 --- a/library/ttk/scale.tcl +++ b/library/ttk/scale.tcl @@ -41,14 +41,14 @@ proc ttk::scale::Press {w x y} { switch -glob -- [$w identify $x $y] { *track - - *trough { - set inc [expr {([$w get $x $y] <= [$w get]) ^ ([$w cget -from] > [$w cget -to]) ? -1 : 1}] - ttk::Repeatedly Increment $w $inc - } - *slider { - set State(dragging) 1 - set State(initial) [$w get] - } + *trough { + set inc [expr {([$w get $x $y] <= [$w get]) ^ ([$w cget -from] > [$w cget -to]) ? -1 : 1}] + ttk::Repeatedly Increment $w $inc + } + *slider { + set State(dragging) 1 + set State(initial) [$w get] + } } } @@ -61,14 +61,14 @@ proc ttk::scale::Jump {w x y} { switch -glob -- [$w identify $x $y] { *track - - *trough { - $w set [$w get $x $y] - set State(dragging) 1 - set State(initial) [$w get] - } - *slider { - Press $w $x $y - } + *trough { + $w set [$w get $x $y] + set State(dragging) 1 + set State(initial) [$w get] + } + *slider { + Press $w $x $y + } } } diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index 7c31511..1a73fd7 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -9,11 +9,11 @@ namespace eval ttk::scrollbar { # State(first) -- value of -first at start of drag. } -bind TScrollbar <Button-1> { ttk::scrollbar::Press %W %x %y } +bind TScrollbar <Button-1> { ttk::scrollbar::Press %W %x %y } bind TScrollbar <B1-Motion> { ttk::scrollbar::Drag %W %x %y } bind TScrollbar <ButtonRelease-1> { ttk::scrollbar::Release %W %x %y } -bind TScrollbar <Button-2> { ttk::scrollbar::Jump %W %x %y } +bind TScrollbar <Button-2> { ttk::scrollbar::Jump %W %x %y } bind TScrollbar <B2-Motion> { ttk::scrollbar::Drag %W %x %y } bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y } @@ -97,7 +97,7 @@ proc ttk::scrollbar::Release {w x y} { } # scrollbar::Jump -- Button-2 binding for scrollbars. -# Behaves exactly like scrollbar::Press, except that +# Behaves exactly like scrollbar::Press, except that # clicking in the trough jumps to the the selected position. # proc ttk::scrollbar::Jump {w x y} { diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl index 2a49451..a4a596b 100644 --- a/library/ttk/sizegrip.tcl +++ b/library/ttk/sizegrip.tcl @@ -19,22 +19,22 @@ switch -- [tk windowingsystem] { namespace eval ttk::sizegrip { variable State array set State { - pressed 0 - pressX 0 - pressY 0 - width 0 - height 0 + pressed 0 + pressX 0 + pressY 0 + width 0 + height 0 widthInc 1 heightInc 1 - resizeX 1 - resizeY 1 - toplevel {} + resizeX 1 + resizeY 1 + toplevel {} } } -bind TSizegrip <Button-1> { ttk::sizegrip::Press %W %X %Y } -bind TSizegrip <B1-Motion> { ttk::sizegrip::Drag %W %X %Y } -bind TSizegrip <ButtonRelease-1> { ttk::sizegrip::Release %W %X %Y } +bind TSizegrip <Button-1> { ttk::sizegrip::Press %W %X %Y } +bind TSizegrip <B1-Motion> { ttk::sizegrip::Drag %W %X %Y } +bind TSizegrip <ButtonRelease-1> { ttk::sizegrip::Release %W %X %Y } proc ttk::sizegrip::Press {W X Y} { variable State @@ -46,7 +46,7 @@ proc ttk::sizegrip::Press {W X Y} { # If the toplevel is not resizable then bail foreach {State(resizeX) State(resizeY)} [wm resizable $top] break if {!$State(resizeX) && !$State(resizeY)} { - return + return } # Sanity-checks: @@ -83,10 +83,10 @@ proc ttk::sizegrip::Drag {W X Y} { set w $State(width) set h $State(height) if {$State(resizeX)} { - set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}] + set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}] } if {$State(resizeY)} { - set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}] + set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}] } if {$w <= 0} { set w 1 } if {$h <= 0} { set h 1 } diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl index 96d8acf..f8d0d31 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -12,26 +12,26 @@ namespace eval ttk::spinbox { } ttk::copyBindings TEntry TSpinbox bind TSpinbox <Motion> { ttk::spinbox::Motion %W %x %y } -bind TSpinbox <Button-1> { ttk::spinbox::Press %W %x %y } -bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W } -bind TSpinbox <Double-Button-1> { ttk::spinbox::DoubleClick %W %x %y } -bind TSpinbox <Triple-Button-1> {} ;# disable TEntry triple-click +bind TSpinbox <Button-1> { ttk::spinbox::Press %W %x %y } +bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W } +bind TSpinbox <Double-Button-1> { ttk::spinbox::DoubleClick %W %x %y } +bind TSpinbox <Triple-Button-1> {} ;# disable TEntry triple-click bind TSpinbox <Up> { event generate %W <<Increment>> } -bind TSpinbox <Down> { event generate %W <<Decrement>> } +bind TSpinbox <Down> { event generate %W <<Decrement>> } bind TSpinbox <<Increment>> { ttk::spinbox::Spin %W +1 } -bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 } +bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 } -ttk::bindMouseWheel TSpinbox { ttk::spinbox::Spin %W } +ttk::bindMouseWheel TSpinbox { ttk::spinbox::Spin %W } bind TSpinbox <Shift-MouseWheel> { # Ignore the event } bind TSpinbox <TouchpadScroll> { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) # TouchpadScroll events fire about 60 times per second. - if {$deltaY != 0 && %# %% 12 == 0} { - ttk::spinbox::Spin %W [expr {$deltaY > 0 ? -1 : 1}] + if {$tk::Priv(deltaY) != 0 && %# %% 12 == 0} { + ttk::spinbox::Spin %W [expr {$tk::Priv(deltaY) > 0 ? -1 : 1}] } } @@ -58,7 +58,7 @@ proc ttk::spinbox::Press {w x y} { switch -glob -- [$w identify $x $y] { *textarea { ttk::entry::Press $w $x } *rightarrow - - *uparrow { ttk::Repeatedly event generate $w <<Increment>> } + *uparrow { ttk::Repeatedly event generate $w <<Increment>> } *leftarrow - *downarrow { ttk::Repeatedly event generate $w <<Decrement>> } *spinbutton { @@ -90,7 +90,7 @@ proc ttk::spinbox::Release {w} { ## MouseWheel -- # Mousewheel callback. Turn these into <<Increment>> (-1, up) -# or <<Decrement> (+1, down) events. Not used any more. +# or <<Decrement> (+1, down) events. Not used any more. # proc ttk::spinbox::MouseWheel {w dir {factor 1.0}} { if {[$w instate disabled]} { return } diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index e9fc5ad..5b95054 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -7,19 +7,19 @@ namespace eval ttk::treeview { # Enter/Leave/Motion # - set State(activeWidget) {} - set State(activeHeading) {} + set State(activeWidget) {} + set State(activeHeading) {} # Press/drag/release: # - set State(pressMode) none + set State(pressMode) none set State(pressX) 0 # For pressMode == "resize" set State(resizeColumn) #0 # For pressmode == "heading" - set State(heading) {} + set State(heading) {} set State(cellAnchor) {} set State(cellAnchorOp) "set" @@ -28,19 +28,19 @@ namespace eval ttk::treeview { ### Widget bindings. # -bind Treeview <Motion> { ttk::treeview::Motion %W %x %y } +bind Treeview <Motion> { ttk::treeview::Motion %W %x %y } bind Treeview <B1-Leave> { #nothing } bind Treeview <Leave> { ttk::treeview::ActivateHeading {} {}} -bind Treeview <Button-1> { ttk::treeview::Press %W %x %y } -bind Treeview <Double-Button-1> { ttk::treeview::DoubleClick %W %x %y } -bind Treeview <ButtonRelease-1> { ttk::treeview::Release %W %x %y } -bind Treeview <B1-Motion> { ttk::treeview::Drag %W %x %y } -bind Treeview <Up> { ttk::treeview::Keynav %W up } -bind Treeview <Down> { ttk::treeview::Keynav %W down } -bind Treeview <Right> { ttk::treeview::Keynav %W right } -bind Treeview <Left> { ttk::treeview::Keynav %W left } +bind Treeview <Button-1> { ttk::treeview::Press %W %x %y } +bind Treeview <Double-Button-1> { ttk::treeview::DoubleClick %W %x %y } +bind Treeview <ButtonRelease-1> { ttk::treeview::Release %W %x %y } +bind Treeview <B1-Motion> { ttk::treeview::Drag %W %x %y } +bind Treeview <Up> { ttk::treeview::Keynav %W up } +bind Treeview <Down> { ttk::treeview::Keynav %W down } +bind Treeview <Right> { ttk::treeview::Keynav %W right } +bind Treeview <Left> { ttk::treeview::Keynav %W left } bind Treeview <Prior> { %W yview scroll -1 pages } -bind Treeview <Next> { %W yview scroll 1 pages } +bind Treeview <Next> { %W yview scroll 1 pages } bind Treeview <Return> { ttk::treeview::ToggleFocus %W } bind Treeview <space> { ttk::treeview::ToggleFocus %W } @@ -66,17 +66,17 @@ proc ttk::treeview::Keynav {w dir} { set cells [expr {[$w cget -selecttype] eq "cell"}] if {$cells} { - lassign $State(cellAnchor) _ colAnchor - # Just in case, give it a valid value - if {$colAnchor eq ""} { - set colAnchor "#1" - } + lassign $State(cellAnchor) _ colAnchor + # Just in case, give it a valid value + if {$colAnchor eq ""} { + set colAnchor "#1" + } } switch -- $dir { up { if {[set up [$w prev $focus]] eq ""} { - set focus [$w parent $focus] + set focus [$w parent $focus] } else { while {[$w item $up -open] && [llength [$w children $up]]} { set up [lindex [$w children $up] end] @@ -86,7 +86,7 @@ proc ttk::treeview::Keynav {w dir} { } down { if {[$w item $focus -open] && [llength [$w children $focus]]} { - set focus [lindex [$w children $focus] 0] + set focus [lindex [$w children $focus] 0] } else { set up $focus while {$up ne "" && [set down [$w next $up]] eq ""} { @@ -96,46 +96,46 @@ proc ttk::treeview::Keynav {w dir} { } } left { - if {$cells} { - # This assumes that colAnchor is of the "#N" format. - set colNo [string range $colAnchor 1 end] - set firstCol [expr {"tree" ni [$w cget -show]}] - if {$colNo > $firstCol} { - incr colNo -1 - set colAnchor "#$colNo" - } - } elseif {[$w item $focus -open] && [llength [$w children $focus]]} { + if {$cells} { + # This assumes that colAnchor is of the "#N" format. + set colNo [string range $colAnchor 1 end] + set firstCol [expr {"tree" ni [$w cget -show]}] + if {$colNo > $firstCol} { + incr colNo -1 + set colAnchor "#$colNo" + } + } elseif {[$w item $focus -open] && [llength [$w children $focus]]} { CloseItem $w $focus } else { set focus [$w parent $focus] } } right { - if {$cells} { - set colNo [string range $colAnchor 1 end] - set dispCol [$w cget -displaycolumns] - if {$dispCol eq "#all"} { - set lastCol [llength [$w cget -columns]] - } else { - set lastCol [llength $dispCol] - } - if {$colNo < ($lastCol - 1)} { - incr colNo - set colAnchor "#$colNo" - } - } else { - OpenItem $w $focus - } + if {$cells} { + set colNo [string range $colAnchor 1 end] + set dispCol [$w cget -displaycolumns] + if {$dispCol eq "#all"} { + set lastCol [llength [$w cget -columns]] + } else { + set lastCol [llength $dispCol] + } + if {$colNo < ($lastCol - 1)} { + incr colNo + set colAnchor "#$colNo" + } + } else { + OpenItem $w $focus + } } } if {$focus != {}} { - if {$cells} { - set cell [list $focus $colAnchor] - SelectOp $w $focus $cell choose - } else { - SelectOp $w $focus "" choose - } + if {$cells} { + set cell [list $focus $colAnchor] + SelectOp $w $focus $cell choose + } else { + SelectOp $w $focus "" choose + } } } @@ -192,9 +192,9 @@ proc ttk::treeview::ActivateHeading {w heading} { proc ttk::treeview::IdentifyCell {w x y} { set cell {} if {[$w cget -selecttype] eq "cell"} { - # Later handling assumes that the column in the cell ID is of the - # format #N, which is always the case from "identify cell" - set cell [$w identify cell $x $y] + # Later handling assumes that the column in the cell ID is of the + # format #N, which is always the case from "identify cell" + set cell [$w identify cell $x $y] } return $cell } @@ -205,7 +205,7 @@ proc ttk::treeview::IdentifyCell {w x y} { # proc ttk::treeview::Select {w x y op} { if {[set item [$w identify row $x $y]] ne "" } { - set cell [IdentifyCell $w $x $y] + set cell [IdentifyCell $w $x $y] SelectOp $w $item $cell $op } } @@ -231,7 +231,7 @@ proc ttk::treeview::Press {w x y} { tree - cell { set item [$w identify item $x $y] - set cell [IdentifyCell $w $x $y] + set cell [IdentifyCell $w $x $y] SelectOp $w $item $cell choose switch -glob -- [$w identify element $x $y] { @@ -293,7 +293,7 @@ proc ttk::treeview::heading.press {w x y} { proc ttk::treeview::heading.drag {w x y} { variable State if { [$w identify region $x $y] eq "heading" - && [$w identify column $x $y] eq $State(heading) + && [$w identify column $x $y] eq $State(heading) } { $w heading $State(heading) state pressed } else { @@ -340,27 +340,27 @@ proc ttk::treeview::select.choose.extended {w item cell} { proc ttk::treeview::select.toggle.extended {w item cell} { variable State if {$cell ne ""} { - $w cellselection toggle [list $cell] - set State(cellAnchor) $cell - set State(cellAnchorOp) add + $w cellselection toggle [list $cell] + set State(cellAnchor) $cell + set State(cellAnchorOp) add } else { - $w selection toggle [list $item] + $w selection toggle [list $item] } } proc ttk::treeview::select.extend.extended {w item cell} { variable State if {$cell ne ""} { - if {$State(cellAnchor) ne ""} { - $w cellselection $State(cellAnchorOp) $State(cellAnchor) $cell - } else { - BrowseTo $w $item $cell - } + if {$State(cellAnchor) ne ""} { + $w cellselection $State(cellAnchorOp) $State(cellAnchor) $cell + } else { + BrowseTo $w $item $cell + } } else { - if {[set anchor [$w focus]] ne ""} { - $w selection set [between $w $anchor $item] - } else { - BrowseTo $w $item $cell - } + if {[set anchor [$w focus]] ne ""} { + $w selection set [between $w $anchor $item] + } else { + BrowseTo $w $item $cell + } } } @@ -426,7 +426,7 @@ proc ttk::treeview::Toggle {w item} { # don't allow toggling on indicators that # are not present in front of leaf items if {[$w children $item] == {}} { - return + return } # not a leaf, toggle! if {[$w item $item -open]} { @@ -455,9 +455,9 @@ proc ttk::treeview::BrowseTo {w item cell} { set State(cellAnchor) $cell set State(cellAnchorOp) set if {$cell ne ""} { - $w cellselection set [list $cell] + $w cellselection set [list $cell] } else { - $w selection set [list $item] + $w selection set [list $item] } } diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl index cbf1303..e5bfc42 100644 --- a/library/ttk/ttk.tcl +++ b/library/ttk/ttk.tcl @@ -95,6 +95,21 @@ proc ::ttk::setTheme {theme} { set currentTheme $theme } +## ttk::configureNotebookStyle $style -- +# Sets theme-specific option values for the ttk::notebook style $style +# and/or the style $style.Tab. To be invoked if the -tabposition option +# of $style has a non-default value (like "sw", "wn", or "en"). +# +proc ::ttk::configureNotebookStyle {style} { + set theme [ttk::style theme use] + if {[llength [info procs theme::${theme}::configureNotebookStyle]] > 0} { + theme::${theme}::configureNotebookStyle $style + return 1 + } else { + return 0 + } +} + ## ttk::setTreeviewRowHeight -- # Sets the default height of the ttk::treeview rows for the current theme. # To be invoked from within the library files for the built-in themes. @@ -154,17 +169,17 @@ proc ttk::LoadThemes {} { set builtinThemes [style theme names] foreach {theme scripts} { - classic classicTheme.tcl - alt altTheme.tcl - clam clamTheme.tcl + classic classicTheme.tcl + alt altTheme.tcl + clam clamTheme.tcl winnative winTheme.tcl xpnative {xpTheme.tcl vistaTheme.tcl} - aqua aquaTheme.tcl + aqua aquaTheme.tcl } { if {[lsearch -exact $builtinThemes $theme] >= 0} { - foreach script $scripts { - uplevel #0 [list source -encoding utf-8 [file join $library $script]] - } + foreach script $scripts { + uplevel #0 [list source -encoding utf-8 [file join $library $script]] + } } } } diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index 3f6446d..a0af39d 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -46,7 +46,7 @@ proc ttk::GuessTakeFocus {w} { } ## ttk::traverseTo $w -- -# Set the keyboard focus to the specified window. +# Set the keyboard focus to the specified window. # proc ttk::traverseTo {w} { set focus [focus] @@ -119,7 +119,7 @@ proc ttk::focusFirst {w} { # See #1239190 and #1411983 for more discussion. # namespace eval ttk { - variable Grab ;# map: window name -> grab token + variable Grab ;# map: window name -> grab token # grab token details: # Two-element list containing: @@ -304,15 +304,14 @@ bind TtkScrollable <Shift-Option-MouseWheel> \ ## Touchpad scrolling # bind TtkScrollable <TouchpadScroll> { - if {%# %% 5 != 0} { - return - } - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { - %W xview scroll [expr {-$deltaX}] units - } - if {$deltaY != 0} { - %W yview scroll [expr {-$deltaY}] units + if {%# %% 5 == 0} { + lassign [tk::PreciseScrollDeltas %D] tk::Priv(deltaX) tk::Priv(deltaY) + if {$tk::Priv(deltaX) != 0} { + %W xview scroll [expr {-$tk::Priv(deltaX)}] units + } + if {$tk::Priv(deltaY) != 0} { + %W yview scroll [expr {-$tk::Priv(deltaY)}] units + } } } #*EOF* diff --git a/library/ttk/vistaTheme.tcl b/library/ttk/vistaTheme.tcl index 4105a1a..5a30837 100644 --- a/library/ttk/vistaTheme.tcl +++ b/library/ttk/vistaTheme.tcl @@ -16,7 +16,7 @@ namespace eval ttk::theme::vista { ttk::style theme settings vista { - ttk::style configure . \ + ttk::style configure . \ -background SystemButtonFace \ -foreground SystemWindowText \ -selectforeground SystemHighlightText \ @@ -42,49 +42,49 @@ namespace eval ttk::theme::vista { # Treeview: ttk::style configure Heading -font TkHeadingFont ttk::style configure Treeview -background SystemWindow \ - -stripedbackground System3dLight + -stripedbackground System3dLight ttk::style configure Treeview.Separator \ - -background System3dLight + -background System3dLight ttk::style map Treeview \ -background [list disabled SystemButtonFace \ selected SystemHighlight] \ -foreground [list disabled SystemGrayText \ selected SystemHighlightText] - # Label and Toolbutton + # Label and Toolbutton ttk::style configure TLabelframe.Label -foreground SystemButtonText ttk::style configure Toolbutton -padding 3p - # Combobox + # Combobox ttk::style configure TCombobox -padding 1.5p - ttk::style element create Combobox.border vsapi \ - COMBOBOX 4 {disabled 4 focus 3 active 2 hover 2 {} 1} - ttk::style element create Combobox.background vsapi \ - EDIT 3 {disabled 3 readonly 5 focus 4 hover 2 {} 1} - ttk::style element create Combobox.rightdownarrow vsapi \ - COMBOBOX 6 {disabled 4 pressed 3 active 2 {} 1} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style layout TCombobox { - Combobox.border -sticky nswe -border 0 -children { - Combobox.rightdownarrow -side right -sticky ns - Combobox.padding -sticky nswe -children { - Combobox.background -sticky nswe -children { - Combobox.focus -sticky nswe -children { - Combobox.textarea -sticky nswe - } - } - } - } - } - # Vista.Combobox droplist frame - ttk::style element create ComboboxPopdownFrame.background vsapi\ - LISTBOX 3 {disabled 4 active 3 focus 2 {} 1} - ttk::style layout ComboboxPopdownFrame { - ComboboxPopdownFrame.background -sticky news -border 1 -children { - ComboboxPopdownFrame.padding -sticky news - } - } + ttk::style element create Combobox.border vsapi \ + COMBOBOX 4 {disabled 4 focus 3 active 2 hover 2 {} 1} + ttk::style element create Combobox.background vsapi \ + EDIT 3 {disabled 3 readonly 5 focus 4 hover 2 {} 1} + ttk::style element create Combobox.rightdownarrow vsapi \ + COMBOBOX 6 {disabled 4 pressed 3 active 2 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style layout TCombobox { + Combobox.border -sticky nswe -border 0 -children { + Combobox.rightdownarrow -side right -sticky ns + Combobox.padding -sticky nswe -children { + Combobox.background -sticky nswe -children { + Combobox.focus -sticky nswe -children { + Combobox.textarea -sticky nswe + } + } + } + } + } + # Vista.Combobox droplist frame + ttk::style element create ComboboxPopdownFrame.background vsapi\ + LISTBOX 3 {disabled 4 active 3 focus 2 {} 1} + ttk::style layout ComboboxPopdownFrame { + ComboboxPopdownFrame.background -sticky news -border 1 -children { + ComboboxPopdownFrame.padding -sticky news + } + } ttk::style map TCombobox \ -selectbackground [list !focus SystemWindow] \ -selectforeground [list !focus SystemWindowText] \ @@ -94,135 +94,166 @@ namespace eval ttk::theme::vista { ] \ -focusfill [list {readonly focus} SystemHighlight] - # Entry - ttk::style configure TEntry -padding {1 1 1 1} ;# Needs lookup - ttk::style element create Entry.field vsapi \ - EDIT 6 {disabled 4 focus 3 hover 2 {} 1} -padding {2 2 2 2} - ttk::style element create Entry.background vsapi \ - EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} - ttk::style layout TEntry { - Entry.field -sticky news -border 0 -children { - Entry.background -sticky news -children { - Entry.padding -sticky news -children { - Entry.textarea -sticky news - } - } - } - } + # Entry + ttk::style configure TEntry -padding {1 1 1 1} ;# Needs lookup + ttk::style element create Entry.field vsapi \ + EDIT 6 {disabled 4 focus 3 hover 2 {} 1} -padding {2 2 2 2} + ttk::style element create Entry.background vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} + ttk::style layout TEntry { + Entry.field -sticky news -border 0 -children { + Entry.background -sticky news -children { + Entry.padding -sticky news -children { + Entry.textarea -sticky news + } + } + } + } ttk::style map TEntry \ -selectbackground [list !focus SystemWindow] \ -selectforeground [list !focus SystemWindowText] - # Spinbox - ttk::style configure TSpinbox -padding 0 - ttk::style element create Spinbox.field vsapi \ - EDIT 9 {disabled 4 focus 3 hover 2 {} 1} -padding {1 1 1 2} - ttk::style element create Spinbox.background vsapi \ - EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} - ttk::style element create Spinbox.innerbg vsapi \ - EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1}\ - -padding {2 0 15 2} - ttk::style element create Spinbox.uparrow vsapi \ - SPIN 1 {disabled 4 pressed 3 active 2 {} 1} \ - -padding 1 -halfheight 1 \ - -syssize { SM_CXVSCROLL SM_CYVSCROLL } - ttk::style element create Spinbox.downarrow vsapi \ - SPIN 2 {disabled 4 pressed 3 active 2 {} 1} \ - -padding 1 -halfheight 1 \ - -syssize { SM_CXVSCROLL SM_CYVSCROLL } - ttk::style layout TSpinbox { - Spinbox.field -sticky nswe -children { - Spinbox.background -sticky news -children { - Spinbox.padding -sticky news -children { - Spinbox.innerbg -sticky news -children { - Spinbox.textarea - } - } - Spinbox.uparrow -side top -sticky ens - Spinbox.downarrow -side bottom -sticky ens - } - } - } + # Spinbox + ttk::style configure TSpinbox -padding 0 + ttk::style element create Spinbox.field vsapi \ + EDIT 9 {disabled 4 focus 3 hover 2 {} 1} -padding {1 1 1 2} + ttk::style element create Spinbox.background vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} + ttk::style element create Spinbox.innerbg vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1}\ + -padding {2 0 15 2} + ttk::style element create Spinbox.uparrow vsapi \ + SPIN 1 {disabled 4 pressed 3 active 2 {} 1} \ + -padding 1 -halfheight 1 \ + -syssize { SM_CXVSCROLL SM_CYVSCROLL } + ttk::style element create Spinbox.downarrow vsapi \ + SPIN 2 {disabled 4 pressed 3 active 2 {} 1} \ + -padding 1 -halfheight 1 \ + -syssize { SM_CXVSCROLL SM_CYVSCROLL } + ttk::style layout TSpinbox { + Spinbox.field -sticky nswe -children { + Spinbox.background -sticky news -children { + Spinbox.padding -sticky news -children { + Spinbox.innerbg -sticky news -children { + Spinbox.textarea + } + } + Spinbox.uparrow -side top -sticky ens + Spinbox.downarrow -side bottom -sticky ens + } + } + } ttk::style map TSpinbox \ -selectbackground [list !focus SystemWindow] \ -selectforeground [list !focus SystemWindowText] - # SCROLLBAR elements (Vista includes a state for 'hover') - ttk::style element create Vertical.Scrollbar.uparrow vsapi \ - SCROLLBAR 1 {disabled 4 pressed 3 active 2 hover 17 {} 1} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style element create Vertical.Scrollbar.downarrow vsapi \ - SCROLLBAR 1 {disabled 8 pressed 7 active 6 hover 18 {} 5} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style element create Vertical.Scrollbar.trough vsapi \ - SCROLLBAR 7 {disabled 4 pressed 3 active 2 hover 5 {} 1} - ttk::style element create Vertical.Scrollbar.thumb vsapi \ - SCROLLBAR 3 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style element create Vertical.Scrollbar.grip vsapi \ - SCROLLBAR 9 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ - -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style element create Horizontal.Scrollbar.leftarrow vsapi \ - SCROLLBAR 1 {disabled 12 pressed 11 active 10 hover 19 {} 9} \ - -syssize {SM_CXHSCROLL SM_CYHSCROLL} - ttk::style element create Horizontal.Scrollbar.rightarrow vsapi \ - SCROLLBAR 1 {disabled 16 pressed 15 active 14 hover 20 {} 13} \ - -syssize {SM_CXHSCROLL SM_CYHSCROLL} - ttk::style element create Horizontal.Scrollbar.trough vsapi \ - SCROLLBAR 5 {disabled 4 pressed 3 active 2 hover 5 {} 1} - ttk::style element create Horizontal.Scrollbar.thumb vsapi \ - SCROLLBAR 2 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ - -syssize {SM_CXHSCROLL SM_CYHSCROLL} - ttk::style element create Horizontal.Scrollbar.grip vsapi \ - SCROLLBAR 8 {disabled 4 pressed 3 active 2 hover 5 {} 1} - - # Progressbar - ttk::style element create Horizontal.Progressbar.pbar vsapi \ - PROGRESS 3 {{} 1} -padding 8 - ttk::style layout Horizontal.TProgressbar { - Horizontal.Progressbar.trough -sticky nswe -children { - Horizontal.Progressbar.pbar -side left -sticky ns - Horizontal.Progressbar.ctext -sticky nesw - } - } - ttk::style element create Vertical.Progressbar.pbar vsapi \ - PROGRESS 3 {{} 1} -padding 8 - ttk::style layout Vertical.TProgressbar { - Vertical.Progressbar.trough -sticky nswe -children { - Vertical.Progressbar.pbar -side bottom -sticky we - } - } - - # Scale - ttk::style element create Horizontal.Scale.slider vsapi \ - TRACKBAR 3 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ - -width 6 -height 12 - ttk::style layout Horizontal.TScale { - Scale.focus -sticky nswe -children { - Horizontal.Scale.trough -sticky nswe -children { - Horizontal.Scale.track -sticky we - Horizontal.Scale.slider -side left -sticky {} - } - } - } - ttk::style element create Vertical.Scale.slider vsapi \ - TRACKBAR 6 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ - -width 12 -height 6 - ttk::style layout Vertical.TScale { - Scale.focus -sticky nswe -children { - Vertical.Scale.trough -sticky nswe -children { - Vertical.Scale.track -sticky ns - Vertical.Scale.slider -side top -sticky {} - } - } - } - - # Treeview - ttk::style configure Item -padding {3p 0 0 0} + # SCROLLBAR elements (Vista includes a state for 'hover') + ttk::style element create Vertical.Scrollbar.uparrow vsapi \ + SCROLLBAR 1 {disabled 4 pressed 3 active 2 hover 17 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.downarrow vsapi \ + SCROLLBAR 1 {disabled 8 pressed 7 active 6 hover 18 {} 5} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.trough vsapi \ + SCROLLBAR 7 {disabled 4 pressed 3 active 2 hover 5 {} 1} + ttk::style element create Vertical.Scrollbar.thumb vsapi \ + SCROLLBAR 3 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.grip vsapi \ + SCROLLBAR 9 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Horizontal.Scrollbar.leftarrow vsapi \ + SCROLLBAR 1 {disabled 12 pressed 11 active 10 hover 19 {} 9} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.rightarrow vsapi \ + SCROLLBAR 1 {disabled 16 pressed 15 active 14 hover 20 {} 13} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.trough vsapi \ + SCROLLBAR 5 {disabled 4 pressed 3 active 2 hover 5 {} 1} + ttk::style element create Horizontal.Scrollbar.thumb vsapi \ + SCROLLBAR 2 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.grip vsapi \ + SCROLLBAR 8 {disabled 4 pressed 3 active 2 hover 5 {} 1} + + # Progressbar + ttk::style element create Horizontal.Progressbar.pbar vsapi \ + PROGRESS 3 {{} 1} -padding 8 + ttk::style layout Horizontal.TProgressbar { + Horizontal.Progressbar.trough -sticky nswe -children { + Horizontal.Progressbar.pbar -side left -sticky ns + Horizontal.Progressbar.ctext -sticky nesw + } + } + ttk::style element create Vertical.Progressbar.pbar vsapi \ + PROGRESS 3 {{} 1} -padding 8 + ttk::style layout Vertical.TProgressbar { + Vertical.Progressbar.trough -sticky nswe -children { + Vertical.Progressbar.pbar -side bottom -sticky we + } + } + + # Scale + ttk::style element create Horizontal.Scale.slider vsapi \ + TRACKBAR 3 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ + -width 6 -height 12 + ttk::style layout Horizontal.TScale { + Scale.focus -sticky nswe -children { + Horizontal.Scale.trough -sticky nswe -children { + Horizontal.Scale.track -sticky we + Horizontal.Scale.slider -side left -sticky {} + } + } + } + ttk::style element create Vertical.Scale.slider vsapi \ + TRACKBAR 6 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ + -width 12 -height 6 + ttk::style layout Vertical.TScale { + Scale.focus -sticky nswe -children { + Vertical.Scale.trough -sticky nswe -children { + Vertical.Scale.track -sticky ns + Vertical.Scale.slider -side top -sticky {} + } + } + } + + # Treeview + ttk::style configure Item -padding {3p 0 0 0} ttk::style configure Treeview -indent 15p ttk::setTreeviewRowHeight - package provide ttk::theme::vista 1.0 + package provide ttk::theme::vista 1.0 + } +} + +# ttk::theme::vista::configureNotebookStyle -- +# +# Sets theme-specific option values for the ttk::notebook style $style and the +# style $style.Tab. Invoked by ::ttk::configureNotebookStyle. + +proc ttk::theme::vista::configureNotebookStyle {style} { + set tabPos [ttk::style lookup $style -tabposition {} nw] + switch -- [string index $tabPos 0] { + n { + ttk::style configure $style -tabmargins {2 2 2 0} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + s { + ttk::style configure $style -tabmargins {2 0 2 2} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + w { + ttk::style configure $style -tabmargins {2 2 0 2} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + e { + ttk::style configure $style -tabmargins {0 2 2 2} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + default { + ttk::style configure $style -tabmargins {2 2 2 0} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } } } diff --git a/library/ttk/winTheme.tcl b/library/ttk/winTheme.tcl index 3be8add..9b9812a 100644 --- a/library/ttk/winTheme.tcl +++ b/library/ttk/winTheme.tcl @@ -17,7 +17,7 @@ namespace eval ttk::theme::winnative { -font TkDefaultFont ttk::style map "." -foreground {disabled SystemGrayText} - ttk::style map "." -embossed {disabled 1} + ttk::style map "." -embossed {disabled 1} ttk::style configure TButton \ -anchor center -width -11 -relief raised -shiftrelief 1 @@ -81,8 +81,39 @@ namespace eval ttk::theme::winnative { -foreground [list disabled SystemGrayText \ selected SystemHighlightText] - ttk::style configure TProgressbar \ + ttk::style configure TProgressbar \ -background SystemHighlight -borderwidth 0 \ -barsize 22.5p -thickness 11.25p } } + +# ttk::theme::winnative::configureNotebookStyle -- +# +# Sets theme-specific option values for the ttk::notebook style $style and the +# style $style.Tab. Invoked by ::ttk::configureNotebookStyle. + +proc ttk::theme::winnative::configureNotebookStyle {style} { + set tabPos [ttk::style lookup $style -tabposition {} nw] + switch -- [string index $tabPos 0] { + n { + ttk::style configure $style -tabmargins {2 2 2 0} + ttk::style map $style.Tab -expand {selected {2 2 2 0}} + } + s { + ttk::style configure $style -tabmargins {2 0 2 2} + ttk::style map $style.Tab -expand {selected {2 0 2 2}} + } + w { + ttk::style configure $style -tabmargins {2 2 0 2} + ttk::style map $style.Tab -expand {selected {2 2 0 2}} + } + e { + ttk::style configure $style -tabmargins {0 2 2 2} + ttk::style map $style.Tab -expand {selected {0 2 2 2}} + } + default { + ttk::style configure $style -tabmargins {2 2 2 0} + ttk::style map $style.Tab -expand {selected {2 2 2 0}} + } + } +} diff --git a/library/ttk/xpTheme.tcl b/library/ttk/xpTheme.tcl index 1c900ba..60c47b0 100644 --- a/library/ttk/xpTheme.tcl +++ b/library/ttk/xpTheme.tcl @@ -62,3 +62,34 @@ namespace eval ttk::theme::xpnative { selected SystemHighlightText] } } + +# ttk::theme::xpnative::configureNotebookStyle -- +# +# Sets theme-specific option values for the ttk::notebook style $style and the +# style $style.Tab. Invoked by ::ttk::configureNotebookStyle. + +proc ttk::theme::xpnative::configureNotebookStyle {style} { + set tabPos [ttk::style lookup $style -tabposition {} nw] + switch -- [string index $tabPos 0] { + n { + ttk::style configure $style -tabmargins {2 2 2 0} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + s { + ttk::style configure $style -tabmargins {2 0 2 2} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + w { + ttk::style configure $style -tabmargins {2 2 0 2} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + e { + ttk::style configure $style -tabmargins {0 2 2 2} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + default { + ttk::style configure $style -tabmargins {2 2 2 0} + ttk::style map $style.Tab -expand {selected {2 2 2 2}} + } + } +} diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index e4d0db5..176d636 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -315,10 +315,10 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { # Builds the UI components of the Motif file dialog. # # Arguments: -# w Pathname of the dialog to build. +# w Pathname of the dialog to build. # # Results: -# None. +# None. proc ::tk::MotifFDialog_BuildUI {w} { set dataName [lindex [split $w .] end] @@ -476,9 +476,9 @@ proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} { # w pathname of the dialog box. # # Results: -# A list of two elements. The first element is the directory -# specified # by the filter. The second element is the filter -# pattern itself. +# A list of two elements. The first element is the directory +# specified # by the filter. The second element is the filter +# pattern itself. proc ::tk::MotifFDialog_InterpFilter {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -538,7 +538,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { # boxes. # # Arguments: -# w pathname of the dialog box. +# w pathname of the dialog box. # # Results: # None. @@ -562,7 +562,7 @@ proc ::tk::MotifFDialog_Update {w} { # to the filter setting. # # Arguments: -# w pathname of the dialog box. +# w pathname of the dialog box. # # Results: # None. @@ -623,7 +623,7 @@ proc ::tk::MotifFDialog_LoadFiles {w} { # (clicked-over) by the user. # # Arguments: -# w The pathname of the dialog box. +# w The pathname of the dialog box. # # Results: # None. @@ -669,7 +669,7 @@ proc ::tk::MotifFDialog_BrowseDList {w} { # (double-clicked) by the user. # # Arguments: -# w The pathname of the dialog box. +# w The pathname of the dialog box. # # Results: # None. @@ -717,7 +717,7 @@ proc ::tk::MotifFDialog_ActivateDList {w} { # (clicked-over) by the user. # # Arguments: -# w The pathname of the dialog box. +# w The pathname of the dialog box. # # Results: # None. @@ -759,7 +759,7 @@ proc ::tk::MotifFDialog_BrowseFList {w} { # (double-clicked) by the user. # # Arguments: -# w The pathname of the dialog box. +# w The pathname of the dialog box. # # Results: # None. @@ -785,7 +785,7 @@ proc ::tk::MotifFDialog_ActivateFList {w} { # text inside the filter entry. # # Arguments: -# w The pathname of the dialog box. +# w The pathname of the dialog box. # # Results: # None. @@ -808,7 +808,7 @@ proc ::tk::MotifFDialog_ActivateFEnt {w} { # terminated. # # Arguments: -# w The pathname of the dialog box. +# w The pathname of the dialog box. # # Results: # None. @@ -926,7 +926,7 @@ proc ::tk::ListBoxKeyAccel_Unset {w} { # keystrokes. # # Arguments: -# w The pathname of the listbox. +# w The pathname of the listbox. # key The key which the user just pressed. # # Results: |
