Tk (non-native) file chooser now uses Ttk widgets for better L&F and supports <Tab> completion of file names. [FRQ 805091]

1 files changed, 144 insertions, 41 deletions

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:"]] \
 	    <<AltUnderlined>> [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) <<ListboxSelect>> \
 	    [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]\
 	    <<AltUnderlined>> [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) <<AltUnderlined>> [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 <Destroy> 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) <Destroy> [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 <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
+    bind $w <KeyPress-Escape> [list $data(cancelBtn) invoke]
     bind $w <Alt-Key> [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) <Return> $okCmd
 	$data(okBtn) configure -command $okCmd
 	bind $w <Alt-s> [list focus $data(ent)]
-	bind $w <Alt-o> [list tk::ButtonInvoke $data(okBtn)]
+	bind $w <Alt-o> [list $data(okBtn) invoke]
     }
     bind $w <Alt-h> [list $data(hiddenBtn) invoke]
+    bind $data(ent) <Tab> [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) <Destroy> {}
     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
+}