Tk Source Code

Changes On Branch tip-645
Login
☰Core Home Timeline Branches Tags Tickets Wiki
Hide Diff Patch Unified Diff
Bounty program for improvements to Tcl and certain Tcl packages.

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

Changes In Branch tip-645 Excluding Merge-Ins

This is equivalent to a diff from 06929a0f to adc596af

2022-10-27
16:13
TIP #645: ttk color palette support check-in: 755608c3 user: jan.nijtmans tags: trunk, main
2022-10-26
09:29
Some updates from latest X11 headers check-in: 52b8a9e5 user: jan.nijtmans tags: trunk, main
2022-10-25
08:52
Merge 8.7 Closed-Leaf check-in: adc596af user: jan.nijtmans tags: tip-645
08:50
Merge 8.7 check-in: ff665fa8 user: jan.nijtmans tags: revised_text, tip-466
08:50
Fix bug in rules.vc (handle TK_MAJOR_VERSION the same as TCL_MAJOR_VERSION) check-in: 06929a0f user: jan.nijtmans tags: trunk, main
08:41
Fix bogus test numbering. check-in: a99a2a16 user: oehhar tags: trunk, main
2022-10-24
21:52
Rebase to latest 8.7 check-in: bc1f75f4 user: jan.nijtmans tags: tip-645

Changes to library/iconlist.tcl.

