Tk Source Code

Check-in [c2823d74]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:partly backport from 8.6
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: c2823d7427796e73fc120b6808e4b424d106eb72
User & Date: jan.nijtmans 2012-08-09 07:25:45
Context
2012-08-09
16:40
Remove useless (void *) casts introduced in checkin [b7a58eae61]. The warnings were false flags from a faulty OpenBSD C compiler. check-in: 25ed4c46 user: stwo tags: core-8-5-branch
08:22
formatting, unnecessary if's check-in: ec385b79 user: jan.nijtmans tags: trunk
07:52
full merge of cocoa experiment, ready to be merged to core-8-5-branch and from there further merge-marked to tk-cocoa-8-5-backport and trunk Closed-Leaf check-in: 3ddbcef2 user: jan.nijtmans tags: jn-cocoa-full-merge-8.5
07:40
merge core-8-5-branch check-in: e3e4eb60 user: jan.nijtmans tags: tk-cocoa-8-5-backport
07:25
partly backport from 8.6 check-in: c2823d74 user: jan.nijtmans tags: core-8-5-branch
2012-08-07
06:52
Installer improvements, like [a3b936f0a1]. check-in: e15a29a0 user: stwo tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/ttk/ttkLabel.c.

340
341
342
343
344
345
346


347
348
349

350

351
352
353
354
355
356
357

    Tk_RedrawImage(image->tkimg, 0,0, width, height, d, b.x, b.y);

    /* If we're disabled there's no state-specific 'disabled' image, 
     * stipple the image.
     * @@@ Possibly: Don't do disabled-stippling at all;
     * @@@ it's ugly and out of fashion.


     */
    if (state & TTK_STATE_DISABLED) {
	if (TtkSelectImage(image->imageSpec, 0ul) == image->tkimg) {

	    StippleOver(image, tkwin, d, b.x,b.y);

	}
    }
}

static void ImageElementSize(
    void *clientData, void *elementRecord, Tk_Window tkwin,
    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)







>
>



>

>







340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361

    Tk_RedrawImage(image->tkimg, 0,0, width, height, d, b.x, b.y);

    /* If we're disabled there's no state-specific 'disabled' image, 
     * 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
	}
    }
}

static void ImageElementSize(
    void *clientData, void *elementRecord, Tk_Window tkwin,
    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)

Changes to library/demos/mclist.tcl.

73
74
75
76
77
78
79










80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95




96

	    $w.tree column $col -width $len
	}
    }
}

## Code to do the sorting of the tree contents when clicked on
proc SortBy {tree col direction} {










    # Build something we can sort
    set data {}
    foreach row [$tree children {}] {
	lappend data [list [$tree set $row $col] $row]
    }

    set dir [expr {$direction ? "-decreasing" : "-increasing"}]
    set r -1

    # Now reshuffle the rows into the sorted order
    foreach info [lsort -dictionary -index 0 $dir $data] {
	$tree move [lindex $info 1] {} [incr r]
    }

    # Switch the heading so that it will sort in the opposite direction
    $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]]




}








>
>
>
>
>
>
>
>
>
>















|
>
>
>
>
|
>
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
	    $w.tree column $col -width $len
	}
    }
}

## 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 {}] {
	lappend data [list [$tree set $row $col] $row]
    }

    set dir [expr {$direction ? "-decreasing" : "-increasing"}]
    set r -1

    # Now reshuffle the rows into the sorted order
    foreach info [lsort -dictionary -index 0 $dir $data] {
	$tree move [lindex $info 1] {} [incr r]
    }

    # Switch the heading so that it will sort in the opposite 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"
    }
}

Changes to library/demos/toolbar.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
# toolbar.tcl --
#
# This demonstration script creates a toolbar that can be torn off.

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

package require Tk
package require Ttk

set w .toolbar
destroy $w
toplevel $w
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."
}

## 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::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     <B1-Motion> [list tearoff $t %X %Y]
    bind $t.tearoff.to  <B1-Motion> [list tearoff $t %X %Y]
    bind $t.tearoff.to2 <B1-Motion> [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
ttk::button $t.button -text "Button" -style Toolbutton -command [list \
	$w.txt insert end "Button Pressed\n"]
ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \
	-command [concat [list $w.txt insert end] {"check is $check\n"}]









<








<
|
|
|
|
|
|
|
|
|
<
<
<
<
<
<





<
|
|
|
|
<





<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<







1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17

18
19
20
21
22
23
24
25
26






27
28
29
30
31

32
33
34
35

36
37
38
39
40

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

58
59
60
61
62
63
64
# toolbar.tcl --
#
# This demonstration script creates a toolbar that can be torn off.

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

package require Tk


set w .toolbar
destroy $w
toplevel $w
wm title $w "Toolbar Demonstration"
wm iconname $w "toolbar"
positionWindow $w


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."







## Set up the toolbar hull
set t [frame $w.toolbar]		;# Must be a frame!
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.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


## Bindings so that the toolbar can be torn off and reattached
bind $t.tearoff     <B1-Motion> [list tearoff $t %X %Y]
bind $t.tearoff.to  <B1-Motion> [list tearoff $t %X %Y]
bind $t.tearoff.to2 <B1-Motion> [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
ttk::button $t.button -text "Button" -style Toolbutton -command [list \
	$w.txt insert end "Button Pressed\n"]
ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \
	-command [concat [list $w.txt insert end] {"check is $check\n"}]