summaryrefslogtreecommitdiffstats
path: root/library/ttk/dialog.tcl
diff options
context:
space:
mode:
authorhobbs <hobbs>2006-10-31 01:42:25 (GMT)
committerhobbs <hobbs>2006-10-31 01:42:25 (GMT)
commit397a2c9832bf618f26be267501cf49ab06a562ec (patch)
tree61d5e957eccfcba57b0dd27ebc73db085385834e /library/ttk/dialog.tcl
parent18d330543869e240c2bd12fc9fbb8d5027f5cad6 (diff)
downloadtk-397a2c9832bf618f26be267501cf49ab06a562ec.zip
tk-397a2c9832bf618f26be267501cf49ab06a562ec.tar.gz
tk-397a2c9832bf618f26be267501cf49ab06a562ec.tar.bz2
* doc/ttk_Geometry.3, doc/ttk_Theme.3, doc/ttk_button.n:
* doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n: * doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n: * doc/ttk_intro.n, doc/ttk_label.n, doc/ttk_labelframe.n: * doc/ttk_menubutton.n, doc/ttk_notebook.n, doc/ttk_panedwindow.n: * doc/ttk_progressbar.n, doc/ttk_radiobutton.n, doc/ttk_scrollbar.n: * doc/ttk_separator.n, doc/ttk_sizegrip.n, doc/ttk_style.n: * doc/ttk_treeview.n, doc/ttk_widget.n,: * generic/ttk/ttk.decls, generic/ttk/ttkBlink.c: * generic/ttk/ttkButton.c, generic/ttk/ttkCache.c: * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c: * generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c: * generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c: * generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c: * generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c: * generic/ttk/ttkLayout.c, generic/ttk/ttkManager.c: * generic/ttk/ttkManager.h, generic/ttk/ttkNotebook.c: * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c: * generic/ttk/ttkScale.c, generic/ttk/ttkScroll.c: * generic/ttk/ttkScrollbar.c, generic/ttk/ttkSeparator.c: * generic/ttk/ttkSquare.c, generic/ttk/ttkState.c: * generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c: * generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c: * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h: * generic/ttk/ttkTrace.c, generic/ttk/ttkTrack.c: * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c: * generic/ttk/ttkWidget.h: * library/demos/ttk_demo.tcl, library/demos/ttk_iconlib.tcl: * library/demos/ttk_repeater.tcl: * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl: * library/ttk/button.tcl, library/ttk/clamTheme.tcl: * library/ttk/classicTheme.tcl, library/ttk/combobox.tcl: * library/ttk/cursors.tcl, library/ttk/defaults.tcl: * library/ttk/dialog.tcl, library/ttk/entry.tcl: * library/ttk/fonts.tcl, library/ttk/icons.tcl: * library/ttk/keynav.tcl, library/ttk/menubutton.tcl: * library/ttk/notebook.tcl, library/ttk/panedwindow.tcl: * library/ttk/progress.tcl, library/ttk/scale.tcl: * library/ttk/scrollbar.tcl, library/ttk/sizegrip.tcl: * library/ttk/treeview.tcl, library/ttk/ttk.tcl: * library/ttk/utils.tcl, library/ttk/winTheme.tcl: * library/ttk/xpTheme.tcl: * macosx/ttkMacOSXTheme.c: * tests/ttk/all.tcl, tests/ttk/bwidget.test, tests/ttk/combobox.test: * tests/ttk/entry.test, tests/ttk/image.test: * tests/ttk/labelframe.test, tests/ttk/layout.test: * tests/ttk/misc.test, tests/ttk/notebook.test: * tests/ttk/panedwindow.test, tests/ttk/progressbar.test: * tests/ttk/scrollbar.test, tests/ttk/treetags.test: * tests/ttk/treeview.test, tests/ttk/ttk.test, tests/ttk/validate.test: * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: First import of Ttk themed Tk widgets as branched from tile 0.7.8 * generic/tkInt.h, generic/tkWindow.c: add Ttk_Init call, copy tk classic widgets to ::tk namespace. * library/tk.tcl: add source of ttk/ttk.tcl, define $::ttk::library. * unix/Makefile.in, win/Makefile.in: add Ttk build bits * win/configure, win/configure.in: check for uxtheme.h (XP theme).
Diffstat (limited to 'library/ttk/dialog.tcl')
-rw-r--r--library/ttk/dialog.tcl272
1 files changed, 272 insertions, 0 deletions
diff --git a/library/ttk/dialog.tcl b/library/ttk/dialog.tcl
new file mode 100644
index 0000000..cb3db47
--- /dev/null
+++ b/library/ttk/dialog.tcl
@@ -0,0 +1,272 @@
+#
+# $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*