blob: f573bfcc991314deace35646748c071dc8c42101 (
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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
#
# $Id: ttk.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
#
# Ttk widget set initialization script.
#
### Source library scripts.
#
namespace eval ::ttk {
variable library
if {![info exists library]} {
set library [file dirname [info script]]
}
}
source [file join $::ttk::library keynav.tcl]
source [file join $::ttk::library fonts.tcl]
source [file join $::ttk::library cursors.tcl]
source [file join $::ttk::library icons.tcl]
source [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
eval [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"
}
### Forward-compatibility.
#
# ttk::panedwindow used to be named ttk::paned. Keep the alias for now.
#
::ttk::deprecated ::ttk::paned ::ttk::panedwindow
if {[info exists ::ttk::deprecrated] && $::ttk::deprecated} {
### Deprecated bits.
#
namespace eval ::tile {
# Deprecated namespace. Define these only when requested
variable library
if {![info exists library]} {
set library [file dirname [info script]]
}
variable version 0.7.8
variable patchlevel 0.7.8
}
package provide tile $::tile::version
### Widgets.
# Widgets are all defined in the ::ttk namespace.
#
# For compatibility with earlier Tile releases, we temporarily
# create aliases ::tile::widget, and ::t$widget.
# Using any of the aliases will issue a warning.
#
namespace eval ttk {
variable widgets {
button checkbutton radiobutton menubutton label entry
frame labelframe scrollbar
notebook progressbar combobox separator
scale
}
variable wc
foreach wc $widgets {
namespace export $wc
deprecated ::t$wc ::ttk::$wc
deprecated ::tile::$wc ::ttk::$wc
namespace eval ::tile [list namespace export $wc]
}
}
}
### ::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 [file join $::ttk::library button.tcl]
source [file join $::ttk::library menubutton.tcl]
source [file join $::ttk::library scrollbar.tcl]
source [file join $::ttk::library scale.tcl]
source [file join $::ttk::library progress.tcl]
source [file join $::ttk::library notebook.tcl]
source [file join $::ttk::library panedwindow.tcl]
source [file join $::ttk::library entry.tcl]
source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
source [file join $::ttk::library treeview.tcl]
source [file join $::ttk::library sizegrip.tcl]
source [file join $::ttk::library dialog.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 themes.
#
source [file join $::ttk::library defaults.tcl]
source [file join $::ttk::library classicTheme.tcl]
source [file join $::ttk::library altTheme.tcl]
source [file join $::ttk::library clamTheme.tcl]
### Choose platform-specific default theme.
#
# Notes:
# + xpnative takes precedence over winnative if available.
# + On X11, users can use the X resource database to
# specify a preferred theme (*TkTheme: themeName)
#
set ::ttk::defaultTheme "default"
if {[package provide ttk::theme::winnative] != {}} {
source [file join $::ttk::library winTheme.tcl]
set ::ttk::defaultTheme "winnative"
}
if {[package provide ttk::theme::xpnative] != {}} {
source [file join $::ttk::library xpTheme.tcl]
set ::ttk::defaultTheme "xpnative"
}
if {[package provide ttk::theme::aqua] != {}} {
source [file join $::ttk::library aquaTheme.tcl]
set ::ttk::defaultTheme "aqua"
}
set ::ttk::userTheme [option get . tkTheme TkTheme]
if {$::ttk::userTheme != {}} {
if {($::ttk::userTheme in [::ttk::style theme names])
|| ![catch {package require ttk::theme::$ttk::userTheme}]} {
set ::ttk::defaultTheme $::ttk::userTheme
}
}
::ttk::setTheme $::ttk::defaultTheme
#*EOF*
|
