From befc686dfc0ef32494588de6019b889c6b289c50 Mon Sep 17 00:00:00 2001 From: ericm Date: Fri, 24 Mar 2000 19:38:56 +0000 Subject: * 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]. --- ChangeLog | 41 ++++++ library/choosedir.tcl | 397 ++++++++++++++++++++++++++++---------------------- library/listbox.tcl | 6 +- library/tclIndex | 40 ++--- library/tk.tcl | 8 +- library/tkfbox.tcl | 360 ++++++++++++++++++++++++++------------------- library/xmfbox.tcl | 59 ++++---- tests/choosedir.test | 68 +++++---- tests/filebox.test | 8 +- 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 + + * 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 + + * 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 + + * 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 * 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 + + * 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 * 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 - # is the same as OK - bind $w $okCommand + # Set a grab and claim the focus too. - # is the same as cancel - bind $w $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 [namespace code [list Update $ent $lst]] - bind $lst [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) [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 [list focus $data(dirMenuBtn)] - bind $w [format { - if {[string equal [%s cget -state] "normal"]} { - focus %s - } - } $data(typeMenuBtn) $data(typeMenuBtn)] - bind $w [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 [list tkButtonInvoke $data(cancelBtn)] bind $w [list tkButtonInvoke $data(cancelBtn)] - bind $w [list tkFDialog_InvokeBtn $w Open] - bind $w [list tkFDialog_InvokeBtn $w Save] + bind $w [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) [list ::tk::dialog::file::ActivateEnt $w] + $data(okBtn) config -command [list ::tk::dialog::file::OkCmd $w] + bind $w [format { + if {[string equal [%s cget -state] "normal"]} { + focus %s + } + } $data(typeMenuBtn) $data(typeMenuBtn)] + bind $w [list focus $data(ent)] + bind $w [list ::tk::dialog::file::InvokeBtn $w Open] + bind $w [list ::tk::dialog::file::InvokeBtn $w Save] + } else { + set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w] + bind $data(ent) $okCmd + $data(okBtn) config -command $okCmd + bind $w [list focus $data(ent)] + bind $w [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 -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 -- cgit v0.12