diff options
author | jenglish <jenglish@flightlab.com> | 2007-05-25 22:55:02 (GMT) |
---|---|---|
committer | jenglish <jenglish@flightlab.com> | 2007-05-25 22:55:02 (GMT) |
commit | 30cec316c5ebe0578971b60f4f97c125278928cf (patch) | |
tree | 78d8894c7ba39e5bafdd9c976ac7688df68cfda8 /library | |
parent | 0d4c1b1e1fdd1bc5132dc0eeb6f4e49679c41e87 (diff) | |
download | tk-30cec316c5ebe0578971b60f4f97c125278928cf.zip tk-30cec316c5ebe0578971b60f4f97c125278928cf.tar.gz tk-30cec316c5ebe0578971b60f4f97c125278928cf.tar.bz2 |
Removed ttk::dialog and dependencies.
Diffstat (limited to 'library')
-rw-r--r-- | library/ttk/dialog.tcl | 272 | ||||
-rw-r--r-- | library/ttk/icons.tcl | 105 | ||||
-rw-r--r-- | library/ttk/keynav.tcl | 163 | ||||
-rw-r--r-- | library/ttk/ttk.tcl | 5 |
4 files changed, 1 insertions, 544 deletions
diff --git a/library/ttk/dialog.tcl b/library/ttk/dialog.tcl deleted file mode 100644 index cb3db47..0000000 --- a/library/ttk/dialog.tcl +++ /dev/null @@ -1,272 +0,0 @@ -# -# $Id: dialog.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ -# -# Copyright (c) 2005, Joe English. Freely redistributable. -# -# Ttk widget set: dialog boxes. -# -# TODO: option to keep dialog onscreen ("persistent" / "transient") -# TODO: accelerator keys. -# TODO: use message catalogs for button labels -# TODO: routines to selectively enable/disable individual command buttons -# TODO: use megawidgetoid API [$dlg dismiss] vs. [ttk::dialog::dismiss $dlg] -# TODO: MAYBE: option for app-modal dialogs -# TODO: MAYBE: [wm withdraw] dialog on dismiss instead of self-destructing -# - -namespace eval ttk::dialog { - - variable Config - # - # Spacing parameters: - # (taken from GNOME HIG 2.0, may need adjustment for other platforms) - # (textwidth just a guess) - # - set Config(margin) 12 ;# space between icon and text - set Config(interspace) 6 ;# horizontal space between buttons - set Config(sepspace) 24 ;# vertical space above buttons - set Config(textwidth) 400 ;# width of dialog box text (pixels) - - variable DialogTypes ;# map -type => list of dialog options - variable ButtonOptions ;# map button name => list of button options - - # stockButton -- define new built-in button - # - proc stockButton {button args} { - variable ButtonOptions - set ButtonOptions($button) $args - } - - # Built-in button types: - # - stockButton ok -text OK - stockButton cancel -text Cancel - stockButton yes -text Yes - stockButton no -text No - stockButton retry -text Retry - - # stockDialog -- define new dialog type. - # - proc stockDialog {type args} { - variable DialogTypes - set DialogTypes($type) $args - } - - # Built-in dialog types: - # - stockDialog ok \ - -icon info -buttons {ok} -default ok - stockDialog okcancel \ - -icon info -buttons {ok cancel} -default ok -cancel cancel - stockDialog retrycancel \ - -icon question -buttons {retry cancel} -cancel cancel - stockDialog yesno \ - -icon question -buttons {yes no} - stockDialog yesnocancel \ - -icon question -buttons {yes no cancel} -cancel cancel -} - -## ttk::dialog::nop -- -# Do nothing (used as a default callback command). -# -proc ttk::dialog::nop {args} { } - -## ttk::dialog -- dialog box constructor. -# -interp alias {} ttk::dialog {} ttk::dialog::Constructor - -proc ttk::dialog::Constructor {dlg args} { - upvar #0 $dlg D - variable Config - variable ButtonOptions - variable DialogTypes - - # - # Option processing: - # - array set defaults { - -title "" - -message "" - -detail "" - -command ttk::dialog::nop - -icon "" - -buttons {} - -labels {} - -default {} - -cancel {} - -parent #AUTO - } - - array set options [array get defaults] - - foreach {option value} $args { - if {$option eq "-type"} { - array set options $DialogTypes($value) - } elseif {![info exists options($option)]} { - set validOptions [join [lsort [array names options]] ", "] - return -code error \ - "Illegal option $option: must be one of $validOptions" - } - } - array set options $args - - # ... - # - array set buttonOptions [array get ::ttk::dialog::ButtonOptions] - foreach {button label} $options(-labels) { - lappend buttonOptions($button) -text $label - } - - # - # Initialize dialog private data: - # - foreach option {-command -message -detail} { - set D($option) $options($option) - } - - toplevel $dlg -class Dialog; wm withdraw $dlg - - # - # Determine default transient parent. - # - # NB: menus (including menubars) are considered toplevels, - # so skip over those. - # - if {$options(-parent) eq "#AUTO"} { - set parent [winfo toplevel [winfo parent $dlg]] - while {[winfo class $parent] eq "Menu" && $parent ne "."} { - set parent [winfo toplevel [winfo parent $parent]] - } - set options(-parent) $parent - } - - # - # Build dialog: - # - if {$options(-parent) ne ""} { - wm transient $dlg $options(-parent) - } - wm title $dlg $options(-title) - wm protocol $dlg WM_DELETE_WINDOW { } - - set f [ttk::frame $dlg.f] - - ttk::label $f.icon - if {$options(-icon) ne ""} { - $f.icon configure -image [ttk::stockIcon dialog/$options(-icon)] - } - ttk::label $f.message -textvariable ${dlg}(-message) \ - -font TkCaptionFont -wraplength $Config(textwidth)\ - -anchor w -justify left - ttk::label $f.detail -textvariable ${dlg}(-detail) \ - -font TkTextFont -wraplength $Config(textwidth) \ - -anchor w -justify left - - # - # Command buttons: - # - set cmd [ttk::frame $f.cmd] - set column 0 - grid columnconfigure $f.cmd 0 -weight 1 - - foreach button $options(-buttons) { - incr column - eval [linsert $buttonOptions($button) 0 ttk::button $cmd.$button] - $cmd.$button configure -command [list ttk::dialog::Done $dlg $button] - grid $cmd.$button -row 0 -column $column \ - -padx [list $Config(interspace) 0] -sticky ew - grid columnconfigure $cmd $column -uniform buttons - } - - if {$options(-default) ne ""} { - keynav::defaultButton $cmd.$options(-default) - focus $cmd.$options(-default) - } - if {$options(-cancel) ne ""} { - bind $dlg <KeyPress-Escape> \ - [list event generate $cmd.$options(-cancel) <<Invoke>>] - wm protocol $dlg WM_DELETE_WINDOW \ - [list event generate $cmd.$options(-cancel) <<Invoke>>] - } - - # - # Assemble dialog. - # - pack $f.cmd -side bottom -expand false -fill x \ - -pady [list $Config(sepspace) $Config(margin)] -padx $Config(margin) - - if {0} { - # GNOME and Apple HIGs say not to use separators. - # But in case we want them anyway: - # - pack [ttk::separator $f.sep -orient horizontal] \ - -side bottom -expand false -fill x \ - -pady [list $Config(sepspace) 0] \ - -padx $Config(margin) - } - - if {$options(-icon) ne ""} { - pack $f.icon -side left -anchor n -expand false \ - -pady $Config(margin) -padx $Config(margin) - } - - pack $f.message -side top -expand false -fill x \ - -padx $Config(margin) -pady $Config(margin) - if {$options(-detail) != ""} { - pack $f.detail -side top -expand false -fill x \ - -padx $Config(margin) - } - - # Client area goes here. - - pack $f -expand true -fill both - keynav::enableMnemonics $dlg - wm deiconify $dlg -} - -## ttk::dialog::clientframe -- -# Returns the widget path of the dialog client frame, -# creating and managing it if necessary. -# -proc ttk::dialog::clientframe {dlg} { - variable Config - set client $dlg.f.client - if {![winfo exists $client]} { - pack [ttk::frame $client] -side top -expand true -fill both \ - -pady $Config(margin) -padx $Config(margin) - lower $client ;# so it's first in keyboard traversal order - } - return $client -} - -## ttk::dialog::Done -- -# -command callback for dialog command buttons (internal) -# -proc ttk::dialog::Done {dlg button} { - upvar #0 $dlg D - set rc [catch [linsert $D(-command) end $button] result] - if {$rc == 1} { - return -code $rc -errorinfo $::errorInfo -errorcode $::errorCode $result - } elseif {$rc == 3 || $rc == 4} { - # break or continue -- don't dismiss dialog - return - } - dismiss $dlg -} - -## ttk::dialog::activate $dlg $button -- -# Simulate a button press. -# -proc ttk::dialog::activate {dlg button} { - event generate $dlg.f.cmd.$button <<Invoke>> -} - -## dismiss -- -# Dismiss the dialog (without invoking any actions). -# -proc ttk::dialog::dismiss {dlg} { - uplevel #0 [list unset $dlg] - destroy $dlg -} - -#*EOF* diff --git a/library/ttk/icons.tcl b/library/ttk/icons.tcl deleted file mode 100644 index 493bb0a..0000000 --- a/library/ttk/icons.tcl +++ /dev/null @@ -1,105 +0,0 @@ -# -# $Id: icons.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ -# -# Ttk package -- stock icons. -# -# Usage: -# $w configure -image [ttk::stockIcon $context/$icon] -# -# At present, only includes icons for dialog boxes, -# dialog/info, dialog/warning, dialog/error, etc. -# -# This list should be expanded. -# -# See the Icon Naming Specification from the Tango project: -# http://standards.freedesktop.org/icon-naming-spec/ -# They've finally gotten around to publishing something. -# - -namespace eval ttk { - variable Icons ;# Map: icon name -> image - namespace eval icons {} ;# container namespace for images -} - -# stockIcon $name -- -# Returns a Tk image for built-in icon $name. -# -proc ttk::stockIcon {name} { - variable Icons - return $Icons($name) -} - -# defineImage -- -# Define a new stock icon. -# -proc ttk::defineImage {name args} { - variable Icons - set iconName ::ttk::icons::$name - eval [linsert $args 0 image create photo $iconName] - set Icons($name) $iconName -} - -# -# Stock icons for dialogs -# -# SOURCE: dialog icons taken from BWidget toolkit. -# -ttk::defineImage dialog/error -data { - R0lGODlhIAAgALMAAIQAAISEhPf/Mf8AAP////////////////////////// - /////////////////////yH5BAEAAAIALAAAAAAgACAAAASwUMhJBbj41s0n - HmAIYl0JiCgKlNWVvqHGnnA9mnY+rBytw4DAxhci2IwqoSdFaMKaSBFPQhxA - nahrdKS0MK8ibSoorBbBVvS4XNOKgey2e7sOmLPvGvkezsPtR3M2e3JzdFIB - gC9vfohxfVCQWI6PII1pkZReeIeWkzGJS1lHdV2bPy9koaKopUOtSatDfECq - phWKOra3G3YuqReJwiwUiRkZwsPEuMnNycslzrIdEQAAOw== -} - -ttk::defineImage dialog/info -data { - R0lGODlhIAAgALMAAAAAAAAA/4SEhMbGxvf/Mf////////////////////// - /////////////////////yH5BAEAAAQALAAAAAAgACAAAAStkMhJibj41s0n - HkUoDljXXaCoqqRgUkK6zqP7CvQQ7IGsAiYcjcejFYAb4ZAYMB4rMaeO51sN - kBKlc/uzRbng0NWlnTF3XAAZzExj2ET3BV7cqufctv2Tj0vvFn11RndkVSt6 - OYVZRmeDXRoTAGFOhTaSlDOWHACHW2MlHQCdYFebN6OkVqkZlzcXqTKWoS8w - GJMhs7WoIoC7v7i+v7uTwsO1o5HHu7TLtcodEQAAOw== -} - -ttk::defineImage dialog/question -data { - R0lGODlhIAAgALMAAAAAAAAA/4SEhMbGxvf/Mf////////////////////// - /////////////////////yH5BAEAAAQALAAAAAAgACAAAAS2kMhJibj41s0n - HkUoDljXXaCoqqRgUkK6zqP7CnS+AiY+D4GgUKbibXwrYEoYIIqMHmcoqGLS - BlBLzlrgzgC22FZYAJKvYG3ODPLS0khd+awDX+Qieh2Dnzb7dnE6VIAffYdl - dmo6bHiBFlJVej+PizRuXyUTAIxBkSGBNpuImZoVAJ9roSYAqH1Yqzetrkmz - GaI3F7MyoaYvHhicoLe/sk8axcnCisnKBczNxa3I0cW+1bm/EQAAOw== -} - -ttk::defineImage dialog/warning -data { - R0lGODlhIAAgALMAAAAAAISEAISEhMbGxv//AP////////////////////// - /////////////////////yH5BAEAAAUALAAAAAAgACAAAASrsMhJZ7g16y0D - IQPAjZr3gYBAroV5piq7uWcoxHJFv3eun0BUz9cJAmHElhFow8lcIQBgwHOu - aNJsDfk8ZgHH4TX4BW/Fo12ZjJ4Z10wuZ0cIZOny0jI6NTbnSwRaS3kUdCd2 - h0JWRYEhVIGFSoEfZo6FipRvaJkfUZB7cp2Cg5FDo6RSmn+on5qCPaivYTey - s4sqtqswp2W+v743whTCxcbHyG0FyczJEhEAADs= -} - -ttk::defineImage dialog/auth -data { - R0lGODlhIAAgAIQAAAAA/wAAAICAgICAAP///7CwsMDAwMjIAPjIAOjo6Pj4 - AODg4HBwcMj4ANjY2JiYANDQ0MjIyPj4yKCgoMiYAMjImDAwAMjIMJiYmJCQ - kAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAgACAAAAX+ICCOYmCa - ZKquZCCMQsDOqWC7NiAMvEyvAoLQVdgZCAfEAPWDERIJk8AwIJwUil5T91y4 - GC6ry4RoKH2zYGLhnS5tMUNAcaAvaUF2m1A9GeQIAQeDaEAECw6IJlVYAmAK - AWZJD3gEDpeXOwRYnHOCCgcPhTWWDhAQQYydkGYIoaOkp6h8m1ieSYOvP0ER - EQwEEap0dWagok1BswmMdbiursfIBHnBQs10oKF30tQ8QkISuAcB25UGQQ4R - EzzsA4MU4+WGBkXo6hMTMQADFQfwFtHmFSlCAEKEU2jc+YsHy8nAML4iJKzQ - Dx65hiWKTIA4pRC7CxblORRA8E/HFfxfQo4KUiBfPgL0SDbkV0ElKZcmEjwE - wqPCgwMiAQTASQDDzhkD4IkMkg+DiwU4aSTVQiIIBgFXE+ATsPHHCRVWM8QI - oJUrxi04TCzA0PQsWh9kMVx1u6UFA3116zLJGwIAOw== -} - -ttk::defineImage dialog/busy -data { - R0lGODlhIAAgALMAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwICAgP8AAAD/ - AP//AAAA//8A/wD//////yH5BAEAAAsALAAAAAAgACAAAASAcMlJq7046827 - /2AYBmRpkoC4BMlzvEkspypg3zitIsfjvgcEQifi+X7BoUpi9AGFxFATCV0u - eMEDQFu1GrdbpZXZC0e9LvF4gkifl8aX2tt7bIPvz/Q5l9btcn0gTWBJeR1G - bWBdO0EPPIuHHDmUSyxIMjM1lJVrnp+goaIfEQAAOw== -} - -#*EOF* diff --git a/library/ttk/keynav.tcl b/library/ttk/keynav.tcl deleted file mode 100644 index 090c8f5..0000000 --- a/library/ttk/keynav.tcl +++ /dev/null @@ -1,163 +0,0 @@ -######################################################################## -# keynav package - Enhanced keyboard navigation -# Copyright (C) 2003 Joe English -# Freely redistributable; see the file license.terms for details. -# -# $Id: keynav.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ -# -######################################################################## -# -# Usage: -# -# package require keynav -# -# keynav::enableMnemonics $toplevel -- -# Enable mnemonic accelerators for toplevel widget. Pressing Alt-K, -# where K is any alphanumeric key, will send an <<Invoke>> event to the -# widget with mnemonic K (as determined by the -underline and -text -# options). -# -# Side effects: adds a binding for <Alt-KeyPress> to $toplevel -# -# keynav::defaultButton $button -- -# Enables default activation for the toplevel window in which $button -# appears. Pressing <Key-Return> invokes the default widget. The -# default widget is set to the widget with keyboard focus if it is -# defaultable, otherwise $button. A widget is _defaultable_ if it has -# a -default option which is not set to "disabled". -# -# Side effects: adds <FocusIn> and <KeyPress-Return> bindings -# to the toplevel containing $button, and a <Destroy> binding -# to $button. -# -# $button must be a defaultable widget. -# - -namespace eval keynav {} - -package require Tcl 8.4 -package require Tk 8.4 -package provide keynav 1.0 - -event add <<Help>> <KeyPress-F1> - -# -# Bindings for stock Tk widgets: -# (NB: for 8.3 use tkButtonInvoke, tkMbPost instead) -# -bind Button <<Invoke>> { tk::ButtonInvoke %W } -bind Checkbutton <<Invoke>> { tk::ButtonInvoke %W } -bind Radiobutton <<Invoke>> { tk::ButtonInvoke %W } -bind Menubutton <<Invoke>> { tk::MbPost %W } - -proc keynav::enableMnemonics {w} { - bind [winfo toplevel $w] <Alt-KeyPress> {+ keynav::Alt-KeyPress %W %K } -} - -# mnemonic $w -- -# Return the mnemonic character for widget $w, -# as determined by the -text and -underline resources. -# -proc keynav::mnemonic {w} { - if {[catch { - set label [$w cget -text] - set underline [$w cget -underline] - }]} { return "" } - return [string index $label $underline] -} - -# FindMnemonic $w $key -- -# Locate the descendant of $w with mnemonic $key. -# -proc keynav::FindMnemonic {w key} { - if {[string length $key] != 1} { return } - set Q [list [set top [winfo toplevel $w]]] - while {[llength $Q]} { - set QN [list] - foreach w $Q { - if {[string equal -nocase $key [mnemonic $w]]} { - return $w - } - foreach c [winfo children $w] { - if {[winfo ismapped $c] && [winfo toplevel $c] eq $top} { - lappend QN $c - } - } - } - set Q $QN - } - return {} -} - -# Alt-KeyPress -- -# Alt-KeyPress binding for toplevels with mnemonic accelerators enabled. -# -proc keynav::Alt-KeyPress {w k} { - set w [FindMnemonic $w $k] - if {$w ne ""} { - event generate $w <<Invoke>> - return -code break - } -} - -# defaultButton $w -- -# Enable default activation for the toplevel containing $w, -# and make $w the default default widget. -# -proc keynav::defaultButton {w} { - variable DefaultButton - - $w configure -default active - set top [winfo toplevel $w] - set DefaultButton(current.$top) $w - set DefaultButton(default.$top) $w - - bind $w <Destroy> [list keynav::CleanupDefault $top] - bind $top <FocusIn> [list keynav::ClaimDefault $top %W] - bind $top <KeyPress-Return> [list keynav::ActivateDefault $top] -} - -proc keynav::CleanupDefault {top} { - variable DefaultButton - unset DefaultButton(current.$top) - unset DefaultButton(default.$top) -} - -# ClaimDefault $top $w -- -# <FocusIn> binding for default activation. -# Sets the default widget to $w if it is defaultable, -# otherwise set it to the default default. -# -proc keynav::ClaimDefault {top w} { - variable DefaultButton - if {![info exists DefaultButton(current.$top)]} { - # Someone destroyed the default default, but not - # the rest of the toplevel. - return; - } - - set default $DefaultButton(default.$top) - if {![catch {$w cget -default} dstate] && $dstate ne "disabled"} { - set default $w - } - - if {$default ne $DefaultButton(current.$top)} { - # Ignore errors -- someone may have destroyed the current default - catch { $DefaultButton(current.$top) configure -default normal } - $default configure -default active - set DefaultButton(current.$top) $default - } -} - -# ActivateDefault -- -# Invoke the default widget for toplevel window, if any. -# -proc keynav::ActivateDefault {top} { - variable DefaultButton - if {[info exists DefaultButton(current.$top)] - && [winfo exists $DefaultButton(current.$top)]} { - event generate $DefaultButton(current.$top) <<Invoke>> - } -} - -#*EOF* diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl index b354958..ebe6a4c 100644 --- a/library/ttk/ttk.tcl +++ b/library/ttk/ttk.tcl @@ -1,5 +1,5 @@ # -# $Id: ttk.tcl,v 1.5 2007/02/06 22:28:44 jenglish Exp $ +# $Id: ttk.tcl,v 1.6 2007/05/25 22:55:03 jenglish Exp $ # # Ttk widget set initialization script. # @@ -14,10 +14,8 @@ namespace eval ::ttk { } } -source [file join $::ttk::library keynav.tcl] source [file join $::ttk::library fonts.tcl] source [file join $::ttk::library cursors.tcl] -source [file join $::ttk::library icons.tcl] source [file join $::ttk::library utils.tcl] ## ttk::deprecated $old $new -- @@ -109,7 +107,6 @@ source [file join $::ttk::library entry.tcl] source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl source [file join $::ttk::library treeview.tcl] source [file join $::ttk::library sizegrip.tcl] -source [file join $::ttk::library dialog.tcl] ## Label and Labelframe bindings: # (not enough to justify their own file...) |