blob: 5c1b5b28e8c371f81d2d6eed912e3d7b685159e6 (
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
|
#
# $Id: ttk.tcl,v 1.3 2006/12/13 05:36:38 jenglish 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
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.
#
# 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 [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*
|
