* tests/filebox.test:

* tests/choosedir.test: Updated tests.

* library/xmfbox.tcl: Updated to stash data array in
::tk::dialog::file namespace instead of in global namespace.

* library/tkfbox.tcl: Extended some functions to support creation
of a choosedir dialog, to allow greater code reuse between the two
dialogs.  Moved tkFDialog* functions into a namespace
(::tk::dialog::file).  Because these are private Tk functions (and
should thus not be used directly by users), this should not impact
anybody (the tk_getOpenFile and tk_getSaveFile commands still
exist at the global scope).

* library/tk.tcl:
* library/tclIndex: Updated function names for tkFDialog*
functions and choosedir functions.

* library/choosedir.tcl: New and improved implementation of
tk_chooseDirectory dialog.  Based on tk_getOpenFile dialog.

* library/listbox.tcl: (tkListboxCancel) Added a check for empty
string value for tkPriv(listboxPrev).  Without this check, it's
possible to get a stack trace under certain conditions. [Bug: 4373].

1 files changed, 222 insertions, 175 deletions

diff --git a/library/choosedir.tcl b/library/choosedir.tcl
index 879af23..4ccd796 100644
--- a/library/choosedir.tcl
+++ b/library/choosedir.tcl
@@ -1,225 +1,272 @@
 # choosedir.tcl --

 #

-#	Choose directory dialog implementation for Unix/Mac.  Adapted from

-#	Christopher Nelson's (chris@pinebush.com) implementation.

+#	Choose directory dialog implementation for Unix/Mac.

 #

 # Copyright (c) 1998-2000 by Scriptics Corporation.

 # All rights reserved.

 # 

-# RCS: @(#) $Id: choosedir.tcl,v 1.5 2000/03/04 01:44:16 ericm Exp $

+# RCS: @(#) $Id: choosedir.tcl,v 1.6 2000/03/24 19:38:57 ericm Exp $

 

 # Make sure the tk::dialog namespace, in which all dialogs should live, exists

 namespace eval ::tk::dialog {}

+namespace eval ::tk::dialog::file {}

 

 # Make the chooseDir namespace inside the dialog namespace

