* Merged 8.1 branch into the main trunk

1 files changed, 368 insertions, 169 deletions

diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index 15ff0ac..2080c97 100644
--- a/library/xmfbox.tcl
+++ b/library/xmfbox.tcl
@@ -4,53 +4,105 @@
 #	Unix platform. This implementation is used only if the
 #	"tk_strictMotif" flag is set.
 #
-# RCS: @(#) $Id: xmfbox.tcl,v 1.6 1998/11/12 06:22:05 welch Exp $
+# RCS: @(#) $Id: xmfbox.tcl,v 1.7 1999/04/16 01:51:27 stanton Exp $
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-
 
 # tkMotifFDialog --
 #
 #	Implements a file dialog similar to the standard Motif file
 #	selection box.
 #
-# Return value:
+# Arguments:
+#	type		"open" or "save"
+#	args		Options parsed by the procedure.
 #
+# Results:
 #	A list of two members. The first member is the absolute
 #	pathname of the selected file or "" if user hits cancel. The
 #	second member is the name of the selected file type, or ""
 #	which stands for "default file type"
-#
-proc tkMotifFDialog {args} {
+
+proc tkMotifFDialog {type args} {
     global tkPriv
-    set w __tk_filedialog
-    upvar #0 $w data
+    set dataName __tk_filedialog
+    upvar #0 $dataName data
 
-    if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
-	set type open
-    } else {
-	set type save
+    set w [tkMotifFDialog_Create $dataName $type $args]
+
+    # Set a grab and claim the focus too.
+
+    set oldFocus [focus]
+    set oldGrab [grab current $w]
+    if {$oldGrab != ""} {
+	set grabStatus [grab status $oldGrab]
     }
+    grab $w
+    focus $data(sEnt)
+    $data(sEnt) select from 0
+    $data(sEnt) select to   end
+
+    # 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.
 
-    tkMotifFDialog_Config $w $type $args
+    tkwait variable tkPriv(selectFilePath)
+    catch {focus $oldFocus}
+    grab release $w
+    wm withdraw $w
+    if {$oldGrab != ""} {
+	if {$grabStatus == "global"} {
+	    grab -global $oldGrab
+	} else {
+	    grab $oldGrab
+	}
+    }
+    return $tkPriv(selectFilePath)
+}
+
+# tkMotifFDialog_Create --
+#
+#	Creates the Motif file dialog (if it doesn't exist yet) and
+#	initialize the internal data structure associated with the
+#	dialog.
+#
+#	This procedure is used by tkMotifFDialog to create the
+#	dialog. It's also used by the test suite to test the Motif
+#	file dialog implementation. User code shouldn't call this
+#	procedure directly.
+#
+# Arguments:
+#	dataName	Name of the global "data" array for the file dialog.
+#	type		"Save" or "Open"
+#	argList		Options parsed by the procedure.
+#
+# Results:
+#	Pathname of the file dialog.
+
+proc tkMotifFDialog_Create {dataName type argList} {
+    global tkPriv
+    upvar #0 $dataName data
+
+    tkMotifFDialog_Config $dataName $type $argList
 
     if {![string compare $data(-parent) .]} {
-        set w .$w
+        set w .$dataName
     } else {
-        set w $data(-parent).$w
+        set w $data(-parent).$dataName
     }
 
     # (re)create the dialog box if necessary
     #
     if {![winfo exists $w]} {
-	tkMotifFDialog_Create $w
+	tkMotifFDialog_BuildUI $w
     } elseif {[string compare [winfo class $w] TkMotifFDialog]} {
 	destroy $w
-	tkMotifFDialog_Create $w
+	tkMotifFDialog_BuildUI $w
     } else {
 	set data(fEnt) $w.top.f1.ent
 	set data(dList) $w.top.f2.a.l
@@ -60,58 +112,42 @@ proc tkMotifFDialog {args} {
 	set data(filterBtn) $w.bot.filter
 	set data(cancelBtn) $w.bot.cancel
     }
+
     wm transient $w $data(-parent)
 
     tkMotifFDialog_Update $w
 
-    # 5. Withdraw the window, then update all the geometry information
+    # 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.
 
     wm withdraw $w
     update idletasks
-    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
-	    - [winfo vrootx [winfo parent $w]]}]
-    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
-	    - [winfo vrooty [winfo parent $w]]}]
+    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+	    - [winfo vrootx [winfo parent $w]]]
+    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+	    - [winfo vrooty [winfo parent $w]]]
     wm geom $w +$x+$y
     wm deiconify $w
     wm title $w $data(-title)
 
