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