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

   1 #
   2 # $Id: ttk.tcl,v 1.8.2.1 2009/05/14 00:53:04 patthoyts 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 package ifneeded tile 0.8.0 { package require Tk ; package provide tile 0.8.0 }
  49
  50 # ttk::panedwindow used to be named ttk::paned.  Keep the alias for now.
  51 #
  52 ::ttk::deprecated ::ttk::paned ::ttk::panedwindow
  53
  54 ### ::ttk::ThemeChanged --
  55 #       Called from [::ttk::style theme use].
  56 #       Sends a <<ThemeChanged>> virtual event to all widgets.
  57 #
  58 proc ::ttk::ThemeChanged {} {
  59     set Q .
  60     while {[llength $Q]} {
  61         set QN [list]
  62         foreach w $Q {
  63             event generate $w <<ThemeChanged>>
  64             foreach child [winfo children $w] {
  65                 lappend QN $child
  66             }
  67         }
  68         set Q $QN
  69     }
  70 }
  71
  72 ### Public API.
  73 #
  74
  75 proc ::ttk::themes {{ptn *}} {
  76     set themes [list]
  77
  78     foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::$ptn] {
  79         lappend themes [namespace tail $pkg]
  80     }
  81
  82     return $themes
  83 }
  84
  85 ## ttk::setTheme $theme --
  86 #       Set the current theme to $theme, loading it if necessary.
  87 #
  88 proc ::ttk::setTheme {theme} {
  89     variable currentTheme ;# @@@ Temp -- [::ttk::style theme use] doesn't work
  90     if {$theme ni [::ttk::style theme names]} {
  91         package require ttk::theme::$theme
  92     }
  93     ::ttk::style theme use $theme
  94     set currentTheme $theme
  95 }
  96
  97 ### Load widget bindings.
  98 #
  99 source [file join $::ttk::library button.tcl]
 100 source [file join $::ttk::library menubutton.tcl]
 101 source [file join $::ttk::library scrollbar.tcl]
 102 source [file join $::ttk::library scale.tcl]
 103 source [file join $::ttk::library progress.tcl]
 104 source [file join $::ttk::library notebook.tcl]
 105 source [file join $::ttk::library panedwindow.tcl]
 106 source [file join $::ttk::library entry.tcl]
 107 source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
 108 source [file join $::ttk::library treeview.tcl]
 109 source [file join $::ttk::library sizegrip.tcl]
 110
 111 ## Label and Labelframe bindings:
 112 #  (not enough to justify their own file...)
 113 #
 114 bind TLabelframe <<Invoke>>     { tk::TabToWindow [tk_focusNext %W] }
 115 bind TLabel <<Invoke>>          { tk::TabToWindow [tk_focusNext %W] }
 116
 117 ### Load settings for built-in themes:
 118 #
 119 proc ttk::LoadThemes {} {
 120     variable library
 121
 122     # "default" always present:
 123     uplevel #0 [list source [file join $library defaults.tcl]]
 124
 125     set builtinThemes [style theme names]
 126     foreach {theme scripts} {
 127         classic         classicTheme.tcl
 128         alt             altTheme.tcl
 129         clam            clamTheme.tcl
 130         winnative       winTheme.tcl
 131         xpnative        {xpTheme.tcl vistaTheme.tcl}
 132         aqua            aquaTheme.tcl
 133     } {
 134         if {[lsearch -exact $builtinThemes $theme] >= 0} {
 135             foreach script $scripts {
 136                 uplevel #0 [list source [file join $library $script]]
 137             }
 138         }
 139     }
 140 }
 141
 142 ttk::LoadThemes; rename ::ttk::LoadThemes {}
 143
 144 ### Select platform-specific default theme:
 145 #
 146 # Notes:
 147 #       + On OSX, aqua theme is the default
 148 #       + On Windows, xpnative takes precedence over winnative if available.
 149 #       + On X11, users can use the X resource database to
 150 #         specify a preferred theme (*TkTheme: themeName);
 151 #         otherwise "default" is used.
 152 #
 153
 154 proc ttk::DefaultTheme {} {
 155     set preferred [list aqua vista xpnative winnative]
 156
 157     set userTheme [option get . tkTheme TkTheme]
 158     if {$userTheme ne {} && ![catch {
 159         uplevel #0 [list package require ttk::theme::$userTheme]
 160     }]} {
 161         return $userTheme
 162     }
 163
 164     foreach theme $preferred {
 165         if {[package provide ttk::theme::$theme] ne ""} {
 166             return $theme
 167         }
 168     }
 169     return "default"
 170 }
 171
 172 ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {}
 173
 174 #*EOF*