-    # 6. Set a grab and claim the focus too.
-
-    set oldFocus [focus]
-    set oldGrab [grab current $w]
-    if {$oldGrab != ""} {
-	set grabStatus [grab status $oldGrab]
-    }
-    grab $w
-    focus $data(sEnt)
-    $data(sEnt) select from 0
-    $data(sEnt) select to   end
-
-    # 7. 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.
-
-    tkwait variable tkPriv(selectFilePath)
-    catch {focus $oldFocus}
-    grab release $w
-    wm withdraw $w
-    if {$oldGrab != ""} {
-	if {$grabStatus == "global"} {
-	    grab -global $oldGrab
-	} else {
-	    grab $oldGrab
-	}
-    }
-    return $tkPriv(selectFilePath)
+    return $w
 }
 
-proc tkMotifFDialog_Config {w type argList} {
-    upvar #0 $w data
+# tkMotifFDialog_Config --
+#
+#	Iterates over the optional arguments to determine the option
+#	values for the Motif file dialog; gives default values to
+#	unspecified options.
+#
+# Arguments:
+#	dataName	The name of the global variable in which
+#			data for the file dialog is stored.
+#	type		"Save" or "Open"
+#	argList		Options parsed by the procedure.
+
+proc tkMotifFDialog_Config {dataName type argList} {
+    upvar #0 $dataName data
 
     set data(type) $type
 
@@ -136,7 +172,7 @@ proc tkMotifFDialog_Config {w type argList} {
 
     # 3: parse the arguments
     #
-    tclParseConfigSpec $w $specs "" $argList
+    tclParseConfigSpec $dataName $specs "" $argList
 
     if {![string compare $data(-title) ""]} {
 	if {![string compare $type "open"]} {
@@ -179,11 +215,21 @@ proc tkMotifFDialog_Config {w type argList} {
     }
 }
 
-proc tkMotifFDialog_Create {w} {
+# tkMotifFDialog_BuildUI --
+#
+#	Builds the UI components of the Motif file dialog.
+#
+# Arguments:
+# 	w		Pathname of the dialog to build.
+#
+# Results:
+# 	None.
+
+proc tkMotifFDialog_BuildUI {w} {
     set dataName [lindex [split $w .] end]
     upvar #0 $dataName data
 
-    # 1: Create the dialog ...
+    # Create the dialog toplevel and internal frames.
     #
     toplevel $w -class TkMotifFDialog
     set top [frame $w.top -relief raised -bd 1]
@@ -261,7 +307,22 @@ proc tkMotifFDialog_Create {w} {
     wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w"
 }
 
-proc tkMotifFDialog_MakeSList {w f label under cmd} {
+# tkMotifFDialog_MakeSList --
+#
+#	Create a scrolled-listbox and set the keyboard accelerator
+#	bindings so that the list selection follows what the user
+#	types.
+#
+# Arguments:
+#	w		Pathname of the dialog box.
+#	f		Frame widget inside which to create the scrolled
+#			listbox. This frame widget already exists.
+#	label		The string to display on top of the listbox.
+#	under		Sets the -under option of the label.
+#	cmdPrefix	Specifies procedures to call when the listbox is
+#			browsed or activated.
+
+proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {
     label $f.lab -text $label -under $under -anchor w
     listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
 	-xscrollcommand "$f.h set" \
@@ -283,13 +344,14 @@ proc tkMotifFDialog_MakeSList {w f label under cmd} {
     # bindings for the listboxes
     #
     set list $f.l
-    bind $list <Up>        "tkMotifFDialog_Browse$cmd $w"
-    bind $list <Down>      "tkMotifFDialog_Browse$cmd $w"
-    bind $list <space>     "tkMotifFDialog_Browse$cmd $w"
-    bind $list <1>         "tkMotifFDialog_Browse$cmd $w"
-    bind $list <B1-Motion> "tkMotifFDialog_Browse$cmd $w"
-    bind $list <Double-1>  "tkMotifFDialog_Activate$cmd $w"
-    bind $list <Return>    "tkMotifFDialog_Browse$cmd $w; tkMotifFDialog_Activate$cmd $w"
+    bind $list <Up>        "tkMotifFDialog_Browse$cmdPrefix $w"
+    bind $list <Down>      "tkMotifFDialog_Browse$cmdPrefix $w"
+    bind $list <space>     "tkMotifFDialog_Browse$cmdPrefix $w"
+    bind $list <1>         "tkMotifFDialog_Browse$cmdPrefix $w"
+    bind $list <B1-Motion> "tkMotifFDialog_Browse$cmdPrefix $w"
+    bind $list <Double-ButtonRelease-1> "tkMotifFDialog_Activate$cmdPrefix $w"
+    bind $list <Return>    "tkMotifFDialog_Browse$cmdPrefix $w; \
+	    tkMotifFDialog_Activate$cmdPrefix $w"
 
     bindtags $list "Listbox $list [winfo toplevel $list] all"
     tkListBoxKeyAccel_Set $list
@@ -297,6 +359,168 @@ proc tkMotifFDialog_MakeSList {w f label under cmd} {
     return $f.l
 }
 
+# tkMotifFDialog_InterpFilter --
+#
+#	Interpret the string in the filter entry into two components:
+#	the directory and the pattern. If the string is a relative
+#	pathname, give a warning to the user and restore the pattern
+#	to original.
+#
+# Arguments:
+#	w		pathname of the dialog box.
+#
+# Results:
+# 	A list of two elements. The first element is the directory
+# 	specified # by the filter. The second element is the filter
+# 	pattern itself.
+
+proc tkMotifFDialog_InterpFilter {w} {
+    upvar #0 [winfo name $w] data
+
+    set text [string trim [$data(fEnt) get]]
+
+    # Perform tilde substitution
+    #
+    set badTilde 0
+    if {[string compare [string index $text 0] ~] == 0} {
+	set list [file split $text]
+	set tilde [lindex $list 0]
+	if [catch {set tilde [glob $tilde]}] {
+	    set badTilde 1
+	} else {
+	    set text [eval file join [concat $tilde [lrange $list 1 end]]]
+	}
+    }
+
+    # If the string is a relative pathname, combine it
+    # with the current selectPath.
+
+    set relative 0
+    if {[file pathtype $text] == "relative"} {
+	set relative 1
+    } elseif {$badTilde} {
+	set relative 1	
+    }
+
+    if {$relative} {
+	tk_messageBox -icon warning -type ok \
+	    -message "\"$text\" must be an absolute pathname"
+
+	$data(fEnt) delete 0 end
+	$data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
+		$data(filter)]
+
+	return [list $data(selectPath) $data(filter)]
+    }
+
+    set resolved [tkFDialog_JoinFile [file dirname $text] [file tail $text]]
+
+    if [file isdirectory $resolved] {
+	set dir $resolved
+	set fil $data(filter)
+    } else {
+	set dir [file dirname $resolved]
+	set fil [file tail    $resolved]
+    }
+
+    return [list $dir $fil]
+}
+
+# tkMotifFDialog_Update
+#
+#	Load the files and synchronize the "filter" and "selection" fields
+#	boxes.
+#
+# Arguments:
+# 	w 		pathname of the dialog box.
+#
+# Results:
+#	None.
+
+proc tkMotifFDialog_Update {w} {
+    upvar #0 [winfo name $w] data
+
+    $data(fEnt) delete 0 end
+    $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)]
+    $data(sEnt) delete 0 end
+    $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
+	    $data(selectFile)]
+ 
+    tkMotifFDialog_LoadFiles $w
+}
+
+# tkMotifFDialog_LoadFiles --
+#
+#	Loads the files and directories into the two listboxes according
+#	to the filter setting.
+#
+# Arguments:
+# 	w 		pathname of the dialog box.
+#
+# Results:
+#	None.
+
+proc tkMotifFDialog_LoadFiles {w} {
+    upvar #0 [winfo name $w] data
+
+    $data(dList) delete 0 end
+    $data(fList) delete 0 end
+
+    set appPWD [pwd]
+    if [catch {
+	cd $data(selectPath)
+    }] {
+	cd $appPWD
+
+	$data(dList) insert end ".."
+	return
+    }
+
+    # Make the dir list
+    #
+    foreach f [lsort -dictionary [glob -nocomplain .* *]] {
+	if [file isdir ./$f] {
+	    $data(dList) insert end $f
+	}
+    }
+    # Make the file list
+    #
+    if ![string compare $data(filter) *] {
+	set files [lsort -dictionary [glob -nocomplain .* *]]
+    } else {
+	set files [lsort -dictionary \
+	    [glob -nocomplain $data(filter)]]
+    }
+
+    set top 0
+    foreach f $files {
+	if ![file isdir ./$f] {
+	    regsub {^[.]/} $f "" f
+	    $data(fList) insert end $f
+	    if [string match .* $f] {
+		incr top
+	    }
+	}
+    }
+
+    # The user probably doesn't want to see the . files. We adjust the view
+    # so that the listbox displays all the non-dot files
+    $data(fList) yview $top
+
+    cd $appPWD
+}
+
+# tkMotifFDialog_BrowseFList --
+#
+#	This procedure is called when the directory list is browsed
+#	(clicked-over) by the user.
+#
+# Arguments:
+# 	w		The pathname of the dialog box.
+#
+# Results:
+#	None.	
+
 proc tkMotifFDialog_BrowseDList {w} {
     upvar #0 [winfo name $w] data
 
@@ -316,14 +540,15 @@ proc tkMotifFDialog_BrowseDList {w} {
 
     switch -- $subdir {
 	. {
-	    set newSpec [file join $data(selectPath) $data(filter)]
+	    set newSpec [tkFDialog_JoinFile $data(selectPath) $data(filter)]
 	}
 	.. {
-	    set newSpec [file join [file dirname $data(selectPath)] \
+	    set newSpec [tkFDialog_JoinFile [file dirname $data(selectPath)] \
 		$data(filter)]
 	}
 	default {
-	    set newSpec [file join $data(selectPath) $subdir $data(filter)]
+	    set newSpec [tkFDialog_JoinFile [tkFDialog_JoinFile \
+		    $data(selectPath) $subdir] $data(filter)]
 	}
     }
 
@@ -331,6 +556,17 @@ proc tkMotifFDialog_BrowseDList {w} {
     $data(fEnt) insert 0 $newSpec
 }
 
+# tkMotifFDialog_ActivateDList --
+#
+#	This procedure is called when the directory list is activated
+#	(double-clicked) by the user.
+#
+# Arguments:
+# 	w		The pathname of the dialog box.
+#
+# Results:
+#	None.	
+
 proc tkMotifFDialog_ActivateDList {w} {
     upvar #0 [winfo name $w] data
 
@@ -352,7 +588,7 @@ proc tkMotifFDialog_ActivateDList {w} {
 	    set newDir [file dirname $data(selectPath)]
 	}
 	default {
-	    set newDir [file join $data(selectPath) $subdir]
+	    set newDir [tkFDialog_JoinFile $data(selectPath) $subdir]
 	}
     }
 
@@ -368,6 +604,17 @@ proc tkMotifFDialog_ActivateDList {w} {
     }
 }
 
+# tkMotifFDialog_BrowseFList --
+#
+#	This procedure is called when the file list is browsed
+#	(clicked-over) by the user.
+#
+# Arguments:
+# 	w		The pathname of the dialog box.
+#
+# Results:
+#	None.	
+
 proc tkMotifFDialog_BrowseFList {w} {
     upvar #0 [winfo name $w] data
 
@@ -383,14 +630,26 @@ proc tkMotifFDialog_BrowseFList {w} {
     $data(dList) selection clear 0 end
 
     $data(fEnt) delete 0 end
-    $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
+    $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)]
     $data(fEnt) xview end
  
     $data(sEnt) delete 0 end
-    $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
+    $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
+	    $data(selectFile)]
     $data(sEnt) xview end
 }
 
+# tkMotifFDialog_ActivateFList --
+#
+#	This procedure is called when the file list is activated
+#	(double-clicked) by the user.
+#
+# Arguments:
+# 	w		The pathname of the dialog box.
+#
+# Results:
+#	None.	
+
 proc tkMotifFDialog_ActivateFList {w} {
     upvar #0 [winfo name $w] data
 
@@ -405,6 +664,18 @@ proc tkMotifFDialog_ActivateFList {w} {
     }
 }
 
+# tkMotifFDialog_ActivateFEnt --
+#
+#	This procedure is called when the user presses Return inside
+#	the "filter" entry. It updates the dialog according to the
+#	text inside the filter entry.
+#
+# Arguments:
+# 	w		The pathname of the dialog box.
+#
+# Results:
+#	None.	
+
 proc tkMotifFDialog_ActivateFEnt {w} {
     upvar #0 [winfo name $w] data
 
@@ -415,34 +686,18 @@ proc tkMotifFDialog_ActivateFEnt {w} {
     tkMotifFDialog_Update $w
 }
 
-proc tkMotifFDialog_InterpFilter {w} {
-    upvar #0 [winfo name $w] data
-
-    set text [string trim [$data(fEnt) get]]
-    # Perform tilde substitution
-    #
-    if {![string compare [string index $text 0] ~]} {
-	set list [file split $text]
-	set tilde [lindex $list 0]
-	catch {
-	    set tilde [glob $tilde]
-	}
-	set text [eval file join [concat $tilde [lrange $list 1 end]]]
-    }
-
-    set resolved [file join [file dirname $text] [file tail $text]]
-
-    if {[file isdirectory $resolved]} {
-	set dir $resolved
-	set fil $data(filter)
-    } else {
-	set dir [file dirname $resolved]
-	set fil [file tail    $resolved]
-    }
-
-    return [list $dir $fil]
-}
-
+# tkMotifFDialog_ActivateSEnt --
+#
+#	This procedure is called when the user presses Return inside
+#	the "selection" entry. It sets the tkPriv(selectFilePath) global
+#	variable so that the vwait loop in tkMotifFDialog will be
+#	terminated.
+#
+# Arguments:
+# 	w		The pathname of the dialog box.
+#
+# Results:
+#	None.	
 
 proc tkMotifFDialog_ActivateSEnt {w} {
     global tkPriv
@@ -452,7 +707,6 @@ proc tkMotifFDialog_ActivateSEnt {w} {
     set selectFile     [file tail    $selectFilePath]
     set selectPath     [file dirname $selectFilePath]
 
-
     if {![string compare $selectFilePath ""]} {
 	tkMotifFDialog_FilterCmd $w
 	return
@@ -522,75 +776,6 @@ proc tkMotifFDialog_CancelCmd {w} {
     set tkPriv(selectPath)     ""
 }
 
-# tkMotifFDialog_Update
-#
-#	Load the files and synchronize the "filter" and "selection" fields
-#	boxes.
-#
-# popup:
-#	If this is true, then update the selection field according to the
-#	"-selection" flag
-#
-proc tkMotifFDialog_Update {w} {
-    upvar #0 [winfo name $w] data
-
-    $data(fEnt) delete 0 end
-    $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
-    $data(sEnt) delete 0 end
-    $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
- 
-    tkMotifFDialog_LoadFiles $w
-}
-
-proc tkMotifFDialog_LoadFiles {w} {
-    upvar #0 [winfo name $w] data
-
-    $data(dList) delete 0 end
-    $data(fList) delete 0 end
-
-    set appPWD [pwd]
-    if {[catch {
-	cd $data(selectPath)
-    }]} {
-	cd $appPWD
-
-	$data(dList) insert end ".."
-	return
-    }
-
-    # Make the dir list
-    #
-    foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] {
-	if {[file isdirectory $f]} {
-	    $data(dList) insert end $f
-	}
-    }
-    # Make the file list
-    #
-    if {![string compare $data(filter) *]} {
-	set files [lsort -command tclSortNoCase [glob -nocomplain .* *]]
-    } else {
-	set files [lsort -command tclSortNoCase \
-	    [glob -nocomplain $data(filter)]]
-    }
-
-    set top 0
-    foreach f $files {
-	if {![file isdir $f]} {
-	    $data(fList) insert end $f
-	    if {[string match .* $f]} {
-		incr top
-	    }
-	}
-    }
-
-    # The user probably doesn't want to see the . files. We adjust the view
-    # so that the listbox displays all the non-dot files
-    $data(fList) yview $top
-
-    cd $appPWD
-}
-
 proc tkListBoxKeyAccel_Set {w} {
     bind Listbox <Any-KeyPress> ""
     bind $w <Destroy> "tkListBoxKeyAccel_Unset $w"
@@ -605,6 +790,20 @@ proc tkListBoxKeyAccel_Unset {w} {
     catch {unset tkPriv(lbAccel,$w,afterId)}
 }
 
+# tkListBoxKeyAccel_Key--
+#
+#	This procedure maintains a list of recently entered keystrokes
+#	over a listbox widget. It arranges an idle event to move the
+#	selection of the listbox to the entry that begins with the
+#	keystrokes.
+#
+# Arguments:
+# 	w		The pathname of the listbox.
+#	key		The key which the user just pressed.
+#
+# Results:
+#	None.	
+
 proc tkListBoxKeyAccel_Key {w key} {
     global tkPriv