From 9d5c1ed7b432d032a20a92a500639fd69160ee6a Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 2 Nov 2007 14:51:39 +0000 Subject: merge updates from HEAD --- ChangeLog | 15 ++++ doc/bind.n | 58 +++++++------- doc/event.n | 10 +-- doc/font.n | 56 +++++++------- doc/palette.n | 10 +-- doc/ttk_combobox.n | 8 +- library/choosedir.tcl | 18 ++--- library/demos/sayings.tcl | 6 +- library/demos/textpeer.tcl | 8 +- library/demos/ttknote.tcl | 4 +- library/msgbox.tcl | 36 +++++---- library/tkfbox.tcl | 189 +++++++++++++++++++++++++++++++++++---------- 12 files changed, 273 insertions(+), 145 deletions(-) diff --git a/ChangeLog b/ChangeLog index 278aa1d..b47ab93 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2007-11-02 Donal K. Fellows + + * library/msgbox.tcl: Made message dialog use Ttk widgets for better + L&F. + + * library/tkfbox.tcl (::tk::dialog::file::CompleteEnt): Added + completion. [FRQ 805091] + * library/tkfbox.tcl: Made file dialog use Ttk widgets for better L&F. + + * library/demos/sayings.tcl: Better resizing. [Bug 1822410] + +2007-11-01 Donal K. Fellows + + * library/demos/textpeer.tcl: Better resizing. [Bug 1822601] + 2007-11-01 Donal K. Fellows * doc/colors.n: Added list of Windows system colors. [Bug 945409] diff --git a/doc/bind.n b/doc/bind.n index 4b0d182..2b81c22 100644 --- a/doc/bind.n +++ b/doc/bind.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: bind.n,v 1.20.2.2 2007/11/01 16:37:13 dgp Exp $ +'\" RCS: @(#) $Id: bind.n,v 1.20.2.3 2007/11/02 14:51:39 dgp Exp $ '\" .so man.macros .TH bind n 8.0 Tk "Tk Built-In Commands" @@ -105,16 +105,16 @@ manual page for each widget for details. Modifiers consist of any of the following values: .DS .ta 6c -\fBControl\fR \fBMod1, M1, Command\fR -\fBAlt\fR \fBMod2, M2, Option\fR -\fBShift\fR \fBMod3, M3\fR -\fBLock\fR \fBMod4, M4\fR -\fBExtended\fR \fBMod5, M5\fR -\fBButton1, B1\fR \fBMeta, M\fR -\fBButton2, B2\fR \fBDouble\fR -\fBButton3, B3\fR \fBTriple\fR -\fBButton4, B4\fR \fBQuadruple\fR -\fBButton5, B5\fR +\fBControl\fR \fBMod1\fR, \fBM1\fR, \fBCommand\fR +\fBAlt\fR \fBMod2\fR, \fBM2\fR, \fBOption\fR +\fBShift\fR \fBMod3\fR, \fBM3\fR +\fBLock\fR \fBMod4\fR, \fBM4\fR +\fBExtended\fR \fBMod5\fR, \fBM5\fR +\fBButton1\fR, \fBB1\fR \fBMeta\fR, \fBM\fR +\fBButton2\fR, \fBB2\fR \fBDouble\fR +\fBButton3\fR, \fBB3\fR \fBTriple\fR +\fBButton4\fR, \fBB4\fR \fBQuadruple\fR +\fBButton5\fR, \fBB5\fR .DE Where more than one value is listed, separated by commas, the values are equivalent. @@ -171,17 +171,17 @@ couple non-standard X event types that were added to better support the Macintosh and Windows platforms. Below is a list of all the valid types; where two names appear together, they are synonyms. .DS -.ta \w'ButtonPress, Button\0\0\0'u +\w'KeyPress, Key\0\0\0'u -\fBActivate Destroy Map -ButtonPress, Button Enter MapRequest -ButtonRelease Expose Motion -Circulate FocusIn MouseWheel -CirculateRequest FocusOut Property -Colormap Gravity Reparent -Configure KeyPress, Key ResizeRequest -ConfigureRequest KeyRelease Unmap -Create Leave Visibility -Deactivate\fR +.ta \w'\fBButtonPress, Button\0\0\0\fR'u +\w'\fBKeyPress, Key\0\0\0\fR'u +\fBActivate\fR \fBDestroy\fR \fBMap\fR +\fBButtonPress\fR, \fBButton\fR \fBEnter\fR \fBMapRequest\fR +\fBButtonRelease\fR \fBExpose\fR \fBMotion\fR +\fBCirculate\fR \fBFocusIn\fR \fBMouseWheel\fR +\fBCirculateRequest\fR \fBFocusOut\fR \fBProperty\fR +\fBColormap\fR \fBGravity\fR \fBReparent\fR +\fBConfigure\fR \fBKeyPress\fR, \fBKey\fR \fBResizeRequest\fR +\fBConfigureRequest\fR \fBKeyRelease\fR \fBUnmap\fR +\fBCreate\fR \fBLeave\fR \fBVisibility\fR +\fBDeactivate\fR .DE Most of the above events have the same fields and behaviors as events in the X Windowing system. You can find more detailed descriptions of @@ -442,17 +442,17 @@ the string will be one of the following: .RS .DS .ta 6c -\fBNotifyAncestor NotifyNonlinearVirtual -NotifyDetailNone NotifyPointer -NotifyInferior NotifyPointerRoot -NotifyNonlinear NotifyVirtual\fR +\fBNotifyAncestor\fR \fBNotifyNonlinearVirtual\fR +\fBNotifyDetailNone\fR \fBNotifyPointer\fR +\fBNotifyInferior\fR \fBNotifyPointerRoot\fR +\fBNotifyNonlinear\fR \fBNotifyVirtual\fR .DE For \fBConfigureRequest\fR events, the string will be one of: .DS .ta 6c -\fBAbove Opposite -Below None -BottomIf TopIf\fR +\fBAbove\fR \fBOpposite\fR +\fBBelow\fR \fBNone\fR +\fBBottomIf\fR \fBTopIf\fR .DE .VS 8.5 For virtual events, the string will be whatever value is stored in the diff --git a/doc/event.n b/doc/event.n index 439357e..2c729e5 100644 --- a/doc/event.n +++ b/doc/event.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: event.n,v 1.12.2.1 2007/11/01 16:37:14 dgp Exp $ +'\" RCS: @(#) $Id: event.n,v 1.12.2.2 2007/11/02 14:51:39 dgp Exp $ '\" .so man.macros .TH event n 8.3 Tk "Tk Built-In Commands" @@ -130,10 +130,10 @@ and must be one of the following: .RS .DS .ta 6c -\fBNotifyAncestor NotifyNonlinearVirtual -NotifyDetailNone NotifyPointer -NotifyInferior NotifyPointerRoot -NotifyNonlinear NotifyVirtual\fR +\fBNotifyAncestor\fR \fBNotifyNonlinearVirtual\fR +\fBNotifyDetailNone\fR \fBNotifyPointer\fR +\fBNotifyInferior\fR \fBNotifyPointerRoot\fR +\fBNotifyNonlinear\fR \fBNotifyVirtual\fR .DE Valid for \fBEnter\fR, \fBLeave\fR, \fBFocusIn\fR and \fBFocusOut\fR events. diff --git a/doc/font.n b/doc/font.n index d4a135e..964851c 100644 --- a/doc/font.n +++ b/doc/font.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: font.n,v 1.11.2.3 2007/11/01 16:37:14 dgp Exp $ +'\" RCS: @(#) $Id: font.n,v 1.11.2.4 2007/11/02 14:51:39 dgp Exp $ '\" .so man.macros .TH font n 8.0 Tk "Tk Built-In Commands" @@ -139,8 +139,8 @@ for the \fIstyle\fR arguments are as follows: .RS .DS .ta 3c 6c 9c -\fBnormal bold roman italic -underline overstrike\fR +\fBnormal\fR \fBbold\fR \fBroman\fR \fBitalic\fR +\fBunderline\fR \fBoverstrike\fR .DE .RE .TP @@ -332,46 +332,46 @@ It is \fInot\fR advised to change these fonts, as they may be modified by Tk itself in response to system changes. Instead, make a copy of the font and modify that. .SH "PLATFORM-SPECIFIC FONTS" -.LP +.PP The following system fonts are supported: -.RS .TP \fBX Windows\fR All valid X font names, including those listed by xlsfonts(1), are available. .TP \fBMS Windows\fR +The following fonts are supported, and are mapped to the user's +style defaults. +.RS .DS .ta 3c 6c -\fBsystem ansi device -systemfixed ansifixed oemfixed\fR +\fBsystem\fR \fBansi\fR \fBdevice\fR +\fBsystemfixed\fR \fBansifixed\fR \fBoemfixed\fR .DE +.RE .TP \fBMac OS X\fR +The following fonts are supported, and are mapped to the user's +style defaults. +.RS .DS .ta 3c 6c -\fBsystem application menu\fR +\fBsystem\fR \fBapplication\fR \fBmenu\fR .DE -Additionally, the following named fonts provide access to the Aqua theme fonts: +.PP +Additionally, the following named fonts provide access to the Aqua +theme fonts: .DS -\fBsystemSystemFont -systemEmphasizedSystemFont -systemSmallSystemFont -systemSmallEmphasizedSystemFont -systemApplicationFont -systemLabelFont -systemViewsFont -systemMenuTitleFont -systemMenuItemFont -systemMenuItemMarkFont -systemMenuItemCmdKeyFont -systemWindowTitleFont -systemPushButtonFont -systemUtilityWindowTitleFont -systemAlertHeaderFont -systemToolbarFont -systemMiniSystemFont -systemDetailSystemFont -systemDetailEmphasizedSystemFont\fR +.ta 5c +\fBsystemSystemFont\fR \fBsystemEmphasizedSystemFont\fR +\fBsystemSmallSystemFont\fR \fBsystemSmallEmphasizedSystemFont\fR +\fBsystemApplicationFont\fR \fBsystemLabelFont\fR +\fBsystemViewsFont\fR \fBsystemMenuTitleFont\fR +\fBsystemMenuItemFont\fR \fBsystemMenuItemMarkFont\fR +\fBsystemMenuItemCmdKeyFont\fR \fBsystemWindowTitleFont\fR +\fBsystemPushButtonFont\fR \fBsystemUtilityWindowTitleFont\fR +\fBsystemAlertHeaderFont\fR \fBsystemToolbarFont\fR +\fBsystemMiniSystemFont\fR \fBsystemDetailSystemFont\fR +\fBsystemDetailEmphasizedSystemFont\fR .DE .RE .SH EXAMPLE diff --git a/doc/palette.n b/doc/palette.n index aa44360..627735a 100644 --- a/doc/palette.n +++ b/doc/palette.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: palette.n,v 1.2.32.1 2007/11/01 16:37:15 dgp Exp $ +'\" RCS: @(#) $Id: palette.n,v 1.2.32.2 2007/11/02 14:51:39 dgp Exp $ '\" .so man.macros .TH tk_setPalette n 4.0 Tk "Tk Built-In Commands" @@ -36,10 +36,10 @@ argument is the new value to use for that option. The following database names are currently supported: .DS L .ta 4c 8c -\fBactiveBackground foreground selectColor -activeForeground highlightBackground selectBackground -background highlightColor selectForeground -disabledForeground insertBackground troughColor\fR +\fBactiveBackground\fR \fBforeground\fR \fBselectColor\fR +\fBactiveForeground\fR \fBhighlightBackground\fR \fBselectBackground\fR +\fBbackground\fR \fBhighlightColor\fR \fBselectForeground\fR +\fBdisabledForeground\fR \fBinsertBackground\fR \fBtroughColor\fR .DE \fBtk_setPalette\fR tries to compute reasonable defaults for any options that you do not specify. You can specify options other diff --git a/doc/ttk_combobox.n b/doc/ttk_combobox.n index c2ea88e..6cc219a 100644 --- a/doc/ttk_combobox.n +++ b/doc/ttk_combobox.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_combobox.n,v 1.4.2.4 2007/11/01 16:37:16 dgp Exp $ +'\" RCS: @(#) $Id: ttk_combobox.n,v 1.4.2.5 2007/11/02 14:51:39 dgp Exp $ '\" .so man.macros .TH ttk::combobox n 8.5 Tk "Tk Themed Widget" @@ -92,9 +92,9 @@ The combobox widget also supports the following \fIttk::entry\fR widget commands (see \fIttk::entry(n)\fR for details): .DS .ta 5.5c 11c -bbox delete icursor -index insert selection -xview +\fBbbox\fR \fBdelete\fR \fBicursor\fR +\fBindex\fR \fBinsert\fR \fBselection\fR +\fBxview\fR .DE .SH "VIRTUAL EVENTS" The combobox widget generates a \fB<>\fR virtual event diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 87988b9..c19d5fc 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -5,7 +5,7 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: choosedir.tcl,v 1.20.2.1 2007/11/01 16:37:20 dgp Exp $ +# RCS: @(#) $Id: choosedir.tcl,v 1.20.2.2 2007/11/02 15:22:39 dgp Exp $ # Make sure the tk::dialog namespace, in which all dialogs should live, exists namespace eval ::tk::dialog {} @@ -43,14 +43,14 @@ proc ::tk::dialog::file::chooseDir:: {args} { destroy $w ::tk::dialog::file::Create $w TkChooseDir } else { - set data(dirMenuBtn) $w.f1.menu - set data(dirMenu) $w.f1.menu.menu - set data(upBtn) $w.f1.up - set data(icons) $w.icons - set data(ent) $w.f2.ent - set data(okBtn) $w.f2.ok - set data(cancelBtn) $w.f2.cancel - set data(hiddenBtn) $w.f2.hidden + set data(dirMenuBtn) $w.contents.f1.menu + set data(dirMenu) $w.contents.f1.menu.menu + set data(upBtn) $w.contents.f1.up + set data(icons) $w.contents.icons + set data(ent) $w.contents.f2.ent + set data(okBtn) $w.contents.f2.ok + set data(cancelBtn) $w.contents.f2.cancel + set data(hiddenBtn) $w.contents.f2.hidden } if {$::tk::dialog::file::showHiddenBtn} { $data(hiddenBtn) configure -state normal diff --git a/library/demos/sayings.tcl b/library/demos/sayings.tcl index c6066ce..a95f287 100644 --- a/library/demos/sayings.tcl +++ b/library/demos/sayings.tcl @@ -4,7 +4,7 @@ # both horizontally and vertically. It displays a collection of # well-known sayings. # -# RCS: @(#) $Id: sayings.tcl,v 1.4 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: sayings.tcl,v 1.4.2.1 2007/11/02 14:51:39 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -27,7 +27,7 @@ set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x frame $w.frame -borderwidth 10 -pack $w.frame -side top -expand yes -fill y +pack $w.frame -side top -expand yes -fill both -padx 1c scrollbar $w.frame.yscroll -command "$w.frame.list yview" @@ -43,4 +43,4 @@ grid rowconfig $w.frame 0 -weight 1 -minsize 0 grid columnconfig $w.frame 0 -weight 1 -minsize 0 -$w.frame.list insert 0 "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth" +$w.frame.list insert 0 "Don't speculate, measure" "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth" "Measure twice, cut once" diff --git a/library/demos/textpeer.tcl b/library/demos/textpeer.tcl index 9a1a985..000f07a 100644 --- a/library/demos/textpeer.tcl +++ b/library/demos/textpeer.tcl @@ -4,7 +4,7 @@ # single logical buffer. This is particularly useful when editing related text # in two (or more) parts of the same file. # -# RCS: @(#) $Id: textpeer.tcl,v 1.1.2.2 2007/10/16 04:03:54 dgp Exp $ +# RCS: @(#) $Id: textpeer.tcl,v 1.1.2.3 2007/11/02 14:51:40 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -21,6 +21,7 @@ positionWindow $w set count 0 +## Define a widget that we peer from; it won't ever actually be shown though set first [text $w.text[incr count]] $first insert end "This is a coupled pair of text widgets; they are peers to " $first insert end "each other. They have the same underlying data model, but " @@ -30,8 +31,9 @@ $first insert end "create additional peers of any of these text widgets using " $first insert end "the Make Peer button beside the text widget to clone, and " $first insert end "delete a particular peer widget using the Delete Peer " $first insert end "button." -grid $first +## Procedures to make and kill clones; most of this is just so that the demo +## looks nice... proc makeClone {w parent} { global count set t [$parent peer create $w.text[incr count] -yscroll "$w.sb$count set"\ @@ -52,9 +54,11 @@ proc killClone {w count} { destroy $w.clone$count $w.kill$count } +## Now set up the GUI makeClone $w $first makeClone $w $first destroy $first ## See Code / Dismiss buttons grid [addSeeDismiss $w.buttons $w] - - -sticky ew -row 5000 +grid columnconfigure $w 0 -weight 1 diff --git a/library/demos/ttknote.tcl b/library/demos/ttknote.tcl index dc2bf71..d4e5511 100644 --- a/library/demos/ttknote.tcl +++ b/library/demos/ttknote.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing a Ttk # notebook widget. # -# RCS: @(#) $Id: ttknote.tcl,v 1.2.2.2 2007/10/24 12:59:33 dgp Exp $ +# RCS: @(#) $Id: ttknote.tcl,v 1.2.2.3 2007/11/02 14:51:40 dgp Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -55,6 +55,6 @@ ttk::frame $w.note.editor $w.note add $w.note.editor -text "Text Editor" -underline 0 text $w.note.editor.t -width 40 -height 10 -wrap char \ -yscroll "$w.note.editor.s set" -scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" +ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" pack $w.note.editor.s -side right -fill y -padx {0 2} -pady 2 pack $w.note.editor.t -fill both -expand 1 -pady 2 -padx {2 0} diff --git a/library/msgbox.tcl b/library/msgbox.tcl index fd9ee20..f163f20 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -3,7 +3,7 @@ # Implements messageboxes for platforms that do not have native # messagebox support. # -# RCS: @(#) $Id: msgbox.tcl,v 1.30.2.2 2007/11/01 16:37:20 dgp Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.30.2.3 2007/11/02 14:51:39 dgp Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -11,6 +11,8 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # +package require Ttk + # Ensure existence of ::tk::dialog namespace # namespace eval ::tk::dialog {} @@ -244,16 +246,17 @@ proc ::tk::MessageBox {args} { set w .__tk__messagebox } + # There is only one background colour for the whole dialog + set bg [ttk::style lookup $::ttk::currentTheme -background] + # 3. Create the top-level window and divide it into top # and bottom parts. catch {destroy $w} - toplevel $w -class Dialog + toplevel $w -class Dialog -bg $bg wm title $w $data(-title) wm iconname $w Dialog wm protocol $w WM_DELETE_WINDOW { } - # There is only one background colour for the whole dialog - set bg [$w cget -background] # Message boxes should be transient with respect to their parent so that # they always stay on top of the parent window. But some window managers @@ -270,14 +273,14 @@ proc ::tk::MessageBox {args} { ::tk::unsupported::MacWindowStyle style $w moveableModal {} } - frame $w.bot -background $bg + ttk::frame $w.bot;# -background $bg grid anchor $w.bot center pack $w.bot -side bottom -fill both - frame $w.top -background $bg + ttk::frame $w.top;# -background $bg pack $w.top -side top -fill both -expand 1 if {$windowingsystem ne "aqua"} { - $w.bot configure -relief raised -bd 1 - $w.top configure -relief raised -bd 1 + #$w.bot configure -relief raised -bd 1 + #$w.top configure -relief raised -bd 1 } # 4. Fill the top part with bitmap, message and detail (use the @@ -289,16 +292,16 @@ proc ::tk::MessageBox {args} { option add *Dialog.msg.font TkCaptionFont widgetDefault option add *Dialog.dtl.font TkDefaultFont widgetDefault - label $w.msg -anchor nw -justify left -text $data(-message) \ - -background $bg + ttk::label $w.msg -anchor nw -justify left -text $data(-message) + #-background $bg if {$data(-detail) ne ""} { - label $w.dtl -anchor nw -justify left -text $data(-detail) \ - -background $bg + ttk::label $w.dtl -anchor nw -justify left -text $data(-detail) + #-background $bg } if {$data(-icon) ne ""} { if {$windowingsystem eq "aqua" || ([winfo depth $w] < 4) || $tk_strictMotif} { - label $w.bitmap -bitmap $data(-icon) -background $bg + ttk::label $w.bitmap -bitmap $data(-icon) -background $bg } else { canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \ -background $bg @@ -356,8 +359,9 @@ proc ::tk::MessageBox {args} { set opts [list -text $capName] } - eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \ + eval [list tk::AmpWidget ttk::button $w.$name] $opts \ [list -command [list set tk::Priv(button) $name]] + # -padx 3m if {$name eq $data(-default)} { $w.$name configure -default active @@ -406,12 +410,12 @@ proc ::tk::MessageBox {args} { bind $w { if {[winfo class %W] eq "Button"} { - tk::ButtonInvoke %W + %W invoke } } # Invoke the designated cancelling operation - bind $w [list tk::ButtonInvoke $w.$cancel] + bind $w [list $w.$cancel invoke] # At the buttons have vanished, so must do this directly. bind $w.msg [list set tk::Priv(button) $cancel] diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index a1b8e3c..d87cd2c 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -11,7 +11,7 @@ # files by clicking on the file icons or by entering a filename # in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.59.2.2 2007/11/01 16:37:21 dgp Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.59.2.3 2007/11/02 14:51:39 dgp Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -19,6 +19,8 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # +package require Ttk + #---------------------------------------------------------------------- # # I C O N L I S T @@ -219,13 +221,17 @@ proc ::tk::IconList_Config {w argList} { proc ::tk::IconList_Create {w} { upvar ::tk::$w data - frame $w - set data(sbar) [scrollbar $w.sbar -orient horizontal -takefocus 0] + ttk::frame $w + ttk::entry $w.cHull -takefocus 0 + set data(sbar) [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0] catch {$data(sbar) configure -highlightthickness 0} - set data(canvas) [canvas $w.canvas -borderwidth 1 -relief sunken \ + set data(canvas) [canvas $w.cHull.canvas -highlightthick 0 \ -width 400 -height 120 -takefocus 1] - pack $data(sbar) -side bottom -fill x -padx 2 - pack $data(canvas) -expand yes -fill both + $data(canvas) configure -background \ + [ttk::style lookup $::ttk::currentTheme -background] + pack $data(sbar) -side bottom -fill x -padx 2 -in $w.cHull -pady {0 2} + pack $data(canvas) -expand yes -fill both -padx 2 -pady {2 0} + pack $w.cHull -expand yes -fill both -ipadx 2 -ipady 2 $data(sbar) configure -command [list $data(canvas) xview] $data(canvas) configure -xscrollcommand [list $data(sbar) set] @@ -631,6 +637,7 @@ proc ::tk::IconList_Leave1 {w x y} { proc ::tk::IconList_FocusIn {w} { upvar ::tk::$w data + $w.cHull state focus if {![info exists data(list)]} { return } @@ -641,6 +648,7 @@ proc ::tk::IconList_FocusIn {w} { } proc ::tk::IconList_FocusOut {w} { + $w.cHull state !focus IconList_Selection $w clear 0 end } @@ -824,17 +832,17 @@ proc ::tk::dialog::file:: {type args} { destroy $w Create $w TkFDialog } else { - set data(dirMenuBtn) $w.f1.menu - set data(dirMenu) $w.f1.menu.menu - set data(upBtn) $w.f1.up - set data(icons) $w.icons - set data(ent) $w.f2.ent - set data(typeMenuLab) $w.f2.lab2 - set data(typeMenuBtn) $w.f2.menu + set data(dirMenuBtn) $w.contents.f1.menu + set data(dirMenu) $w.contents.f1.menu.menu + set data(upBtn) $w.contents.f1.up + set data(icons) $w.contents.icons + set data(ent) $w.contents.f2.ent + set data(typeMenuLab) $w.contents.f2.lab2 + set data(typeMenuBtn) $w.contents.f2.menu set data(typeMenu) $data(typeMenuBtn).m - set data(okBtn) $w.f2.ok - set data(cancelBtn) $w.f2.cancel - set data(hiddenBtn) $w.f2.hidden + set data(okBtn) $w.contents.f2.ok + set data(cancelBtn) $w.contents.f2.cancel + set data(hiddenBtn) $w.contents.f2.hidden SetSelectMode $w $data(-multiple) } if {$::tk::dialog::file::showHiddenBtn} { @@ -1035,17 +1043,25 @@ proc ::tk::dialog::file::Create {w class} { global tk_library toplevel $w -class $class + pack [ttk::frame $w.contents] -expand 1 -fill both + #set w $w.contents # f1: the frame with the directory option menu # - set f1 [frame $w.f1] - bind [::tk::AmpWidget label $f1.lab -text [mc "&Directory:"]] \ + set f1 [ttk::frame $w.contents.f1] + bind [::tk::AmpWidget ttk::label $f1.lab -text [mc "&Directory:"]] \ <> [list focus $f1.menu] set data(dirMenuBtn) $f1.menu - set data(dirMenu) [tk_optionMenu $f1.menu \ - [format %s(selectPath) ::tk::dialog::file::$dataName] ""] - set data(upBtn) [button $f1.up] + if {![info exists data(selectPath)]} { + set data(selectPath) "" + } + set data(dirMenu) $f1.menu.menu + ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \ + -textvariable [format %s(selectPath) ::tk::dialog::file::$dataName] + [menu $data(dirMenu) -tearoff 0] add radiobutton -label "" -variable \ + [format %s(selectPath) ::tk::dialog::file::$dataName] + set data(upBtn) [ttk::button $f1.up] if {![info exists Priv(updirImage)]} { set Priv(updirImage) [image create bitmap -data { #define updir_width 28 @@ -1060,7 +1076,7 @@ static char updir_bits[] = { } $data(upBtn) configure -image $Priv(updirImage) - $f1.menu configure -takefocus 1 -highlightthickness 2 + $f1.menu configure -takefocus 1;# -highlightthickness 2 pack $data(upBtn) -side right -padx 4 -fill both pack $f1.lab -side left -padx 4 -fill both @@ -1080,7 +1096,7 @@ static char updir_bits[] = { set fNameCaption [mc "&Selection:"] set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w] } - set data(icons) [::tk::IconList $w.icons \ + set data(icons) [::tk::IconList $w.contents.icons \ -command $iconListCommand -multiple $data(-multiple)] bind $data(icons) <> \ [list ::tk::dialog::file::ListBrowse $w] @@ -1088,23 +1104,26 @@ static char updir_bits[] = { # f2: the frame with the OK button, cancel button, "file name" field # and file types field. # - set f2 [frame $w.f2] - bind [::tk::AmpWidget label $f2.lab -text $fNameCaption -anchor e -pady 0]\ + set f2 [ttk::frame $w.contents.f2] + bind [::tk::AmpWidget ttk::label $f2.lab -text $fNameCaption -anchor e]\ <> [list focus $f2.ent] - set data(ent) [entry $f2.ent] + # -pady 0 + set data(ent) [ttk::entry $f2.ent] # The font to use for the icons. The default Canvas font on Unix # is just deviant. - set ::tk::$w.icons(font) [$data(ent) cget -font] + set ::tk::$w.contents.icons(font) [$data(ent) cget -font] # Make the file types bits only if this is a File Dialog if {$class eq "TkFDialog"} { - set data(typeMenuLab) [::tk::AmpWidget label $f2.lab2 \ - -text $fTypeCaption -anchor e -pady [$f2.lab cget -pady]] - set data(typeMenuBtn) [menubutton $f2.menu -indicatoron 1 \ + set data(typeMenuLab) [::tk::AmpWidget ttk::label $f2.lab2 \ + -text $fTypeCaption -anchor e] + # -pady [$f2.lab cget -pady] + set data(typeMenuBtn) [ttk::menubutton $f2.menu \ -menu $f2.menu.m] + # -indicatoron 1 set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0] - $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w + # $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w bind $data(typeMenuLab) <> [list \ focus $data(typeMenuBtn)] } @@ -1117,10 +1136,11 @@ static char updir_bits[] = { } else { set text [mc "Show &Hidden Directories"] } - set data(hiddenBtn) [::tk::AmpWidget checkbutton $f2.hidden \ - -text $text -anchor w -padx 3 -state disabled \ + set data(hiddenBtn) [::tk::AmpWidget ttk::checkbutton $f2.hidden \ + -text $text -state disabled \ -variable ::tk::dialog::file::showHiddenVar \ -command [list ::tk::dialog::file::UpdateWhenIdle $w]] +# -anchor w -padx 3 # the okBtn is created after the typeMenu so that the keyboard traversal # is in the right order, and add binding so that we find out when the @@ -1128,11 +1148,11 @@ static char updir_bits[] = { # window so no confusion about how much gets called; exactly # once will do). [Bug 987169] - set data(okBtn) [::tk::AmpWidget button $f2.ok \ - -text [mc "&OK"] -default active -pady 3] + set data(okBtn) [::tk::AmpWidget ttk::button $f2.ok \ + -text [mc "&OK"] -default active];# -pady 3] bind $data(okBtn) [list ::tk::dialog::file::Destroyed $w] - set data(cancelBtn) [::tk::AmpWidget button $f2.cancel \ - -text [mc "&Cancel"] -default normal -pady 3] + set data(cancelBtn) [::tk::AmpWidget ttk::button $f2.cancel \ + -text [mc "&Cancel"] -default normal];# -pady 3] # grid the widgets in f2 # @@ -1160,7 +1180,7 @@ static char updir_bits[] = { wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w] $data(upBtn) configure -command [list ::tk::dialog::file::UpDirCmd $w] $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w] - bind $w [list tk::ButtonInvoke $data(cancelBtn)] + bind $w [list $data(cancelBtn) invoke] bind $w [list tk::AltKeyInDialog $w %A] # Set up event handlers specific to File or Directory Dialogs @@ -1178,9 +1198,10 @@ static char updir_bits[] = { bind $data(ent) $okCmd $data(okBtn) configure -command $okCmd bind $w [list focus $data(ent)] - bind $w [list tk::ButtonInvoke $data(okBtn)] + bind $w [list $data(okBtn) invoke] } bind $w [list $data(hiddenBtn) invoke] + bind $data(ent) [list ::tk::dialog::file::CompleteEnt $w] # Build the focus group for all the entries # @@ -1211,7 +1232,7 @@ proc ::tk::dialog::file::SetSelectMode {w multi} { set fNameCaption [mc "File &name:"] } set iconListCommand [list ::tk::dialog::file::OkCmd $w] - ::tk::SetAmpText $w.f2.lab $fNameCaption + ::tk::SetAmpText $w.contents.f2.lab $fNameCaption ::tk::IconList_Config $data(icons) \ [list -multiple $multi -command $iconListCommand] return @@ -1400,7 +1421,7 @@ proc ::tk::dialog::file::SetFilter {w type} { set data(filterType) $type set data(filter) [lindex $type 1] - $data(typeMenuBtn) configure -text [lindex $type 0] -indicatoron 1 + $data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1 # If we aren't using a default extension, use the one suppled # by the filter. @@ -1678,7 +1699,7 @@ proc ::tk::dialog::file::InvokeBtn {w key} { upvar ::tk::dialog::file::[winfo name $w] data if {[$data(okBtn) cget -text] eq $key} { - ::tk::ButtonInvoke $data(okBtn) + $data(okBtn) invoke } } @@ -1864,3 +1885,87 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { bind $data(okBtn) {} set Priv(selectFilePath) $selectFilePath } + +proc ::tk::dialog::file::CompleteEnt {w} { + upvar ::tk::dialog::file::[winfo name $w] data + set f [$data(ent) get] + if {$data(-multiple)} { + if {[catch {llength $f} len] || $len != 1} { + return -code break + } + set f [lindex $f 0] + } + + # Get list of matching filenames and dirnames + set globF [list glob -tails -directory $data(selectPath) \ + -type {f b c l p s} -nocomplain] + set globD [list glob -tails -directory $data(selectPath) -type d \ + -nocomplain *] + if {$data(filter) eq "*"} { + lappend globF * + if {$::tk::dialog::file::showHiddenVar} { + lappend globF .* + lappend globD .* + } + if {[winfo class $w] eq "TkFDialog"} { + set files [lsort -dictionary -unique [{*}$globF]] + } else { + set files {} + } + set dirs [lsort -dictionary -unique [{*}$globD]] + } else { + if {$::tk::dialog::file::showHiddenVar} { + lappend globD .* + } + if {[winfo class $w] eq "TkFDialog"} { + set files [lsort -dictionary -unique [{*}$globF {*}$data(filter)]] + } else { + set files {} + } + set dirs [lsort -dictionary -unique [{*}$globD]] + } + # Filter specials + set dirs [lsearch -all -not -exact -inline $dirs .] + set dirs [lsearch -all -not -exact -inline $dirs ..] + set dirs2 {} + foreach d $dirs {lappend dirs2 $d/} + + set targets [concat \ + [lsearch -glob -all -inline $files $f*] \ + [lsearch -glob -all -inline $dirs2 $f*]] + + if {[llength $targets] == 1} { + # We have a winner! + set f [lindex $targets 0] + } elseif {$f in $targets || [llength $targets] == 0} { + if {[string length $f] > 0} { + bell + } + return + } elseif {[llength $targets] > 1} { + # Multiple possibles + if {[string length $f] == 0} { + return + } + set t0 [lindex $targets 0] + for {set len [string length $t0]} {$len>0} {} { + set allmatch 1 + foreach s $targets { + if {![string equal -length $len $s $t0]} { + set allmatch 0 + break + } + } + incr len -1 + if {$allmatch} break + } + set f [string range $t0 0 $len] + } + + if {$data(-multiple)} { + set f [list $f] + } + $data(ent) delete 0 end + $data(ent) insert 0 $f + return -code break +} -- cgit v0.12