diff options
Diffstat (limited to 'library')
-rw-r--r-- | library/bgerror.tcl | 17 | ||||
-rw-r--r-- | library/button.tcl | 10 | ||||
-rw-r--r-- | library/demos/toolbar.tcl | 4 | ||||
-rw-r--r-- | library/demos/tree.tcl | 2 | ||||
-rw-r--r-- | library/demos/ttkpane.tcl | 2 | ||||
-rw-r--r-- | library/menu.tcl | 9 | ||||
-rw-r--r-- | library/ttk/aquaTheme.tcl | 97 | ||||
-rw-r--r-- | library/ttk/combobox.tcl | 16 | ||||
-rw-r--r-- | library/ttk/entry.tcl | 1 | ||||
-rw-r--r-- | library/ttk/menubutton.tcl | 140 | ||||
-rw-r--r-- | library/ttk/scrollbar.tcl | 18 | ||||
-rw-r--r-- | library/ttk/treeview.tcl | 6 |
12 files changed, 213 insertions, 109 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl index b15387e..574ad8b 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -97,7 +97,7 @@ proc ::tk::dialog::error::ReturnInDetails w { # Arguments: # err - The error message. # -proc ::tk::dialog::error::bgerror err { +proc ::tk::dialog::error::bgerror {err {flag 1}} { global errorInfo variable button @@ -106,15 +106,20 @@ proc ::tk::dialog::error::bgerror err { set ret [catch {::tkerror $err} msg]; if {$ret != 1} {return -code $ret $msg} - # Ok the application's tkerror either failed or was not found - # we use the default dialog then : + # The application's tkerror either failed or was not found + # so we use the default dialog. But on Aqua we cannot display + # the dialog if the background error occurs in an idle task + # being processed inside of [NSView drawRect]. In that case + # we post the dialog as an after task instead. set windowingsystem [tk windowingsystem] if {$windowingsystem eq "aqua"} { - set ok [mc Ok] - } else { - set ok [mc OK] + if $flag { + after 500 [list bgerror "$err" 0] + return + } } + set ok [mc OK] # Truncate the message if it is too wide (>maxLine characters) or # too tall (>4 lines). Truncation occurs at the first point at # which one of those conditions is met. diff --git a/library/button.tcl b/library/button.tcl index 80d8bf9..9b13607 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -748,11 +748,15 @@ proc ::tk::CheckLeave {w} { $w configure -state normal } - # Restore the original button "selected" color; assume that the user - # wasn't monkeying around with things too much. + # Restore the original button "selected" color; but only if the user + # has not changed it in the meantime. if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} { - $w configure -selectcolor $Priv($w,selectcolor) + if {[$w cget -selectcolor] eq $Priv($w,selectcolor) + || ([info exist Priv($w,aselectcolor)] && + [$w cget -selectcolor] eq $Priv($w,aselectcolor))} { + $w configure -selectcolor $Priv($w,selectcolor) + } } unset -nocomplain Priv($w,selectcolor) Priv($w,aselectcolor) diff --git a/library/demos/toolbar.tcl b/library/demos/toolbar.tcl index 0ae4669..cb2a495 100644 --- a/library/demos/toolbar.tcl +++ b/library/demos/toolbar.tcl @@ -31,7 +31,7 @@ ttk::separator $w.sep ttk::frame $t.tearoff -cursor fleur ttk::separator $t.tearoff.to -orient vertical ttk::separator $t.tearoff.to2 -orient vertical -pack $t.tearoff.to -fill y -expand 1 -padx 2 -side left +pack $t.tearoff.to -fill y -expand 1 -padx 4 -side left pack $t.tearoff.to2 -fill y -expand 1 -side left ttk::frame $t.contents grid $t.tearoff $t.contents -sticky nsew @@ -79,7 +79,7 @@ text $w.txt -width 40 -height 10 interp alias {} doInsert {} $w.txt insert end ;# Make bindings easy to write ## Arrange contents -grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -sticky ns +grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -pady 4 -sticky ns grid $t -sticky ew grid $w.sep -sticky ew grid $w.msg -sticky ew diff --git a/library/demos/tree.tcl b/library/demos/tree.tcl index 71c32c1..8decdf2 100644 --- a/library/demos/tree.tcl +++ b/library/demos/tree.tcl @@ -75,7 +75,7 @@ ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" $w.tree heading \#0 -text "Directory Structure" $w.tree heading size -text "File Size" -$w.tree column size -stretch 0 -width 70 +$w.tree column size -width 70 populateRoots $w.tree bind $w.tree <<TreeviewOpen>> {populateTree %W [%W focus]} diff --git a/library/demos/ttkpane.tcl b/library/demos/ttkpane.tcl index 7575d76..3f88987 100644 --- a/library/demos/ttkpane.tcl +++ b/library/demos/ttkpane.tcl @@ -104,7 +104,7 @@ if {[tk windowingsystem] ne "aqua"} { pack $w.outer -fill both -expand 1 } else { text $w.txt -wrap word -yscroll "$w.sb set" -width 30 -borderwidth 0 - scrollbar $w.sb -orient vertical -command "$w.txt yview" + ttk::scrollbar $w.sb -orient vertical -command "$w.txt yview" pack $w.sb -side right -fill y -in $w.outer.inRight.bot pack $w.txt -fill both -expand 1 -in $w.outer.inRight.bot pack $w.outer -fill both -expand 1 -padx 10 -pady {6 10} diff --git a/library/menu.tcl b/library/menu.tcl index 8d06868..9d6370a 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -1178,15 +1178,6 @@ if {[tk windowingsystem] eq "aqua"} { set entry 0 } } - if {$entry ne ""} { - if {$entry == [$menu index last]} { - set entryHeight [expr {[winfo reqheight $menu] \ - - [$menu yposition $entry]}] - } else { - set entryHeight [expr {[$menu yposition [expr {$entry+1}]] \ - - [$menu yposition $entry]}] - } - } set x [winfo rootx $button] set y [winfo rooty $button] switch [$button cget -direction] { diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl index a548d65..92689d8 100644 --- a/library/ttk/aquaTheme.tcl +++ b/library/ttk/aquaTheme.tcl @@ -7,45 +7,102 @@ namespace eval ttk::theme::aqua { ttk::style configure . \ -font TkDefaultFont \ - -background systemWindowBody \ - -foreground systemModelessDialogActiveText \ + -background systemWindowBackgroundColor \ + -foreground systemLabelColor \ -selectbackground systemHighlight \ - -selectforeground systemModelessDialogActiveText \ + -selectforeground systemLabelColor \ -selectborderwidth 0 \ -insertwidth 1 ttk::style map . \ - -foreground {disabled systemModelessDialogInactiveText - background systemModelessDialogInactiveText} \ - -selectbackground {background systemHighlightSecondary - !focus systemHighlightSecondary} \ - -selectforeground {background systemModelessDialogInactiveText - !focus systemDialogActiveText} + -foreground { + disabled systemDisabledControlTextColor + background systemLabelColor} \ + -selectbackground { + background systemSelectedTextBackgroundColor + !focus systemSelectedTextBackgroundColor} \ + -selectforeground { + background systemSelectedTextColor + !focus systemSelectedTextColor} + + # Button + ttk::style configure TButton -anchor center -width -6\ + -foreground systemControlTextColor + ttk::style configure TMenubutton -anchor center -padding {2 0 0 2} + ttk::style configure Toolbutton -anchor center + + # Entry + ttk::style configure TEntry \ + -foreground systemTextColor \ + -background systemTextBackgroundColor \ # Workaround for #1100117: # Actually, on Aqua we probably shouldn't stipple images in # disabled buttons even if it did work... ttk::style configure . -stipple {} - ttk::style configure TButton -anchor center -width -6 - ttk::style configure Toolbutton -padding 4 - + # Notebook ttk::style configure TNotebook -tabmargins {10 0} -tabposition n ttk::style configure TNotebook -padding {18 8 18 17} ttk::style configure TNotebook.Tab -padding {12 3 12 2} + ttk::style configure TNotebook.Tab -foreground systemControlTextColor + ttk::style map TNotebook.Tab \ + -foreground { + background systemControlTextColor + disabled systemDisabledControlTextColor + selected systemSelectedTabTextColor} # Combobox: - ttk::style configure TCombobox -postoffset {5 -2 -10 0} + ttk::style configure TCombobox \ + -foreground systemTextColor \ + -background systemTransparent \ + -selectforeground systemSelectedTextColor \ + -selectbackground systemSelectedTextBackgroundColor + ttk::style map TCombobox \ + -foreground { + disabled systemDisabledControlTextColor + } \ + -selectforeground { + !active systemTextColor + } \ + -selectbackground { + !active systemTextBackgroundColor + !focus systemTextBackgroundColor + focus systemSelectedTextBackgroundColor + } + # Spinbox + ttk::style configure TSpinbox \ + -foreground systemTextColor \ + -background systemTextBackgroundColor \ + -selectforeground systemSelectedTextColor \ + -selectbackground systemSelectedTextBackgroundColor + ttk::style map TSpinbox \ + -foreground { + disabled systemDisabledControlTextColor + } \ + -selectforeground { + !active systemTextColor + } \ + -selectbackground { + !active systemTextBackgroundColor + !focus systemTextBackgroundColor + focus systemSelectedTextBackgroundColor + } + # Treeview: - ttk::style configure Heading -font TkHeadingFont - ttk::style configure Treeview -rowheight 18 -background White + ttk::style configure Heading \ + -font TkHeadingFont \ + -foreground systemTextColor \ + -background systemWindowBackgroundColor + ttk::style configure Treeview -rowheight 18 \ + -background systemTextBackgroundColor \ + -foreground systemTextColor \ + -fieldbackground systemTextBackgroundColor ttk::style map Treeview \ - -background [list disabled systemDialogBackgroundInactive \ - {selected background} systemHighlightSecondary \ - selected systemHighlight] \ - -foreground [list disabled systemModelessDialogInactiveText \ - selected systemModelessDialogActiveText] + -background { + selected systemSelectedTextBackgroundColor + } # Enable animation for ttk::progressbar widget: ttk::style configure TProgressbar -period 100 -maxphase 255 diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index c1b6da6..1355a04 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -251,30 +251,16 @@ proc ttk::combobox::UnmapPopdown {w} { ttk::releaseGrab $w } -### -# - -namespace eval ::ttk::combobox { - # @@@ Until we have a proper native scrollbar on Aqua, use - # @@@ the regular Tk one. Use ttk::scrollbar on other platforms. - variable scrollbar ttk::scrollbar - if {[tk windowingsystem] eq "aqua"} { - set scrollbar ::scrollbar - } -} - ## PopdownWindow -- # Returns the popdown widget associated with a combobox, # creating it if necessary. # proc ttk::combobox::PopdownWindow {cb} { - variable scrollbar - if {![winfo exists $cb.popdown]} { set poplevel [PopdownToplevel $cb.popdown] set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame] - $scrollbar $popdown.sb \ + ttk::scrollbar $popdown.sb \ -orient vertical -command [list $popdown.l yview] listbox $popdown.l \ -listvariable ttk::combobox::Values($cb) \ diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 50f866d..383eebd 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -218,7 +218,6 @@ proc ttk::entry::ClosestGap {w x} { ## See $index -- Make sure that the character at $index is visible. # proc ttk::entry::See {w {index insert}} { - update idletasks ;# ensure scroll data up-to-date set c [$w index $index] # @@@ OR: check [$w index left] / [$w index right] if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} { diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl index 2be064c..43b3cd8 100644 --- a/library/ttk/menubutton.tcl +++ b/library/ttk/menubutton.tcl @@ -61,43 +61,112 @@ if {[tk windowingsystem] eq "x11"} { } # PostPosition -- -# Returns the x and y coordinates where the menu -# should be posted, based on the menubutton and menu size -# and -direction option. +# Returns x and y coordinates and a menu item index. +# If the index is not an empty string the menu should +# be posted so that the upper left corner of the indexed +# menu item is located at the point (x, y). Otherwise +# the top left corner of the menu itself should be located +# at that point. # # TODO: adjust menu width to be at least as wide as the button # for -direction above, below. # -proc ttk::menubutton::PostPosition {mb menu} { - set x [winfo rootx $mb] - set y [winfo rooty $mb] - set dir [$mb cget -direction] - set bw [winfo width $mb] - set bh [winfo height $mb] - set mw [winfo reqwidth $menu] - set mh [winfo reqheight $menu] - set sw [expr {[winfo screenwidth $menu] - $bw - $mw}] - set sh [expr {[winfo screenheight $menu] - $bh - $mh}] - - switch -- $dir { - above { if {$y >= $mh} { incr y -$mh } { incr y $bh } } - below { if {$y <= $sh} { incr y $bh } { incr y -$mh } } - left { if {$x >= $mw} { incr x -$mw } { incr x $bw } } - right { if {$x <= $sw} { incr x $bw } { incr x -$mw } } - flush { - # post menu atop menubutton. - # If there's a menu entry whose label matches the - # menubutton -text, assume this is an optionmenu - # and place that entry over the menubutton. - set index [FindMenuEntry $menu [$mb cget -text]] - if {$index ne ""} { - incr y -[$menu yposition $index] +if {[tk windowingsystem] eq "aqua"} { + proc ::ttk::menubutton::PostPosition {mb menu} { + set menuPad 5 + set buttonPad 1 + set bevelPad 4 + set mh [winfo reqheight $menu] + set bh [expr {[winfo height $mb]} + $buttonPad] + set bbh [expr {[winfo height $mb]} + $bevelPad] + set mw [winfo reqwidth $menu] + set bw [winfo width $mb] + set dF [expr {[winfo width $mb] - [winfo reqwidth $menu] - $menuPad}] + set entry "" + set entry [::tk::MenuFindName $menu [$mb cget -text]] + if {$entry eq ""} { + set entry 0 + } + set x [winfo rootx $mb] + set y [winfo rooty $mb] + switch [$mb cget -direction] { + above { + set entry "" + incr y [expr {-$mh + 2 * $menuPad}] + } + below { + set entry "" + incr y $bh + } + left { + incr y $menuPad + incr x -$mw + } + right { + incr y $menuPad + incr x $bw + } + default { + incr y $bbh } } + return [list $x $y $entry] + } +} else { + proc ::ttk::menubutton::PostPosition {mb menu} { + set mh [expr {[winfo reqheight $menu]}] + set bh [expr {[winfo height $mb]}] + set mw [expr {[winfo reqwidth $menu]}] + set bw [expr {[winfo width $mb]}] + set dF [expr {[winfo width $mb] - [winfo reqwidth $menu]}] + if {[tk windowingsystem] eq "win32"} { + incr mh 6 + incr mw 16 + } + set entry {} + set entry [::tk::MenuFindName $menu [$mb cget -text]] + if {$entry eq {}} { + set entry 0 + } + set x [winfo rootx $mb] + set y [winfo rooty $mb] + switch [$mb cget -direction] { + above { + set entry {} + incr y -$mh + # 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]}] + } + } + below { + set entry {} + incr y $bh + # if we go offscreen to the bottom, show as 'above' + if {($y + $mh) > ([winfo vrooty $mb] + [winfo vrootheight $mb])} { + set y [expr {[winfo vrooty $mb] + [winfo vrootheight $mb] \ + + [winfo rooty $mb] - $mh}] + } + } + left { + incr x -$mw + } + right { + incr x $bw + } + default { + if {[$mb cget -style] eq ""} { + incr x [expr {([winfo width $mb] - \ + [winfo reqwidth $menu])/ 2}] + } else { + incr y $bh + } + } + } + return [list $x $y $entry] } - - return [list $x $y] } # Popdown -- @@ -107,8 +176,8 @@ proc ttk::menubutton::Popdown {mb} { if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} { return } - foreach {x y} [PostPosition $mb $menu] { break } - tk_popup $menu $x $y + foreach {x y entry} [PostPosition $mb $menu] { break } + tk_popup $menu $x $y $entry } # Pulldown (X11 only) -- @@ -121,13 +190,17 @@ proc ttk::menubutton::Pulldown {mb} { if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} { return } - foreach {x y} [PostPosition $mb $menu] { break } set State(pulldown) 1 set State(oldcursor) [$mb cget -cursor] $mb state pressed $mb configure -cursor [$menu cget -cursor] - $menu post $x $y + foreach {x y entry} [PostPosition $mb $menu] { break } + if {$entry ne {}} { + $menu post $x $y $entry + } else { + $menu post $x $y + } tk_menuSetFocus $menu } @@ -143,6 +216,7 @@ proc ttk::menubutton::TransferGrab {mb} { set State(pulldown) 0 set menu [$mb cget -menu] + foreach {x y entry} [PostPosition $mb $menu] { break } tk_popup $menu [winfo rootx $menu] [winfo rooty $menu] } } diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index 4bd5107..d08e1e2 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -2,24 +2,6 @@ # Bindings for TScrollbar widget # -# Still don't have a working ttk::scrollbar under OSX - -# Swap in a [tk::scrollbar] on that platform, -# unless user specifies -class or -style. -# -if {[tk windowingsystem] eq "aqua"} { - rename ::ttk::scrollbar ::ttk::_scrollbar - proc ttk::scrollbar {w args} { - set constructor ::tk::scrollbar - foreach {option _} $args { - if {$option eq "-class" || $option eq "-style"} { - set constructor ::ttk::_scrollbar - break - } - } - return [$constructor $w {*}$args] - } -} - namespace eval ttk::scrollbar { variable State # State(xPress) -- diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 1ed87db..6a6f5d4 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -336,6 +336,12 @@ proc ttk::treeview::CloseItem {w item} { ## Toggle -- toggle opened/closed state of item # 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 + } + # not a leaf, toggle! if {[$w item $item -open]} { CloseItem $w $item } else { |