1# 2# $Id$ 3# 4# Ttk widget set initialization script. 5# 6 7### Source library scripts. 8# 9 10namespace eval ::ttk { 11 variable library 12 if {![info exists library]} { 13 set library [file dirname [info script]] 14 } 15} 16 17source [file join $::ttk::library fonts.tcl] 18source [file join $::ttk::library cursors.tcl] 19source [file join $::ttk::library utils.tcl] 20 21## ttk::deprecated $old $new -- 22# Define $old command as a deprecated alias for $new command 23# $old and $new must be fully namespace-qualified. 24# 25proc ttk::deprecated {old new} { 26 interp alias {} $old {} ttk::do'deprecate $old $new 27} 28## do'deprecate -- 29# Implementation procedure for deprecated commands -- 30# issue a warning (once), then re-alias old to new. 31# 32proc ttk::do'deprecate {old new args} { 33 deprecated'warning $old $new 34 interp alias {} $old {} $new 35 uplevel 1 [linsert $args 0 $new] 36} 37 38## deprecated'warning -- 39# Gripe about use of deprecated commands. 40# 41proc ttk::deprecated'warning {old new} { 42 puts stderr "$old deprecated -- use $new instead" 43} 44 45### Backward-compatibility. 46# 47# 48# Make [package require tile] an effective no-op; 49# see SF#3016598 for discussion. 50# 51package ifneeded tile 0.8.6 { package provide tile 0.8.6 } 52 53# ttk::panedwindow used to be named ttk::paned. Keep the alias for now. 54# 55::ttk::deprecated ::ttk::paned ::ttk::panedwindow 56 57### ::ttk::ThemeChanged -- 58# Called from [::ttk::style theme use]. 59# Sends a <<ThemeChanged>> virtual event to all widgets. 60# 61proc ::ttk::ThemeChanged {} { 62 set Q . 63 while {[llength $Q]} { 64 set QN [list] 65 foreach w $Q { 66 event generate $w <<ThemeChanged>> 67 foreach child [winfo children $w] { 68 lappend QN $child 69 } 70 } 71 set Q $QN 72 } 73} 74 75### Public API. 76# 77 78proc ::ttk::themes {{ptn *}} { 79 set themes [list] 80 81 foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::$ptn] { 82 lappend themes [namespace tail $pkg] 83 } 84 85 return $themes 86} 87 88## ttk::setTheme $theme -- 89# Set the current theme to $theme, loading it if necessary. 90# 91proc ::ttk::setTheme {theme} { 92 variable currentTheme ;# @@@ Temp -- [::ttk::style theme use] doesn't work 93 if {$theme ni [::ttk::style theme names]} { 94 package require ttk::theme::$theme 95 } 96 ::ttk::style theme use $theme 97 set currentTheme $theme 98} 99 100### Load widget bindings. 101# 102source [file join $::ttk::library button.tcl] 103source [file join $::ttk::library menubutton.tcl] 104source [file join $::ttk::library scrollbar.tcl] 105source [file join $::ttk::library scale.tcl] 106source [file join $::ttk::library progress.tcl] 107source [file join $::ttk::library notebook.tcl] 108source [file join $::ttk::library panedwindow.tcl] 109source [file join $::ttk::library entry.tcl] 110source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl 111source [file join $::ttk::library spinbox.tcl] ;# dependency: entry.tcl 112source [file join $::ttk::library treeview.tcl] 113source [file join $::ttk::library sizegrip.tcl] 114 115## Label and Labelframe bindings: 116# (not enough to justify their own file...) 117# 118bind TLabelframe <<Invoke>> { tk::TabToWindow [tk_focusNext %W] } 119bind TLabel <<Invoke>> { tk::TabToWindow [tk_focusNext %W] } 120 121### Load settings for built-in themes: 122# 123proc ttk::LoadThemes {} { 124 variable library 125 126 # "default" always present: 127 uplevel #0 [list source [file join $library defaults.tcl]] 128 129 set builtinThemes [style theme names] 130 foreach {theme scripts} { 131 classic classicTheme.tcl 132 alt altTheme.tcl 133 clam clamTheme.tcl 134 winnative winTheme.tcl 135 xpnative {xpTheme.tcl vistaTheme.tcl} 136 aqua aquaTheme.tcl 137 } { 138 if {[lsearch -exact $builtinThemes $theme] >= 0} { 139 foreach script $scripts { 140 uplevel #0 [list source [file join $library $script]] 141 } 142 } 143 } 144} 145 146ttk::LoadThemes; rename ::ttk::LoadThemes {} 147 148### Select platform-specific default theme: 149# 150# Notes: 151# + On OSX, aqua theme is the default 152# + On Windows, xpnative takes precedence over winnative if available. 153# + On X11, users can use the X resource database to 154# specify a preferred theme (*TkTheme: themeName); 155# otherwise "default" is used. 156# 157 158proc ttk::DefaultTheme {} { 159 set preferred [list aqua vista xpnative winnative] 160 161 set userTheme [option get . tkTheme TkTheme] 162 if {$userTheme ne {} && ![catch { 163 uplevel #0 [list package require ttk::theme::$userTheme] 164 }]} { 165 return $userTheme 166 } 167 168 foreach theme $preferred { 169 if {[package provide ttk::theme::$theme] ne ""} { 170 return $theme 171 } 172 } 173 return "default" 174} 175 176ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {} 177 178#*EOF* 179