︙︙
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387

	}

	my DrawSelection
    }

    method DrawSelection {} {
	$canvas delete selection
	$canvas itemconfigure selectionText -fill black
	$canvas dtag selectionText
	set cbg [ttk::style lookup TEntry -selectbackground focus]
	set cfg [ttk::style lookup TEntry -selectforeground focus]
	foreach item $selection {
	    set rTag [lindex $list $item 2]
	    foreach {iTag tTag text serial} $itemList($rTag) {
		break







|








373
374
375
376
377
378
379
380
381
382
383
384
385
386
387

	}

	my DrawSelection
    }

    method DrawSelection {} {
	$canvas delete selection
	$canvas itemconfigure selectionText -fill $fill
	$canvas dtag selectionText
	set cbg [ttk::style lookup TEntry -selectbackground focus]
	set cfg [ttk::style lookup TEntry -selectforeground focus]
	foreach item $selection {
	    set rTag [lindex $list $item 2]
	    foreach {iTag tTag text serial} $itemList($rTag) {
		break
︙︙
401
402
403
404
405
406
407
408

409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437

    #	operations.
    #
    method Create {} {
	variable hull
	set sbar [ttk::scrollbar $hull.sbar -orient horizontal -takefocus 0]
	catch {$sbar configure -highlightthickness 0}
	set canvas [canvas $hull.canvas -highlightthick 0 -takefocus 1 \
			-width 400 -height 120 -background white]

	pack $sbar -side bottom -fill x -padx 2 -pady {0 2}
	pack $canvas -expand yes -fill both -padx 2 -pady {2 0}

	$sbar configure -command [list $canvas xview]
	$canvas configure -xscrollcommand [list $sbar set]

	# Initializes the max icon/text width and height and other variables
	#
	set maxIW 1
	set maxIH 1
	set maxTW 1
	set maxTH 1
	set numItems 0
	set noScroll 1
	set selection {}
	set index(anchor) ""
	set fg [option get $canvas foreground Foreground]
	if {$fg eq ""} {
	    set fill black
	} else {
	    set fill $fg
	}

	# Creates the event bindings.
	#
	bind $canvas <Configure>	[namespace code {my WhenIdle Arrange}]

	bind $canvas <Button-1>		[namespace code {my Btn1 %x %y}]
	bind $canvas <B1-Motion>	[namespace code {my Motion1 %x %y}]







|
>
















<
<
<
<
|
<








401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425




426

427
428
429
430
431
432
433

    #	operations.
    #
    method Create {} {
	variable hull
	set sbar [ttk::scrollbar $hull.sbar -orient horizontal -takefocus 0]
	catch {$sbar configure -highlightthickness 0}
	set canvas [canvas $hull.canvas -highlightthick 0 -takefocus 1 \
			-width 400 -height 120 \
			-background [ttk::style lookup Treeview -background {} white]]
	pack $sbar -side bottom -fill x -padx 2 -pady {0 2}
	pack $canvas -expand yes -fill both -padx 2 -pady {2 0}

	$sbar configure -command [list $canvas xview]
	$canvas configure -xscrollcommand [list $sbar set]

	# Initializes the max icon/text width and height and other variables
	#
	set maxIW 1
	set maxIH 1
	set maxTW 1
	set maxTH 1
	set numItems 0
	set noScroll 1
	set selection {}
	set index(anchor) ""




	set fill [ttk::style lookup Treeview -foreground {} black]


	# Creates the event bindings.
	#
	bind $canvas <Configure>	[namespace code {my WhenIdle Arrange}]

	bind $canvas <Button-1>		[namespace code {my Btn1 %x %y}]
	bind $canvas <B1-Motion>	[namespace code {my Motion1 %x %y}]
︙︙

Changes to library/palette.tcl.

︙︙
135
136
137
138
139
140
141
















142
143
144
145
146
147
148

	option add *$option $new($option) widgetDefault
    }

    # Save the options in the variable ::tk::Palette, for use the
    # next time we change the options.

    array set ::tk::Palette [array get new]
















}

# ::tk::RecolorTree --
# This procedure changes the colors in a window and all of its
# descendants, according to information provided by the colors
# argument. This looks at the defaults provided by the option
# database, if it exists, and if not, then it looks at the default







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164

	option add *$option $new($option) widgetDefault
    }

    # Save the options in the variable ::tk::Palette, for use the
    # next time we change the options.

    array set ::tk::Palette [array get new]

    # Update the 'default' ttk theme with the new palette,
    # and then set 'default' as the current ttk theme,
    # in order to apply the new palette to the ttk widgets.

    foreach option [array names new] {
	if {[info exists ttk::theme::default::colorOptionLookup($option)]} {
	    foreach colorName $ttk::theme::default::colorOptionLookup($option) {
		set ttk::theme::default::colors($colorName) $new($option)
	    }
	}
    }
    ttk::theme::default::reconfigureDefaultTheme
    ttk::setTheme default

    return
}

# ::tk::RecolorTree --
# This procedure changes the colors in a window and all of its
# descendants, according to information provided by the colors
# argument. This looks at the defaults provided by the option
# database, if it exists, and if not, then it looks at the default
︙︙

Changes to library/ttk/defaults.tcl.

︙︙
17
18
19
20
21
22
23



























































24
25
26
27
28
29
30

	-disabledfg		"#a3a3a3"
	-indicator		"#4a6984"
	-disabledindicator	"#a3a3a3"
	-altindicator		"#9fbdd8"
	-disabledaltindicator	"#c0c0c0"
    }




























































    ttk::style theme settings default {

	ttk::style configure "." \
	    -borderwidth 	1 \
	    -background 	$colors(-frame) \
	    -foreground 	$colors(-foreground) \
	    -troughcolor 	$colors(-darker) \







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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
77
78
79
80
81
82
83
84
85
86
87
88
89

	-disabledfg		"#a3a3a3"
	-indicator		"#4a6984"
	-disabledindicator	"#a3a3a3"
	-altindicator		"#9fbdd8"
	-disabledaltindicator	"#c0c0c0"
    }

    # On X11, if the user specifies their own choice of colour scheme via X resources,
    # then set the colour palette based on the user's choice.
    if {[tk windowingsystem] eq "x11"} {
	foreach\
	    xResourceName\
                 { {	background		Background		}
                 {	foreground		Foreground		}
                 {	background		Background		}
                 {	foreground		Foreground		}
                 {	activeBackground	ActiveBackground	}
                 {	selectBackground	SelectBackground	}
                 {	selectForeground	SelectForeground	}
                 {	troughColor		TroughColor		}
                 {	disabledForeground	DisabledForeground	}
                 {	selectBackground	SelectBackground	}
                 {	disabledForeground	DisabledForeground	}
                 {	selectBackground	SelectBackground	}
                 {	troughColor		TroughColor		} }\
	    colorName\
                 { -frame -foreground -window -text
                 -activebg -selectbg -selectfg
                 -darker -disabledfg -indicator
                 -disabledindicator -altindicator
                 -disabledaltindicator }\
	{
	    set color [eval option get . $xResourceName]
	    if {$color ne ""} {
                 set colors($colorName) $color
	    }
	}
    }
    # This array is used to match up the tk widget options with the
    # corresponding values in the 'colors' array.
    # This is used by tk_setPalette to apply the new palette
    # to the ttk widgets.
    variable colorOptionLookup
    array set colorOptionLookup {
	background		{-frame -window}
	foreground		{-foreground -text}
	activeBackground	-activebg
	selectBackground	{-selectbg -indicator -altindicator}
	selectForeground	-selectfg
	troughColor		{-darker -disabledaltindicator}
	disabledForeground	{-disabledfg -disabledindicator}
    }
}
# ttk::theme::default::reconfigureDefaultTheme --
# This procedure contains the definition of the 'default' theme itself.
# The theme definition is in a procedure, so it can be re-called
# when required, enabling tk_setPalette to set the colours
# of the ttk widgets.
#
# Arguments:
# None.

