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

   1 #
   2 # $Id: ttk.tcl,v 1.8.2.2 2010/08/26 02:06:10 hobbs Exp $
   3 #
   4 # Ttk widget set initialization script.
   5 #
   6
   7 ### Source library scripts.
   8 #
   9
  10 namespace eval ::ttk {
  11     variable library
  12     if {![info exists library]} {
  13         set library [file dirname [info script]]
  14     }
  15 }
  16
  17 source [file join $::ttk::library fonts.tcl]
  18 source [file join $::ttk::library cursors.tcl]
  19 source [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 #
  25 proc 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 #
  32 proc 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 #
  41 proc 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 #
  51 package 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 #
  61 proc ::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
  78 proc ::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 #
  91 proc ::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 #
 102 source [file join $::ttk::library button.tcl]
 103 source [file join $::ttk::library menubutton.tcl]
 104 source [file join $::ttk::library scrollbar.tcl]
 105 source [file join $::ttk::library scale.tcl]
 106 source [file join $::ttk::library progress.tcl]
 107 source [file join $::ttk::library notebook.tcl]
 108 source [file join $::ttk::library panedwindow.tcl]
 109 source [file join $::ttk::library entry.tcl]
 110 source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
 111 source [file join $::ttk::library spinbox.tcl]  ;# dependency: entry.tcl
 112 source [file join $::ttk::library treeview.tcl]
 113 source [file join $::ttk::library sizegrip.tcl]
 114
 115 ## Label and Labelframe bindings:
 116 #  (not enough to justify their own file...)
 117 #
 118 bind TLabelframe <<Invoke>>     { tk::TabToWindow [tk_focusNext %W] }
 119 bind TLabel <<Invoke>>          { tk::TabToWindow [tk_focusNext %W] }
 120
 121 ### Load settings for built-in themes:
 122 #
 123 proc 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
 146 ttk::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
 158 proc 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
 176 ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {}
 177
 178 #*EOF*