From 6a53e1bcab0c83c50e6a686c0ac485687ff29b8f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Aug 2012 07:25:45 +0000 Subject: partly backport from 8.6 --- generic/ttk/ttkLabel.c | 4 +++ library/demos/mclist.tcl | 17 +++++++++++- library/demos/toolbar.tcl | 68 +++++++++++++++++++---------------------------- 3 files changed, 48 insertions(+), 41 deletions(-) diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index 52782ea..6dd1a9e 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -344,10 +344,14 @@ static void ImageDraw( * stipple the image. * @@@ Possibly: Don't do disabled-stippling at all; * @@@ it's ugly and out of fashion. + * Do not stipple at all under Aqua, just draw the image: it shows up + * as a white rectangle otherwise. */ if (state & TTK_STATE_DISABLED) { if (TtkSelectImage(image->imageSpec, 0ul) == image->tkimg) { +#ifndef MAC_OSX_TK StippleOver(image, tkwin, d, b.x,b.y); +#endif } } } diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl index d1d3f47..21dcf29 100644 --- a/library/demos/mclist.tcl +++ b/library/demos/mclist.tcl @@ -77,6 +77,16 @@ foreach {country capital currency} $data { ## Code to do the sorting of the tree contents when clicked on proc SortBy {tree col direction} { + # Determine currently sorted column and its sort direction + foreach c {country capital currency} { + set s [$tree heading $c state] + if {("selected" in $s || "alternate" in $s) && $col ne $c} { + # Sorted column has changed + $tree heading $c state {!selected !alternate !user1} + set direction [expr {"alternate" in $s}] + } + } + # Build something we can sort set data {} foreach row [$tree children {}] { @@ -92,5 +102,10 @@ proc SortBy {tree col direction} { } # Switch the heading so that it will sort in the opposite direction - $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] + $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \ + state [expr {$direction?"!selected alternate":"selected !alternate"}] + if {[tk windowingsystem] eq "aqua"} { + # Aqua theme displays native sort arrows when user1 state is set + $tree heading $col state "user1" + } } diff --git a/library/demos/toolbar.tcl b/library/demos/toolbar.tcl index 541e8ba..0ae4669 100644 --- a/library/demos/toolbar.tcl +++ b/library/demos/toolbar.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .toolbar destroy $w @@ -16,57 +15,46 @@ wm title $w "Toolbar Demonstration" wm iconname $w "toolbar" positionWindow $w -if {[tk windowingsystem] ne "aqua"} { - ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\ - a toolbar that is styled correctly and which can be torn off. The\ - buttons are configured to be \u201Ctoolbar style\u201D buttons by\ - telling them that they are to use the Toolbutton style. At the left\ - end of the toolbar is a simple marker that the cursor changes to a\ - movement icon over; drag that away from the toolbar to tear off the\ - whole toolbar into a separate toplevel widget. When the dragged-off\ - toolbar is no longer needed, just close it like any normal toplevel\ - and it will reattach to the window it was torn off from." -} else { ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\ - a toolbar that is styled correctly. The buttons are configured to\ - be \u201Ctoolbar style\u201D buttons by telling them that they are\ - to use the Toolbutton style." -} + a toolbar that is styled correctly and which can be torn off. The\ + buttons are configured to be \u201Ctoolbar style\u201D buttons by\ + telling them that they are to use the Toolbutton style. At the left\ + end of the toolbar is a simple marker that the cursor changes to a\ + movement icon over; drag that away from the toolbar to tear off the\ + whole toolbar into a separate toplevel widget. When the dragged-off\ + toolbar is no longer needed, just close it like any normal toplevel\ + and it will reattach to the window it was torn off from." ## Set up the toolbar hull set t [frame $w.toolbar] ;# Must be a frame! ttk::separator $w.sep ttk::frame $t.tearoff -cursor fleur -if {[tk windowingsystem] ne "aqua"} { - 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.to2 -fill y -expand 1 -side left -} +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.to2 -fill y -expand 1 -side left ttk::frame $t.contents grid $t.tearoff $t.contents -sticky nsew grid columnconfigure $t $t.contents -weight 1 grid columnconfigure $t.contents 1000 -weight 1 -if {[tk windowingsystem] ne "aqua"} { - ## Bindings so that the toolbar can be torn off and reattached - bind $t.tearoff [list tearoff $t %X %Y] - bind $t.tearoff.to [list tearoff $t %X %Y] - bind $t.tearoff.to2 [list tearoff $t %X %Y] - proc tearoff {w x y} { - if {[string match $w* [winfo containing $x $y]]} { - return - } - grid remove $w - grid remove $w.tearoff - wm manage $w - wm protocol $w WM_DELETE_WINDOW [list untearoff $w] - } - proc untearoff {w} { - wm forget $w - grid $w.tearoff - grid $w +## Bindings so that the toolbar can be torn off and reattached +bind $t.tearoff [list tearoff $t %X %Y] +bind $t.tearoff.to [list tearoff $t %X %Y] +bind $t.tearoff.to2 [list tearoff $t %X %Y] +proc tearoff {w x y} { + if {[string match $w* [winfo containing $x $y]]} { + return } + grid remove $w + grid remove $w.tearoff + wm manage $w + wm protocol $w WM_DELETE_WINDOW [list untearoff $w] +} +proc untearoff {w} { + wm forget $w + grid $w.tearoff + grid $w } ## Toolbar contents -- cgit v0.12