123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177 |
- #
- # Ttk widget set initialization script.
- #
- ### Source library scripts.
- #
- namespace eval ::ttk {
- variable library
- if {![info exists library]} {
- set library [file dirname [info script]]
- }
- }
- source [file join $::ttk::library fonts.tcl]
- source [file join $::ttk::library cursors.tcl]
- source [file join $::ttk::library utils.tcl]
- ## ttk::deprecated $old $new --
- # Define $old command as a deprecated alias for $new command
- # $old and $new must be fully namespace-qualified.
- #
- proc ttk::deprecated {old new} {
- interp alias {} $old {} ttk::do'deprecate $old $new
- }
- ## do'deprecate --
- # Implementation procedure for deprecated commands --
- # issue a warning (once), then re-alias old to new.
- #
- proc ttk::do'deprecate {old new args} {
- deprecated'warning $old $new
- interp alias {} $old {} $new
- uplevel 1 [linsert $args 0 $new]
- }
- ## deprecated'warning --
- # Gripe about use of deprecated commands.
- #
- proc ttk::deprecated'warning {old new} {
- puts stderr "$old deprecated -- use $new instead"
- }
- ### Backward-compatibility.
- #
- #
- # Make [package require tile] an effective no-op;
- # see SF#3016598 for discussion.
- #
- package ifneeded tile 0.8.6 { package provide tile 0.8.6 }
- # ttk::panedwindow used to be named ttk::paned. Keep the alias for now.
- #
- ::ttk::deprecated ::ttk::paned ::ttk::panedwindow
- ### ::ttk::ThemeChanged --
- # Called from [::ttk::style theme use].
- # Sends a <<ThemeChanged>> virtual event to all widgets.
- #
- proc ::ttk::ThemeChanged {} {
- set Q .
- while {[llength $Q]} {
- set QN [list]
- foreach w $Q {
- event generate $w <<ThemeChanged>>
- foreach child [winfo children $w] {
- lappend QN $child
- }
- }
- set Q $QN
- }
- }
- ### Public API.
- #
- proc ::ttk::themes {{ptn *}} {
- set themes [list]
- foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::$ptn] {
- lappend themes [namespace tail $pkg]
- }
- return $themes
- }
- ## ttk::setTheme $theme --
- # Set the current theme to $theme, loading it if necessary.
- #
- proc ::ttk::setTheme {theme} {
- variable currentTheme ;# @@@ Temp -- [::ttk::style theme use] doesn't work
- if {$theme ni [::ttk::style theme names]} {
- package require ttk::theme::$theme
- }
- ::ttk::style theme use $theme
- set currentTheme $theme
- }
- ### Load widget bindings.
- #
- source [file join $::ttk::library button.tcl]
- source [file join $::ttk::library menubutton.tcl]
- source [file join $::ttk::library scrollbar.tcl]
- source [file join $::ttk::library scale.tcl]
- source [file join $::ttk::library progress.tcl]
- source [file join $::ttk::library notebook.tcl]
- source [file join $::ttk::library panedwindow.tcl]
- source [file join $::ttk::library entry.tcl]
- source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
- source [file join $::ttk::library spinbox.tcl] ;# dependency: entry.tcl
- source [file join $::ttk::library treeview.tcl]
- source [file join $::ttk::library sizegrip.tcl]
- ## Label and Labelframe bindings:
- # (not enough to justify their own file...)
- #
- bind TLabelframe <<Invoke>> { tk::TabToWindow [tk_focusNext %W] }
- bind TLabel <<Invoke>> { tk::TabToWindow [tk_focusNext %W] }
- ### Load settings for built-in themes:
- #
- proc ttk::LoadThemes {} {
- variable library
- # "default" always present:
- uplevel #0 [list source [file join $library defaults.tcl]]
- set builtinThemes [style theme names]
- foreach {theme scripts} {
- classic classicTheme.tcl
- alt altTheme.tcl
- clam clamTheme.tcl
- winnative winTheme.tcl
- xpnative {xpTheme.tcl vistaTheme.tcl}
- aqua aquaTheme.tcl
- } {
- if {[lsearch -exact $builtinThemes $theme] >= 0} {
- foreach script $scripts {
- uplevel #0 [list source [file join $library $script]]
- }
- }
- }
- }
- ttk::LoadThemes; rename ::ttk::LoadThemes {}
- ### Select platform-specific default theme:
- #
- # Notes:
- # + On OSX, aqua theme is the default
- # + On Windows, xpnative takes precedence over winnative if available.
- # + On X11, users can use the X resource database to
- # specify a preferred theme (*TkTheme: themeName);
- # otherwise "default" is used.
- #
- proc ttk::DefaultTheme {} {
- set preferred [list aqua vista xpnative winnative]
- set userTheme [option get . tkTheme TkTheme]
- if {$userTheme ne {} && ![catch {
- uplevel #0 [list package require ttk::theme::$userTheme]
- }]} {
- return $userTheme
- }
- foreach theme $preferred {
- if {[package provide ttk::theme::$theme] ne ""} {
- return $theme
- }
- }
- return "default"
- }
- ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {}
- #*EOF*
|