diff options
Diffstat (limited to 'ds9/library/xmfbox.tcl')
| -rw-r--r-- | ds9/library/xmfbox.tcl | 998 |
1 files changed, 998 insertions, 0 deletions
diff --git a/ds9/library/xmfbox.tcl b/ds9/library/xmfbox.tcl new file mode 100644 index 0000000..fb821c8 --- /dev/null +++ b/ds9/library/xmfbox.tcl @@ -0,0 +1,998 @@ +# xmfbox.tcl -- +# +# Implements the "Motif" style file selection dialog for the +# Unix platform. This implementation is used only if the +# "::tk_strictMotif" flag is set. +# +# 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 {} + + +# ::tk::MotifFDialog -- +# +# Implements a file dialog similar to the standard Motif file +# selection box. +# +# Arguments: +# type "open" or "save" +# args Options parsed by the procedure. +# +# Results: +# When -multiple is set to 0, this returns the absolute pathname +# of the selected file. (NOTE: This is not the same as a single +# element list.) +# +# When -multiple is set to > 0, this returns a Tcl list of absolute +# pathnames. The argument for -multiple is ignored, but for consistency +# with Windows it defines the maximum amount of memory to allocate for +# the returned filenames. + +proc ::tk::MotifFDialog {type args} { + variable ::tk::Priv + set dataName __tk_filedialog + upvar ::tk::dialog::file::$dataName data + + set w [MotifFDialog_Create $dataName $type $args] + + # Set a grab and claim the focus too. + + ::tk::SetFocusGrab $w $data(sEnt) + $data(sEnt) selection range 0 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) + set result $Priv(selectFilePath) + ::tk::RestoreFocusGrab $w $data(sEnt) withdraw + + return $result +} + +# ::tk::MotifFDialog_Create -- +# +# Creates the Motif file dialog (if it doesn't exist yet) and +# initialize the internal data structure associated with the +# dialog. +# +# This procedure is used by ::tk::MotifFDialog to create the +# dialog. It's also used by the test suite to test the Motif +# file dialog implementation. User code shouldn't call this +# procedure directly. +# +# Arguments: +# dataName Name of the global "data" array for the file dialog. +# type "Save" or "Open" +# argList Options parsed by the procedure. +# +# Results: +# Pathname of the file dialog. + +proc ::tk::MotifFDialog_Create {dataName type argList} { + upvar ::tk::dialog::file::$dataName data + + MotifFDialog_Config $dataName $type $argList + + if {$data(-parent) eq "."} { + set w .$dataName + } else { + set w $data(-parent).$dataName + } + + # (re)create the dialog box if necessary + # + if {![winfo exists $w]} { + MotifFDialog_BuildUI $w + } elseif {[winfo class $w] ne "TkMotifFDialog"} { + destroy $w + MotifFDialog_BuildUI $w + } else { + set data(fEnt) $w.top.f1.ent + set data(dList) $w.top.f2.a.l + set data(fList) $w.top.f2.b.l + set data(sEnt) $w.top.f3.ent + set data(okBtn) $w.bot.ok + set data(filterBtn) $w.bot.filter + set data(cancelBtn) $w.bot.cancel + } + MotifFDialog_SetListMode $w + + # 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) + } + + MotifFDialog_FileTypes $w + MotifFDialog_Update $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 + wm title $w $data(-title) + + return $w +} + +# ::tk::MotifFDialog_FileTypes -- +# +# Checks the -filetypes option. If present this adds a list of radio- +# buttons to pick the file types from. +# +# Arguments: +# w Pathname of the tk_get*File dialogue. +# +# Results: +# none + +proc ::tk::MotifFDialog_FileTypes {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + set f $w.top.f3.types + destroy $f + + # No file types: use "*" as the filter and display no radio-buttons + if {$data(-filetypes) eq ""} { + set data(filter) * + return + } + + # The filetypes radiobuttons + # set data(fileType) $data(-defaulttype) + # Default type to first entry + set initialTypeName [lindex $data(-filetypes) 0 0] + if {$data(-typevariable) ne ""} { + upvar #0 $data(-typevariable) typeVariable + if {[info exists typeVariable]} { + set initialTypeName $typeVariable + } + } + set ix 0 + set data(fileType) 0 + foreach fltr $data(-filetypes) { + set fname [lindex $fltr 0] + if {[string first $initialTypeName $fname] == 0} { + set data(fileType) $ix + break + } + incr ix + } + + MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)] + + #don't produce radiobuttons for only one filetype + if {[llength $data(-filetypes)] == 1} { + return + } + + ttk::frame $f + set cnt 0 + if {$data(-filetypes) ne {}} { + foreach type $data(-filetypes) { + set title [lindex [lindex $type 0] 0] + set filter [lindex $type 1] + ttk::radiobutton $f.b$cnt \ + -text $title \ + -variable ::tk::dialog::file::[winfo name $w](fileType) \ + -value $cnt \ + -command [list tk::MotifFDialog_SetFilter $w $type] + pack $f.b$cnt -side left + incr cnt + } + } + $f.b$data(fileType) invoke + + pack $f -side bottom -fill both + + return +} + +# This proc gets called whenever data(filter) is set +# +proc ::tk::MotifFDialog_SetFilter {w type} { + upvar ::tk::dialog::file::[winfo name $w] data + variable ::tk::Priv + + set data(filter) [lindex $type 1] + set Priv(selectFileType) [lindex [lindex $type 0] 0] + + MotifFDialog_Update $w +} + +# ::tk::MotifFDialog_Config -- +# +# Iterates over the optional arguments to determine the option +# values for the Motif file dialog; gives default values to +# unspecified options. +# +# Arguments: +# dataName The name of the global variable in which +# data for the file dialog is stored. +# type "Save" or "Open" +# argList Options parsed by the procedure. + +proc ::tk::MotifFDialog_Config {dataName type argList} { + upvar ::tk::dialog::file::$dataName data + + set data(type) $type + + # 1: the configuration specs + # + set specs { + {-defaultextension "" "" ""} + {-filetypes "" "" ""} + {-initialdir "" "" ""} + {-initialfile "" "" ""} + {-parent "" "" "."} + {-title "" "" ""} + {-typevariable "" "" ""} + } + if {$type eq "open"} { + lappend specs {-multiple "" "" "0"} + } + if {$type eq "save"} { + lappend specs {-confirmoverwrite "" "" "1"} + } + + set data(-multiple) 0 + set data(-confirmoverwrite) 1 + # 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] + set data(selectFile) "" + } + + # 3: parse the arguments + # + tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList + + if {$data(-title) eq ""} { + if {$type eq "open"} { + if {$data(-multiple) != 0} { + set data(-title) "[mc {Open Multiple Files}]" + } else { + set data(-title) [mc "Open"] + } + } else { + set data(-title) [mc "Save As"] + } + } + + # 4: set the default directory and selection according to the -initial + # settings + # + if {$data(-initialdir) ne ""} { + 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 + } + set data(selectFile) $data(-initialfile) + + # 5. Parse the -filetypes option. It is not used by the motif + # file dialog, but we check for validity of the value to make sure + # the application code also runs fine with the TK file dialog. + # + set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)] + + if {![info exists data(filter)]} { + set data(filter) * + } + if {![winfo exists $data(-parent)]} { + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" + } +} + +# ::tk::MotifFDialog_BuildUI -- +# +# Builds the UI components of the Motif file dialog. +# +# Arguments: +# w Pathname of the dialog to build. +# +# Results: +# None. + +proc ::tk::MotifFDialog_BuildUI {w} { + set dataName [lindex [split $w .] end] + upvar ::tk::dialog::file::$dataName data + + # Create the dialog toplevel and internal frames. + # + toplevel $w -class TkMotifFDialog + set top [ttk::frame $w.top -relief raised -borderwidth 1] + set bot [ttk::frame $w.bot -relief raised -borderwidth 1] + + pack $w.bot -side bottom -fill x + pack $w.top -side top -expand yes -fill both + + set f1 [ttk::frame $top.f1] + set f2 [ttk::frame $top.f2] + set f3 [ttk::frame $top.f3] + + pack $f1 -side top -fill x + pack $f3 -side bottom -fill x + pack $f2 -expand yes -fill both + + set f2a [ttk::frame $f2.a] + set f2b [ttk::frame $f2.b] + + grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \ + -sticky news + grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \ + -sticky news + grid rowconfigure $f2 0 -minsize 0 -weight 1 + grid columnconfigure $f2 0 -minsize 0 -weight 1 + grid columnconfigure $f2 1 -minsize 150 -weight 2 + + # The Filter box + # + bind [::tk::AmpWidget ttk::label $f1.lab -text [mc "Fil&ter:"] -anchor w] \ + <<AltUnderlined>> [list focus $f1.ent] + ttk::entry $f1.ent + pack $f1.lab -side top -fill x -padx 6 -pady 4 + pack $f1.ent -side top -fill x -padx 4 -pady 0 + set data(fEnt) $f1.ent + + # The file and directory lists + # + set data(dList) [MotifFDialog_MakeSList $w $f2a \ + [mc "&Directory:"] DList] + set data(fList) [MotifFDialog_MakeSList $w $f2b \ + [mc "Fi&les:"] FList] + + # The Selection box + # + bind [::tk::AmpWidget ttk::label $f3.lab -text [mc "&Selection:"] -anchor w] \ + <<AltUnderlined>> [list focus $f3.ent] + ttk::entry $f3.ent + pack $f3.lab -side top -fill x -padx 6 -pady 0 + pack $f3.ent -side top -fill x -padx 4 -pady 4 + set data(sEnt) $f3.ent + + # The buttons + # + set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel] + set maxWidth [expr {$maxWidth<6?6:$maxWidth}] + set data(okBtn) [::tk::AmpWidget ttk::button $bot.ok -text [mc "&OK"] \ + -width $maxWidth \ + -command [list tk::MotifFDialog_OkCmd $w]] + set data(filterBtn) [::tk::AmpWidget ttk::button $bot.filter -text [mc "&Filter"] \ + -width $maxWidth \ + -command [list tk::MotifFDialog_FilterCmd $w]] + set data(cancelBtn) [::tk::AmpWidget ttk::button $bot.cancel -text [mc "&Cancel"] \ + -width $maxWidth \ + -command [list tk::MotifFDialog_CancelCmd $w]] + + pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \ + -side left + + # Create the bindings: + # + bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A] + + bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w] + bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w] + bind $w <Escape> [list tk::MotifFDialog_CancelCmd $w] + bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) {}} + + wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w] +} + +proc ::tk::MotifFDialog_SetListMode {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + if {$data(-multiple) != 0} { + set selectmode extended + } else { + set selectmode browse + } + set f $w.top.f2.b + $f.l configure -selectmode $selectmode +} + +# ::tk::MotifFDialog_MakeSList -- +# +# Create a scrolled-listbox and set the keyboard accelerator +# bindings so that the list selection follows what the user +# types. +# +# Arguments: +# w Pathname of the dialog box. +# f Frame widget inside which to create the scrolled +# listbox. This frame widget already exists. +# label The string to display on top of the listbox. +# under Sets the -under option of the label. +# cmdPrefix Specifies procedures to call when the listbox is +# browsed or activated. + +proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} { + bind [::tk::AmpWidget ttk::label $f.lab -text $label -anchor w] \ + <<AltUnderlined>> [list focus $f.l] + listbox $f.l -width 12 -height 5 -exportselection 0\ + -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set] + ttk::scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview] + ttk::scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview] + grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \ + -padx 2 -pady 2 + grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news + grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news + grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news + + grid rowconfigure $f 0 -weight 0 -minsize 0 + grid rowconfigure $f 1 -weight 1 -minsize 0 + grid columnconfigure $f 0 -weight 1 -minsize 0 + + # bindings for the listboxes + # + set list $f.l + bind $list <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w] + bind $list <Double-ButtonRelease-1> \ + [list tk::MotifFDialog_Activate$cmdPrefix $w] + bind $list <Return> "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \ + tk::MotifFDialog_Activate$cmdPrefix [list $w]" + + bindtags $list [list Listbox $list [winfo toplevel $list] all] + ListBoxKeyAccel_Set $list + + return $f.l +} + +# ::tk::MotifFDialog_InterpFilter -- +# +# Interpret the string in the filter entry into two components: +# the directory and the pattern. If the string is a relative +# pathname, give a warning to the user and restore the pattern +# to original. +# +# Arguments: +# w pathname of the dialog box. +# +# Results: +# A list of two elements. The first element is the directory +# specified # by the filter. The second element is the filter +# pattern itself. + +proc ::tk::MotifFDialog_InterpFilter {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + set text [string trim [$data(fEnt) get]] + + # Perform tilde substitution + # + set badTilde 0 + if {[string index $text 0] eq "~"} { + set list [file split $text] + set tilde [lindex $list 0] + if {[catch {set tilde [glob $tilde]}]} { + set badTilde 1 + } else { + set text [eval file join [concat $tilde [lrange $list 1 end]]] + } + } + + # If the string is a relative pathname, combine it + # with the current selectPath. + + set relative 0 + if {[file pathtype $text] eq "relative"} { + set relative 1 + } elseif {$badTilde} { + set relative 1 + } + + if {$relative} { + tk_messageBox -icon warning -type ok \ + -message "\"$text\" must be an absolute pathname" + + $data(fEnt) delete 0 end + $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ + $data(filter)] + + return [list $data(selectPath) $data(filter)] + } + + set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]] + + if {[file isdirectory $resolved]} { + set dir $resolved + set fil $data(filter) + } else { + set dir [file dirname $resolved] + set fil [file tail $resolved] + } + + return [list $dir $fil] +} + +# ::tk::MotifFDialog_Update +# +# Load the files and synchronize the "filter" and "selection" fields +# boxes. +# +# Arguments: +# w pathname of the dialog box. +# +# Results: +# None. + +proc ::tk::MotifFDialog_Update {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + $data(fEnt) delete 0 end + $data(fEnt) insert 0 \ + [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)] + $data(sEnt) delete 0 end + $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ + $data(selectFile)] + + MotifFDialog_LoadFiles $w +} + +# ::tk::MotifFDialog_LoadFiles -- +# +# Loads the files and directories into the two listboxes according +# to the filter setting. +# +# Arguments: +# w pathname of the dialog box. +# +# Results: +# None. + +proc ::tk::MotifFDialog_LoadFiles {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + $data(dList) delete 0 end + $data(fList) delete 0 end + + set appPWD [pwd] + if {[catch {cd $data(selectPath)}]} { + cd $appPWD + + $data(dList) insert end ".." + return + } + + # Make the dir and file lists + # + # For speed we only have one glob, which reduces the file system + # calls (good for slow NFS networks). + # + # We also do two smaller sorts (files + dirs) instead of one large sort, + # which gives a small speed increase. + # + set top 0 + set dlist "" + set flist "" + foreach f [glob -nocomplain .* *] { + if {[file isdir ./$f]} { + lappend dlist $f + } else { + foreach pat $data(filter) { + if {[string match $pat $f]} { + if {[string match .* $f]} { + incr top + } + lappend flist $f + break + } + } + } + } + eval [list $data(dList) insert end] [lsort -dictionary $dlist] + eval [list $data(fList) insert end] [lsort -dictionary $flist] + + # The user probably doesn't want to see the . files. We adjust the view + # so that the listbox displays all the non-dot files + $data(fList) yview $top + + cd $appPWD +} + +# ::tk::MotifFDialog_BrowseDList -- +# +# This procedure is called when the directory list is browsed +# (clicked-over) by the user. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + +proc ::tk::MotifFDialog_BrowseDList {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + focus $data(dList) + if {[$data(dList) curselection] eq ""} { + return + } + set subdir [$data(dList) get [$data(dList) curselection]] + if {$subdir eq ""} { + return + } + + $data(fList) selection clear 0 end + + set list [MotifFDialog_InterpFilter $w] + set data(filter) [lindex $list 1] + + switch -- $subdir { + . { + set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)] + } + .. { + set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \ + $data(filter)] + } + default { + set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \ + $data(selectPath) $subdir] $data(filter)] + } + } + + $data(fEnt) delete 0 end + $data(fEnt) insert 0 $newSpec +} + +# ::tk::MotifFDialog_ActivateDList -- +# +# This procedure is called when the directory list is activated +# (double-clicked) by the user. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + +proc ::tk::MotifFDialog_ActivateDList {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + if {[$data(dList) curselection] eq ""} { + return + } + set subdir [$data(dList) get [$data(dList) curselection]] + if {$subdir eq ""} { + return + } + + $data(fList) selection clear 0 end + + switch -- $subdir { + . { + set newDir $data(selectPath) + } + .. { + set newDir [file dirname $data(selectPath)] + } + default { + set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir] + } + } + + set data(selectPath) $newDir + MotifFDialog_Update $w + + if {$subdir ne ".."} { + $data(dList) selection set 0 + $data(dList) activate 0 + } else { + $data(dList) selection set 1 + $data(dList) activate 1 + } +} + +# ::tk::MotifFDialog_BrowseFList -- +# +# This procedure is called when the file list is browsed +# (clicked-over) by the user. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + +proc ::tk::MotifFDialog_BrowseFList {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + focus $data(fList) + set data(selectFile) "" + foreach item [$data(fList) curselection] { + lappend data(selectFile) [$data(fList) get $item] + } + if {[llength $data(selectFile)] == 0} { + return + } + + $data(dList) selection clear 0 end + + $data(fEnt) delete 0 end + $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ + $data(filter)] +# $data(fEnt) xview end + + # if it's a multiple selection box, just put in the filenames + # otherwise put in the full path as usual + $data(sEnt) delete 0 end + if {$data(-multiple) != 0} { + $data(sEnt) insert 0 $data(selectFile) + } else { + $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ + [lindex $data(selectFile) 0]] + } +# $data(sEnt) xview end +} + +# ::tk::MotifFDialog_ActivateFList -- +# +# This procedure is called when the file list is activated +# (double-clicked) by the user. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + +proc ::tk::MotifFDialog_ActivateFList {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + if {[$data(fList) curselection] eq ""} { + return + } + set data(selectFile) [$data(fList) get [$data(fList) curselection]] + if {$data(selectFile) eq ""} { + return + } else { + MotifFDialog_ActivateSEnt $w + } +} + +# ::tk::MotifFDialog_ActivateFEnt -- +# +# This procedure is called when the user presses Return inside +# the "filter" entry. It updates the dialog according to the +# text inside the filter entry. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + +proc ::tk::MotifFDialog_ActivateFEnt {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + set list [MotifFDialog_InterpFilter $w] + set data(selectPath) [lindex $list 0] + set data(filter) [lindex $list 1] + + MotifFDialog_Update $w +} + +# ::tk::MotifFDialog_ActivateSEnt -- +# +# This procedure is called when the user presses Return inside +# the "selection" entry. It sets the ::tk::Priv(selectFilePath) +# variable so that the vwait loop in tk::MotifFDialog will be +# terminated. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. + +proc ::tk::MotifFDialog_ActivateSEnt {w} { + variable ::tk::Priv + upvar ::tk::dialog::file::[winfo name $w] data + + set selectFilePath [string trim [$data(sEnt) get]] + + if {$selectFilePath eq ""} { + MotifFDialog_FilterCmd $w + return + } + + if {$data(-multiple) == 0} { + set selectFilePath [list $selectFilePath] + } + + if {[file isdirectory [lindex $selectFilePath 0]]} { + set data(selectPath) [lindex [glob $selectFilePath] 0] + set data(selectFile) "" + MotifFDialog_Update $w + return + } + + set newFileList "" + foreach item $selectFilePath { + if {[file pathtype $item] ne "absolute"} { + set item [file join $data(selectPath) $item] + } elseif {![file exists [file dirname $item]]} { + tk_messageBox -icon warning -type ok \ + -message [mc {Directory "%1$s" does not exist.} \ + [file dirname $item]] + return + } + + # we want to strip any filtering/ext/blocking instructions + # from the file name + + set aa [string first "\[" $item] + if {$aa > 0} { + set fn [string range $item 0 [expr $aa-1]] + } else { + set fn $item + } + + if {![file exists $fn]} { + if {$data(type) eq "open"} { + tk_messageBox -icon warning -type ok \ + -message [mc {File "%1$s" does not exist.} $fn] + return + } + } elseif {$data(type) eq "save" && $data(-confirmoverwrite)} { + set message [format %s%s \ + [mc "File \"%1\$s\" already exists.\n\n" $selectFilePath] \ + [mc {Replace existing file?}]] + set answer [tk_messageBox -icon warning -type yesno \ + -message $message] + if {$answer eq "no"} { + return + } + } + + lappend newFileList $item + } + + # Return selected filter + if {[info exists data(-typevariable)] && $data(-typevariable) ne "" + && [info exists data(-filetypes)] && $data(-filetypes) ne ""} { + upvar #0 $data(-typevariable) typeVariable + set typeVariable [lindex $data(-filetypes) $data(fileType) 0] + } + + if {$data(-multiple) != 0} { + set Priv(selectFilePath) $newFileList + } else { + set Priv(selectFilePath) [lindex $newFileList 0] + } + + # Set selectFile and selectPath to first item in list + set Priv(selectFile) [file tail [lindex $newFileList 0]] + set Priv(selectPath) [file dirname [lindex $newFileList 0]] +} + + +proc ::tk::MotifFDialog_OkCmd {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + MotifFDialog_ActivateSEnt $w +} + +proc ::tk::MotifFDialog_FilterCmd {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + MotifFDialog_ActivateFEnt $w +} + +proc ::tk::MotifFDialog_CancelCmd {w} { + variable ::tk::Priv + + set Priv(selectFilePath) "" + set Priv(selectFile) "" + set Priv(selectPath) "" +} + +proc ::tk::ListBoxKeyAccel_Set {w} { + bind Listbox <Any-KeyPress> "" + bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w] + bind $w <Any-KeyPress> [list tk::ListBoxKeyAccel_Key $w %A] +} + +proc ::tk::ListBoxKeyAccel_Unset {w} { + variable ::tk::Priv + + catch {after cancel $Priv(lbAccel,$w,afterId)} + unset -nocomplain Priv(lbAccel,$w) Priv(lbAccel,$w,afterId) +} + +# ::tk::ListBoxKeyAccel_Key-- +# +# This procedure maintains a list of recently entered keystrokes +# over a listbox widget. It arranges an idle event to move the +# selection of the listbox to the entry that begins with the +# keystrokes. +# +# Arguments: +# w The pathname of the listbox. +# key The key which the user just pressed. +# +# Results: +# None. + +proc ::tk::ListBoxKeyAccel_Key {w key} { + variable ::tk::Priv + + if { $key eq "" } { + return + } + append Priv(lbAccel,$w) $key + ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w) + catch { + after cancel $Priv(lbAccel,$w,afterId) + } + set Priv(lbAccel,$w,afterId) [after 500 \ + [list tk::ListBoxKeyAccel_Reset $w]] +} + +proc ::tk::ListBoxKeyAccel_Goto {w string} { + variable ::tk::Priv + + set string [string tolower $string] + set end [$w index end] + set theIndex -1 + + for {set i 0} {$i < $end} {incr i} { + set item [string tolower [$w get $i]] + if {[string compare $string $item] >= 0} { + set theIndex $i + } + if {[string compare $string $item] <= 0} { + set theIndex $i + break + } + } + + if {$theIndex >= 0} { + $w selection clear 0 end + $w selection set $theIndex $theIndex + $w activate $theIndex + $w see $theIndex + event generate $w <<ListboxSelect>> + } +} + +proc ::tk::ListBoxKeyAccel_Reset {w} { + variable ::tk::Priv + + unset -nocomplain Priv(lbAccel,$w) +} + +proc ::tk_getFileType {} { + variable ::tk::Priv + + return $Priv(selectFileType) +} + |