From 095cd3280ca77a1c44f4ee014fdce3f751c26817 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 26 May 2007 04:06:05 +0000 Subject: merge updates from HEAD --- ChangeLog | 94 +++-- doc/canvas.n | 6 +- doc/menu.n | 4 +- doc/ttk_dialog.n | 134 ------- doc/ttk_sizegrip.n | 4 +- generic/tkEntry.c | 6 +- library/demos/ttk_demo.tcl | 883 ----------------------------------------- library/demos/ttk_iconlib.tcl | 110 ----- library/demos/ttk_repeater.tcl | 117 ------ library/ttk/dialog.tcl | 272 ------------- library/ttk/icons.tcl | 105 ----- library/ttk/keynav.tcl | 163 -------- library/ttk/ttk.tcl | 5 +- tests/ttk/misc.test | 33 -- unix/Makefile.in | 3 +- 15 files changed, 65 insertions(+), 1874 deletions(-) delete mode 100644 doc/ttk_dialog.n delete mode 100644 library/demos/ttk_demo.tcl delete mode 100644 library/demos/ttk_iconlib.tcl delete mode 100644 library/demos/ttk_repeater.tcl delete mode 100644 library/ttk/dialog.tcl delete mode 100644 library/ttk/icons.tcl delete mode 100644 library/ttk/keynav.tcl delete mode 100644 tests/ttk/misc.test diff --git a/ChangeLog b/ChangeLog index c606832..32210a9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,17 @@ +2007-05-25 Joe English + + * library/ttk/ttk.tcl: Omit ttk::dialog and dependencies. + * library/ttk/dialog.tcl, library/ttk/icons.tcl, + library/ttk/keynav.tcl: Removed. + * tests/ttk/misc.test: Removed. + * doc/ttk_dialog.tcl: Removed. + + +2007-05-25 Donal K. Fellows + + * doc/canvas.n: Fixed documentation of default -joinstyle option + values for line and polygon items. [Bug 1725782] + 2007-05-22 Don Porter [core-stabilizer-branch] @@ -14,13 +28,11 @@ 2007-05-18 Joe English - * generic/ttk/ttkEntry.c(EntrySetValue): Ensure - that widget is in a consistent state before setting - the linked -textvariable. Previously, it was possible - for [$e index insert] to point past the end of the string, - leading to heap corruption [Bug 1721532]. - * tests/ttk/entry.test(entry-9.1): Add test case - for the above. + * generic/ttk/ttkEntry.c(EntrySetValue): Ensure that widget is in a + consistent state before setting the linked -textvariable. Previously, + it was possible for [$e index insert] to point past the end of the + string, leading to heap corruption [Bug 1721532]. + * tests/ttk/entry.test(entry-9.1): Add test case for the above. 2007-05-18 Don Porter @@ -47,9 +59,9 @@ 2007-05-16 Joe English - * generic/tkStubLib.c: Change Tk_InitStubs(), tkStubsPtr, - and the auxilliary stubs table pointers back to public visibility. - See [Bug 1716117] for details. + * generic/tkStubLib.c: Change Tk_InitStubs(), tkStubsPtr, and the + auxilliary stubs table pointers back to public visibility. See [Bug + 1716117] for details. Removed TCL_STORAGE_CLASS monkey business, as it had no effect. @@ -57,7 +69,7 @@ * library/choosedir.tcl: Removed uses of obsolete {expand} * library/comdlg.tcl: syntax; replaced with the now - * library/tk.tcl: approved {*}. [Bug 1710633] + * library/tk.tcl: approved {*}. [Bug 1710633] * tests/canvImg.test: * tests/imgPhoto.test: @@ -69,8 +81,8 @@ 2007-05-15 Joe English - * unix/tkUnixRFont.c: Fix crash introduced by previous fix - exposed under newer fontconfig libraries [Bug 1717830] again. + * unix/tkUnixRFont.c: Fix crash introduced by previous fix exposed + under newer fontconfig libraries [Bug 1717830] again. 2007-05-15 Don Porter @@ -78,8 +90,8 @@ 2007-05-15 Joe English - * unix/tkUnixRFont.c: Fix various memory leaks [Bug 1717830], - [Bug 800149]. + * unix/tkUnixRFont.c: Fix various memory leaks. [Bug 1717830], [Bug + 800149] 2007-05-14 Don Porter @@ -94,11 +106,11 @@ * generic/tkTest.c: commands for testing various Tk * tests/constraints.tcl: legacy interfaces where a separate * tests/image.test: compilation unit is needed in order - to #define suitable macros during compilation. Only the effect of + to #define suitable macros during compilation. Only the effect of USE_OLD_IMAGE on Tk_CreateImageType() is currently tested, but more - similar testing commands can be added to this same file. New + similar testing commands can be added to this same file. New constraint defined to detect presence of the image type provided by - the new testing code, and a few tests added to exercise it. Having + the new testing code, and a few tests added to exercise it. Having USE_OLD_IMAGE support tested by the default test suite should reduce chance of a recurrence of this bug. @@ -111,13 +123,13 @@ * generic/tk.decls: Reworked USE_OLD_IMAGE support to use * generic/tk.h: the same support mechanisms both with - * generic/tkStubImg.c (deleted):and without a stub-enabled build. In + * generic/tkStubImg.c (deleted):and without a stub-enabled build. In each case, route the legacy calls to Tk_CreateImageType and Tk_CreatePhotoImageFormat through the Tk_CreateOldImageType and - Tk_CreateOldPhotoImageFormat routines. Add those routines to the + Tk_CreateOldPhotoImageFormat routines. Add those routines to the public stub table so they're available to a stub-enabled extension. - Remove the definition of Tk_InitImageArgs() and use a macro to - convert any calls to it in source code into a comment. + Remove the definition of Tk_InitImageArgs() and use a macro to convert + any calls to it in source code into a comment. * generic/tkImage.c: Removed the MODULE_SCOPE declarations that * generic/tkImgPhoto.c: broke USE_OLD_IMAGE support. @@ -126,8 +138,8 @@ * tests/winButton.test: Avoid font dependencies in results. - * generic/tkFont.c: propagate error from TkDeleteNamedFont - [Bug 1716613]. + * generic/tkFont.c: propagate error from TkDeleteNamedFont. [Bug + 1716613] 2007-05-09 Daniel Steffen @@ -159,7 +171,7 @@ * macosx/tkMacOSXButton.c: fix debug msg typo. * tests/constraints.tcl: ensure 'nonUnixUserInteraction' constraint is - set for aqua. + set for aqua. * tests/choosedir.test: add 'notAqua' constraints to X11-only tests; * tests/clrpick.test: add 'nonUnixUserInteraction' to 'unix' tests @@ -170,9 +182,9 @@ 2007-05-07 Joe English - * unix/tkUnixRFont.c: Properly cast sentinel arguments - to variadic function (fixes "warning: missing - sentinel in function call", [Bug 1712001]) + * unix/tkUnixRFont.c: Properly cast sentinel arguments to variadic + function (fixes "warning: missing sentinel in function call", [Bug + 1712001]) 2007-05-04 Pat Thoyts @@ -187,21 +199,21 @@ 2007-05-04 Donal K. Fellows - * doc/ttk_treeview.n, doc/ttk_panedwindow.n, doc/ttk_dialog.n: + * doc/ttk_treeview.n, doc/ttk_panedwindow.n, doc/ttk_dialog.n: * doc/ttk_checkbutton.n, doc/tk.n, doc/menu.n, doc/font.n: * doc/canvas.n: Spelling fixes. [Bug 1686210] 2007-05-03 Donal K. Fellows - * generic/tkStubLib.c (Tk_InitStubs): - * generic/ttk/ttkLabel.c (LabelSetup): - * unix/tkUnixSelect.c (ConvertSelection): - * unix/tkUnixEvent.c (TkUnixDoOneXEvent): - * generic/tkConfig.c (Tk_RestoreSavedOptions): - * generic/tkCanvPs.c (TkCanvPostscriptCmd): - * generic/tkOption.c (GetDefaultOptions): - * unix/tkUnixRFont.c (TkpGetFontAttrsForChar, InitFont) - (TkpGetFontFamilies, TkpGetSubFonts): + * generic/tkStubLib.c (Tk_InitStubs): + * generic/ttk/ttkLabel.c (LabelSetup): + * unix/tkUnixSelect.c (ConvertSelection): + * unix/tkUnixEvent.c (TkUnixDoOneXEvent): + * generic/tkConfig.c (Tk_RestoreSavedOptions): + * generic/tkCanvPs.c (TkCanvPostscriptCmd): + * generic/tkOption.c (GetDefaultOptions): + * unix/tkUnixRFont.c (TkpGetFontAttrsForChar, InitFont) + (TkpGetFontFamilies, TkpGetSubFonts): * unix/tkUnixSend.c (TkpTestsendCmd, RegOpen): Squelch warnings from GCC type aliasing. [Bug 1711985 and others] @@ -217,9 +229,9 @@ 2007-04-26 Joe English - * macosx/ttkMacOSXTheme.c: Merged OFFSET_RECT processing into - BoxToRect(); factored out PatternOrigin; resynchronized - with Tile codebase. + * macosx/ttkMacOSXTheme.c: Merged OFFSET_RECT processing into + BoxToRect(); factored out PatternOrigin; resynchronized with Tile + codebase. 2007-04-26 Jeff Hobbs diff --git a/doc/canvas.n b/doc/canvas.n index e436fd5..993cf30 100644 --- a/doc/canvas.n +++ b/doc/canvas.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: canvas.n,v 1.24 2007/05/03 23:55:29 dkf Exp $ +'\" RCS: @(#) $Id: canvas.n,v 1.24.2.1 2007/05/26 04:06:06 dgp Exp $ '\" .so man.macros .TH canvas n 8.3 Tk "Tk Built-In Commands" @@ -1392,7 +1392,7 @@ Specifies the ways in which joints are to be drawn at the vertices of the line. \fIStyle\fR may have any of the forms accepted by \fBTk_GetCapStyle\fR (\fBbevel\fR, \fBmiter\fR, or \fBround\fR). -If this option isn't specified then it defaults to \fBmiter\fR. +If this option isn't specified then it defaults to \fBround\fR. If the line only contains two points then this option is irrelevant. .TP @@ -1526,7 +1526,7 @@ Specifies the ways in which joints are to be drawn at the vertices of the outline. \fIStyle\fR may have any of the forms accepted by \fBTk_GetCapStyle\fR (\fBbevel\fR, \fBmiter\fR, or \fBround\fR). -If this option isn't specified then it defaults to \fBmiter\fR. +If this option isn't specified then it defaults to \fBround\fR. .TP \fB\-smooth \fIboolean\fR \fIBoolean\fR must have one of the forms accepted by \fBTcl_GetBoolean\fR diff --git a/doc/menu.n b/doc/menu.n index 8359326..c5e09ac 100644 --- a/doc/menu.n +++ b/doc/menu.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: menu.n,v 1.15 2007/05/03 23:55:29 dkf Exp $ +'\" RCS: @(#) $Id: menu.n,v 1.15.2.1 2007/05/26 04:06:06 dgp Exp $ '\" .so man.macros .TH menu n 4.1 Tk "Tk Built-In Commands" @@ -529,7 +529,7 @@ command. \fIpathName\fR \fBclone\fR \fInewPathname ?cloneType?\fR Makes a clone of the current menu named \fInewPathName\fR. This clone is a menu in its own right, but any changes to the clone are -propogated to the original menu and vice versa. \fIcloneType\fR can be +propagated to the original menu and vice versa. \fIcloneType\fR can be \fBnormal\fR, \fBmenubar\fR, or \fBtearoff\fR. Should not normally be called outside of the Tk library. See the \fBCLONES\fR section for more information. diff --git a/doc/ttk_dialog.n b/doc/ttk_dialog.n deleted file mode 100644 index f8b9398..0000000 --- a/doc/ttk_dialog.n +++ /dev/null @@ -1,134 +0,0 @@ -'\" -'\" Copyright (c) 2005 Joe English -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -'\" RCS: @(#) $Id: ttk_dialog.n,v 1.4 2007/05/03 23:55:30 dkf Exp $ -'\" -.so man.macros -.TH ttk_dialog n 8.5 Tk "Tk Themed Widget" -.BS -.\" Use _ instead of :: as the name becomes a filename on install -.SH NAME -ttk_dialog \- create a dialog box -.SH "SYNOPSIS" -\fBttk::dialog\fR \fIpathname\fR ?\fIoptions...\fR? -\fBttk::dialog::define\fR \fIdialogType\fR ?\fIoptions...\fR? -.BE - -.SH DESCRIPTION -A dialog box is a transient top-level window -containing an icon, a short message, an optional, longer, detail message, -and a row of command buttons. -When the user presses any of the buttons, -a callback function is invoked -and then the dialog is destroyed. -.PP -Additional widgets may be added in the dialog \fIclient frame\fR. - -.SH "WIDGET-SPECIFIC OPTIONS" -.OP \-title undefined undefined -Specifies a string to use as the window manager title. -.OP \-message undefined undefined -Specifies the message to display in this dialog. -.OP \-detail undefined undefined -Specifies a longer auxiliary message. -.OP \-command undefined undefined -Specifies a command prefix to be invoked when the user presses -one of the command buttons. -The symbolic name of the button is passed as an additional argument -to the command. -The dialog is dismissed after invoking the command. -.OP \-parent undefined undefined -Specifies a toplevel window for which the dialog is transient. -If omitted, the default is the nearest ancestor toplevel. -If set to the empty string, the dialog will not be a transient window. -.OP \-type undefined undefined -Specifies a built-in or user-defined dialog type. -See \fBPREDEFINED DIALOG TYPES\fR, below. -.OP \-icon undefined undefined -Specifies one of the stock dialog icons, -\fBinfo\fR, \fBquestion\fR, \fBwarning\fR, \fBerror\fR, -\fBauth\fR, or \fBbusy\fR. -If set to the empty string (the default), no icon is displayed. -.OP \-buttons undefined undefined -A list of symbolic button names. -.OP \-labels undefined undefined -A dictionary mapping symbolic button names to textual labels. -May be omitted if all the buttons are predefined. -.OP \-default undefined undefined -The symbolic name of the default button. -.OP \-cancel undefined undefined -The symbolic name of the "cancel" button. -The cancel button is invoked if the user presses the Escape key -and when the dialog is closed from the window manager. -If \fB-cancel\fR is not specified, -the dialog ignores window manager close commands (WM_DELETE_WINDOW). - -.SH "WIDGET COMMANDS" -.TP -\fBttk::dialog::clientframe \fIdlg\fR -Returns the widget path of the client frame. -Other widgets may be added to the client frame. -The client frame appears between the detail message and the command buttons. - -.SH "PREDEFINED DIALOG TYPES" -The \fB-type\fR option, if present, specifies default values -for other options. \fBttk::dialog::define \fItype options...\fR -specifies a new stock dialog \fItype\fR. -The following stock dialog types are predefined: -.CS -ttk::dialog::define ok \e - -icon info -buttons {ok} -default ok -ttk::dialog::define okcancel \e - -icon info -buttons {ok cancel} -default ok -cancel cancel -ttk::dialog::define yesno \e - -icon question -buttons {yes no} -ttk::dialog::define yesnocancel \e - -icon question -buttons {yes no cancel} -cancel cancel -ttk::dialog::define retrycancel \e - -icon question -buttons {retry cancel} -cancel cancel -.CE - -.SH "STOCK BUTTONS" -The following ``stock'' symbolic button names have predefined labels: -\fByes\fR, \fBno\fR, \fBok\fR, \fBcancel\fR, and \fBretry\fR. -.PP -It is not necessary to list these in the \fB-labels\fR dictionary. -.\" .SH "DIFFERENCES FROM MESSAGE BOXES" -.\" The \fBttk::dialog\fR constructor is similar to -.\" the Tk library procedure \fBtk_messageBox\fR, -.\" but with the following notable differences: -.\" .IP \(bu -.\" The first argument to \fBttk::dialog\fR is the name of -.\" the widget to create; \fBtk_messageBox\fR has -.\" .IP \(bu -.\" Ttk dialog boxes are non-modal by default. -.\" .IP \(bu -.\" The \fBtk_messageBox\fR command is blocking: -.\" it does not return until the user presses one of the command buttons. -.\" \fBttk::dialog\fR returns immediately after creating the dialog box. -.SH EXAMPLE -.CS -proc saveFileComplete {button} { - switch -- $button { - yes { # save file ... } - no { exit } - cancel { # no-op } - } -} - -ttk::dialog .saveFileDialog \e - -title "Save file?" \e - -icon question \e - -message "Save file before closing?" \e - -detail "If you do not save the file, your work will be lost" \e - -buttons [list yes no cancel] \e - -labels [list yes "Save file" no "Don't save"] \e - -command saveFileComplete \e - ; -.CE - -.SH "SEE ALSO" -tk_messageBox(n), wm(n), toplevel(n) diff --git a/doc/ttk_sizegrip.n b/doc/ttk_sizegrip.n index 41e9565..105114f 100644 --- a/doc/ttk_sizegrip.n +++ b/doc/ttk_sizegrip.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ttk_sizegrip.n,v 1.3 2006/12/13 23:04:33 hobbs Exp $ +'\" RCS: @(#) $Id: ttk_sizegrip.n,v 1.3.2.1 2007/05/26 04:06:06 dgp Exp $ '\" .so man.macros .TH ttk_sizegrip n 8.5 Tk "Tk Themed Widget" @@ -50,7 +50,7 @@ grid [ttk::sizegrip $top.statusbar.grip] \ .SH "BUGS" If the containing toplevel's position was specified -relative to the right or bottom of the sceen +relative to the right or bottom of the screen (e.g., \fB[wm geometry ... \fIw\fBx\fIh\fB-\fIx\fB-\fIy\fB]\fR instead of \fB[wm geometry ... \fIw\fBx\fIh\fB+\fIx\fB+\fIy\fB]\fR), the sizegrip widget will not resize the window. diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 0f0b475..1a94123 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkEntry.c,v 1.44 2007/04/23 21:15:18 das Exp $ + * RCS: @(#) $Id: tkEntry.c,v 1.44.2.1 2007/05/26 04:06:07 dgp Exp $ */ #include "tkInt.h" @@ -539,7 +539,7 @@ Tk_EntryObjCmd( entryPtr->validate = VALIDATE_NONE; /* - * Keep a hold of the associated tkwin until we destroy the listbox, + * Keep a hold of the associated tkwin until we destroy the entry, * otherwise Tk might free it while we still need it. */ @@ -3573,7 +3573,7 @@ Tk_SpinboxObjCmd( sbPtr->buRelief = TK_RELIEF_FLAT; /* - * Keep a hold of the associated tkwin until we destroy the listbox, + * Keep a hold of the associated tkwin until we destroy the spinbox, * otherwise Tk might free it while we still need it. */ diff --git a/library/demos/ttk_demo.tcl b/library/demos/ttk_demo.tcl deleted file mode 100644 index 0686b62..0000000 --- a/library/demos/ttk_demo.tcl +++ /dev/null @@ -1,883 +0,0 @@ -# -# $Id: ttk_demo.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ -# -# Tile widget set -- widget demo -# -package require Tk 8.5 - -eval destroy [winfo children .] ;# in case script is re-sourced - -### Load auxilliary scripts. -# -variable demodir [file dirname [info script]] -lappend auto_path . $demodir - -source [file join $demodir ttk_iconlib.tcl] -source [file join $demodir ttk_repeater.tcl] - -# This forces an update of the available packages list. -# It's required for package names to find the themes in demos/themes/*.tcl -eval [package unknown] Tcl [package provide Tcl] - -### Global options and bindings. -# -option add *Button.default normal -option add *Text.background white -option add *Entry.background white -option add *tearOff false - -# See toolbutton.tcl. -# -option add *Toolbar.relief groove -option add *Toolbar.borderWidth 2 -option add *Toolbar.Button.Pad 2 -option add *Toolbar.Button.default disabled -option add *Toolbar*takeFocus 0 - -# ... for debugging: -bind all { set ::W %W } -bind all { focus %W } - -# Stealth feature: -# -if {![catch {package require Img 1.3}]} { - bind all screenshot - proc screenshot {} { - image create photo ScreenShot -format window -data . - bell - # Gamma looks off if we use PNG ... - # Looks even worse if we use GIF ... - ScreenShot write screenshot.png -format png - image delete ScreenShot - bell - } -} - -### Global data. -# - -# The descriptive names of the builtin themes: -# -set ::THEMELIST { - default "Default" - classic "Classic" - alt "Revitalized" - winnative "Windows native" - xpnative "XP Native" - aqua "Aqua" -} -array set ::THEMES $THEMELIST; - -# Add in any available loadable themes: -# -foreach name [ttk::themes] { - if {![info exists ::THEMES($name)]} { - lappend THEMELIST $name [set ::THEMES($name) [string totitle $name]] - } -} - -# Generate icons (see also: iconlib.tcl): -# -foreach {icon data} [array get ::ImgData] { - set ::ICON($icon) [image create photo -data $data] -} - -variable ROOT "." -variable BASE [ttk::frame .base] -pack $BASE -side top -expand true -fill both - -array set ::V { - COMPOUND top - CONSOLE 0 - MENURADIO1 One - PBMODE determinate - SELECTED 1 - CHOICE 2 - SCALE 50 - VSCALE 0 -} - -### Utilities. -# - -## foreachWidget varname widget script -- -# Execute $script with $varname set to each widget in the hierarchy. -# -proc foreachWidget {varname Q script} { - upvar 1 $varname w - while {[llength $Q]} { - set QN [list] - foreach w $Q { - uplevel 1 $script - foreach child [winfo children $w] { - lappend QN $child - } - } - set Q $QN - } -} - -## sbstub $sb -- stub -command option for a scrollbar. -# Updates the scrollbar's position. -# -proc sbstub {sb cmd number {units units}} { sbstub.$cmd $sb $number $units } -proc sbstub.moveto {sb number _} { $sb set $number [expr {$number + 0.5}] } -proc sbstub.scroll {sb number units} { - if {$units eq "pages"} { - set delta 0.2 - } else { - set delta 0.05 - } - set current [$sb get] - set new0 [expr {[lindex $current 0] + $delta*$number}] - set new1 [expr {[lindex $current 1] + $delta*$number}] - $sb set $new0 $new1 -} - -## sbset $sb -- auto-hide scrollbar -# Scrollable widget -[xy]scrollcommand prefix. -# Sets the scrollbar, auto-hides/shows. -# Scrollbar must be controlled by the grid geometry manager. -# -proc sbset {sb first last} { - if {$first <= 0 && $last >= 1} { - grid remove $sb - } else { - grid $sb - } - $sb set $first $last -} - -## scrolled -- create a widget with attached scrollbars. -# -proc scrolled {class w args} { - set sf "${w}_sf" - - frame $sf - eval [linsert $args 0 $class $w] - scrollbar $sf.hsb -orient horizontal -command [list $w xview] - scrollbar $sf.vsb -orient vertical -command [list $w yview] - - configure.scrolled $sf $w - return $sf -} - -## ttk::scrolled -- create a widget with attached Ttk scrollbars. -# -proc ttk::scrolled {class w args} { - set sf "${w}_sf" - - ttk::frame $sf - eval [linsert $args 0 $class $w] - ttk::scrollbar $sf.hsb -orient horizontal -command [list $w xview] - ttk::scrollbar $sf.vsb -orient vertical -command [list $w yview] - - configure.scrolled $sf $w - return $sf -} - -## configure.scrolled -- common factor of [scrolled] and [ttk::scrolled] -# -proc configure.scrolled {sf w} { - $w configure -xscrollcommand [list $sf.hsb set] - $w configure -yscrollcommand [list $sf.vsb set] - - grid $w -in $sf -row 0 -column 0 -sticky nwse - grid $sf.hsb -row 1 -column 0 -sticky we - grid $sf.vsb -row 0 -column 1 -sticky ns - - grid columnconfigure $sf 0 -weight 1 - grid rowconfigure $sf 0 -weight 1 -} - -### Toolbars. -# -proc makeToolbars {} { - set buttons [list open new save] - set checkboxes [list bold italic] - - # - # Ttk toolbar: - # - set tb [ttk::frame $::BASE.tbar_styled -class Toolbar] - set i 0 - foreach icon $buttons { - set b [ttk::button $tb.tb[incr i] \ - -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \ - -style Toolbutton] - grid $b -row 0 -column $i -sticky news - } - ttk::separator $tb.sep -orient vertical - grid $tb.sep -row 0 -column [incr i] -sticky news -padx 2 -pady 2 - foreach icon $checkboxes { - set b [ttk::checkbutton $tb.cb[incr i] \ - -variable ::V($icon) \ - -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \ - -style Toolbutton] - grid $b -row 0 -column $i -sticky news - } - - ttk::menubutton $tb.compound \ - -text "toolbar" -image $::ICON(file) -compound $::V(COMPOUND) - $tb.compound configure -menu [makeCompoundMenu $tb.compound.menu] - grid $tb.compound -row 0 -column [incr i] -sticky news - - grid columnconfigure $tb [incr i] -weight 1 - - # - # Standard toolbar: - # - set tb [frame $::BASE.tbar_orig -class Toolbar] - set i 0 - foreach icon $buttons { - set b [button $tb.tb[incr i] \ - -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \ - -relief flat -overrelief raised] - grid $b -row 0 -column $i -sticky news - } - frame $tb.sep -borderwidth 1 -width 2 -relief sunken - grid $tb.sep -row 0 -column [incr i] -sticky news -padx 2 -pady 2 - foreach icon $checkboxes { - set b [checkbutton $tb.cb[incr i] -variable ::V($icon) \ - -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \ - -indicatoron false \ - -selectcolor {} \ - -relief flat \ - -overrelief raised \ - -offrelief flat] - grid $b -row 0 -column $i -sticky news - } - - menubutton $tb.compound \ - -text "toolbar" -image $::ICON(file) -compound $::V(COMPOUND) \ - -indicatoron true - $tb.compound configure -menu [makeCompoundMenu $tb.compound.menu] - grid $tb.compound -row 0 -column [incr i] -sticky news - - grid columnconfigure $tb [incr i] -weight 1 -} - -# -# Toolbar -compound control: -# -proc makeCompoundMenu {menu} { - variable compoundStrings {text image none top bottom left right center} - menu $menu - foreach string $compoundStrings { - $menu add radiobutton \ - -label [string totitle $string] \ - -variable ::V(COMPOUND) -value $string \ - -command changeToolbars ; - } - return $menu -} - -proc changeToolbars {} { - foreachWidget w [list $::BASE.tbar_styled $::BASE.tbar_orig] { - catch { $w configure -compound $::V(COMPOUND) } - } -} - -makeToolbars - -### Theme control panel. -# -proc makeThemeControl {c} { - ttk::labelframe $c -text "Theme" - foreach {theme name} $::THEMELIST { - set b [ttk::radiobutton $c.s$theme -text $name \ - -variable ::ttk::currentTheme -value $theme \ - -command [list ttk::setTheme $theme]] - pack $b -side top -expand false -fill x - if {[lsearch -exact [package names] ttk::theme::$theme] == -1} { - $c.s$theme state disabled - } - } - return $c -} -makeThemeControl $::BASE.control - -### Notebook widget. -# -set nb [ttk::notebook $::BASE.nb] -ttk::notebook::enableTraversal $nb - -### Main demo pane. -# -# Side-by comparison of Ttk vs. core widgets. -# - - -set pw [ttk::panedwindow $nb.client -orient horizontal] -$nb add $pw -text "Demo" -underline 0 -padding 6 -set l [ttk::labelframe $pw.l -text "Themed" -padding 6 -underline 1] -set r [labelframe $pw.r -text "Standard" -padx 6 -pady 6] -$pw add $l -weight 1; $pw add $r -weight 1 - -## menubuttonMenu -- demo menu for menubutton widgets. -# -proc menubuttonMenu {menu} { - menu $menu - foreach dir {above below left right flush} { - $menu add command -label [string totitle $dir] \ - -command [list [winfo parent $menu] configure -direction $dir] - } - $menu add cascade -label "Submenu" -menu [set submenu [menu $menu.submenu]] - $submenu add command -label "Subcommand 1" - $submenu add command -label "Subcommand 2" - $submenu add command -label "Subcommand 3" - $menu add separator - $menu add command -label "Quit" -command [list destroy .] - - return $menu -} - -## Main demo pane - themed widgets. -# -ttk::checkbutton $l.cb -text "Checkbutton" -variable ::V(SELECTED) -underline 2 -ttk::radiobutton $l.rb1 -text "One" -variable ::V(CHOICE) -value 1 -underline 0 -ttk::radiobutton $l.rb2 -text "Two" -variable ::V(CHOICE) -value 2 -ttk::radiobutton $l.rb3 -text "Three" -variable ::V(CHOICE) -value 3 -under 0 -ttk::button $l.button -text "Button" -underline 0 - -ttk::menubutton $l.mb -text "Menubutton" -underline 2 -$l.mb configure -menu [menubuttonMenu $l.mb.menu] - -set ::entryText "Entry widget" -ttk::entry $l.e -textvariable ::entryText -$l.e selection range 6 end - -set ltext [ttk::scrolled text $l.t -width 12 -height 5 -wrap none] - -grid $l.cb -sticky ew -grid $l.rb1 -sticky ew -grid $l.rb2 -sticky ew -grid $l.rb3 -sticky ew -grid $l.button -sticky ew -padx 2 -pady 2 -grid $l.mb -sticky ew -padx 2 -pady 2 -grid $l.e -sticky ew -padx 2 -pady 2 -grid $ltext -sticky news - -grid columnconfigure $l 0 -weight 1 -grid rowconfigure $l 7 -weight 1 ; # text widget (grid is a PITA) - -## Main demo pane - core widgets. -# -checkbutton $r.cb -text "Checkbutton" -variable ::V(SELECTED) -radiobutton $r.rb1 -text "One" -variable ::V(CHOICE) -value 1 -radiobutton $r.rb2 -text "Two" -variable ::V(CHOICE) -value 2 -underline 1 -radiobutton $r.rb3 -text "Three" -variable ::V(CHOICE) -value 3 -button $r.button -text "Button" -menubutton $r.mb -text "Menubutton" -underline 3 -takefocus 1 -$r.mb configure -menu [menubuttonMenu $r.mb.menu] -# Add -indicatoron control: -set ::V(rmbIndicatoron) [$r.mb cget -indicatoron] -$r.mb.menu insert 0 checkbutton -label "Indicator?" \ - -variable ::V(rmbIndicatoron) \ - -command "$r.mb configure -indicatoron \$::V(rmbIndicatoron)" ; -$r.mb.menu insert 1 separator - -entry $r.e -textvariable ::entryText - -set rtext [scrolled text $r.t -width 12 -height 5 -wrap none] - -grid $r.cb -sticky ew -grid $r.rb1 -sticky ew -grid $r.rb2 -sticky ew -grid $r.rb3 -sticky ew -grid $r.button -sticky ew -padx 2 -pady 2 -grid $r.mb -sticky ew -padx 2 -pady 2 -grid $r.e -sticky ew -padx 2 -pady 2 -grid $rtext -sticky news - -grid columnconfigure $r 0 -weight 1 -grid rowconfigure $r 7 -weight 1 ; # text widget - -# -# Add some text to the text boxes: -# - -set cb $::BASE.tbar_orig.cb5 -set txt "checkbutton $cb \\\n" -foreach copt [$cb configure] { - if {[llength $copt] == 5} { - append txt " [lindex $copt 0] [lindex $copt 4] \\\n" - } -} -append txt " ;\n" - -$l.t insert end $txt -$r.t insert end $txt - -### Scales and sliders pane. -# -proc scales.pane {scales} { - ttk::frame $scales - - ttk::panedwindow $scales.pw -orient horizontal - set l [ttk::labelframe $scales.styled -text "Themed" -padding 6] - set r [labelframe $scales.orig -text "Standard" -padx 6 -pady 6] - - ttk::scale $l.scale -orient horizontal -from 0 -to 100 -variable ::V(SCALE) - ttk::scale $l.vscale -orient vertical -from 100 -to 0 -variable ::V(VSCALE) - ttk::progressbar $l.progress -orient horizontal -maximum 100 - ttk::progressbar $l.vprogress -orient vertical -maximum 100 - if {1} { - $l.scale configure -command [list $l.progress configure -value] - $l.vscale configure -command [list $l.vprogress configure -value] - } else { - # This would also work, but the Tk scale widgets - # in the right hand pane cause some interference when - # in autoincrement/indeterminate mode. - # - $l.progress configure -variable ::V(SCALE) - $l.vprogress configure -variable ::V(VSCALE) - } - - $l.scale set 50 - $l.vscale set 50 - - ttk::label $l.lmode -text "Progress bar mode:" - ttk::radiobutton $l.pbmode0 -variable ::V(PBMODE) \ - -text determinate -value determinate -command [list pbMode $l] - ttk::radiobutton $l.pbmode1 -variable ::V(PBMODE) \ - -text indeterminate -value indeterminate -command [list pbMode $l] - proc pbMode {l} { - variable V - $l.progress configure -mode $V(PBMODE) - $l.vprogress configure -mode $V(PBMODE) - } - - ttk::button $l.start -text "Start" -command [list pbStart $l] - proc pbStart {l} { - set ::V(PBMODE) indeterminate; pbMode $l - $l.progress start 10 - $l.vprogress start - } - - ttk::button $l.stop -text "Stop" -command [list pbStop $l] - proc pbStop {l} { - $l.progress stop - $l.vprogress stop - } - - grid $l.scale -columnspan 2 -sticky ew - grid $l.progress -columnspan 2 -sticky ew - grid $l.vscale $l.vprogress -sticky nws - - grid $l.lmode -sticky we -columnspan 2 - grid $l.pbmode0 -sticky we -columnspan 2 - grid $l.pbmode1 -sticky we -columnspan 2 - grid $l.start -sticky we -columnspan 2 - grid $l.stop -sticky we -columnspan 2 - - grid columnconfigure $l 0 -weight 1 - grid columnconfigure $l 1 -weight 1 - - grid rowconfigure $l 99 -weight 1 - - scale $r.scale -orient horizontal -from 0 -to 100 -variable ::V(SCALE) - scale $r.vscale -orient vertical -from 100 -to 0 -variable ::V(VSCALE) - grid $r.scale -sticky news - grid $r.vscale -sticky nws - - grid rowconfigure $r 99 -weight 1 - grid columnconfigure $r 0 -weight 1 - - ## - $scales.pw add $l -weight 1 - $scales.pw add $r -weight 1 - pack $scales.pw -expand true -fill both - - return $scales -} -$nb add [scales.pane $nb.scales] -text Scales -sticky nwes -padding 6 - -### Combobox demo pane. -# -proc combobox.pane {cbf} { - ttk::frame $cbf - set values [list abc def ghi jkl mno pqr stu vwx yz] - pack \ - [ttk::combobox $cbf.cb1 -values $values -textvariable ::COMBO] \ - [ttk::combobox $cbf.cb2 -values $values -textvariable ::COMBO ] \ - -side top -padx 2 -pady 2 -expand false -fill x; - $cbf.cb2 configure -state readonly - $cbf.cb1 current 3 - return $cbf -} -$nb add [combobox.pane $nb.combos] -text "Combobox" -underline 7 - -### Treeview widget demo pane. -# -proc tree.pane {w} { - ttk::frame $w - ttk::scrollbar $w.vsb -command [list $w.t yview] - ttk::treeview $w.t -columns [list Class] \ - -padding 4 \ - -yscrollcommand [list sbset $w.vsb] - - grid $w.t $w.vsb -sticky nwse - grid columnconfigure $w 0 -weight 1 - grid rowconfigure $w 0 -weight 1 - grid propagate $w 0 - - # - # Add initial tree node: - # Later nodes will be added in <> binding. - # - $w.t insert {} 0 -id . -text "Main Window" -open 0 \ - -values [list [winfo class .]] - $w.t heading \#0 -text "Widget" - $w.t heading Class -text "Class" - bind $w.t <> [list fillTree $w.t] - - return $w -} - -# fillTree -- <> binding for tree widget. -# -proc fillTree {tv} { - set id [$tv focus] - if {![winfo exists $id]} { - $tv delete $id - return - } - - # - # Replace tree item children with current list of child windows. - # - $tv delete [$tv children $id] - set children [winfo children $id] - foreach child $children { - $tv insert $id end -id $child -text [winfo name $child] -open 0 \ - -values [list [winfo class $child]] - if {[llength [winfo children $child]]} { - # insert dummy child to show [+] indicator - $tv insert $child end - } - } -} - -if {[llength [info commands ttk::treeview]]} { - $nb add [tree.pane $nb.tree] -text "Tree" -sticky news -} - -### Other demos. -# -$nb add [ttk::frame $nb.others] -text "Others" -underline 4 - -set Timers(StateMonitor) {} -set Timers(FocusMonitor) {} - -set others $::BASE.nb.others - -ttk::label $others.m -justify left -wraplength 300 -bind ShowDescription { $BASE.nb.others.m configure -text $Desc(%W) } -bind ShowDescription { $BASE.nb.others.m configure -text "" } - -foreach {command label description} { - trackStates "Widget states..." - "Display/modify widget state bits" - - scrollbarResizeDemo "Scrollbar resize behavior..." - "Shows how Ttk and standard scrollbars differ when they're sized too large" - - trackFocus "Track keyboard focus..." - "Display the name of the widget that currently has focus" - - repeatDemo "Repeating buttons" - "Demonstrates custom classes (see demos/repeater.tcl)" - -} { - set b [ttk::button $others.$command -text $label -command $command] - set Desc($b) $description - bindtags $b [lreplace [bindtags $b] end 0 ShowDescription] - - pack $b -side top -expand false -fill x -padx 6 -pady 6 -} - -pack $others.m -side bottom -expand true -fill both - - -### Scrollbar resize demo. -# -proc scrollbarResizeDemo {} { - set t .scrollbars - destroy $t - toplevel $t ; wm geometry $t 200x200 - frame $t.f -height 200 - grid \ - [ttk::scrollbar $t.f.tsb -command [list sbstub $t.f.tsb]] \ - [scrollbar $t.f.sb -command [list sbstub $t.f.sb]] \ - -sticky news - - $t.f.sb set 0 0.5 ;# prevent backwards-compatibility mode for old SB - - grid columnconfigure $t.f 0 -weight 1 - grid columnconfigure $t.f 1 -weight 1 - grid rowconfigure $t.f 0 -weight 1 - pack $t.f -expand true -fill both -} - -### Track focus demo. -# -proc trackFocus {} { - global Focus - set t .focus - destroy $t - toplevel $t - wm title $t "Keyboard focus" - set i 0 - foreach {label variable} { - "Focus widget:" Focus(Widget) - "Class:" Focus(WidgetClass) - "Next:" Focus(WidgetNext) - "Grab:" Focus(Grab) - "Status:" Focus(GrabStatus) - } { - grid [ttk::label $t.l$i -text $label -anchor e] \ - [ttk::label $t.v$i -textvariable $variable \ - -width 40 -anchor w -relief groove] \ - -sticky ew; - incr i - } - grid columnconfigure $t 1 -weight 1 - grid rowconfigure $t $i -weight 1 - - bind $t {after cancel $Timers(FocusMonitor)} - FocusMonitor -} - -proc FocusMonitor {} { - global Focus - - set Focus(Widget) [focus] - if {$::Focus(Widget) ne ""} { - set Focus(WidgetClass) [winfo class $Focus(Widget)] - set Focus(WidgetNext) [tk_focusNext $Focus(Widget)] - } else { - set Focus(WidgetClass) [set Focus(WidgetNext) ""] - } - - set Focus(Grab) [grab current] - if {$Focus(Grab) ne ""} { - set Focus(GrabStatus) [grab status $Focus(Grab)] - } else { - set Focus(GrabStatus) "" - } - - set ::Timers(FocusMonitor) [after 200 FocusMonitor] -} - -### Widget states demo. -# -variable Widget .tbar_styled.tb1 - -bind all { TrackWidget %W ; break } - -proc TrackWidget {w} { - set ::Widget $w ; - if {[winfo exists .states]} { - UpdateStates - } else { - trackStates - } -} - -variable states [list \ - active disabled focus pressed selected readonly \ - background alternate invalid] - -proc trackStates {} { - variable states - set t .states - destroy $t; toplevel $t ; wm title $t "Widget states" - - set tf [ttk::frame $t.f] ; pack $tf -expand true -fill both - - ttk::label $tf.info -text "Press Control-Shift-Button-1 on any widget" - - ttk::label $tf.lw -text "Widget:" -anchor e -relief groove - ttk::label $tf.w -textvariable ::Widget -anchor w -relief groove - - grid $tf.info - -sticky ew -padx 6 -pady 6 - grid $tf.lw $tf.w -sticky ew - - foreach state $states { - ttk::checkbutton $tf.s$state \ - -text $state \ - -variable ::State($state) \ - -command [list ChangeState $state] ; - grid x $tf.s$state -sticky nsew - } - - grid columnconfigure $tf 1 -weight 1 - - grid x [ttk::frame $tf.cmd] -sticky nse - grid x \ - [ttk::button $tf.cmd.close -text Close -command [list destroy $t]] \ - -padx 4 -pady {6 4}; - grid columnconfigure $tf.cmd 0 -weight 1 - - bind $t [list event generate $tf.cmd.close <>] - bind $t { after cancel $::Timers(StateMonitor) } - StateMonitor -} - -proc StateMonitor {} { - if {$::Widget ne ""} { UpdateStates } - set ::Timers(StateMonitor) [after 200 StateMonitor] -} - -proc UpdateStates {} { - variable states - variable State - variable Widget - - foreach state $states { - if {[catch {set State($state) [$Widget instate $state]}]} { - # Not a Ttk widget: - .states.f.s$state state disabled - } else { - .states.f.s$state state !disabled - } - } -} - -proc ChangeState {state} { - variable State - variable Widget - if {$Widget ne ""} { - if {$State($state)} { - $Widget state $state - } else { - $Widget state !$state - } - } -} - -### Repeating button demo. -# - -proc repeatDemo {} { - set top .repeatDemo - if {![catch { wm deiconify $top ; raise $top }]} { return } - toplevel $top - wm title $top "Repeating button" - keynav::enableMnemonics $top - - set f [ttk::frame .repeatDemo.f] - ttk::button $f.b -class Repeater -text "Press and hold" \ - -command [list $f.p step] - ttk::progressbar $f.p -orient horizontal -maximum 10 - - ttk::separator $f.sep -orient horizontal - set cmd [ttk::frame $f.cmd] - pack \ - [ttk::button $cmd.close -text Close -command [list destroy $top]] \ - -side right -padx 6; - - pack $f.cmd -side bottom -expand false -fill x -padx 6 -pady 6 - pack $f.sep -side bottom -expand false -fill x -padx 6 -pady 6 - pack $f.b -side left -expand false -fill none -padx 6 -pady 6 - pack $f.p -side right -expand true -fill x -padx 6 -pady 6 - - $f.b configure -underline 0 - $cmd.close configure -underline 0 - bind $top [list event generate $cmd.close <>] - - pack $f -expand true -fill both -} - - -### Command box. -# -set cmd [ttk::frame $::BASE.command] -ttk::button $cmd.close -text Close -underline 0 -command [list destroy .] -ttk::button $cmd.help -text Help -command showHelp - -proc showHelp {} { - if {![winfo exists .helpDialog]} { - lappend detail "Tk version $::tk_version" - lappend detail "Ttk library: $::ttk::library" - ttk::dialog .helpDialog -type ok -icon info \ - -message "Ttk demo" -detail [join $detail \n] - } -} - -grid x $cmd.close $cmd.help -pady 6 -padx 6 -grid columnconfigure $cmd 0 -weight 1 - -## Status bar (to demonstrate size grip) -# -set statusbar [ttk::frame $BASE.statusbar] -pack [ttk::sizegrip $statusbar.grip] -side right -anchor se - -## Accelerators: -# -bind $::ROOT [list event generate $cmd.close <>] -bind $::ROOT <> [list event generate $cmd.help <>] -keynav::enableMnemonics $::ROOT -keynav::defaultButton $cmd.help - -### Menubar. -# -set menu [menu $::BASE.menu] -$::ROOT configure -menu $menu -$menu add cascade -label "File" -underline 0 -menu [menu $menu.file] -$menu.file add command -label "Open" -underline 0 \ - -compound left -image $::ICON(open) -$menu.file add command -label "Save" -underline 0 \ - -compound left -image $::ICON(save) -$menu.file add separator -$menu.file add checkbutton -label "Checkbox" -underline 0 \ - -variable ::V(SELECTED) -$menu.file add cascade -label "Choices" -underline 1 \ - -menu [menu $menu.file.choices] -foreach {label value} {One 1 Two 2 Three 3} { - $menu.file.choices add radiobutton \ - -label $label -variable ::V(CHOICE) -value $value -} - -$menu.file insert end separator -if {[tk windowingsystem] ne "x11"} { - $menu.file insert end checkbutton -label Console -underline 5 \ - -variable ::V(CONSOLE) -command toggleconsole - proc toggleconsole {} { - if {$::V(CONSOLE)} {console show} else {console hide} - } -} -$menu.file add command -label "Exit" -underline 1 \ - -command [list event generate $cmd.close <>] - -# Add Theme menu. -# -proc makeThemeMenu {menu} { - menu $menu - foreach {theme name} $::THEMELIST { - $menu add radiobutton -label $name \ - -variable ::ttk::currentTheme -value $theme \ - -command [list ttk::setTheme $theme] - if {[lsearch -exact [package names] ttk::theme::$theme] == -1} { - $menu entryconfigure end -state disabled - } - } - return $menu -} - -$menu add cascade -label "Theme" -underline 3 -menu [makeThemeMenu $menu.theme] - -### Main window layout. -# - -pack $BASE.statusbar -side bottom -expand false -fill x -pack $BASE.command -side bottom -expand false -fill x -pack $BASE.tbar_styled -side top -expand false -fill x -pack $BASE.tbar_orig -side top -expand false -fill x -pack $BASE.control -side left -expand false -fill y -padx 6 -pady 6 -pack $BASE.nb -side left -expand true -fill both -padx 6 -pady 6 - -wm title $ROOT "Ttk demo" -wm iconname $ROOT "Ttk demo" -update; wm deiconify $ROOT diff --git a/library/demos/ttk_iconlib.tcl b/library/demos/ttk_iconlib.tcl deleted file mode 100644 index 9a93ece..0000000 --- a/library/demos/ttk_iconlib.tcl +++ /dev/null @@ -1,110 +0,0 @@ -array set ImgData { -bold {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI6hI+py60U3wj+ -RYQFJYRvEWFBCeFbRFhQQvhG8YPgX0RYUEL4FhEWlBC+RYQFJYQPFN8IPqYut/8hBQA7} -copy {R0lGODlhEAAQAJEAANnZ2QAAAP///wAAhCH5BAEAAAAALAAAAAAQABAAAAJUhI8JFJ/gY4iI -UEL4FyIiFIXgW0iEUDgfACBI9pzMAAGRiIghWSMDECR7JEKGtkFIRFBG+TIQKDQxtgzcDcmX -IfgwQrFlCD4MyZch+EDzj+Bj6mYBADs=} -cut {R0lGODlhEAAQAJEAANnZ2QAAAAAAhP///yH5BAEAAAAALAAAAAAQABAAAAJFhI+pcUHwEeIi -E0gACIKPEAFBIXy0gMg8EhM+YmQiKSL4eAIiJMI/EQEhQGYGYiQIQAg+iAkIATIzECMBIgT/ -RBARERlSADs=} -dragfile {R0lGODlhGAAYAKIAANnZ2TMzM////wAAAJmZmf///////////yH5BAEAAAAALAAAAAAYABgA -AAPACBi63IqgC4GiyxwogaAbKLrMgSKBoBoousyBogEACIGiyxwoKgGAECI4uiyCExMTOACB -osuNpDoAGCI4uiyCIkREOACBosutSDoAgSI4usyCIjQAGCi63Iw0ACEoOLrMgiI0ABgoutyM -NAAhKDi6zIIiNAAYKLrcjDQAISg4usyCIjQAGCi63Iw0AIGiiqPLIyhCA4CBosvNSAMQKKo4 -ujyCIjQAGCi63Iw0AIGiy81IAxCBpMu9GAMAgKPL3QgJADs=} -dragicon {R0lGODlhGAAYALMAANnZ2TMzM/////8zM8zMzGYAAAAAAJmZmQCZMwAzZgCZzGZmZv////// -/////////yH5BAEAAAAALAAAAAAYABgAAAT/EMAgJ60SAjlBgEJOSoMIEMgZoJCT0iADBFIG -KOSkNMwAAABhwiHnIEKIIIQQAQIZhBBwyDmKEMIEE0yABoAghIBDzlGEENDIaQAIQgg45BwF -CinPOccAECYcUiKEEBFCiHPgMQAEIcQYYyABBUGIQCHlMQCEScZAAhKEEApCECGOARAEIQQp -BRGIpAyCJCGOASBAISdEcqJAVBLiGABggELOAJGUKyiVhDgGABigkJMEhNAKSqkEhTgGgCCl -FCQEGIJSSiUhjgEgQCEnJVBJmYQ4BoAAhZyTQCVnEuIYAAIUckoCk5xSiGMACFDISSs9BoBg -rRXQMQAEKOSklR4DEUAI8MhJ6wwGAACgkZNWCkAEADs=} -error {R0lGODlhIAAgAKIAANnZ2YQAAP8AAISEhP///////////////yH5BAEAAAAALAAAAAAgACAA -AAP/CLoMGLqKoMvtGIqiqxEYCLrcioGiyxwIusyBgaLLLRiBoMsQKLrcjYGgu4Giy+2CAkFX -A0WX2wXFIOgGii7trkCEohsDCACBoktEKLpKhISiGwAIECiqSKooukiqKKoxgACBooukKiIo -SKooujGDECi6iqQqsopEV2MQAkV3kXQZRXdjEAJFl5F0FUWXY3ACRZcFSRdFlyVwJlB0WZB0 -UXRZAmcCRZeRdBVFl2NwAkV3kXQZRXdjcAJFV5FURVaR6GoMDgSKLpKqiKAgqaLoxgwOBIoq -kiqKLpIqimrM4ECg6BIRiq4SIaHoxgyCBoou7a5AhKIbMzgAAIGiy+2CTWJmBhAAAkWX2wXF -zCDoBooud2PMDIKuRqDocgtGzMwg6O4Eii5z4Kgi6DIMhqLoagQGjiqCLvPgYOgqji6CLrfi -6DIj6HI7jq4i6DIkADs=} -file {R0lGODlhCwANAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAALAA0AAAIyhI9G8Q0AguSH -AMQdxQgxEyEFQfItICQokYgEBMm3gBCKLRIQJN8CQii2SECQfAug+FgAOw==} -folder {R0lGODlhEAANAKIAANnZ2YSEhMbGxv//AP///wAAAP///////yH5BAEAAAAALAAAAAAQAA0A -AANjCIqhiqDLITgyEgi6GoIjIyMYugCBpMsaWBA0giMjIzgyUYBBMjIoIyODEgVBODIygiMj -E1gQJIMyMjIoI1GAQSMjODIyghMFQSgjI4MyMhJYEDSCIyMjODJRgKHLXAiApcucADs=} -hourglass {R0lGODlhIAAgAKIAANnZ2YAAAAAAAP8AAP///8DAwICAgP///yH5BAEAAAAALAAAAAAgACAA -AAPZCLrc/jDKSau9OGcUuqyCoMvNGENVhaMrCLrcjaLLgqDL7WhFVIVVZoKgy+1oRUSFVWaC -oMvtaEVEhVVmgqDL7WhFRIVVZoKgy+1oVVaCJWaCoMvtgKxISrBMEHS5fZEVSRkKgi63NzIq -EwRdbndkVCYIutzeyIqqDAVBl9sXWRFJYZkg6HI7ICsiKqwyEwRdbkcrIhKsMhMEXW5HKyIp -lDITBF1uRysyEiwxEwRdbkcrIyuUEhMEXW5H0WVB0OVujKGqwtEVBF1uRtHlRdDl9odRTlrt -xRmjBAA7} -info {R0lGODlhIAAgAKIAANnZ2YSEhMbGxv///wAA/wAAAP///////yH5BAEAAAAALAAAAAAgACAA -AAP/CLoMGLqKoMvtGCo4uhKBgaDLDRghOLqsghEIuryBgqPLPSiBoMsQOLojhEQkOLpTCLob -OLqKpIujq4WgC4Gju0i6OLpbCKohOLorhEQkOLorhaAQOLrc3qgCIARHl9sbSQUEji4j6RKO -Lk9hQODosiKp4ujyFIbi6LIiqeLo8hSG4uiyIqni6PIUhuLosiKp4ujyFIYKji4PkiqOLkth -BASOLg+SKo4uV2AEhODoMpIqju5KYShA4Ogqku7i6E4FRgAAYOHocvugiohAUC0cXe7GiohA -0IUSHF3uQamICATdrULB0WUVrIqIQNBlCCwVHF2pwsJQRdDlDYyoKsHRPMLQDQRdbsDQqBmc -wlBF0OV2jJqZwggEXW5vVDMVgaDL7Y5qKgJBl9sfVUUg6HL7AxSKoMvtr1AEgi5DAgA7} -italic {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAIrhI+py+1A4hN8 -hIjINBITPlpEZBqJCR8tIjKNxISPFhGZQOITfExdbv9FCgA7} -new {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAJFhI95FN8IvgXJ -jyD4ECQ/JAh+kPyICIIdJP+CYAfJvyDYQfIvCHaQ/AuCHST/gmAHyb8g2EHyLwh2kPwLgk3x -MQg+pu4WADs=} -open {R0lGODlhEAAQAKIAANnZ2QAAAP//AP///4SEAP///////////yH5BAEAAAAALAAAAAAQABAA -AANZCLrczigUQZc1EDQgEHSZAwMgIhB0NQIDQkYwdANBNUZwZGQEJxBUQwZlZGRQAkE1RnAE -Q5dVcCSQdDcAYySQdDcAISSQdDcAASKQdDcAAQBDlwNBl9sfApQAOw==} -openfold {R0lGODlhEAANAKIAANnZ2YSEhP///8bGxv//AAAAAP///////yH5BAEAAAAALAAAAAAQAA0A -AANgCIqhiqDLgaIaCLoagkNDIxi6AIFCQ0M4KKpRgCFDQzg0NIQThaHLSxgVKLochRMVMkhD -Q4M0VBFYEDKEQ0NDOFFRgCE0NEhDQ4MVBRAoNDSEQ0NRWAAYuqyFBQBYurwJADs=} -overstrike {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI3hI+py80Uh+Aj -RFhQCP8iMILgWwRGEHyLwAiCbxEYQfCB4iPBhwiMIPgXYREEHyEiguBj6nI7FQA7} -palette {R0lGODlhEAAQAKIAANnZ2QAAAP//AP////8A/4QAhP8AAAD//yH5BAEAAAAALAAAAAAQABAA -AANtCLrcjqGBoMsRKCMTgaALMSgDAYMSCKoxgAFBITgSAIAQEhUIARCAEgAQOBAwghMQEwga -MoIjIxAIEgCAEBEyKBAgg4GgGxAIYTGCgaALcRgQIIGgCwEYICODgaALITgyEoGguxiqCLrc -/lChBAA7} -passwd {R0lGODlhIAAgAMQAANnZ2QAAAICAgICAAP///7CwsMDAwMjIAPjIAOjo6Pj4AODg4HBwcMj4 -ANjY2JiYANDQ0MjIyPj4yKCgoMiYAMjImDAwAMjIMJiYmJCQkP////////////////////// -/yH5BAEAAAAALAAAAAAgACAAAAX/ICCOIhiIIgiII1maZSCMQnCeJyAIQiAIAiAMwxCcJwkk -EAQRCIUwGMSBDEEAAuJIlgKRJEEgGAMRBIGiDENQlqNAJAsYCEwgEEEgBAHSIEMAAuJIAgKR -LEsgGEMgCEJgBMqhHENQlgJILMsSCMRABEFgGAESHMcRgIA4kgKxOIsTBAOhKAITKEGDHMhD -kqIAEqAjisJAgIooBkpwNMcTgIA4jgLhOBAkEAOhKIoSKEGDIMcTkKQICgQEQQIxEIqiBEpw -IMdxPAEIiCMJCEQUMUQ0EIqiHIfSIM3xBGUpCiABCUQyEMqhHMiBHMjxBCAgjuQoEAKxRANB -HMqhHM1x/zxDUJajQIACsUTDQBAEIR3IcQRDAALiSIoCYQiEE03gII7HQR3BEICAOJICYRSC -QDjRNE1CAAzVQR3WE5AkAAqEUQiFQEARBAUAAAzHQR3BEICAOI4CUQhFIBAREwXjUFUHdQRD -QJJAABbCFAhEJBgBAADAMAwXdQRDAALiCAhEIRQCYRiCEZDjUFFHMAQkIBAFOAmTQBiFUAQg -II7AUFXUEQwBCQjEJExBkBRCEZCjMIBD9RxDAALiGEzCFBBYIRTBOI7AQB1DMIoCMQkYGAjL -JEwBCIgjOVDDEJCAQGACJiTTJEwBSY5BEJAiSCCwTAiCZBKmAATEkSzNQBCCYCDBJgELTNMk -g0AMEgwTAhAQR7I0zYARgvM8TyAIznMMAQA7} -paste {R0lGODlhEAAQAKIAANnZ2QAAAP//AISEAISEhP///wAAhP///yH5BAEAAAAALAAAAAAQABAA -AANwCLrcjqGBoKsYqiKrCDSGBkMiJJCGAgCDKBB0gwYDIKYwdJUIAyBokIaGBmloAhBiaAgH -TdcCEIKGBsmwVM0AIYaGcAxL1coQgoYGySoisMzMAoeGxrB01QJpaMiwMHTLAEPVsHTVEHTR -dBlBlxswAQA7} -print {R0lGODlhEAAQAKIAANnZ2QAAAP///4SEhP//AP///////////yH5BAEAAAAALAAAAAAQABAA -AANZCLrcjqG7CLqBoquBoBuCoSqBoBsouhoIuiEYqrKBoIGiqwEYEIChyxAIEYGgywEYgKHL -DAgRCLozgwABARgIukSEABEBGLq8gAEQCLobgAEAgKHLgaDLzZgAOw==} -question {R0lGODlhIAAgAKIAANnZ2YSEhMbGxv///wAAAAAA/////////yH5BAEAAAAALAAAAAAgACAA -AAP/CLoMGLqKoMvtGCo4uhKBgaDLDRghOLqsghEIuryBgqPLPSiBoMsQOLrcjYSgu4GjO4Kl -Kzi6Qwi6EDi6I4UyU1VYgqM7hKAagqM7VTg6VYWFoztCCAqBo6tVWDVThVU4ukqBACE4ulqF -VSNVWIWjq0IYEDi6K4UlU1VYOLpMgRA4uryCpTi6PIShOLq8hVU4uqyEoTi6vIUlOLqshKE4 -uryFhaPLSxgqOLrc3kgoAgJHl0ewSnB0eQhDIQRHl6uwCkeXhTAUIHB0uQqrcHSZAiMAAJBw -dFcKS3B0lwIjAkGVcHS5GykiAkEXSHB0uQeFIiIQdJcIBUeXVZAoIgJBT5chkFRwdIUICUMV -QZc3MIKIBEcJQzcQdLkBQ4NmcAhDFUGX2zFoZggjEHS5vRHNUASCLrc7oqEIBF1uf0QUgaDL -7Q9QKIIut79CEQi6DAkAOw==} -redo {R0lGODlhEAAQAJEAANnZ2QAAhP///////yH5BAEAAAAALAAAAAAQABAAAAIvhI+py+1vSByC -jxAYQXDMwsyAggQAQBB8iwgMgg8REQgUwqbYBDsIPqYutz+MgBQAOw==} -save {R0lGODlhEAAQAJEAANnZ2QAAAISEAP///yH5BAEAAAAALAAAAAAQABAAAAJWhI9pFB8RIIRC -+BYQFqQQvkWEBSmEbyFhQQrhW0hYkEL4FhIWpBC+hYQFSYxvIgFAoXy0AAiSGP8kAIIkxgcI -CSBEQvEBQgIIkVB8gJAAAhgfj+BjWgEAOw==} -underline {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI3hI+py60UBy4I -vkVcBMG/iIsg+BdxEQT/Ii6C4F/ERRD8i7gIgn8RF0HwkWITfExFin8EH1OXCwA7} -undo {R0lGODlhEAAQAJEAANnZ2QAAhP///////yH5BAEAAAAALAAAAAAQABAAAAIuhI+py+2vSByC -HxdxQCHsCIg7oAAAEUHwLTAiKIQPgRSbYMfd3VEIH1OX2x8mUgA7} -warning {R0lGODlhIAAgAKIAANnZ2YSEAP//AMbGxgAAAISEhP///////yH5BAEAAAAALAAAAAAgACAA -AAP/CLq8gREIutz+KESGEHS5vVGIiAxSIehy+6JAUaUqBF1uBxQoukOFhaDL7RgoukKFhaDL -3RgoujqEVQi63IyBortUWAi63IuBostDWIWgy60YIjKERCMiSFUIutyAISKCpCoiOFSFoMsd -KCpIqiKCQlUIusyBooqkKiIoQ1UIuryBooqkiqJKVQi6rIGii6SKojpUWAi6DIGiG0RIgaJL -VQi6HCi6MoREg6I7VFgIuhsoukqEhKKrVFgIuhoouhuEgaKrQ1iFoAuBortDOCi6S4WFoBso -uiyEostDWIWgGii63K6IqgAAIVB0WQaJBkV3h7AKAAJFl4WQiFB0mQoLRyBQdFkJiQhFl4ew -CgJFl3WQaFB0WQirIFB0ud0RVVWg6HJ7o6GqAgwUXW5fNFRVhQCBpMvti0oVABCwdLndEehi -6XI7I4AEADs=} -} diff --git a/library/demos/ttk_repeater.tcl b/library/demos/ttk_repeater.tcl deleted file mode 100644 index b515ed4..0000000 --- a/library/demos/ttk_repeater.tcl +++ /dev/null @@ -1,117 +0,0 @@ -# -# $Id: ttk_repeater.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ -# -# Demonstration of custom classes. -# -# The Ttk button doesn't have built-in support for autorepeat. -# Instead of adding -repeatdelay and -repeatinterval options, -# and all the extra binding scripts required to deal with them, -# we create a custom widget class for autorepeating buttons. -# -# Usage: -# ttk::button .b -class Repeater [... other options ...] -# -# TODO: -# Use system settings for repeat interval and initial delay. -# -# Notes: -# Repeater buttons work more like scrollbar arrows than -# Tk repeating buttons: they fire once immediately when -# first pressed, and $State(delay) specifies the initial -# interval before the button starts autorepeating. -# - -namespace eval ttk::Repeater { - variable State - set State(timer) {} ;# [after] id of repeat script - set State(interval) 100 ;# interval between repetitions - set State(delay) 300 ;# delay after initial invocation -} - -### Class bindings. -# - -bind Repeater { %W state active } -bind Repeater { %W state !active } - -bind Repeater { ttk::Repeater::Activate %W } -bind Repeater <> { ttk::Repeater::Activate %W } - -bind Repeater { ttk::Repeater::Press %W } -bind Repeater { ttk::Repeater::Release %W } -bind Repeater { ttk::Repeater::Pause %W } -bind Repeater { ttk::Repeater::Resume %W } ;# @@@ see below - -# @@@ Workaround for metacity-induced bug: -bind Repeater \ - { if {"%d" ne "NotifyUngrab"} { ttk::Repeater::Resume %W } } - -### Binding procedures. -# - -## Activate -- Keyboard activation binding. -# Simulate clicking the button, and invoke the command once. -# -proc ttk::Repeater::Activate {w} { - $w instate disabled { return } - set oldState [$w state pressed] - update idletasks; after 100 - $w state $oldState - after idle [list $w invoke] -} - -## Press -- ButtonPress-1 binding. -# Invoke the command once and start autorepeating after -# $State(delay) milliseconds. -# -proc ttk::Repeater::Press {w} { - variable State - $w instate disabled { return } - $w state pressed - $w invoke - after cancel $State(timer) - set State(timer) [after $State(delay) [list ttk::Repeater::Repeat $w]] -} - -## Release -- ButtonRelease binding. -# Stop repeating. -# -proc ttk::Repeater::Release {w} { - variable State - $w state !pressed - after cancel $State(timer) -} - -## Pause -- B1-Leave binding -# Temporarily suspend autorepeat. -# -proc ttk::Repeater::Pause {w} { - variable State - $w state !pressed - after cancel $State(timer) -} - -## Resume -- B1-Enter binding -# Resume autorepeat. -# -proc ttk::Repeater::Resume {w} { - variable State - $w instate disabled { return } - $w state pressed - $w invoke - after cancel $State(timer) - set State(timer) [after $State(interval) [list ttk::Repeater::Repeat $w]] -} - -## Repeat -- Timer script -# Invoke the command and reschedule another repetition -# after $State(interval) milliseconds. -# -proc ttk::Repeater::Repeat {w} { - variable State - $w instate disabled { return } - $w invoke - set State(timer) [after $State(interval) [list ttk::Repeater::Repeat $w]] -} - -#*EOF* 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 \ - [list event generate $cmd.$options(-cancel) <>] - wm protocol $dlg WM_DELETE_WINDOW \ - [list event generate $cmd.$options(-cancel) <>] - } - - # - # 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 <> -} - -## 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 <> event to the -# widget with mnemonic K (as determined by the -underline and -text -# options). -# -# Side effects: adds a binding for to $toplevel -# -# keynav::defaultButton $button -- -# Enables default activation for the toplevel window in which $button -# appears. Pressing 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 and bindings -# to the toplevel containing $button, and a 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 <> - -# -# Bindings for stock Tk widgets: -# (NB: for 8.3 use tkButtonInvoke, tkMbPost instead) -# -bind Button <> { tk::ButtonInvoke %W } -bind Checkbutton <> { tk::ButtonInvoke %W } -bind Radiobutton <> { tk::ButtonInvoke %W } -bind Menubutton <> { tk::MbPost %W } - -proc keynav::enableMnemonics {w} { - bind [winfo toplevel $w] {+ 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 <> - 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 [list keynav::CleanupDefault $top] - bind $top [list keynav::ClaimDefault $top %W] - bind $top [list keynav::ActivateDefault $top] -} - -proc keynav::CleanupDefault {top} { - variable DefaultButton - unset DefaultButton(current.$top) - unset DefaultButton(default.$top) -} - -# ClaimDefault $top $w -- -# 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) <> - } -} - -#*EOF* diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl index b354958..b70c855 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.5.2.1 2007/05/26 04:06:07 dgp 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...) diff --git a/tests/ttk/misc.test b/tests/ttk/misc.test deleted file mode 100644 index 27b87d6..0000000 --- a/tests/ttk/misc.test +++ /dev/null @@ -1,33 +0,0 @@ -# -# $Id: misc.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $ -# - -package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* -loadTestedCommands - -test misc-1.0 "#1551500 -parent option in ttk::dialog doesn't work" -body { - ttk::dialog .dialog -parent . -type ok \ - -message "Something to say" -title "Let's see" - wm transient .dialog -} -result . -cleanup { destroy .dialog } - -test misc-1.1 "ttk::dialog w/no -parent option" -body { - toplevel .t - ttk::dialog .t.dialog -type ok - wm transient .t.dialog -} -result .t -cleanup { destroy .t } - -test misc-1.2 "Explicitly specify -parent" -body { - toplevel .t - ttk::dialog .t.dialog -type ok -parent . - wm transient .t.dialog -} -result . -cleanup { destroy .t } - -test misc-1.3 "Nontransient dialog" -body { - toplevel .t - ttk::dialog .t.dialog -type ok -parent "" - wm transient .t.dialog -} -result "" -cleanup { destroy .t } - -tcltest::cleanupTests diff --git a/unix/Makefile.in b/unix/Makefile.in index 73965b8..ee03061 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.128 2007/05/14 20:58:27 dgp Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.128.2.1 2007/05/26 04:06:07 dgp Exp $ # Current Tk version; used in various names. @@ -835,7 +835,6 @@ install-doc: @echo "Installing and cross-linking command (.n) docs"; @for i in $(TOP_DIR)/doc/*.n; do \ - if [ "ttk_dialog.n" = `basename $$i` ] ; then continue ; fi ; \ $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i $(MANN_INSTALL_DIR); \ done -- cgit v0.12