proc ttk::theme::default::reconfigureDefaultTheme {} {
    upvar ttk::theme::default::colors colors
    # The definition of the 'default' theme.

    ttk::style theme settings default {

	ttk::style configure "." \
	    -borderwidth 	1 \
	    -background 	$colors(-frame) \
	    -foreground 	$colors(-foreground) \
	    -troughcolor 	$colors(-darker) \
︙︙
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
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

	ttk::style configure TButton \
	    -anchor center -padding "3 3" -width -9 \
	    -relief raised -shiftrelief 1
	ttk::style map TButton -relief [list {!disabled pressed} sunken]

	ttk::style configure TCheckbutton \
	    -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
	ttk::style map TCheckbutton -indicatorcolor \
	    [list pressed $colors(-activebg)  \
			{!disabled alternate} $colors(-altindicator) \
			{disabled alternate} $colors(-disabledaltindicator) \
			{!disabled selected} $colors(-indicator) \
			{disabled selected} $colors(-disabledindicator)]
	ttk::style map TCheckbutton -indicatorrelief \
	    [list alternate raised]

	ttk::style configure TRadiobutton \
	    -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
	ttk::style map TRadiobutton -indicatorcolor \
	    [list pressed $colors(-activebg)  \
			{!disabled alternate} $colors(-altindicator) \
			{disabled alternate} $colors(-disabledaltindicator) \
			{!disabled selected} $colors(-indicator) \
			{disabled selected} $colors(-disabledindicator)]
	ttk::style map TRadiobutton -indicatorrelief \
	    [list alternate raised]

	ttk::style configure TMenubutton \
	    -relief raised -padding "10 3"

	ttk::style configure TEntry \
	    -relief sunken -fieldbackground white -padding 1
	ttk::style map TEntry -fieldbackground \
	    [list readonly $colors(-frame) disabled $colors(-frame)]

	ttk::style configure TCombobox -arrowsize 12 -padding 1
	ttk::style map TCombobox -fieldbackground \
	    [list readonly $colors(-frame) disabled $colors(-frame)] \
	    -arrowcolor [list disabled $colors(-disabledfg)]

	ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
	ttk::style map TSpinbox -fieldbackground \
	    [list readonly $colors(-frame) disabled $colors(-frame)] \
	    -arrowcolor [list disabled $colors(-disabledfg)]

	ttk::style configure TLabelframe \
	    -relief groove -borderwidth 2

	ttk::style configure TScrollbar \
	    -width 12 -arrowsize 12
	ttk::style map TScrollbar \
	    -arrowcolor [list disabled $colors(-disabledfg)]

	ttk::style configure TScale \
	    -sliderrelief raised
	ttk::style configure TProgressbar \
	    -background $colors(-selectbg)

	ttk::style configure TNotebook.Tab \







|










|













|






|




|







|








102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

	ttk::style configure TButton \
	    -anchor center -padding "3 3" -width -9 \
	    -relief raised -shiftrelief 1
	ttk::style map TButton -relief [list {!disabled pressed} sunken]

	ttk::style configure TCheckbutton \
	    -indicatorcolor $colors(-window) -indicatorrelief sunken -padding 1
	ttk::style map TCheckbutton -indicatorcolor \
	    [list pressed $colors(-activebg)  \
			{!disabled alternate} $colors(-altindicator) \
			{disabled alternate} $colors(-disabledaltindicator) \
			{!disabled selected} $colors(-indicator) \
			{disabled selected} $colors(-disabledindicator)]
	ttk::style map TCheckbutton -indicatorrelief \
	    [list alternate raised]

	ttk::style configure TRadiobutton \
	    -indicatorcolor $colors(-window) -indicatorrelief sunken -padding 1
	ttk::style map TRadiobutton -indicatorcolor \
	    [list pressed $colors(-activebg)  \
			{!disabled alternate} $colors(-altindicator) \
			{disabled alternate} $colors(-disabledaltindicator) \
			{!disabled selected} $colors(-indicator) \
			{disabled selected} $colors(-disabledindicator)]
	ttk::style map TRadiobutton -indicatorrelief \
	    [list alternate raised]

	ttk::style configure TMenubutton \
	    -relief raised -padding "10 3"

	ttk::style configure TEntry \
	    -relief sunken -fieldbackground $colors(-window) -padding 1
	ttk::style map TEntry -fieldbackground \
	    [list readonly $colors(-frame) disabled $colors(-frame)]

	ttk::style configure TCombobox -arrowsize 12 -padding 1
	ttk::style map TCombobox -fieldbackground \
	    [list readonly $colors(-frame) disabled $colors(-frame)] \
	    -arrowcolor [list disabled $colors(-disabledfg) !disabled $colors(-text)]

	ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0}
	ttk::style map TSpinbox -fieldbackground \
	    [list readonly $colors(-frame) disabled $colors(-frame)] \
	    -arrowcolor [list disabled $colors(-disabledfg) !disabled $colors(-text)]

	ttk::style configure TLabelframe \
	    -relief groove -borderwidth 2

	ttk::style configure TScrollbar \
	    -width 12 -arrowsize 12
	ttk::style map TScrollbar \
	    -arrowcolor [list disabled $colors(-disabledfg) !disabled $colors(-text)]

	ttk::style configure TScale \
	    -sliderrelief raised
	ttk::style configure TProgressbar \
	    -background $colors(-selectbg)

	ttk::style configure TNotebook.Tab \
︙︙
141
142
143
144
145
146
147



	    -padding 2 -relief flat
	ttk::style map Toolbutton -relief \
	    [list disabled flat selected sunken pressed sunken active raised]
	ttk::style map Toolbutton -background \
	    [list pressed $colors(-darker)  active $colors(-activebg)]
    }
}









>
>

200
201
202
203
204
205
206
207
208

	    -padding 2 -relief flat
	ttk::style map Toolbutton -relief \
	    [list disabled flat selected sunken pressed sunken active raised]
	ttk::style map Toolbutton -background \
	    [list pressed $colors(-darker)  active $colors(-activebg)]
    }
}

ttk::theme::default::reconfigureDefaultTheme

This page was generated in about 0.025s by Fossil 2.21 [a9e862b887] 2022-11-30 12:19:33