-namespace eval ::tk::dialog::chooseDir {

-    # value is an array that holds the current selection value for each dialog

-    variable value

+namespace eval ::tk::dialog::file::chooseDir {

 }

 

-proc ::tk::dialog::chooseDir::tkChooseDirectory { args } {

-    variable value

-

-    # Error messages

-    append err(usage) "tk_chooseDirectory "

-    append err(usage) "?-initialdir directory? ?-mustexist boolean? "

-    append err(usage) "?-parent window? ?-title title?"

-

-    set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""

-    set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""

-    set err(unknownOpt)   "unknown option \"%s\": should be \"$err(usage)\""

-    set err(badWindow)    "bad window path name \"%s\""

-

-    # Default values

-    set opts(-initialdir)	[pwd]

-    set opts(-mustexist)	0

-    set opts(-parent)		.

-    set opts(-title)		"Choose Directory"

-

-    # Process args

-    set len [llength $args]

-    for { set i 0 } { $i < $len } {incr i} {

-	set flag [lindex $args $i]

-	incr i

-	if { $i >= $len } {

-	    error [format $err(valueMissing) $flag]

-	}

-	switch -glob -- $flag {

-	    "-initialdir" -

-	    "-mustexist"  -

-	    "-parent"     -

-	    "-title" {

-		set opts($flag) [lindex $args $i]

-	    }

-	    default {

-		error [format $err(unknownOpt) $flag]

-	    }

-	}

-    }

-	    

-    # Handle default parent window

-    if { ![winfo exists $opts(-parent)] } {

-	error [format $err(badWindow) $opts(-parent)]

-    }

-    if {[string equal $opts(-parent) "."]} {

-	set opts(-parent) ""

-    }

+# ::tk::dialog::file::tkChooseDirectory --

+#

+#	Implements the TK directory selection dialog.

+#

+# Arguments:

+#	args		Options parsed by the procedure.

+#

 

-    if { [string equal $opts(-initialdir) ""] } {

-	set opts(-initialdir) [pwd]

+proc ::tk::dialog::file::chooseDir::tkChooseDirectory {args} {

+    global tkPriv

+    set dataName __tk_choosedir

+    upvar ::tk::dialog::file::$dataName data

+    ::tk::dialog::file::chooseDir::Config $dataName $args

+

+    if {[string equal $data(-parent) .]} {

+        set w .$dataName

+    } else {

+        set w $data(-parent).$dataName

     }

 

-    set w [toplevel $opts(-parent).choosedirectory]

-    wm title $w $opts(-title)

-

-    # Commands for various bindings (which follow)

-    set okCommand  [namespace code \

-	    [list Done $w ok $opts(-mustexist)]]

-

-    set cancelCommand  [namespace code \

-	    [list Done $w cancel $opts(-mustexist)]]

-

-    # Create controls.

-    set lbl  [label $w.l -text "Directory name:" -anchor w]

-    set ent  [entry $w.e -width 30]

-    set frm  [frame $w.f]

-    set lst  [listbox $frm.lb -height 8 \

-	    -yscrollcommand [list $frm.sb set] \

-	    -selectmode browse \

-	    -setgrid true \

-	    -exportselection 0 \

-	    -takefocus 1]

-    set scr  [scrollbar $frm.sb -orient vertical \

-	    -command [list $frm.lb yview]]

-    set bOK  [button $w.ok     -width 8 -text OK -command $okCommand \

-	    -default active]

-    set bCan [button $w.cancel -width 8 -text Cancel -command $cancelCommand]

-

-    if {[llength [file volumes]]} {

-	# On Macs it would be nice to add a volume combobox

+    # (re)create the dialog box if necessary

+    #

+    if {![winfo exists $w]} {

+	::tk::dialog::file::Create $w TkChooseDir

+    } elseif {[string compare [winfo class $w] TkChooseDir]} {

+	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.f3.cancel

     }

+    wm transient $w $data(-parent)

 

-    # Place controls on window

-    set padding 4

-    grid $lst $scr -sticky nsew

-    grid columnconfigure $frm 0 -weight 1

-    grid rowconfigure    $frm 0 -weight 1

+    trace variable data(selectPath) w "::tk::dialog::file::SetPath $w"

+    $data(dirMenuBtn) configure \

+	    -textvariable ::tk::dialog::file::${dataName}(selectPath)

 

-    grid $lbl $bOK  -padx $padding -pady $padding

-    grid $ent $bCan -padx $padding -pady $padding

-    grid $frm       -padx $padding -pady $padding

+    set data(filter) "*"

+    set data(previousEntryText) ""

+    ::tk::dialog::file::UpdateWhenIdle $w

 

-    grid configure $lbl -sticky w

-    grid configure $ent -sticky ew

-    grid configure $frm -sticky nsew

-    grid columnconfigure $w 0 -weight 1

-    grid columnconfigure $w 1 -weight 1

-    grid rowconfigure $w 2 -weight 1

+    # Withdraw the window, then update all the geometry information

+    # so we know how big it wants to be, then center the window in the

+    # display and de-iconify it.

 

-    $ent insert end $opts(-initialdir)

+    ::tk::PlaceWindow $w widget $data(-parent)

+    wm title $w $data(-title)

 

-    # Set bindings

-    # <Return> is the same as OK

-    bind $w <Return> $okCommand

+    # Set a grab and claim the focus too.

 

-    # <Escape> is the same as cancel

-    bind $w <Escape> $cancelCommand

+    ::tk::SetFocusGrab $w $data(ent)

+    $data(ent) delete 0 end

+    $data(ent) insert 0 $data(selectPath)

+    $data(ent) selection range 0 end

+    $data(ent) icursor end

 

-    # Closing the window is the same as cancel

-    wm protocol $w WM_DELETE_WINDOW $cancelCommand

-    

-    # Fill listbox and bind for browsing

-    Refresh $lst $opts(-initialdir)

-    

-    bind $lst <Return> [namespace code [list Update $ent $lst]]

-    bind $lst <Double-ButtonRelease-1> [namespace code [list Update $ent $lst]]

+    # Wait for the user to respond, then restore the focus and

+    # return the index of the selected button.  Restore the focus

+    # before deleting the window, since otherwise the window manager

+    # may take the focus away so we can't redirect it.  Finally,

+    # restore any grab that was in effect.

 

-    ::tk::PlaceWindow $w widget [winfo parent $w]

+    tkwait variable tkPriv(selectFilePath)

 

-    # Set the min size when the size is known

-#    tkwait visibility $w

-#    tkChooseDirectory::MinSize $w

+    ::tk::RestoreFocusGrab $w $data(ent) withdraw

 

-    focus $ent

-    $ent selection range 0 end

-    grab set $w

+    # Cleanup traces on selectPath variable

+    #

 

-    # Wait for OK, Cancel or close

-    tkwait window $w

+    foreach trace [trace vinfo data(selectPath)] {

+	trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]

+    }

+    $data(dirMenuBtn) configure -textvariable {}

 

-    grab release $w

+    # Return value to user

+    #

     

-    set dir $value($w)

-    unset value($w)

-    return $dir

+    return $tkPriv(selectFilePath)

 }

-# tkChooseDirectory::tk_chooseDirectory

 

-proc ::tk::dialog::chooseDir::MinSize { w } {

-    set geometry [wm geometry $w]

+# ::tk::dialog::file::chooseDir::Config --

+#

+#	Configures the Tk choosedir dialog according to the argument list

+#

+proc ::tk::dialog::file::chooseDir::Config {dataName argList} {

+    upvar ::tk::dialog::file::$dataName data

 

-    regexp {([0-9]*)x([0-9]*)\+} geometry whole width height

+    # 0: Delete all variable that were set on data(selectPath) the

+    # last time the file dialog is used. The traces may cause troubles

+    # if the dialog is now used with a different -parent option.

 

-    wm minsize $w $width $height

-}

+    foreach trace [trace vinfo data(selectPath)] {

+	trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]

+    }

 

-proc ::tk::dialog::chooseDir::Done { w why mustexist } {

-    variable value

-

-    switch -- $why {

-	ok {

-	    # If mustexist, validate value

-	    set value($w) [$w.e get]

-	    if { $mustexist } {

-		if { ![file exists $value($w)] } {

-		    return

-		}

-		if { ![file isdirectory $value($w)] } {

-		    return

-		}

-	    }

-	}

-	cancel {

-	    set value($w) ""

-	}

+    # 1: the configuration specs

+    #

+

+    set specs {

+	{-mustexist "" "" 0}

+	{-initialdir "" "" ""}

+	{-parent "" "" "."}

+	{-title "" "" ""}

     }

 

-    destroy $w

-}

+    # 2: default values depending on the type of the dialog

+    #

+

+    if {![info exists data(selectPath)]} {

+	# first time the dialog has been popped up

+	set data(selectPath) [pwd]

+    }

 

-proc ::tk::dialog::chooseDir::Refresh { listbox dir } {

-    $listbox delete 0 end

+    # 3: parse the arguments

+    #

 

-    # Find the parent directory; if it is different (ie, we're not

-    # already at the root), add a ".." entry

-    set parentDir [file dirname $dir]

-    if { ![string equal $parentDir $dir] } {

-	$listbox insert end ".."

+    tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList

+

+    if {[string equal $data(-title) ""]} {

+	set data(-title) "Choose Directory"

     }

-    

-    # add the subdirs to the listbox

-    foreach f [lsort [glob -nocomplain $dir/*]] {

-	if {[file isdirectory $f]} {

-	    $listbox insert end "[file tail $f]/"

+

+    # 4: set the default directory and selection according to the -initial

+    #    settings

+    #

+

+    if {[string compare $data(-initialdir) ""]} {

+	if {[file isdirectory $data(-initialdir)]} {

+	    set data(selectPath) [lindex [glob $data(-initialdir)] 0]

+	} else {

+	    set data(selectPath) [pwd]

+	}

+

+	# Convert the initialdir to an absolute path name.

+

+	set old [pwd]

+	cd $data(selectPath)

+	set data(selectPath) [pwd]

+	cd $old

+    }

+

+    if {![winfo exists $data(-parent)]} {

+	error "bad window path name \"$data(-parent)\""

+    }

+}

+

+# Gets called when user presses Return in the "Selection" entry or presses OK.

+#

+proc ::tk::dialog::file::chooseDir::OkCmd {w} {

+    upvar ::tk::dialog::file::[winfo name $w] data

+

+    # This is the brains behind selecting non-existant directories.  Here's

+    # the flowchart:

+    # 1.  If the icon list has a selection, join it with the current directory,

+    #     and return that value.

+    # 1a.  If the icon list does not have a selection ...

+    # 2.  If the entry is empty, do nothing.

+    # 3.  If the entry contains an invalid directory, then...

+    # 3a.   If the value is the same as last time through here, end dialog.

+    # 3b.   If the value is different than last time, save it and return.

+    # 4.  If entry contains a valid directory, then...

+    # 4a.   If the value is the same as the current directory, end dialog.

+    # 4b.   If the value is different from the current directory, change to

+    #       that directory.

+

+    set iconText [tkIconList_Get $data(icons)]

+    if { ![string equal $iconText ""] } {

+	set iconText [file join $data(selectPath) $iconText]

+	::tk::dialog::file::chooseDir::Done $w $iconText

+    } else {

+	set text [$data(ent) get]

+	if { [string equal $text ""] } {

+	    return

+	}

+	set text [eval file join [file split [string trim $text]]]

+	if { ![file exists $text] || ![file isdirectory $text] } {

+	    # Entry contains an invalid directory.  If it's the same as the

+	    # last time they came through here, reset the saved value and end

+	    # the dialog.  Otherwise, save the value (so we can do this test

+	    # next time).

+	    if { [string equal $text $data(previousEntryText)] } {

+		set data(previousEntryText) ""

+		::tk::dialog::file::chooseDir::Done $w $text

+	    } else {

+		set data(previousEntryText) $text

+	    }

+	} else {

+	    # Entry contains a valid directory.  If it is the same as the

+	    # current directory, end the dialog.  Otherwise, change to that

+	    # directory.

+	    if { [string equal $text $data(selectPath)] } {

+		::tk::dialog::file::chooseDir::Done $w $text

+	    } else {

+		set data(selectPath) $text

+	    }

 	}

     }

+    return

 }

 

-proc ::tk::dialog::chooseDir::Update { entry listbox } {

-    set sel [$listbox curselection]

-    if { [string equal $sel ""] } {

+proc ::tk::dialog::file::chooseDir::DblClick {w} {

+    upvar ::tk::dialog::file::[winfo name $w] data

+    set text [tkIconList_Get $data(icons)]

+    if {[string compare $text ""]} {

+	set file $data(selectPath)

+	if {[file isdirectory $file]} {

+	    ::tk::dialog::file::ListInvoke $w $text

+	    return

+	}

+    }

+}    

+

+# Gets called when user browses the IconList widget (dragging mouse, arrow

+# keys, etc)

+#

+proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {

+    upvar ::tk::dialog::file::[winfo name $w] data

+

+    if {[string equal $text ""]} {

 	return

     }

-    set subdir [$listbox get $sel]

-    if {[string equal $subdir ".."]} {

-	set fullpath [file dirname [$entry get]]

-	if { [string equal $fullpath [$entry get]] } {

+

+    set file [::tk::dialog::file::JoinFile $data(selectPath) $text]

+    $data(ent) delete 0 end

+    $data(ent) insert 0 $file

+}

+

+# ::tk::dialog::file::chooseDir::Done --

+#

+#	Gets called when user has input a valid filename.  Pops up a

+#	dialog box to confirm selection when necessary. Sets the

+#	tkPriv(selectFilePath) variable, which will break the "tkwait"

+#	loop in tk_chooseDirectory and return the selected filename to the

+#	script that calls tk_getOpenFile or tk_getSaveFile

+#

+proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} {

+    upvar ::tk::dialog::file::[winfo name $w] data

+    global tkPriv

+

+    if {[string equal $selectFilePath ""]} {

+	set selectFilePath $data(selectPath)

+    }

+    if { $data(-mustexist) } {

+	if { ![file exists $selectFilePath] || \

+		![file isdir $selectFilePath] } {

 	    return

 	}

-    } else {

-	set fullpath [file join [$entry get] $subdir]

     }

-    $entry delete 0 end

-    $entry insert end $fullpath

-    Refresh $listbox $fullpath

+    set tkPriv(selectFilePath) $selectFilePath

 }