diff options
Diffstat (limited to 'library/xmfbox.tcl')
| -rw-r--r-- | library/xmfbox.tcl | 537 |
1 files changed, 368 insertions, 169 deletions
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 15ff0ac..2080c97 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -4,53 +4,105 @@ # Unix platform. This implementation is used only if the # "tk_strictMotif" flag is set. # -# RCS: @(#) $Id: xmfbox.tcl,v 1.6 1998/11/12 06:22:05 welch Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.7 1999/04/16 01:51:27 stanton Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# - # tkMotifFDialog -- # # Implements a file dialog similar to the standard Motif file # selection box. # -# Return value: +# Arguments: +# type "open" or "save" +# args Options parsed by the procedure. # +# Results: # A list of two members. The first member is the absolute # pathname of the selected file or "" if user hits cancel. The # second member is the name of the selected file type, or "" # which stands for "default file type" -# -proc tkMotifFDialog {args} { + +proc tkMotifFDialog {type args} { global tkPriv - set w __tk_filedialog - upvar #0 $w data + set dataName __tk_filedialog + upvar #0 $dataName data - if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} { - set type open - } else { - set type save + set w [tkMotifFDialog_Create $dataName $type $args] + + # Set a grab and claim the focus too. + + set oldFocus [focus] + set oldGrab [grab current $w] + if {$oldGrab != ""} { + set grabStatus [grab status $oldGrab] } + grab $w + focus $data(sEnt) + $data(sEnt) select from 0 + $data(sEnt) select to 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. - tkMotifFDialog_Config $w $type $args + tkwait variable tkPriv(selectFilePath) + catch {focus $oldFocus} + grab release $w + wm withdraw $w + if {$oldGrab != ""} { + if {$grabStatus == "global"} { + grab -global $oldGrab + } else { + grab $oldGrab + } + } + return $tkPriv(selectFilePath) +} + +# tkMotifFDialog_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 tkMotifFDialog 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 tkMotifFDialog_Create {dataName type argList} { + global tkPriv + upvar #0 $dataName data + + tkMotifFDialog_Config $dataName $type $argList if {![string compare $data(-parent) .]} { - set w .$w + set w .$dataName } else { - set w $data(-parent).$w + set w $data(-parent).$dataName } # (re)create the dialog box if necessary # if {![winfo exists $w]} { - tkMotifFDialog_Create $w + tkMotifFDialog_BuildUI $w } elseif {[string compare [winfo class $w] TkMotifFDialog]} { destroy $w - tkMotifFDialog_Create $w + tkMotifFDialog_BuildUI $w } else { set data(fEnt) $w.top.f1.ent set data(dList) $w.top.f2.a.l @@ -60,58 +112,42 @@ proc tkMotifFDialog {args} { set data(filterBtn) $w.bot.filter set data(cancelBtn) $w.bot.cancel } + wm transient $w $data(-parent) tkMotifFDialog_Update $w - # 5. Withdraw the window, then update all the geometry information + # 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. wm withdraw $w update idletasks - set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \ - - [winfo vrootx [winfo parent $w]]}] - set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \ - - [winfo vrooty [winfo parent $w]]}] + set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \ + - [winfo vrootx [winfo parent $w]]] + set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \ + - [winfo vrooty [winfo parent $w]]] wm geom $w +$x+$y wm deiconify $w wm title $w $data(-title) - # 6. Set a grab and claim the focus too. - - set oldFocus [focus] - set oldGrab [grab current $w] - if {$oldGrab != ""} { - set grabStatus [grab status $oldGrab] - } - grab $w - focus $data(sEnt) - $data(sEnt) select from 0 - $data(sEnt) select to end - - # 7. 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) - catch {focus $oldFocus} - grab release $w - wm withdraw $w - if {$oldGrab != ""} { - if {$grabStatus == "global"} { - grab -global $oldGrab - } else { - grab $oldGrab - } - } - return $tkPriv(selectFilePath) + return $w } -proc tkMotifFDialog_Config {w type argList} { - upvar #0 $w data +# tkMotifFDialog_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 tkMotifFDialog_Config {dataName type argList} { + upvar #0 $dataName data set data(type) $type @@ -136,7 +172,7 @@ proc tkMotifFDialog_Config {w type argList} { # 3: parse the arguments # - tclParseConfigSpec $w $specs "" $argList + tclParseConfigSpec $dataName $specs "" $argList if {![string compare $data(-title) ""]} { if {![string compare $type "open"]} { @@ -179,11 +215,21 @@ proc tkMotifFDialog_Config {w type argList} { } } -proc tkMotifFDialog_Create {w} { +# tkMotifFDialog_BuildUI -- +# +# Builds the UI components of the Motif file dialog. +# +# Arguments: +# w Pathname of the dialog to build. +# +# Results: +# None. + +proc tkMotifFDialog_BuildUI {w} { set dataName [lindex [split $w .] end] upvar #0 $dataName data - # 1: Create the dialog ... + # Create the dialog toplevel and internal frames. # toplevel $w -class TkMotifFDialog set top [frame $w.top -relief raised -bd 1] @@ -261,7 +307,22 @@ proc tkMotifFDialog_Create {w} { wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w" } -proc tkMotifFDialog_MakeSList {w f label under cmd} { +# tkMotifFDialog_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 tkMotifFDialog_MakeSList {w f label under cmdPrefix} { label $f.lab -text $label -under $under -anchor w listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\ -xscrollcommand "$f.h set" \ @@ -283,13 +344,14 @@ proc tkMotifFDialog_MakeSList {w f label under cmd} { # bindings for the listboxes # set list $f.l - bind $list <Up> "tkMotifFDialog_Browse$cmd $w" - bind $list <Down> "tkMotifFDialog_Browse$cmd $w" - bind $list <space> "tkMotifFDialog_Browse$cmd $w" - bind $list <1> "tkMotifFDialog_Browse$cmd $w" - bind $list <B1-Motion> "tkMotifFDialog_Browse$cmd $w" - bind $list <Double-1> "tkMotifFDialog_Activate$cmd $w" - bind $list <Return> "tkMotifFDialog_Browse$cmd $w; tkMotifFDialog_Activate$cmd $w" + bind $list <Up> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <Down> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <space> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <1> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <B1-Motion> "tkMotifFDialog_Browse$cmdPrefix $w" + bind $list <Double-ButtonRelease-1> "tkMotifFDialog_Activate$cmdPrefix $w" + bind $list <Return> "tkMotifFDialog_Browse$cmdPrefix $w; \ + tkMotifFDialog_Activate$cmdPrefix $w" bindtags $list "Listbox $list [winfo toplevel $list] all" tkListBoxKeyAccel_Set $list @@ -297,6 +359,168 @@ proc tkMotifFDialog_MakeSList {w f label under cmd} { return $f.l } +# tkMotifFDialog_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 tkMotifFDialog_InterpFilter {w} { + upvar #0 [winfo name $w] data + + set text [string trim [$data(fEnt) get]] + + # Perform tilde substitution + # + set badTilde 0 + if {[string compare [string index $text 0] ~] == 0} { + 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] == "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 [tkFDialog_JoinFile $data(selectPath) \ + $data(filter)] + + return [list $data(selectPath) $data(filter)] + } + + set resolved [tkFDialog_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] +} + +# tkMotifFDialog_Update +# +# Load the files and synchronize the "filter" and "selection" fields +# boxes. +# +# Arguments: +# w pathname of the dialog box. +# +# Results: +# None. + +proc tkMotifFDialog_Update {w} { + upvar #0 [winfo name $w] data + + $data(fEnt) delete 0 end + $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)] + $data(sEnt) delete 0 end + $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \ + $data(selectFile)] + + tkMotifFDialog_LoadFiles $w +} + +# tkMotifFDialog_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 tkMotifFDialog_LoadFiles {w} { + upvar #0 [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 list + # + foreach f [lsort -dictionary [glob -nocomplain .* *]] { + if [file isdir ./$f] { + $data(dList) insert end $f + } + } + # Make the file list + # + if ![string compare $data(filter) *] { + set files [lsort -dictionary [glob -nocomplain .* *]] + } else { + set files [lsort -dictionary \ + [glob -nocomplain $data(filter)]] + } + + set top 0 + foreach f $files { + if ![file isdir ./$f] { + regsub {^[.]/} $f "" f + $data(fList) insert end $f + if [string match .* $f] { + incr top + } + } + } + + # 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 +} + +# tkMotifFDialog_BrowseFList -- +# +# 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 tkMotifFDialog_BrowseDList {w} { upvar #0 [winfo name $w] data @@ -316,14 +540,15 @@ proc tkMotifFDialog_BrowseDList {w} { switch -- $subdir { . { - set newSpec [file join $data(selectPath) $data(filter)] + set newSpec [tkFDialog_JoinFile $data(selectPath) $data(filter)] } .. { - set newSpec [file join [file dirname $data(selectPath)] \ + set newSpec [tkFDialog_JoinFile [file dirname $data(selectPath)] \ $data(filter)] } default { - set newSpec [file join $data(selectPath) $subdir $data(filter)] + set newSpec [tkFDialog_JoinFile [tkFDialog_JoinFile \ + $data(selectPath) $subdir] $data(filter)] } } @@ -331,6 +556,17 @@ proc tkMotifFDialog_BrowseDList {w} { $data(fEnt) insert 0 $newSpec } +# tkMotifFDialog_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 tkMotifFDialog_ActivateDList {w} { upvar #0 [winfo name $w] data @@ -352,7 +588,7 @@ proc tkMotifFDialog_ActivateDList {w} { set newDir [file dirname $data(selectPath)] } default { - set newDir [file join $data(selectPath) $subdir] + set newDir [tkFDialog_JoinFile $data(selectPath) $subdir] } } @@ -368,6 +604,17 @@ proc tkMotifFDialog_ActivateDList {w} { } } +# tkMotifFDialog_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 tkMotifFDialog_BrowseFList {w} { upvar #0 [winfo name $w] data @@ -383,14 +630,26 @@ proc tkMotifFDialog_BrowseFList {w} { $data(dList) selection clear 0 end $data(fEnt) delete 0 end - $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)] + $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)] $data(fEnt) xview end $data(sEnt) delete 0 end - $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)] + $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \ + $data(selectFile)] $data(sEnt) xview end } +# tkMotifFDialog_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 tkMotifFDialog_ActivateFList {w} { upvar #0 [winfo name $w] data @@ -405,6 +664,18 @@ proc tkMotifFDialog_ActivateFList {w} { } } +# tkMotifFDialog_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 tkMotifFDialog_ActivateFEnt {w} { upvar #0 [winfo name $w] data @@ -415,34 +686,18 @@ proc tkMotifFDialog_ActivateFEnt {w} { tkMotifFDialog_Update $w } -proc tkMotifFDialog_InterpFilter {w} { - upvar #0 [winfo name $w] data - - set text [string trim [$data(fEnt) get]] - # Perform tilde substitution - # - if {![string compare [string index $text 0] ~]} { - set list [file split $text] - set tilde [lindex $list 0] - catch { - set tilde [glob $tilde] - } - set text [eval file join [concat $tilde [lrange $list 1 end]]] - } - - set resolved [file join [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] -} - +# tkMotifFDialog_ActivateSEnt -- +# +# This procedure is called when the user presses Return inside +# the "selection" entry. It sets the tkPriv(selectFilePath) global +# variable so that the vwait loop in tkMotifFDialog will be +# terminated. +# +# Arguments: +# w The pathname of the dialog box. +# +# Results: +# None. proc tkMotifFDialog_ActivateSEnt {w} { global tkPriv @@ -452,7 +707,6 @@ proc tkMotifFDialog_ActivateSEnt {w} { set selectFile [file tail $selectFilePath] set selectPath [file dirname $selectFilePath] - if {![string compare $selectFilePath ""]} { tkMotifFDialog_FilterCmd $w return @@ -522,75 +776,6 @@ proc tkMotifFDialog_CancelCmd {w} { set tkPriv(selectPath) "" } -# tkMotifFDialog_Update -# -# Load the files and synchronize the "filter" and "selection" fields -# boxes. -# -# popup: -# If this is true, then update the selection field according to the -# "-selection" flag -# -proc tkMotifFDialog_Update {w} { - upvar #0 [winfo name $w] data - - $data(fEnt) delete 0 end - $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)] - $data(sEnt) delete 0 end - $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)] - - tkMotifFDialog_LoadFiles $w -} - -proc tkMotifFDialog_LoadFiles {w} { - upvar #0 [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 list - # - foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] { - if {[file isdirectory $f]} { - $data(dList) insert end $f - } - } - # Make the file list - # - if {![string compare $data(filter) *]} { - set files [lsort -command tclSortNoCase [glob -nocomplain .* *]] - } else { - set files [lsort -command tclSortNoCase \ - [glob -nocomplain $data(filter)]] - } - - set top 0 - foreach f $files { - if {![file isdir $f]} { - $data(fList) insert end $f - if {[string match .* $f]} { - incr top - } - } - } - - # 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 -} - proc tkListBoxKeyAccel_Set {w} { bind Listbox <Any-KeyPress> "" bind $w <Destroy> "tkListBoxKeyAccel_Unset $w" @@ -605,6 +790,20 @@ proc tkListBoxKeyAccel_Unset {w} { catch {unset tkPriv(lbAccel,$w,afterId)} } +# tkListBoxKeyAccel_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 tkListBoxKeyAccel_Key {w key} { global tkPriv |