Add files via upload
This commit is contained in:
MatMasIt
176
windowsAgent/dist/tk/ttk/ttk.tcl
vendored
Normal file
176
windowsAgent/dist/tk/ttk/ttk.tcl
vendored
Normal file
@ -0,0 +1,176 @@
|
||||
#
|
||||
# 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*
|
||||
Reference in New Issue
Block a user