# Implements the "Motif" style file selection dialog for the
# Unix platform. This implementation is used only if the
# "::tk_strictMotif" flag is set.
# RCS: @(#) $Id: xmfbox.tcl,v 1.25.2.1 2004/10/27 16:37:59 dgp 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 {}
# Implements a file dialog similar to the standard Motif file
# args Options parsed by the procedure.
# When -multiple is set to 0, this returns the absolute pathname
# of the selected file. (NOTE: This is not the same as a single
# 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
} {
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
# ::tk::MotifFDialog_Create --
# Creates the Motif file dialog (if it doesn't exist yet) and
# initialize the internal data structure associated with the
# 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
# dataName Name of the global "data" array for the file dialog.
# argList Options parsed by the procedure.
# Pathname of the file dialog.
proc ::tk::MotifFDialog_Create {dataName type argList
} {
upvar ::tk::dialog::file::$dataName data
MotifFDialog_Config
$dataName $type $argList
if {[string equal
$data(-parent) .
]} {
set w
$data(-parent).
$dataName
# (re)create the dialog box if necessary
if {![winfo exists
$w]} {
} elseif
{[string compare
[winfo class
$w] TkMotifFDialog
]} {
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
# 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.
wm title
$w $data(-title)
# ::tk::MotifFDialog_FileTypes --
# Checks the -filetypes option. If present this adds a list of radio-
# buttons to pick the file types from.
# w Pathname of the tk_get*File dialogue.
proc ::tk::MotifFDialog_FileTypes {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
# No file types: use "*" as the filter and display no radio-buttons
if {$data(-filetypes) == ""} {
# The filetypes radiobuttons
# set data(fileType) $data(-defaulttype)
MotifFDialog_SetFilter
$w [lindex $data(-filetypes) $data(fileType
)]
#don't produce radiobuttons for only one filetype
if {[llength $data(-filetypes)] == 1} {
if {$data(-filetypes) != {}} {
foreach type
$data(-filetypes) {
set title
[lindex [lindex $type 0] 0]
set filter
[lindex $type 1]
-variable ::tk::dialog::file::[winfo name
$w](fileType
) \
-command "[list tk::MotifFDialog_SetFilter $w $type]"
$f.b
$data(fileType
) invoke
pack $f -side bottom
-fill both
# This proc gets called whenever data(filter) is set
proc ::tk::MotifFDialog_SetFilter {w type
} {
upvar ::tk::dialog::file::[winfo name
$w] data
set data
(filter
) [lindex $type 1]
set Priv
(selectFileType
) [lindex [lindex $type 0] 0]
# ::tk::MotifFDialog_Config --
# Iterates over the optional arguments to determine the option
# values for the Motif file dialog; gives default values to
# dataName The name of the global variable in which
# data for the file dialog is stored.
# argList Options parsed by the procedure.
proc ::tk::MotifFDialog_Config {dataName type argList
} {
upvar ::tk::dialog::file::$dataName data
# 1: the configuration specs
{-defaultextension "" "" ""}
if { [string equal
$type "open"] } {
lappend specs
{-multiple "" "" "0"}
# 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]
tclParseConfigSpec
::tk::dialog::file::$dataName $specs "" $argList
if {[string equal
$data(-title) ""]} {
if {[string equal
$type "open"]} {
if {$data(-multiple) != 0} {
set data
(-title) "[mc {Open Multiple Files}]"
set data
(-title) [mc
"Open"]
set data
(-title) [mc
"Save As"]
# 4: set the default directory and selection according to the -initial
if {[string compare
$data(-initialdir) ""]} {
if {[file isdirectory
$data(-initialdir)]} {
set data
(selectPath
) [lindex [glob $data(-initialdir)] 0]
set data
(selectPath
) [pwd]
# Convert the initialdir to an absolute path name.
set data
(selectPath
) [pwd]
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
)]} {
if {![winfo exists
$data(-parent)]} {
error "bad window path name \"$data(-parent)\""
# ::tk::MotifFDialog_BuildUI --
# Builds the UI components of the Motif file dialog.
# w Pathname of the dialog to build.
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
[frame $w.top
-relief raised
-bd 1]
set bot
[frame $w.bot
-relief raised
-bd 1]
pack $w.bot
-side bottom
-fill x
pack $w.top
-side top
-expand yes
-fill both
pack $f1 -side top
-fill x
pack $f3 -side bottom
-fill x
pack $f2 -expand yes
-fill both
grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
grid rowconfig
$f2 0 -minsize 0 -weight 1
grid columnconfig
$f2 0 -minsize 0 -weight 1
grid columnconfig
$f2 1 -minsize 150 -weight 2
bind [::tk::AmpWidget label $f1.lab
-text [mc
"Fil&ter:"] -anchor w
] \
<<AltUnderlined
>> [list focus $f1.ent
]
pack $f1.lab
-side top
-fill x
-padx 6 -pady 4
pack $f1.ent
-side top
-fill x
-padx 4 -pady 0
# The file and directory lists
set data
(dList
) [MotifFDialog_MakeSList
$w $f2a \
[mc
"&Directory:"] DList
]
set data
(fList
) [MotifFDialog_MakeSList
$w $f2b \
bind [::tk::AmpWidget label $f3.lab
-text [mc
"&Selection:"] -anchor w
] \
<<AltUnderlined
>> [list focus $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 maxWidth
[::tk::mcmaxamp &OK
&Filter
&Cancel
]
set maxWidth
[expr {$maxWidth<6?
6:$maxWidth}]
set data
(okBtn
) [::tk::AmpWidget button $bot.ok
-text [mc
"&OK"] \
-command [list tk::MotifFDialog_OkCmd $w]]
set data
(filterBtn
) [::tk::AmpWidget button $bot.filter
-text [mc
"&Filter"] \
-command [list tk::MotifFDialog_FilterCmd $w]]
set data
(cancelBtn
) [::tk::AmpWidget button $bot.cancel
-text [mc
"&Cancel"] \
-command [list tk::MotifFDialog_CancelCmd $w]]
pack $bot.ok
$bot.filter
$bot.cancel
-padx 10 -pady 10 -expand yes
\
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} {
$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
# 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
proc ::tk::MotifFDialog_MakeSList {w f
label cmdPrefix
} {
bind [::tk::AmpWidget 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]
scrollbar $f.v
-orient vertical
-takefocus 0 -command [list $f.l yview
]
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 \
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 rowconfig
$f 0 -weight 0 -minsize 0
grid rowconfig
$f 1 -weight 1 -minsize 0
grid columnconfig
$f 0 -weight 1 -minsize 0
# bindings for the listboxes
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
# ::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
# w pathname of the dialog box.
# A list of two elements. The first element is the directory
# specified # by the filter. The second element is the filter
proc ::tk::MotifFDialog_InterpFilter {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
set text [string trim
[$data(fEnt
) get
]]
# Perform tilde substitution
if {[string equal
[string index
$text 0] ~
]} {
set list [file split $text]
set tilde
[lindex $list 0]
if {[catch {set tilde
[glob $tilde]}]} {
set text [eval file join [concat $tilde [lrange $list 1 end
]]]
# If the string is a relative pathname, combine it
# with the current selectPath.
if {[string equal
[file pathtype
$text] "relative"]} {
tk_messageBox -icon warning
-type ok
\
-message "\"$text\" must be an absolute pathname"
$data(fEnt
) insert
0 [::tk::dialog::file::JoinFile $data(selectPath
) \
return [list $data(selectPath
) $data(filter
)]
set resolved
[::tk::dialog::file::JoinFile [file dirname
$text] [file tail
$text]]
if {[file isdirectory
$resolved]} {
set dir
[file dirname
$resolved]
set fil
[file tail
$resolved]
# ::tk::MotifFDialog_Update
# Load the files and synchronize the "filter" and "selection" fields
# w pathname of the dialog box.
proc ::tk::MotifFDialog_Update {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
[::tk::dialog::file::JoinFile $data(selectPath
) $data(filter
)]
$data(sEnt
) insert
0 [::tk::dialog::file::JoinFile $data(selectPath
) \
MotifFDialog_LoadFiles
$w
# ::tk::MotifFDialog_LoadFiles --
# Loads the files and directories into the two listboxes according
# w pathname of the dialog box.
proc ::tk::MotifFDialog_LoadFiles {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
$data(dList
) delete
0 end
$data(fList
) delete
0 end
if {[catch {cd $data(selectPath
)}]} {
$data(dList
) insert end
".."
# 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.
foreach f
[glob -nocomplain .
* *] {
foreach pat
$data(filter
) {
if {[string match
$pat $f]} {
if {[string match .
* $f]} {
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
# ::tk::MotifFDialog_BrowseDList --
# This procedure is called when the directory list is browsed
# (clicked-over) by the user.
# w The pathname of the dialog box.
proc ::tk::MotifFDialog_BrowseDList {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
if {[string equal
[$data(dList
) curselection
] ""]} {
set subdir
[$data(dList
) get
[$data(dList
) curselection
]]
if {[string equal
$subdir ""]} {
$data(fList
) selection clear
0 end
set list [MotifFDialog_InterpFilter
$w]
set data
(filter
) [lindex $list 1]
set newSpec
[::tk::dialog::file::JoinFile $data(selectPath
) $data(filter
)]
set newSpec
[::tk::dialog::file::JoinFile [file dirname
$data(selectPath
)] \
set newSpec
[::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
$data(selectPath
) $subdir] $data(filter
)]
$data(fEnt
) insert
0 $newSpec
# ::tk::MotifFDialog_ActivateDList --
# This procedure is called when the directory list is activated
# (double-clicked) by the user.
# w The pathname of the dialog box.
proc ::tk::MotifFDialog_ActivateDList {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
if {[string equal
[$data(dList
) curselection
] ""]} {
set subdir
[$data(dList
) get
[$data(dList
) curselection
]]
if {[string equal
$subdir ""]} {
$data(fList
) selection clear
0 end
set newDir
$data(selectPath
)
set newDir
[file dirname
$data(selectPath
)]
set newDir
[::tk::dialog::file::JoinFile $data(selectPath
) $subdir]
set data
(selectPath
) $newDir
if {[string compare
$subdir ..
]} {
$data(dList
) selection set 0
$data(dList
) selection set 1
# ::tk::MotifFDialog_BrowseFList --
# This procedure is called when the file list is browsed
# (clicked-over) by the user.
# w The pathname of the dialog box.
proc ::tk::MotifFDialog_BrowseFList {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
foreach item
[$data(fList
) curselection
] {
lappend data
(selectFile
) [$data(fList
) get
$item]
if {[llength $data(selectFile
)] == 0} {
$data(dList
) selection clear
0 end
$data(fEnt
) insert
0 [::tk::dialog::file::JoinFile $data(selectPath
) \
# if it's a multiple selection box, just put in the filenames
# otherwise put in the full path as usual
if {$data(-multiple) != 0} {
$data(sEnt
) insert
0 $data(selectFile
)
$data(sEnt
) insert
0 [::tk::dialog::file::JoinFile $data(selectPath
) \
[lindex $data(selectFile
) 0]]
# ::tk::MotifFDialog_ActivateFList --
# This procedure is called when the file list is activated
# (double-clicked) by the user.
# w The pathname of the dialog box.
proc ::tk::MotifFDialog_ActivateFList {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
if {[string equal
[$data(fList
) curselection
] ""]} {
set data
(selectFile
) [$data(fList
) get
[$data(fList
) curselection
]]
if {[string equal
$data(selectFile
) ""]} {
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.
# w The pathname of the dialog box.
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]
# ::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
# w The pathname of the dialog box.
proc ::tk::MotifFDialog_ActivateSEnt {w
} {
upvar ::tk::dialog::file::[winfo name
$w] data
set selectFilePath
[string trim
[$data(sEnt
) get
]]
if {[string equal
$selectFilePath ""]} {
MotifFDialog_FilterCmd
$w
if {$data(-multiple) == 0} {
set selectFilePath
[list $selectFilePath]
if {[file isdirectory
[lindex $selectFilePath 0]]} {
set data
(selectPath
) [lindex [glob $selectFilePath] 0]
foreach item
$selectFilePath {
if {[string compare
[file pathtype
$item] "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.
} \
if {![file exists
$item]} {
if {[string equal
$data(type
) open]} {
tk_messageBox -icon warning
-type ok
\
-message [mc
{File
"%1$s" does not exist.
} $item]
if {[string equal
$data(type
) save
]} {
set message [format %s
%s
\
[mc
"File \"%1\$s\" already exists.\n\n" \
[mc
{Replace existing
file?
}]]
set answer
[tk_messageBox -icon warning
-type yesno
\
if {[string equal
$answer "no"]} {
lappend newFileList
$item
if {$data(-multiple) != 0} {
set Priv
(selectFilePath
) $newFileList
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
} {
set Priv
(selectFilePath
) ""
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
} {
catch {after cancel
$Priv(lbAccel
,$w,afterId
)}
catch {unset Priv
(lbAccel
,$w)}
catch {unset 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
# w The pathname of the listbox.
# key The key which the user just pressed.
proc ::tk::ListBoxKeyAccel_Key {w key
} {
append Priv
(lbAccel
,$w) $key
ListBoxKeyAccel_Goto
$w $Priv(lbAccel
,$w)
after cancel
$Priv(lbAccel
,$w,afterId
)
set Priv
(lbAccel
,$w,afterId
) [after 500 \
[list tk::ListBoxKeyAccel_Reset $w]]
proc ::tk::ListBoxKeyAccel_Goto {w
string} {
set string [string tolower
$string]
for {set i
0} {$i < $end} {incr i
} {
set item
[string tolower
[$w get
$i]]
if {[string compare
$string $item] >= 0} {
if {[string compare
$string $item] <= 0} {
$w selection set $theIndex $theIndex
event generate
$w <<ListboxSelect
>>
proc ::tk::ListBoxKeyAccel_Reset {w
} {
catch {unset Priv
(lbAccel
,$w)}
proc ::tk_getFileType {} {
return $Priv(selectFileType
)