mingw/lib/tk8.5/ttk/ttk.tcl

   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*