summaryrefslogtreecommitdiffstats
path: root/library/ttk/ttk.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/ttk/ttk.tcl')
-rw-r--r--library/ttk/ttk.tcl176
1 files changed, 176 insertions, 0 deletions
diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl
new file mode 100644
index 0000000..7bae211
--- /dev/null
+++ b/library/ttk/ttk.tcl
@@ -0,0 +1,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 [file join $::ttk::library fonts.tcl]
+source [file join $::ttk::library cursors.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.
+#
+#
+# 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 [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 spinbox.tcl] ;# dependency: entry.tcl
+source [file join $::ttk::library treeview.tcl]
+source [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 [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 [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*