diff options
author | hobbs <hobbs> | 2006-10-31 01:42:25 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2006-10-31 01:42:25 (GMT) |
commit | 397a2c9832bf618f26be267501cf49ab06a562ec (patch) | |
tree | 61d5e957eccfcba57b0dd27ebc73db085385834e /library/ttk/dialog.tcl | |
parent | 18d330543869e240c2bd12fc9fbb8d5027f5cad6 (diff) | |
download | tk-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.tcl | 272 |
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* |