blob: 73ee3d9d97ef9a280293e8041cd73c3660ff82e8 (
plain)
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
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
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
#
# Ttk widget set initialization script.
#
### Source library scripts.
#
namespace eval ::ttk {
variable library
if {![info exists library]} {
set library [file dirname [info script]]
}
}
source -encoding utf-8 [file join $::ttk::library fonts.tcl]
source -encoding utf-8 [file join $::ttk::library cursors.tcl]
source -encoding utf-8 [file join $::ttk::library utils.tcl]
## ttk::deprecated $old $new --
# Define $old command as a deprecated alias for $new command
# $old and $new must be fully namespace-qualified.
#
proc ttk::deprecated {old new} {
interp alias {} $old {} ttk::do'deprecate $old $new
}
## do'deprecate --
# Implementation procedure for deprecated commands --
# issue a warning (once), then re-alias old to new.
#
proc ttk::do'deprecate {old new args} {
deprecated'warning $old $new
interp alias {} $old {} $new
uplevel 1 [linsert $args 0 $new]
}
## deprecated'warning --
# Gripe about use of deprecated commands.
#
proc ttk::deprecated'warning {old new} {
puts stderr "$old deprecated -- use $new instead"
}
### Backward-compatibility.
#
#
# Make [package require tile] an effective no-op;
# see SF#3016598 for discussion.
#
package ifneeded tile 0.8.6 { package provide tile 0.8.6 }
# ttk::panedwindow used to be named ttk::paned. Keep the alias for now.
#
::ttk::deprecated ::ttk::paned ::ttk::panedwindow
### ::ttk::ThemeChanged --
# Called from [::ttk::style theme use].
# Sends a <<ThemeChanged>> virtual event to all widgets.
#
proc ::ttk::ThemeChanged {} {
set Q .
while {[llength $Q]} {
set QN [list]
foreach w $Q {
event generate $w <<ThemeChanged>>
foreach child [winfo children $w] {
lappend QN $child
}
}
set Q $QN
}
}
### Public API.
#
proc ::ttk::themes {{ptn *}} {
set themes [list]
foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::$ptn] {
lappend themes [namespace tail $pkg]
}
return $themes
}
## ttk::setTheme $theme --
# Set the current theme to $theme, loading it if necessary.
#
proc ::ttk::setTheme {theme} {
variable currentTheme ;# @@@ Temp -- [::ttk::style theme use] doesn't work
if {$theme ni [::ttk::style theme names]} {
package require ttk::theme::$theme
}
::ttk::style theme use $theme
set currentTheme $theme
}
### Load widget bindings.
#
source -encoding utf-8 [file join $::ttk::library button.tcl]
source -encoding utf-8 [file join $::ttk::library menubutton.tcl]
source -encoding utf-8 [file join $::ttk::library scrollbar.tcl]
source -encoding utf-8 [file join $::ttk::library scale.tcl]
source -encoding utf-8 [file join $::ttk::library progress.tcl]
source -encoding utf-8 [file join $::ttk::library notebook.tcl]
source -encoding utf-8 [file join $::ttk::library panedwindow.tcl]
source -encoding utf-8 [file join $::ttk::library entry.tcl]
source -encoding utf-8 [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
source -encoding utf-8 [file join $::ttk::library spinbox.tcl] ;# dependency: entry.tcl
source -encoding utf-8 [file join $::ttk::library treeview.tcl]
source -encoding utf-8 [file join $::ttk::library sizegrip.tcl]
## Label and Labelframe bindings:
# (not enough to justify their own file...)
#
bind TLabelframe <<Invoke>> { tk::TabToWindow [tk_focusNext %W] }
bind TLabel <<Invoke>> { tk::TabToWindow [tk_focusNext %W] }
### Load settings for built-in themes:
#
proc ttk::LoadThemes {} {
variable library
# "default" always present:
uplevel #0 [list source -encoding utf-8 [file join $library defaults.tcl]]
set builtinThemes [style theme names]
foreach {theme scripts} {
classic classicTheme.tcl
alt altTheme.tcl
clam clamTheme.tcl
winnative winTheme.tcl
xpnative {xpTheme.tcl vistaTheme.tcl}
aqua aquaTheme.tcl
} {
if {[lsearch -exact $builtinThemes $theme] >= 0} {
foreach script $scripts {
uplevel #0 [list source -encoding utf-8 [file join $library $script]]
}
}
}
}
ttk::LoadThemes; rename ::ttk::LoadThemes {}
### Select platform-specific default theme:
#
# Notes:
# + On OSX, aqua theme is the default
# + On Windows, xpnative takes precedence over winnative if available.
# + On X11, users can use the X resource database to
# specify a preferred theme (*TkTheme: themeName);
# otherwise "default" is used.
#
proc ttk::DefaultTheme {} {
set preferred [list aqua vista xpnative winnative]
set userTheme [option get . tkTheme TkTheme]
if {$userTheme ne {} && ![catch {
uplevel #0 [list package require ttk::theme::$userTheme]
}]} {
return $userTheme
}
foreach theme $preferred {
if {[package provide ttk::theme::$theme] ne ""} {
return $theme
}
}
return "default"
}
ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {}
#*EOF*
|
