From c0900bcedd02bc90832f164503daa12f47107c4b Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 2 Nov 2007 11:54:09 +0000 Subject: Tk (non-native) file chooser now uses Ttk widgets for better L&F and supports completion of file names. [FRQ 805091] --- ChangeLog | 4 ++ library/tkfbox.tcl | 185 +++++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 148 insertions(+), 41 deletions(-) diff --git a/ChangeLog b/ChangeLog index 238d5a7..f7f4ad9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2007-11-02 Donal K. Fellows + * 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 diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index bbd4dd9..62d7743 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.61 2007/10/30 01:57:54 hobbs Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.62 2007/11/02 11:54:10 dkf 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,15 @@ 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 + 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 +635,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 +646,7 @@ proc ::tk::IconList_FocusIn {w} { } proc ::tk::IconList_FocusOut {w} { + $w.cHull state !focus IconList_Selection $w clear 0 end } @@ -824,17 +830,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 +1041,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 +1074,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 +1094,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,10 +1102,11 @@ 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. @@ -1099,12 +1114,14 @@ static char updir_bits[] = { # 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 +1134,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 +1146,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 +1178,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 +1196,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 +1230,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 +1419,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 +1697,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 +1883,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