diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-18 17:31:55 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-18 17:31:55 (GMT) |
commit | 39e34335fb6eb6eaf2b7ee51ccf172006dd46fbb (patch) | |
tree | 8e5374666c7f0b3017176ec9d6e6b6eae0dcabac /tk8.6/library/choosedir.tcl | |
parent | 066971b1e6e77991d9161bb0216a63ba94ea04f9 (diff) | |
parent | 6b095f3c8521ca7215e6ff5dcbada52b197ef7d0 (diff) | |
download | blt-39e34335fb6eb6eaf2b7ee51ccf172006dd46fbb.zip blt-39e34335fb6eb6eaf2b7ee51ccf172006dd46fbb.tar.gz blt-39e34335fb6eb6eaf2b7ee51ccf172006dd46fbb.tar.bz2 |
Merge commit '6b095f3c8521ca7215e6ff5dcbada52b197ef7d0' as 'tk8.6'
Diffstat (limited to 'tk8.6/library/choosedir.tcl')
-rw-r--r-- | tk8.6/library/choosedir.tcl | 308 |
1 files changed, 308 insertions, 0 deletions
diff --git a/tk8.6/library/choosedir.tcl b/tk8.6/library/choosedir.tcl new file mode 100644 index 0000000..68dd9b0 --- /dev/null +++ b/tk8.6/library/choosedir.tcl @@ -0,0 +1,308 @@ +# 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 +} |