diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/choosedir.tcl | 536 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 19 |
2 files changed, 272 insertions, 283 deletions
diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 4ccd796..acd6683 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -1,272 +1,264 @@ -# choosedir.tcl --
-#
-# Choose directory dialog implementation for Unix/Mac.
-#
-# Copyright (c) 1998-2000 by Scriptics Corporation.
-# All rights reserved.
-#
-# 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::file::chooseDir {
-}
-
-# ::tk::dialog::file::tkChooseDirectory --
-#
-# Implements the TK directory selection dialog.
-#
-# Arguments:
-# args Options parsed by the procedure.
-#
-
-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
- }
-
- # (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)
-
- trace variable data(selectPath) w "::tk::dialog::file::SetPath $w"
- $data(dirMenuBtn) configure \
- -textvariable ::tk::dialog::file::${dataName}(selectPath)
-
- set data(filter) "*"
- set data(previousEntryText) ""
- ::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
- # display and de-iconify it.
-
- ::tk::PlaceWindow $w widget $data(-parent)
- wm title $w $data(-title)
-
- # Set a grab and claim the focus too.
-
- ::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
-
- # Wait for the user to respond, then restore the focus and
- # return the index of the selected button. Restore the focus
- # before deleting the window, since otherwise the window manager
- # may take the focus away so we can't redirect it. Finally,
- # restore any grab that was in effect.
-
- tkwait variable tkPriv(selectFilePath)
-
- ::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 value to user
- #
-
- return $tkPriv(selectFilePath)
-}
-
-# ::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
-
- # 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.
-
- foreach trace [trace vinfo data(selectPath)] {
- trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
- }
-
- # 1: the configuration specs
- #
-
- set specs {
- {-mustexist "" "" 0}
- {-initialdir "" "" ""}
- {-parent "" "" "."}
- {-title "" "" ""}
- }
-
- # 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]
- }
-
- # 3: parse the arguments
- #
-
- tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
-
- if {[string equal $data(-title) ""]} {
- set data(-title) "Choose Directory"
- }
-
- # 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::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 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
- }
- }
- set tkPriv(selectFilePath) $selectFilePath
-}
+# choosedir.tcl -- +# +# Choose directory dialog implementation for Unix/Mac. +# +# Copyright (c) 1998-2000 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: choosedir.tcl,v 1.7 2000/04/19 23:12:56 hobbs 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::file::chooseDir { +} + +# ::tk::dialog::file::tkChooseDirectory -- +# +# Implements the TK directory selection dialog. +# +# Arguments: +# args Options parsed by the procedure. +# +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 + } + + # (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) + + trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w] + $data(dirMenuBtn) configure \ + -textvariable ::tk::dialog::file::${dataName}(selectPath) + + set data(filter) "*" + set data(previousEntryText) "" + ::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 + # display and de-iconify it. + + ::tk::PlaceWindow $w widget $data(-parent) + wm title $w $data(-title) + + # Set a grab and claim the focus too. + + ::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 + + # Wait for the user to respond, then restore the focus and + # return the index of the selected button. Restore the focus + # before deleting the window, since otherwise the window manager + # may take the focus away so we can't redirect it. Finally, + # restore any grab that was in effect. + + tkwait variable tkPriv(selectFilePath) + + ::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 value to user + # + + return $tkPriv(selectFilePath) +} + +# ::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 + + # 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. + # + foreach trace [trace vinfo data(selectPath)] { + trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1] + } + + # 1: the configuration specs + # + set specs { + {-mustexist "" "" 0} + {-initialdir "" "" ""} + {-parent "" "" "."} + {-title "" "" ""} + } + + # 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] + } + + # 3: parse the arguments + # + tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList + + if {$data(-title) == ""} { + set data(-title) "Choose Directory" + } + + # 4: set the default directory and selection according to the -initial + # settings + # + if {$data(-initialdir) != ""} { + # Ensure that initialdir is an absolute path name. + if {[file isdirectory $data(-initialdir)]} { + set old [pwd] + cd $data(-initialdir) + set data(selectPath) [pwd] + cd $old + } else { + set data(selectPath) [pwd] + } + } + + 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 dir, + # 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::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 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 + } + } + set tkPriv(selectFilePath) $selectFilePath +} diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 42c330d..3bd59d6 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.18 2000/03/31 09:24:12 hobbs Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.19 2000/04/19 23:12:56 hobbs Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -771,7 +771,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { # tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList - if {[string equal $data(-title) ""]} { + if {$data(-title) == ""} { if {[string equal $type "open"]} { set data(-title) "Open" } else { @@ -782,19 +782,16 @@ proc ::tk::dialog::file::Config {dataName type argList} { # 4: set the default directory and selection according to the -initial # settings # - if {[string compare $data(-initialdir) ""]} { + if {$data(-initialdir) != ""} { + # Ensure that initialdir is an absolute path name. if {[file isdirectory $data(-initialdir)]} { - set data(selectPath) [lindex [glob $data(-initialdir)] 0] + set old [pwd] + cd $data(-initialdir) + set data(selectPath) [pwd] + cd $old } 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 } set data(selectFile) $data(-initialfile) |