summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog41
-rw-r--r--library/choosedir.tcl397
-rw-r--r--library/listbox.tcl6
-rw-r--r--library/tclIndex40
-rw-r--r--library/tk.tcl8
-rw-r--r--library/tkfbox.tcl360
-rw-r--r--library/xmfbox.tcl59
-rw-r--r--tests/choosedir.test68
-rw-r--r--tests/filebox.test8
9 files changed, 572 insertions, 415 deletions
diff --git a/ChangeLog b/ChangeLog
index 61d0ca4..9a168e6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,39 @@
+2000-03-24 Eric Melski <ericm@scriptics.com>
+
+ * 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.
+
+2000-03-23 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkWindow.c:
+ * generic/tkInt.h: Updated Tcl_OptionCmd -> Tcl_OptionObjCmd
+
+ * generic/tkOption.c: Tcl_Obj'ectified the "option" command.
+
+2000-03-22 Eric Melski <ericm@scriptics.com>
+
+ * 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].
+
2000-03-15 Sven Delmas <sven@scriptics.com>
* win/tkWinDialog.c: Changed the behavior for the
@@ -7,6 +43,11 @@
return the value shown in the entry. This seems to be in
accordance with the expected behavior for this dialog.
+2000-03-14 Eric Melski <ericm@scriptics.com>
+
+ * tests/choosedir.test: Marked test 3.1 and 3.2 as bad until the
+ issue with those tests on IRIX can be determined.
+
2000-03-10 Eric Melski <ericm@scriptics.com>
* library/menu.tcl: Applied patch from [Bug: 4155]; protects
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
}
diff --git a/library/listbox.tcl b/library/listbox.tcl
index cd5d6c8..41b3d7a 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
-# RCS: @(#) $Id: listbox.tcl,v 1.10 2000/02/10 08:52:50 hobbs Exp $
+# RCS: @(#) $Id: listbox.tcl,v 1.11 2000/03/24 19:38:57 ericm Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
@@ -465,6 +465,10 @@ proc tkListboxCancel w {
}
set first [$w index anchor]
set last $tkPriv(listboxPrev)
+ if { [string equal $last ""] } {
+ # Not actually doing any selection right now
+ return
+ }
if {$first > $last} {
set tmp $first
set first $last
diff --git a/library/tclIndex b/library/tclIndex
index 5a8cb43..659e012 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -201,26 +201,26 @@ set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_Config) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_Create) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_Update) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_SetPathSilently) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_SetPath) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_SetFilter) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::tkFDialog) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::Update) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::SetPathSilently) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::SetPath) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::SetFilter) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_EntFocusIn) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_EntFocusOut) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_ActivateEnt) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_InvokeBtn) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_UpDirCmd) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_JoinFile) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_OkCmd) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_CancelCmd) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_ListBrowse) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_ListInvoke) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_Done) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::EntFocusIn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::EntFocusOut) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::ActivateEnt) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::InvokeBtn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::UpDirCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::JoinFile) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::OkCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::CancelCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::ListBrowse) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::ListInvoke) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::Done) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]
@@ -242,4 +242,4 @@ set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]
set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]
-set auto_index(::tk::dialog::chooseDir::tkChooseDirectory) [list source [file join $dir choosedir.tcl]]
+set auto_index(::tk::dialog::file::chooseDir::tkChooseDirectory) [list source [file join $dir choosedir.tcl]]
diff --git a/library/tk.tcl b/library/tk.tcl
index 4f1b378..333816b 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# RCS: @(#) $Id: tk.tcl,v 1.19 2000/02/08 10:00:55 hobbs Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.20 2000/03/24 19:38:57 ericm Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -236,7 +236,7 @@ if {[string equal [info commands tk_getOpenFile] ""]} {
if {$::tk_strictMotif} {
return [eval tkMotifFDialog open $args]
} else {
- return [eval tkFDialog open $args]
+ return [eval ::tk::dialog::file::tkFDialog open $args]
}
}
}
@@ -245,7 +245,7 @@ if {[string equal [info commands tk_getSaveFile] ""]} {
if {$::tk_strictMotif} {
return [eval tkMotifFDialog save $args]
} else {
- return [eval tkFDialog save $args]
+ return [eval ::tk::dialog::file::tkFDialog save $args]
}
}
}
@@ -256,7 +256,7 @@ if {[string equal [info commands tk_messageBox] ""]} {
}
if {[string equal [info command tk_chooseDirectory] ""]} {
proc tk_chooseDirectory {args} {
- return [eval ::tk::dialog::chooseDir::tkChooseDirectory $args]
+ return [eval ::tk::dialog::file::chooseDir::tkChooseDirectory $args]
}
}
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index fade2bd..0495192 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.15 2000/02/07 22:12:26 ericm Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.16 2000/03/24 19:38:57 ericm Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -620,6 +620,9 @@ proc tkIconList_Reset {w} {
#
#----------------------------------------------------------------------
+namespace eval ::tk::dialog {}
+namespace eval ::tk::dialog::file {}
+
# tkFDialog --
#
# Implements the TK file selection dialog. This dialog is used when
@@ -631,12 +634,12 @@ proc tkIconList_Reset {w} {
# args Options parsed by the procedure.
#
-proc tkFDialog {type args} {
+proc ::tk::dialog::file::tkFDialog {type args} {
global tkPriv
set dataName __tk_filedialog
- upvar #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
- tkFDialog_Config $dataName $type $args
+ ::tk::dialog::file::Config $dataName $type $args
if {[string equal $data(-parent) .]} {
set w .$dataName
@@ -647,10 +650,10 @@ proc tkFDialog {type args} {
# (re)create the dialog box if necessary
#
if {![winfo exists $w]} {
- tkFDialog_Create $w
+ ::tk::dialog::file::Create $w TkFDialog
} elseif {[string compare [winfo class $w] TkFDialog]} {
destroy $w
- tkFDialog_Create $w
+ ::tk::dialog::file::Create $w TkFDialog
} else {
set data(dirMenuBtn) $w.f1.menu
set data(dirMenu) $w.f1.menu.menu
@@ -665,7 +668,12 @@ proc tkFDialog {type args} {
}
wm transient $w $data(-parent)
- trace variable data(selectPath) w "tkFDialog_SetPath $w"
+ # Add traces on the selectPath variable
+ #
+
+ trace variable data(selectPath) w "::tk::dialog::file::SetPath $w"
+ $data(dirMenuBtn) configure \
+ -textvariable ::tk::dialog::file::${dataName}(selectPath)
# Initialize the file types menu
#
@@ -675,9 +683,9 @@ proc tkFDialog {type args} {
set title [lindex $type 0]
set filter [lindex $type 1]
$data(typeMenu) add command -label $title \
- -command [list tkFDialog_SetFilter $w $type]
+ -command [list ::tk::dialog::file::SetFilter $w $type]
}
- tkFDialog_SetFilter $w [lindex $data(-filetypes) 0]
+ ::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0]
$data(typeMenuBtn) config -state normal
$data(typeMenuLab) config -state normal
} else {
@@ -685,7 +693,7 @@ proc tkFDialog {type args} {
$data(typeMenuBtn) config -state disabled -takefocus 0
$data(typeMenuLab) config -state disabled
}
- tkFDialog_UpdateWhenIdle $w
+ ::tk::dialog::file::UpdateWhenIdle $w
# Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
@@ -712,15 +720,23 @@ proc tkFDialog {type args} {
::tk::RestoreFocusGrab $w $data(ent) withdraw
+ # Cleanup traces on selectPath variable
+ #
+
+ foreach trace [trace vinfo data(selectPath)] {
+ trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
+ }
+ $data(dirMenuBtn) configure -textvariable {}
+
return $tkPriv(selectFilePath)
}
-# tkFDialog_Config --
+# ::tk::dialog::file::Config --
#
# Configures the TK filedialog according to the argument list
#
-proc tkFDialog_Config {dataName type argList} {
- upvar #0 $dataName data
+proc ::tk::dialog::file::Config {dataName type argList} {
+ upvar ::tk::dialog::file::$dataName data
set data(type) $type
@@ -753,7 +769,7 @@ proc tkFDialog_Config {dataName type argList} {
# 3: parse the arguments
#
- tclParseConfigSpec $dataName $specs "" $argList
+ tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
if {[string equal $data(-title) ""]} {
if {[string equal $type "open"]} {
@@ -791,19 +807,19 @@ proc tkFDialog_Config {dataName type argList} {
}
}
-proc tkFDialog_Create {w} {
+proc ::tk::dialog::file::Create {w class} {
set dataName [lindex [split $w .] end]
- upvar #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
global tk_library tkPriv
- toplevel $w -class TkFDialog
+ toplevel $w -class $class
# f1: the frame with the directory option menu
#
set f1 [frame $w.f1]
label $f1.lab -text "Directory:" -under 0
set data(dirMenuBtn) $f1.menu
- set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) $dataName] ""]
+ set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""]
set data(upBtn) [button $f1.up]
if {![info exists tkPriv(updirImage)]} {
set tkPriv(updirImage) [image create bitmap -data {
@@ -827,14 +843,24 @@ static char updir_bits[] = {
# data(icons): the IconList that list the files and directories.
#
+ if { [string equal $class TkFDialog] } {
+ set fNameCaption "File name:"
+ set fNameUnder 5
+ set iconListCommand [list ::tk::dialog::file::OkCmd $w]
+ } else {
+ set fNameCaption "Selection:"
+ set fNameUnder 0
+ set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
+ }
set data(icons) [tkIconList $w.icons \
- -browsecmd [list tkFDialog_ListBrowse $w] \
- -command [list tkFDialog_OkCmd $w]]
+ -browsecmd [list ::tk::dialog::file::ListBrowse $w] \
+ -command $iconListCommand]
# f2: the frame with the OK button and the "file name" field
#
set f2 [frame $w.f2 -bd 0]
- label $f2.lab -text "File name:" -anchor e -width 14 -under 5 -pady 0
+ label $f2.lab -text $fNameCaption -anchor e -width 14 \
+ -under $fNameUnder -pady 0
set data(ent) [entry $f2.ent]
# The font to use for the icons. The default Canvas font on Unix
@@ -846,26 +872,30 @@ static char updir_bits[] = {
#
set f3 [frame $w.f3 -bd 0]
- # The "File of types:" label needs to be grayed-out when
- # -filetypes are not specified. The label widget does not support
- # grayed-out text on monochrome displays. Therefore, we have to
- # use a button widget to emulate a label widget (by setting its
- # bindtags)
-
- set data(typeMenuLab) [button $f3.lab -text "Files of type:" \
- -anchor e -width 14 -under 9 \
- -bd [$f2.lab cget -bd] \
- -highlightthickness [$f2.lab cget -highlightthickness] \
- -relief [$f2.lab cget -relief] \
- -padx [$f2.lab cget -padx] \
- -pady [$f2.lab cget -pady]]
- bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
- [winfo toplevel $data(typeMenuLab)] all]
-
- set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 -menu $f3.menu.m]
- set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
- $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \
- -relief raised -bd 2 -anchor w
+ # Make the file types bits only if this is a File Dialog
+ if { [string equal $class TkFDialog] } {
+ # The "File of types:" label needs to be grayed-out when
+ # -filetypes are not specified. The label widget does not support
+ # grayed-out text on monochrome displays. Therefore, we have to
+ # use a button widget to emulate a label widget (by setting its
+ # bindtags)
+
+ set data(typeMenuLab) [button $f3.lab -text "Files of type:" \
+ -anchor e -width 14 -under 9 \
+ -bd [$f2.lab cget -bd] \
+ -highlightthickness [$f2.lab cget -highlightthickness] \
+ -relief [$f2.lab cget -relief] \
+ -padx [$f2.lab cget -padx] \
+ -pady [$f2.lab cget -pady]]
+ bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
+ [winfo toplevel $data(typeMenuLab)] all]
+
+ set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 \
+ -menu $f3.menu.m]
+ set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
+ $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \
+ -relief raised -bd 2 -anchor w
+ }
# the okBtn is created after the typeMenu so that the keyboard traversal
# is in the right order
@@ -881,8 +911,10 @@ static char updir_bits[] = {
pack $f2.ent -expand yes -fill x -padx 2 -pady 0
pack $data(cancelBtn) -side right -padx 4 -anchor w
- pack $data(typeMenuLab) -side left -padx 4
- pack $data(typeMenuBtn) -expand yes -fill x -side right
+ if { [string equal $class TkFDialog] } {
+ pack $data(typeMenuLab) -side left -padx 4
+ pack $data(typeMenuBtn) -expand yes -fill x -side right
+ }
# Pack all the frames together. We are done with widget construction.
#
@@ -891,68 +923,83 @@ static char updir_bits[] = {
pack $f2 -side bottom -fill x
pack $data(icons) -expand yes -fill both -padx 4 -pady 1
- # Set up the event handlers
+ # Set up the event handlers that are common to Directory and File Dialogs
#
- bind $data(ent) <Return> [list tkFDialog_ActivateEnt $w]
-
- $data(upBtn) config -command [list tkFDialog_UpDirCmd $w]
- $data(okBtn) config -command [list tkFDialog_OkCmd $w]
- $data(cancelBtn) config -command [list tkFDialog_CancelCmd $w]
- bind $w <Alt-d> [list focus $data(dirMenuBtn)]
- bind $w <Alt-t> [format {
- if {[string equal [%s cget -state] "normal"]} {
- focus %s
- }
- } $data(typeMenuBtn) $data(typeMenuBtn)]
- bind $w <Alt-n> [list focus $data(ent)]
+ wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
+ $data(upBtn) config -command [list ::tk::dialog::file::UpDirCmd $w]
+ $data(cancelBtn) config -command [list ::tk::dialog::file::CancelCmd $w]
bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]
bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]
- bind $w <Alt-o> [list tkFDialog_InvokeBtn $w Open]
- bind $w <Alt-s> [list tkFDialog_InvokeBtn $w Save]
+ bind $w <Alt-d> [list focus $data(dirMenuBtn)]
+
+ # Set up event handlers specific to File or Directory Dialogs
+ #
- wm protocol $w WM_DELETE_WINDOW [list tkFDialog_CancelCmd $w]
+ if { [string equal $class TkFDialog] } {
+ bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
+ $data(okBtn) config -command [list ::tk::dialog::file::OkCmd $w]
+ bind $w <Alt-t> [format {
+ if {[string equal [%s cget -state] "normal"]} {
+ focus %s
+ }
+ } $data(typeMenuBtn) $data(typeMenuBtn)]
+ bind $w <Alt-n> [list focus $data(ent)]
+ bind $w <Alt-o> [list ::tk::dialog::file::InvokeBtn $w Open]
+ bind $w <Alt-s> [list ::tk::dialog::file::InvokeBtn $w Save]
+ } else {
+ set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
+ bind $data(ent) <Return> $okCmd
+ $data(okBtn) config -command $okCmd
+ bind $w <Alt-s> [list focus $data(ent)]
+ bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]
+ }
# Build the focus group for all the entries
#
tkFocusGroup_Create $w
- tkFocusGroup_BindIn $w $data(ent) [list tkFDialog_EntFocusIn $w]
- tkFocusGroup_BindOut $w $data(ent) [list tkFDialog_EntFocusOut $w]
+ tkFocusGroup_BindIn $w $data(ent) [list ::tk::dialog::file::EntFocusIn $w]
+ tkFocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]
}
-# tkFDialog_UpdateWhenIdle --
+# ::tk::dialog::file::UpdateWhenIdle --
#
# Creates an idle event handler which updates the dialog in idle
# time. This is important because loading the directory may take a long
# time and we don't want to load the same directory for multiple times
# due to multiple concurrent events.
#
-proc tkFDialog_UpdateWhenIdle {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::UpdateWhenIdle {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[info exists data(updateId)]} {
return
} else {
- set data(updateId) [after idle [list tkFDialog_Update $w]]
+ set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
}
}
-# tkFDialog_Update --
+# ::tk::dialog::file::Update --
#
# Loads the files and directories into the IconList widget. Also
# sets up the directory option menu for quick access to parent
# directories.
#
-proc tkFDialog_Update {w} {
+proc ::tk::dialog::file::Update {w} {
# This proc may be called within an idle handler. Make sure that the
# window has not been destroyed before this proc is called
- if {![winfo exists $w] || [string compare [winfo class $w] TkFDialog]} {
+ if {![winfo exists $w]} {
+ return
+ }
+ set class [winfo class $w]
+ if { [string compare $class TkFDialog] && \
+ [string compare $class TkChooseDir] } {
return
}
set dataName [winfo name $w]
- upvar #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
global tk_library tkPriv
catch {unset data(updateId)}
@@ -972,7 +1019,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
cd $data(selectPath)
}]} {
# We cannot change directory to $data(selectPath). $data(selectPath)
- # should have been checked before tkFDialog_Update is called, so
+ # should have been checked before ::tk::dialog::file::Update is called, so
# we normally won't come to here. Anyways, give an error and abort
# action.
tk_messageBox -type ok -parent $w -message \
@@ -1009,22 +1056,23 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
}
}
}
- # Make the file list
- #
- if {[string equal $data(filter) *]} {
- set files [lsort -dictionary \
- [glob -nocomplain .* *]]
- } else {
- set files [lsort -dictionary \
- [eval glob -nocomplain $data(filter)]]
- }
-
- set top 0
- foreach f $files {
- if {![file isdir ./$f]} {
- if {![info exists hasDoneFile($f)]} {
- tkIconList_Add $data(icons) $file $f
- set hasDoneFile($f) 1
+ if { [string equal $class TkFDialog] } {
+ # Make the file list if this is a File Dialog
+ #
+ if {[string equal $data(filter) *]} {
+ set files [lsort -dictionary \
+ [glob -nocomplain .* *]]
+ } else {
+ set files [lsort -dictionary \
+ [eval glob -nocomplain $data(filter)]]
+ }
+
+ foreach f $files {
+ if {![file isdir ./$f]} {
+ if {![info exists hasDoneFile($f)]} {
+ tkIconList_Add $data(icons) $file $f
+ set hasDoneFile($f) 1
+ }
}
}
}
@@ -1041,7 +1089,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
}
$data(dirMenu) delete 0 end
- set var [format %s(selectPath) $dataName]
+ set var [format %s(selectPath) ::tk::dialog::file::$dataName]
foreach path $list {
$data(dirMenu) add command -label $path -command [list set $var $path]
}
@@ -1050,12 +1098,14 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
#
cd $appPWD
- # Restore the Open/Save Button
- #
- if {[string equal $data(type) open]} {
- $data(okBtn) config -text "Open"
- } else {
- $data(okBtn) config -text "Save"
+ if { [string equal $class TkFDialog] } {
+ # Restore the Open/Save Button if this is a File Dialog
+ #
+ if {[string equal $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
}
# turn off the busy cursor.
@@ -1064,32 +1114,37 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
$w config -cursor $dlgCursor
}
-# tkFDialog_SetPathSilently --
+# ::tk::dialog::file::SetPathSilently --
#
# Sets data(selectPath) without invoking the trace procedure
#
-proc tkFDialog_SetPathSilently {w path} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::SetPathSilently {w path} {
+ upvar ::tk::dialog::file::[winfo name $w] data
- trace vdelete data(selectPath) w [list tkFDialog_SetPath $w]
+ trace vdelete data(selectPath) w [list ::tk::dialog::file::SetPath $w]
set data(selectPath) $path
- trace variable data(selectPath) w [list tkFDialog_SetPath $w]
+ trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
}
# This proc gets called whenever data(selectPath) is set
#
-proc tkFDialog_SetPath {w name1 name2 op} {
+proc ::tk::dialog::file::SetPath {w name1 name2 op} {
if {[winfo exists $w]} {
- upvar #0 [winfo name $w] data
- tkFDialog_UpdateWhenIdle $w
+ upvar ::tk::dialog::file::[winfo name $w] data
+ ::tk::dialog::file::UpdateWhenIdle $w
+ # On directory dialogs, we keep the entry in sync with the currentdir.
+ if { [string equal [winfo class $w] TkChooseDir] } {
+ $data(ent) delete 0 end
+ $data(ent) insert end $data(selectPath)
+ }
}
}
# This proc gets called whenever data(filter) is set
#
-proc tkFDialog_SetFilter {w type} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::SetFilter {w type} {
+ upvar ::tk::dialog::file::[winfo name $w] data
upvar \#0 $data(icons) icons
set data(filter) [lindex $type 1]
@@ -1097,7 +1152,7 @@ proc tkFDialog_SetFilter {w type} {
$icons(sbar) set 0.0 0.0
- tkFDialog_UpdateWhenIdle $w
+ ::tk::dialog::file::UpdateWhenIdle $w
}
# tkFDialogResolveFile --
@@ -1136,7 +1191,7 @@ proc tkFDialogResolveFile {context text defaultext} {
set appPWD [pwd]
- set path [tkFDialog_JoinFile $context $text]
+ set path [::tk::dialog::file::JoinFile $context $text]
# If the file has no extension, append the default. Be careful not
# to do this for directories, otherwise typing a dirname in the box
@@ -1202,8 +1257,8 @@ proc tkFDialogResolveFile {context text defaultext} {
# from the icon list . This way the user can be certain that the input in the
# entry box is the selection.
#
-proc tkFDialog_EntFocusIn {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::EntFocusIn {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[string compare [$data(ent) get] ""]} {
$data(ent) selection range 0 end
@@ -1214,15 +1269,18 @@ proc tkFDialog_EntFocusIn {w} {
tkIconList_Unselect $data(icons)
- if {[string equal $data(type) open]} {
- $data(okBtn) config -text "Open"
- } else {
- $data(okBtn) config -text "Save"
+ if { [string equal [winfo class $w] TkFDialog] } {
+ # If this is a File Dialog, make sure the buttons are labeled right.
+ if {[string equal $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
}
}
-proc tkFDialog_EntFocusOut {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::EntFocusOut {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
$data(ent) selection clear
}
@@ -1230,8 +1288,8 @@ proc tkFDialog_EntFocusOut {w} {
# Gets called when user presses Return in the "File name" entry.
#
-proc tkFDialog_ActivateEnt {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::ActivateEnt {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
set text [string trim [$data(ent) get]]
set list [tkFDialogResolveFile $data(selectPath) $text \
@@ -1247,9 +1305,9 @@ proc tkFDialog_ActivateEnt {w} {
set data(selectPath) $path
$data(ent) delete 0 end
} else {
- tkFDialog_SetPathSilently $w $path
+ ::tk::dialog::file::SetPathSilently $w $path
set data(selectFile) $file
- tkFDialog_Done $w
+ ::tk::dialog::file::Done $w
}
}
PATTERN {
@@ -1263,9 +1321,9 @@ proc tkFDialog_ActivateEnt {w} {
$data(ent) selection range 0 end
$data(ent) icursor end
} else {
- tkFDialog_SetPathSilently $w $path
+ ::tk::dialog::file::SetPathSilently $w $path
set data(selectFile) $file
- tkFDialog_Done $w
+ ::tk::dialog::file::Done $w
}
}
PATH {
@@ -1293,8 +1351,8 @@ proc tkFDialog_ActivateEnt {w} {
# Gets called when user presses the Alt-s or Alt-o keys.
#
-proc tkFDialog_InvokeBtn {w key} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::InvokeBtn {w key} {
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[string equal [$data(okBtn) cget -text] $key]} {
tkButtonInvoke $data(okBtn)
@@ -1303,8 +1361,8 @@ proc tkFDialog_InvokeBtn {w key} {
# Gets called when user presses the "parent directory" button
#
-proc tkFDialog_UpDirCmd {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::UpDirCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[string compare $data(selectPath) "/"]} {
set data(selectPath) [file dirname $data(selectPath)]
@@ -1314,7 +1372,7 @@ proc tkFDialog_UpDirCmd {w} {
# Join a file name to a path name. The "file join" command will break
# if the filename begins with ~
#
-proc tkFDialog_JoinFile {path file} {
+proc ::tk::dialog::file::JoinFile {path file} {
if {[string match {~*} $file] && [file exists $path/$file]} {
return [file join $path ./$file]
} else {
@@ -1326,25 +1384,25 @@ proc tkFDialog_JoinFile {path file} {
# Gets called when user presses the "OK" button
#
-proc tkFDialog_OkCmd {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::OkCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
set text [tkIconList_Get $data(icons)]
if {[string compare $text ""]} {
- set file [tkFDialog_JoinFile $data(selectPath) $text]
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
if {[file isdirectory $file]} {
- tkFDialog_ListInvoke $w $text
+ ::tk::dialog::file::ListInvoke $w $text
return
}
}
- tkFDialog_ActivateEnt $w
+ ::tk::dialog::file::ActivateEnt $w
}
# Gets called when user presses the "Cancel" button
#
-proc tkFDialog_CancelCmd {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::CancelCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
global tkPriv
set tkPriv(selectFilePath) ""
@@ -1353,41 +1411,45 @@ proc tkFDialog_CancelCmd {w} {
# Gets called when user browses the IconList widget (dragging mouse, arrow
# keys, etc)
#
-proc tkFDialog_ListBrowse {w text} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::ListBrowse {w text} {
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[string equal $text ""]} {
return
}
- set file [tkFDialog_JoinFile $data(selectPath) $text]
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
if {![file isdirectory $file]} {
$data(ent) delete 0 end
$data(ent) insert 0 $text
- if {[string equal $data(type) open]} {
- $data(okBtn) config -text "Open"
- } else {
- $data(okBtn) config -text "Save"
+ if { [string equal [winfo class $w] TkFDialog] } {
+ if {[string equal $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
}
} else {
- $data(okBtn) config -text "Open"
+ if { [string equal [winfo class $w] TkFDialog] } {
+ $data(okBtn) config -text "Open"
+ }
}
}
# Gets called when user invokes the IconList widget (double-click,
# Return key, etc)
#
-proc tkFDialog_ListInvoke {w text} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::ListInvoke {w text} {
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[string equal $text ""]} {
return
}
- set file [tkFDialog_JoinFile $data(selectPath) $text]
-
- if {[file isdirectory $file]} {
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
+ set class [winfo class $w]
+ if {[string equal $class TkChooseDir] || [file isdirectory $file]} {
set appPWD [pwd]
if {[catch {cd $file}]} {
tk_messageBox -type ok -parent $w -message \
@@ -1399,11 +1461,11 @@ proc tkFDialog_ListInvoke {w text} {
}
} else {
set data(selectFile) $file
- tkFDialog_Done $w
+ ::tk::dialog::file::Done $w
}
}
-# tkFDialog_Done --
+# ::tk::dialog::file::Done --
#
# Gets called when user has input a valid filename. Pops up a
# dialog box to confirm selection when necessary. Sets the
@@ -1411,12 +1473,12 @@ proc tkFDialog_ListInvoke {w text} {
# loop in tkFDialog and return the selected filename to the
# script that calls tk_getOpenFile or tk_getSaveFile
#
-proc tkFDialog_Done {w {selectFilePath ""}} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
+ upvar ::tk::dialog::file::[winfo name $w] data
global tkPriv
if {[string equal $selectFilePath ""]} {
- set selectFilePath [tkFDialog_JoinFile $data(selectPath) \
+ set selectFilePath [::tk::dialog::file::JoinFile $data(selectPath) \
$data(selectFile)]
set tkPriv(selectFile) $data(selectFile)
set tkPriv(selectPath) $data(selectPath)
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index 3d168e6..d202a02 100644
--- a/library/xmfbox.tcl
+++ b/library/xmfbox.tcl
@@ -4,13 +4,18 @@
# Unix platform. This implementation is used only if the
# "tk_strictMotif" flag is set.
#
-# RCS: @(#) $Id: xmfbox.tcl,v 1.10 2000/01/06 02:22:25 hobbs Exp $
+# RCS: @(#) $Id: xmfbox.tcl,v 1.11 2000/03/24 19:38:57 ericm Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+namespace eval ::tk::dialog {}
+namespace eval ::tk::dialog::file {}
+
+
# tkMotifFDialog --
#
# Implements a file dialog similar to the standard Motif file
@@ -29,7 +34,7 @@
proc tkMotifFDialog {type args} {
global tkPriv
set dataName __tk_filedialog
- upvar #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
set w [tkMotifFDialog_Create $dataName $type $args]
@@ -71,7 +76,7 @@ proc tkMotifFDialog {type args} {
proc tkMotifFDialog_Create {dataName type argList} {
global tkPriv
- upvar #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
tkMotifFDialog_Config $dataName $type $argList
@@ -125,7 +130,7 @@ proc tkMotifFDialog_Create {dataName type argList} {
# argList Options parsed by the procedure.
proc tkMotifFDialog_Config {dataName type argList} {
- upvar #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
set data(type) $type
@@ -150,7 +155,7 @@ proc tkMotifFDialog_Config {dataName type argList} {
# 3: parse the arguments
#
- tclParseConfigSpec $dataName $specs "" $argList
+ tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
if {[string equal $data(-title) ""]} {
if {[string equal $type "open"]} {
@@ -205,7 +210,7 @@ proc tkMotifFDialog_Config {dataName type argList} {
proc tkMotifFDialog_BuildUI {w} {
set dataName [lindex [split $w .] end]
- upvar #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
# Create the dialog toplevel and internal frames.
#
@@ -351,7 +356,7 @@ proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {
# pattern itself.
proc tkMotifFDialog_InterpFilter {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
set text [string trim [$data(fEnt) get]]
@@ -383,13 +388,13 @@ proc tkMotifFDialog_InterpFilter {w} {
-message "\"$text\" must be an absolute pathname"
$data(fEnt) delete 0 end
- $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
+ $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
$data(filter)]
return [list $data(selectPath) $data(filter)]
}
- set resolved [tkFDialog_JoinFile [file dirname $text] [file tail $text]]
+ set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]
if {[file isdirectory $resolved]} {
set dir $resolved
@@ -414,12 +419,12 @@ proc tkMotifFDialog_InterpFilter {w} {
# None.
proc tkMotifFDialog_Update {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
$data(fEnt) delete 0 end
- $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)]
+ $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
$data(sEnt) delete 0 end
- $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
+ $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
$data(selectFile)]
tkMotifFDialog_LoadFiles $w
@@ -437,7 +442,7 @@ proc tkMotifFDialog_Update {w} {
# None.
proc tkMotifFDialog_LoadFiles {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
$data(dList) delete 0 end
$data(fList) delete 0 end
@@ -496,7 +501,7 @@ proc tkMotifFDialog_LoadFiles {w} {
# None.
proc tkMotifFDialog_BrowseDList {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
focus $data(dList)
if {[string equal [$data(dList) curselection] ""]} {
@@ -514,14 +519,14 @@ proc tkMotifFDialog_BrowseDList {w} {
switch -- $subdir {
. {
- set newSpec [tkFDialog_JoinFile $data(selectPath) $data(filter)]
+ set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
}
.. {
- set newSpec [tkFDialog_JoinFile [file dirname $data(selectPath)] \
+ set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
$data(filter)]
}
default {
- set newSpec [tkFDialog_JoinFile [tkFDialog_JoinFile \
+ set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
$data(selectPath) $subdir] $data(filter)]
}
}
@@ -542,7 +547,7 @@ proc tkMotifFDialog_BrowseDList {w} {
# None.
proc tkMotifFDialog_ActivateDList {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[string equal [$data(dList) curselection] ""]} {
return
@@ -562,7 +567,7 @@ proc tkMotifFDialog_ActivateDList {w} {
set newDir [file dirname $data(selectPath)]
}
default {
- set newDir [tkFDialog_JoinFile $data(selectPath) $subdir]
+ set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
}
}
@@ -590,7 +595,7 @@ proc tkMotifFDialog_ActivateDList {w} {
# None.
proc tkMotifFDialog_BrowseFList {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
focus $data(fList)
if {[string equal [$data(fList) curselection] ""]} {
@@ -604,11 +609,11 @@ proc tkMotifFDialog_BrowseFList {w} {
$data(dList) selection clear 0 end
$data(fEnt) delete 0 end
- $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)]
+ $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
$data(fEnt) xview end
$data(sEnt) delete 0 end
- $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
+ $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
$data(selectFile)]
$data(sEnt) xview end
}
@@ -625,7 +630,7 @@ proc tkMotifFDialog_BrowseFList {w} {
# None.
proc tkMotifFDialog_ActivateFList {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[string equal [$data(fList) curselection] ""]} {
return
@@ -651,7 +656,7 @@ proc tkMotifFDialog_ActivateFList {w} {
# None.
proc tkMotifFDialog_ActivateFEnt {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
set list [tkMotifFDialog_InterpFilter $w]
set data(selectPath) [lindex $list 0]
@@ -675,7 +680,7 @@ proc tkMotifFDialog_ActivateFEnt {w} {
proc tkMotifFDialog_ActivateSEnt {w} {
global tkPriv
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
set selectFilePath [string trim [$data(sEnt) get]]
set selectFile [file tail $selectFilePath]
@@ -731,13 +736,13 @@ proc tkMotifFDialog_ActivateSEnt {w} {
proc tkMotifFDialog_OkCmd {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
tkMotifFDialog_ActivateSEnt $w
}
proc tkMotifFDialog_FilterCmd {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
tkMotifFDialog_ActivateFEnt $w
}
diff --git a/tests/choosedir.test b/tests/choosedir.test
index 3f4d381..d0fb557 100644
--- a/tests/choosedir.test
+++ b/tests/choosedir.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: choosedir.test,v 1.7 2000/03/14 20:37:08 ericm Exp $
+# RCS: @(#) $Id: choosedir.test,v 1.8 2000/03/24 19:38:57 ericm Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -23,8 +23,8 @@ proc ToPressButton {parent btn} {
after 100 SendButtonPress $parent $btn mouse
}
-proc ToEnterDirByKey {parent dir} {
- after 100 EnterDirByKey $parent [list $dir]
+proc ToEnterDirsByKey {parent dirs} {
+ after 100 [list EnterDirsByKey $parent $dirs]
}
proc PressButton {btn} {
@@ -33,28 +33,34 @@ proc PressButton {btn} {
event generate $btn <ButtonRelease-1> -x 5 -y 5
}
-proc EnterDirByKey {parent dir} {
+proc EnterDirsByKey {parent dirs} {
+ global tk_strictMotif
if {$parent == "."} {
- set w .choosedirectory
+ set w .__tk_choosedir
} else {
- set w $parent.choosedirectory
+ set w $parent.__tk_choosedir
}
+ upvar ::tk::dialog::file::__tk_choosedir data
- $w.e delete 0 end
- $w.e insert 0 $dir
-
- update
- SendButtonPress $parent ok mouse
+ foreach dir $dirs {
+ $data(ent) delete 0 end
+ $data(ent) insert 0 $dir
+ update
+ SendButtonPress $parent ok mouse
+ after 50
+ }
}
proc SendButtonPress {parent btn type} {
+ global tk_strictMotif
if {$parent == "."} {
- set w .choosedirectory
+ set w .__tk_choosedir
} else {
- set w $parent.choosedirectory
+ set w $parent.__tk_choosedir
}
+ upvar ::tk::dialog::file::__tk_choosedir data
- set button $w.$btn
+ set button $data($btn\Btn)
if ![winfo ismapped $button] {
update
}
@@ -75,15 +81,6 @@ proc SendButtonPress {parent btn type} {
# The test suite proper
#
#----------------------------------------------------------------------
-catch {unset err}
-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)\""
-
# Make a dir for us to rely on for tests
makeDirectory choosedirTest
set dir [pwd]
@@ -95,11 +92,11 @@ set parent .
foreach opt {-initialdir -mustexist -parent -title} {
test choosedir-1.1 "tk_chooseDirectory command" unixOnly {
list [catch {tk_chooseDirectory $opt} msg] $msg
- } [list 1 [format $err(valueMissing) $opt]]
+ } [list 1 "value for \"$opt\" missing"]
}
test choosedir-1.2 "tk_chooseDirectory command" unixOnly {
list [catch {tk_chooseDirectory -foo bar} msg] $msg
-} [list 1 [format $err(unknownOpt) "-foo"]]
+} [list 1 "bad option \"-foo\": must be -initialdir, -mustexist, -parent, or -title"]
test choosedir-1.3 "tk_chooseDirectory command" unixOnly {
list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg
} {1 {bad window path name "foo.bar"}}
@@ -110,19 +107,16 @@ test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unixOnly} {
tk_chooseDirectory -title "Press Cancel" -parent $parent
} ""
-test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly badTest} {
+test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly} {
# first enter a bogus dirname, then enter a real one.
- set afterId1 [after 100 EnterDirByKey $parent [list $fake]]
- set afterId2 [after 200 EnterDirByKey $parent [list $real]]
+ ToEnterDirsByKey $parent [list $fake $real $real]
set result [tk_chooseDirectory \
-title "Enter \"$fake\", press OK, enter \"$real\", press OK" \
-parent $parent -mustexist 1]
- after cancel $afterId1
- after cancel $afterId2
set result
} $real
-test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unixOnly badTest} {
- ToEnterDirByKey $parent $fake
+test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unixOnly} {
+ ToEnterDirsByKey $parent [list $fake $fake]
tk_chooseDirectory -title "Enter \"$fake\", press OK" \
-parent $parent -mustexist 0
} $fake
@@ -132,20 +126,24 @@ test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unixOnly} {
tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real
} $real
test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unixOnly} {
- ToEnterDirByKey $parent $fake
+ ToEnterDirsByKey $parent [list $fake $fake]
tk_chooseDirectory \
-title "Enter \"$fake\" and press Ok" \
-parent $parent -initialdir $real
} $fake
test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unixOnly} {
+ catch {unset ::tk::dialog::file::__tk_choosedir}
ToPressButton $parent ok
tk_chooseDirectory \
-title "Press OK" \
-parent $parent -initialdir ""
} [pwd]
-
-unset err
+test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unixOnly} {
+ ToEnterDirsByKey $parent [list "" $real $real]
+ tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \
+ -parent $parent
+} $real
# cleanup
::tcltest::cleanupTests
diff --git a/tests/filebox.test b/tests/filebox.test
index 5aa2050..4f8242e 100644
--- a/tests/filebox.test
+++ b/tests/filebox.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: filebox.test,v 1.8 1999/11/30 00:02:20 hobbs Exp $
+# RCS: @(#) $Id: filebox.test,v 1.9 2000/03/24 19:38:57 ericm Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -54,7 +54,7 @@ proc EnterFileByKey {parent fileName fileDir} {
} else {
set w $parent.__tk_filedialog
}
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::__tk_filedialog data
if {$tk_strictMotif} {
$data(sEnt) delete 0 end
@@ -75,7 +75,7 @@ proc SendButtonPress {parent btn type} {
} else {
set w $parent.__tk_filedialog
}
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::__tk_filedialog data
set button $data($btn\Btn)
if ![winfo ismapped $button] {
@@ -160,7 +160,7 @@ foreach mode $modes {
list [catch {$command -filetypes {Foo}} msg] $msg
} {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
- if {[info commands tkMotifFDialog] == "" && [info commands tkFDialog] == ""} {
+ if {[info commands tkMotifFDialog] == "" && [info commands ::tk::dialog::file::tkFDialog] == ""} {
set isNative 1
} else {
set isNative 0
generated by cgit v0.12 at 2024-07-08 01:51:47 (GMT)