123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308 |
- # choosedir.tcl --
- #
- # Choose directory dialog implementation for Unix/Mac.
- #
- # Copyright (c) 1998-2000 by Scriptics Corporation.
- # All rights reserved.
- # 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 {
- namespace import -force ::tk::msgcat::*
- }
- # ::tk::dialog::file::chooseDir:: --
- #
- # Implements the TK directory selection dialog.
- #
- # Arguments:
- # args Options parsed by the procedure.
- #
- proc ::tk::dialog::file::chooseDir:: {args} {
- variable ::tk::Priv
- set dataName __tk_choosedir
- upvar ::tk::dialog::file::$dataName data
- Config $dataName $args
- if {$data(-parent) eq "."} {
- 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 {[winfo class $w] ne "TkChooseDir"} {
- destroy $w
- ::tk::dialog::file::Create $w TkChooseDir
- } else {
- set data(dirMenuBtn) $w.contents.f1.menu
- set data(dirMenu) $w.contents.f1.menu.menu
- set data(upBtn) $w.contents.f1.up
- set data(icons) $w.contents.icons
- set data(ent) $w.contents.f2.ent
- set data(okBtn) $w.contents.f2.ok
- set data(cancelBtn) $w.contents.f2.cancel
- set data(hiddenBtn) $w.contents.f2.hidden
- }
- if {$::tk::dialog::file::showHiddenBtn} {
- $data(hiddenBtn) configure -state normal
- grid $data(hiddenBtn)
- } else {
- $data(hiddenBtn) configure -state disabled
- grid remove $data(hiddenBtn)
- }
- # When using -mustexist, manage the OK button state for validity
- $data(okBtn) configure -state normal
- if {$data(-mustexist)} {
- $data(ent) configure -validate key \
- -validatecommand [list ::tk::dialog::file::chooseDir::IsOK? $w %P]
- } else {
- $data(ent) configure -validate none
- }
- # Dialog boxes should be transient with respect to their parent,
- # so that they will always stay on top of their parent window. However,
- # some window managers will create the window as withdrawn if the parent
- # window is withdrawn or iconified. Combined with the grab we put on the
- # window, this can hang the entire application. Therefore we only make
- # the dialog transient if the parent is viewable.
- if {[winfo viewable [winfo toplevel $data(-parent)]] } {
- wm transient $w $data(-parent)
- }
- trace add variable data(selectPath) write \
- [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 (Motif style) 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.
- vwait ::tk::Priv(selectFilePath)
- ::tk::RestoreFocusGrab $w $data(ent) withdraw
- # Cleanup traces on selectPath variable
- #
- foreach trace [trace info variable data(selectPath)] {
- trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
- }
- $data(dirMenuBtn) configure -textvariable {}
- # Return value to user
- #
- return $Priv(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 info variable data(selectPath)] {
- trace remove variable 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) eq ""} {
- set data(-title) "[mc "Choose Directory"]"
- }
- # Stub out the -multiple value for the dialog; it doesn't make sense for
- # choose directory dialogs, but we have to have something there because we
- # share so much code with the file dialogs.
- set data(-multiple) 0
- # 4: set the default directory and selection according to the -initial
- # settings
- #
- if {$data(-initialdir) ne ""} {
- # 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)]} {
- return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
- "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 selection [$data(icons) selection get]
- if {[llength $selection] != 0} {
- set iconText [$data(icons) get [lindex $selection 0]]
- set iconText [file join $data(selectPath) $iconText]
- Done $w $iconText
- } else {
- set text [$data(ent) get]
- if {$text eq ""} {
- return
- }
- set text [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 {$text eq $data(previousEntryText)} {
- set data(previousEntryText) ""
- 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 {$text eq $data(selectPath)} {
- Done $w $text
- } else {
- set data(selectPath) $text
- }
- }
- }
- return
- }
- # Change state of OK button to match -mustexist correctness of entry
- #
- proc ::tk::dialog::file::chooseDir::IsOK? {w text} {
- upvar ::tk::dialog::file::[winfo name $w] data
- set ok [file isdirectory $text]
- $data(okBtn) configure -state [expr {$ok ? "normal" : "disabled"}]
- # always return 1
- return 1
- }
- proc ::tk::dialog::file::chooseDir::DblClick {w} {
- upvar ::tk::dialog::file::[winfo name $w] data
- set selection [$data(icons) selection get]
- if {[llength $selection] != 0} {
- set filenameFragment [$data(icons) get [lindex $selection 0]]
- set file $data(selectPath)
- if {[file isdirectory $file]} {
- ::tk::dialog::file::ListInvoke $w [list $filenameFragment]
- 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 {$text eq ""} {
- 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
- # Priv(selectFilePath) variable, which will break the "vwait"
- # 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
- variable ::tk::Priv
- if {$selectFilePath eq ""} {
- set selectFilePath $data(selectPath)
- }
- if {$data(-mustexist) && ![file isdirectory $selectFilePath]} {
- return
- }
- set Priv(selectFilePath) $selectFilePath
- }
|