diff options
| -rw-r--r-- | ChangeLog | 24 | ||||
| -rw-r--r-- | doc/getOpenFile.n | 6 | ||||
| -rw-r--r-- | library/choosedir.tcl | 17 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 546 | ||||
| -rw-r--r-- | library/xmfbox.tcl | 256 |
5 files changed, 621 insertions, 228 deletions
@@ -1,3 +1,24 @@ +2000-06-22 Eric Melski <ericm@ajubasolutions.com> + + * doc/getOpenFile.n: Updated with information about -multiple. + + * library/choosedir.tcl: Tweaked to handle modified tkIconList API's. + + * library/tkfbox.tcl: Preliminary implementation of multiple + selection; based on patch from [RFE: 604]. Some of the tkIconList + functions changed to support this and to make the dialog faster. + + * library/xmfbox.tcl: Added support for multiple selection, from + patch in [RFE: 4999]. + +2000-06-21 Eric Melski <ericm@scriptics.com> + + * library/text.tcl: Corrected behavior of text widget with respect + to this sequence of events: click, shift-click. Previously, the + shift-click just moved the cursor and anchor; now, the shift-click + will select the text between the click and the shift-click, which + is the behavior most users expect. [Bug: 5929]. + 2000-06-19 Eric Melski <ericm@scriptics.com> * library/bgerror.tcl: Added auto-truncation for long error @@ -6,7 +27,8 @@ 2000-06-15 Eric Melski <ericm@scriptics.com> - * win/tkWinDialog.c: Patched to support tk_getOpenFile -multiple. + * win/tkWinDialog.c: Patched to support tk_getOpenFile + -multiple. [RFE: 604]. 2000-06-13 Eric Melski <ericm@scriptics.com> diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n index 7cfe783..bd6795f 100644 --- a/doc/getOpenFile.n +++ b/doc/getOpenFile.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: getOpenFile.n,v 1.6 2000/04/23 03:47:13 jingham Exp $ +'\" RCS: @(#) $Id: getOpenFile.n,v 1.7 2000/06/23 00:22:28 ericm Exp $ '\" .so man.macros .TH tk_getOpenFile n 4.2 Tk "Tk Built-In Commands" @@ -72,8 +72,8 @@ option is ignored on the Macintosh platform. .TP \fB\-multiple\fR Allows the user to choose multiple files from the Open dialog. -This is only available on the Macintosh, and only when Navigation -Services are installed. +On the Macintosh, this is only available when Navigation Services are +installed. .TP \fB\-message\fR Specifies a message to include in the client area of the dialog. diff --git a/library/choosedir.tcl b/library/choosedir.tcl index acd6683..bae35af 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -5,7 +5,7 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: choosedir.tcl,v 1.7 2000/04/19 23:12:56 hobbs Exp $ +# RCS: @(#) $Id: choosedir.tcl,v 1.8 2000/06/23 00:22:28 ericm Exp $ # Make sure the tk::dialog namespace, in which all dialogs should live, exists namespace eval ::tk::dialog {} @@ -138,6 +138,11 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { set data(-title) "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 # @@ -177,8 +182,9 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # 4b. If the value is different from the current directory, change to # that directory. - set iconText [tkIconList_Get $data(icons)] - if { ![string equal $iconText ""] } { + set selection [tkIconList_Curselection $data(icons)] + if { [llength $selection] != 0 } { + set iconText [tkIconList_Get $data(icons) [lindex $selection 0]] set iconText [file join $data(selectPath) $iconText] ::tk::dialog::file::chooseDir::Done $w $iconText } else { @@ -214,8 +220,9 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { proc ::tk::dialog::file::chooseDir::DblClick {w} { upvar ::tk::dialog::file::[winfo name $w] data - set text [tkIconList_Get $data(icons)] - if {[string compare $text ""]} { + set selection [tkIconList_Curselection $data(icons)] + if { [llength $selection] != 0 } { + set text [tkIconList_Get $data(icons) [lindex $selection 0]] set file $data(selectPath) if {[file isdirectory $file]} { ::tk::dialog::file::ListInvoke $w $text diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 3bd59d6..9987abe 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -11,7 +11,7 @@ # files by clicking on the file icons or by entering a filename # in the "Filename:" entry. # -# RCS: @(#) $Id: tkfbox.tcl,v 1.19 2000/04/19 23:12:56 hobbs Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.20 2000/06/23 00:22:28 ericm Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -39,6 +39,150 @@ proc tkIconList {w args} { tkIconList_Create $w } +proc tkIconList_Index {w i} { + upvar #0 $w data + upvar #0 $w:itemList itemList + switch -regexp -- $i { + "^[0-9]+$" { + return $i + } + "^active$" { + return $data(index,active) + } + "^anchor$" { + return $data(index,anchor) + } + "^end$" { + return [llength $data(list)] + } + "@-?[0-9]+,-?[0-9]+" { + foreach {x y} [scan $i "@%d,%d"] { + break + } + set item [$data(canvas) find closest $x $y] + return [lindex [$data(canvas) itemcget $item -tags] 1] + } + } +} + +proc tkIconList_Selection {w op args} { + upvar #0 $w data + switch -exact -- $op { + "anchor" { + if { [llength $args] == 1 } { + set data(index,anchor) [lindex $args 0] + } else { + return $data(index,anchor) + } + } + "clear" { + if { [llength $args] == 2 } { + foreach {first last} $args { + break + } + } elseif { [llength $args] == 1 } { + set first [set last [lindex $args 0]] + } else { + error "wrong # args: should be tkIconList_Selection path\ + clear first ?last?" + } + set first [tkIconList_Index $w $first] + set last [tkIconList_Index $w $last] + if { $first > $last } { + set tmp $first + set first $last + set last $tmp + } + set ind 0 + foreach item $data(selection) { + if { $item >= $first } { + set first $ind + break + } + } + set ind [expr {[llength $data(selection)] - 1}] + for {} {$ind >= 0} {incr ind -1} { + set item [lindex $data(selection) $ind] + if { $item <= $last } { + set last $ind + break + } + } + + if { $first > $last } { + return + } + set data(selection) [lreplace $data(selection) $first $last] + event generate $w <<ListboxSelect>> + tkIconList_DrawSelection $w + } + "includes" { + set index [lsearch -exact $data(selection) [lindex $args 0]] + return [expr {$index != -1}] + } + "set" { + if { [llength $args] == 2 } { + foreach {first last} $args { + break + } + } elseif { [llength $args] == 1 } { + set last [set first [lindex $args 0]] + } else { + error "wrong # args: should be tkIconList_Selection path\ + set first ?last?" + } + + set first [tkIconList_Index $w $first] + set last [tkIconList_Index $w $last] + if { $first > $last } { + set tmp $first + set first $last + set last $tmp + } + for {set i $first} {$i <= $last} {incr i} { + lappend data(selection) $i + } + set data(selection) [lsort -integer -unique $data(selection)] + event generate $w <<ListboxSelect>> + tkIconList_DrawSelection $w + } + } +} + +proc tkIconList_Curselection {w} { + upvar #0 $w data + return $data(selection) +} + +proc tkIconList_DrawSelection {w} { + upvar #0 $w data + upvar #0 $w:itemList itemList + + $data(canvas) delete selection + foreach item $data(selection) { + set rTag [lindex [lindex $data(list) $item] 2] + foreach {iTag tTag text serial} $itemList($rTag) { + break + } + + set bbox [$data(canvas) bbox $tTag] + $data(canvas) create rect $bbox -fill \#a0a0ff -outline \#a0a0ff \ + -tags selection + } + $data(canvas) lower selection + return +} + +proc tkIconList_Get {w item} { + upvar #0 $w data + upvar #0 $w:itemList itemList + set rTag [lindex [lindex $data(list) $item] 2] + foreach {iTag tTag text serial} $itemList($rTag) { + break + } + return $text +} + # tkIconList_Config -- # # Configure the widget variables of IconList, according to the command @@ -50,8 +194,8 @@ proc tkIconList_Config {w argList} { # 1: the configuration specs # set specs { - {-browsecmd "" "" ""} {-command "" "" ""} + {-multiple "" "" "0"} } # 2: parse the arguments @@ -88,6 +232,8 @@ proc tkIconList_Create {w} { set data(numItems) 0 set data(curItem) {} set data(noScroll) 1 + set data(selection) {} + set data(index,anchor) "" # Creates the event bindings. # @@ -96,6 +242,8 @@ proc tkIconList_Create {w} { bind $data(canvas) <1> [list tkIconList_Btn1 $w %x %y] bind $data(canvas) <B1-Motion> [list tkIconList_Motion1 $w %x %y] bind $data(canvas) <B1-Leave> [list tkIconList_Leave1 $w %x %y] + bind $data(canvas) <Control-1> [list tkIconList_CtrlBtn1 $w %x %y] + bind $data(canvas) <Shift-1> [list tkIconList_ShiftBtn1 $w %x %y] bind $data(canvas) <B1-Enter> [list tkCancelRepeat] bind $data(canvas) <ButtonRelease-1> [list tkCancelRepeat] bind $data(canvas) <Double-ButtonRelease-1> \ @@ -111,6 +259,7 @@ proc tkIconList_Create {w} { bind $data(canvas) <Alt-KeyPress> ";" bind $data(canvas) <FocusIn> [list tkIconList_FocusIn $w] + bind $data(canvas) <FocusOut> [list tkIconList_FocusOut $w] return $w } @@ -172,46 +321,57 @@ proc tkIconList_DeleteAll {w} { set data(numItems) 0 set data(curItem) {} set data(noScroll) 1 + set data(selection) {} + set data(index,anchor) "" $data(sbar) set 0.0 1.0 $data(canvas) xview moveto 0 } # Adds an icon into the IconList with the designated image and text # -proc tkIconList_Add {w image text} { +proc tkIconList_Add {w image items} { upvar #0 $w data upvar #0 $w:itemList itemList upvar #0 $w:textList textList - set iTag [$data(canvas) create image 0 0 -image $image -anchor nw] - set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \ - -font $data(font)] - set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline ""] + foreach text $items { + set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \ + -tags [list icon $data(numItems)]] + set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \ + -font $data(font) -tags [list text $data(numItems)]] + set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline "" \ + -tags [list rect $data(numItems)]] + + foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] { + break + } + set iW [expr {$x2 - $x1}] + set iH [expr {$y2 - $y1}] + if {$data(maxIW) < $iW} { + set data(maxIW) $iW + } + if {$data(maxIH) < $iH} { + set data(maxIH) $iH + } - set b [$data(canvas) bbox $iTag] - set iW [expr {[lindex $b 2]-[lindex $b 0]}] - set iH [expr {[lindex $b 3]-[lindex $b 1]}] - if {$data(maxIW) < $iW} { - set data(maxIW) $iW - } - if {$data(maxIH) < $iH} { - set data(maxIH) $iH - } + foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] { + break + } + set tW [expr {$x2 - $x1}] + set tH [expr {$y2 - $y1}] + if {$data(maxTW) < $tW} { + set data(maxTW) $tW + } + if {$data(maxTH) < $tH} { + set data(maxTH) $tH + } - set b [$data(canvas) bbox $tTag] - set tW [expr {[lindex $b 2]-[lindex $b 0]}] - set tH [expr {[lindex $b 3]-[lindex $b 1]}] - if {$data(maxTW) < $tW} { - set data(maxTW) $tW + lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \ + $tH $data(numItems)] + set itemList($rTag) [list $iTag $tTag $text $data(numItems)] + set textList($data(numItems)) [string tolower $text] + incr data(numItems) } - if {$data(maxTH) < $tH} { - set data(maxTH) $tH - } - - lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)] - set itemList($rTag) [list $iTag $tTag $text $data(numItems)] - set textList($data(numItems)) [string tolower $text] - incr data(numItems) } # Places the icons in a column-major arrangement. @@ -252,20 +412,15 @@ proc tkIconList_Arrange {w} { set usedColumn 0 foreach sublist $data(list) { set usedColumn 1 - set iTag [lindex $sublist 0] - set tTag [lindex $sublist 1] - set rTag [lindex $sublist 2] - set iW [lindex $sublist 3] - set iH [lindex $sublist 4] - set tW [lindex $sublist 5] - set tH [lindex $sublist 6] + foreach {iTag tTag rTag iW iH tW tH} $sublist { + break + } set i_dy [expr {($dy - $iH)/2}] set t_dy [expr {($dy - $tH)/2}] $data(canvas) coords $iTag $x [expr {$y + $i_dy}] $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] - $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}] incr y $dy @@ -309,7 +464,7 @@ proc tkIconList_Arrange {w} { proc tkIconList_Invoke {w} { upvar #0 $w data - if {$data(-command) != "" && [info exists data(selected)]} { + if {$data(-command) != "" && [llength $data(selection)]} { uplevel #0 $data(-command) } } @@ -367,88 +522,70 @@ proc tkIconList_See {w rTag} { } } -proc tkIconList_SelectAtXY {w x y} { - upvar #0 $w data - - tkIconList_Select $w [$data(canvas) find closest \ - [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]] -} - -proc tkIconList_Select {w rTag {callBrowse 1}} { +proc tkIconList_Btn1 {w x y} { upvar #0 $w data - upvar #0 $w:itemList itemList - - if {![info exists itemList($rTag)]} { - return - } - set iTag [lindex $itemList($rTag) 0] - set tTag [lindex $itemList($rTag) 1] - set text [lindex $itemList($rTag) 2] - set serial [lindex $itemList($rTag) 3] - - if {![info exists data(rect)]} { - set data(rect) [$data(canvas) create rect 0 0 0 0 \ - -fill #a0a0ff -outline #a0a0ff] - } - $data(canvas) lower $data(rect) - set bbox [$data(canvas) bbox $tTag] - eval [list $data(canvas) coords $data(rect)] $bbox - - set data(curItem) $serial - set data(selected) $text - if {$callBrowse && $data(-browsecmd) != ""} { - eval $data(-browsecmd) [list $text] - } + focus $data(canvas) + set x [expr {int([$data(canvas) canvasx $x])}] + set y [expr {int([$data(canvas) canvasy $y])}] + set i [tkIconList_Index $w @${x},${y}] + tkIconList_Selection $w clear 0 end + tkIconList_Selection $w set $i + tkIconList_Selection $w anchor $i } -proc tkIconList_Unselect {w} { +proc tkIconList_CtrlBtn1 {w x y} { upvar #0 $w data - - if {[info exists data(rect)]} { - $data(canvas) delete $data(rect) - unset data(rect) - } - if {[info exists data(selected)]} { - unset data(selected) + + if { $data(-multiple) } { + focus $data(canvas) + set x [expr {int([$data(canvas) canvasx $x])}] + set y [expr {int([$data(canvas) canvasy $y])}] + set i [tkIconList_Index $w @${x},${y}] + if { [tkIconList_Selection $w includes $i] } { + tkIconList_Selection $w clear $i + } else { + tkIconList_Selection $w set $i + tkIconList_Selection $w anchor $i + } } - #set data(curItem) {} } -# Returns the selected item -# -proc tkIconList_Get {w} { +proc tkIconList_ShiftBtn1 {w x y} { upvar #0 $w data - - if {[info exists data(selected)]} { - return $data(selected) - } else { - return "" + + if { $data(-multiple) } { + focus $data(canvas) + set x [expr {int([$data(canvas) canvasx $x])}] + set y [expr {int([$data(canvas) canvasy $y])}] + set i [tkIconList_Index $w @${x},${y}] + set a [tkIconList_Index $w anchor] + if { [string equal $a ""] } { + set a $i + } + tkIconList_Selection $w clear 0 end + tkIconList_Selection $w set $a $i } } - -proc tkIconList_Btn1 {w x y} { - upvar #0 $w data - - focus $data(canvas) - tkIconList_SelectAtXY $w $x $y -} - # Gets called on button-1 motions # proc tkIconList_Motion1 {w x y} { + upvar #0 $w data global tkPriv set tkPriv(x) $x set tkPriv(y) $y - - tkIconList_SelectAtXY $w $x $y + set x [expr {int([$data(canvas) canvasx $x])}] + set y [expr {int([$data(canvas) canvasy $y])}] + set i [tkIconList_Index $w @${x},${y}] + tkIconList_Selection $w clear 0 end + tkIconList_Selection $w set $i } proc tkIconList_Double1 {w x y} { upvar #0 $w data - if {[string compare $data(curItem) {}]} { + if {[llength $data(selection)]} { tkIconList_Invoke $w } } @@ -472,11 +609,15 @@ proc tkIconList_FocusIn {w} { return } - if {[string compare $data(curItem) {}]} { - tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 1 + if {[llength $data(selection)]} { + tkIconList_DrawSelection $w } } +proc tkIconList_FocusOut {w} { + tkIconList_Selection $w clear 0 end +} + # tkIconList_UpDown -- # # Moves the active element up or down by one element @@ -665,6 +806,7 @@ proc ::tk::dialog::file::tkFDialog {type args} { set data(typeMenu) $data(typeMenuBtn).m set data(okBtn) $w.f2.ok set data(cancelBtn) $w.f3.cancel + ::tk::dialog::file::SetSelectMode $w $data(-multiple) } wm transient $w $data(-parent) @@ -759,6 +901,12 @@ proc ::tk::dialog::file::Config {dataName type argList} { {-title "" "" ""} } + # The "-multiple" option is only available for the "open" file dialog. + # + if { [string equal $type "open"] } { + lappend specs {-multiple "" "" "0"} + } + # 2: default values depending on the type of the dialog # if {![info exists data(selectPath)]} { @@ -802,6 +950,18 @@ proc ::tk::dialog::file::Config {dataName type argList} { if {![winfo exists $data(-parent)]} { error "bad window path name \"$data(-parent)\"" } + + # Set -multiple to a one or zero value (not other boolean types + # like "yes") so we can use it in tests more easily. + if {![string compare $type save]} { + set data(-multiple) 0 + } else { + if {$data(-multiple)} { + set data(-multiple) 1 + } else { + set data(-multiple) 0 + } + } } proc ::tk::dialog::file::Create {w class} { @@ -841,7 +1001,11 @@ static char updir_bits[] = { # data(icons): the IconList that list the files and directories. # if { [string equal $class TkFDialog] } { - set fNameCaption "File name:" + if { $data(-multiple) } { + set fNameCaption "File names:" + } else { + set fNameCaption "File name:" + } set fNameUnder 5 set iconListCommand [list ::tk::dialog::file::OkCmd $w] } else { @@ -850,8 +1014,10 @@ static char updir_bits[] = { set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w] } set data(icons) [tkIconList $w.icons \ - -browsecmd [list ::tk::dialog::file::ListBrowse $w] \ - -command $iconListCommand] + -command $iconListCommand \ + -multiple $data(-multiple)] + bind $data(icons) <<ListboxSelect>> \ + [list ::tk::dialog::file::ListBrowse $w] # f2: the frame with the OK button and the "file name" field # @@ -959,6 +1125,33 @@ static char updir_bits[] = { tkFocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w] } +# ::tk::dialog::file::SetSelectMode -- +# +# Set the select mode of the dialog to single select or multi-select. +# +# Arguments: +# w The dialog path. +# multi 1 if the dialog is multi-select; 0 otherwise. +# +# Results: +# None. + +proc ::tk::dialog::file::SetSelectMode {w multi} { + set dataName __tk_filedialog + upvar ::tk::dialog::file::$dataName data + if { $multi } { + set fNameCaption "File names:" + } else { + set fNameCaption "File name:" + } + set fNameUnder 5 + set iconListCommand [list ::tk::dialog::file::OkCmd $w] + $w.f2.lab configure -text $fNameCaption -under $fNameUnder + tkIconList_Config $data(icons) \ + [list -multiple $multi -command $iconListCommand] + return +} + # ::tk::dialog::file::UpdateWhenIdle -- # # Creates an idle event handler which updates the dialog in idle @@ -1039,7 +1232,9 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] # Make the dir list # - foreach f [lsort -dictionary [glob -nocomplain .* *]] { + set completeFileList [lsort -dictionary -unique [glob -nocomplain .* *]] + set dirList {} + foreach f $completeFileList { if {[string equal $f .]} { continue } @@ -1047,31 +1242,30 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] continue } if {[file isdir ./$f]} { - if {![info exists hasDoneDir($f)]} { - tkIconList_Add $data(icons) $folder $f - set hasDoneDir($f) 1 - } + lappend dirList $f } } + tkIconList_Add $data(icons) $folder $dirList if { [string equal $class TkFDialog] } { # Make the file list if this is a File Dialog # if {[string equal $data(filter) *]} { - set files [lsort -dictionary \ - [glob -nocomplain .* *]] + set files $completeFileList } else { - set files [lsort -dictionary \ - [eval glob -nocomplain $data(filter)]] + set files {} + foreach f $completeFileList { + if { [string match $data(filter) $f] } { + lappend files $f + } + } } - + set fileList {} foreach f $files { if {![file isdir ./$f]} { - if {![info exists hasDoneFile($f)]} { - tkIconList_Add $data(icons) $file $f - set hasDoneFile($f) 1 - } + lappend fileList $f } } + tkIconList_Add $data(icons) $file $fileList } tkIconList_Arrange $data(icons) @@ -1264,8 +1458,6 @@ proc ::tk::dialog::file::EntFocusIn {w} { $data(ent) selection clear } - tkIconList_Unselect $data(icons) - if { [string equal [winfo class $w] TkFDialog] } { # If this is a File Dialog, make sure the buttons are labeled right. if {[string equal $data(type) open]} { @@ -1287,13 +1479,28 @@ proc ::tk::dialog::file::EntFocusOut {w} { # proc ::tk::dialog::file::ActivateEnt {w} { upvar ::tk::dialog::file::[winfo name $w] data + + set text [$data(ent) get] + if {$data(-multiple)} { + set data(selectFile) "" + foreach fname $text { + ::tk::dialog::file::VerifyFileName $w $fname + } + } else { + ::tk::dialog::file::VerifyFileName $w $text + } +} - set text [string trim [$data(ent) get]] - set list [::tk::dialog::file::ResolveFile $data(selectPath) $text \ - $data(-defaultextension)] - set flag [lindex $list 0] - set path [lindex $list 1] - set file [lindex $list 2] +# Verification procedure +# +proc ::tk::dialog::file::VerifyFileName {w filename} { + upvar ::tk::dialog::file::[winfo name $w] data + + set list [::tk::dialog::file::ResolveFile $data(selectPath) $filename \ + $data(-defaultextension)] + foreach {flag path file} $list { + break + } switch -- $flag { OK { @@ -1303,7 +1510,11 @@ proc ::tk::dialog::file::ActivateEnt {w} { $data(ent) delete 0 end } else { ::tk::dialog::file::SetPathSilently $w $path - set data(selectFile) $file + if {$data(-multiple)} { + lappend data(selectFile) $file + } else { + set data(selectFile) $file + } ::tk::dialog::file::Done $w } } @@ -1319,7 +1530,11 @@ proc ::tk::dialog::file::ActivateEnt {w} { $data(ent) icursor end } else { ::tk::dialog::file::SetPathSilently $w $path - set data(selectFile) $file + if {$data(-multiple)} { + lappend data(selectFile) $file + } else { + set data(selectFile) $file + } ::tk::dialog::file::Done $w } } @@ -1377,15 +1592,18 @@ proc ::tk::dialog::file::JoinFile {path file} { } } - - # Gets called when user presses the "OK" button # proc ::tk::dialog::file::OkCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data - set text [tkIconList_Get $data(icons)] - if {[string compare $text ""]} { + set text {} + foreach item [tkIconList_Curselection $data(icons)] { + lappend text [tkIconList_Get $data(icons) $item] + } + + if {[llength $text] && !$data(-multiple)} { + set text [lindex $text 0] set file [::tk::dialog::file::JoinFile $data(selectPath) $text] if {[file isdirectory $file]} { ::tk::dialog::file::ListInvoke $w $text @@ -1408,15 +1626,32 @@ proc ::tk::dialog::file::CancelCmd {w} { # Gets called when user browses the IconList widget (dragging mouse, arrow # keys, etc) # -proc ::tk::dialog::file::ListBrowse {w text} { +proc ::tk::dialog::file::ListBrowse {w} { upvar ::tk::dialog::file::[winfo name $w] data - if {[string equal $text ""]} { + set text {} + foreach item [tkIconList_Curselection $data(icons)] { + lappend text [tkIconList_Get $data(icons) $item] + } + if {[llength $text] == 0} { return } - - set file [::tk::dialog::file::JoinFile $data(selectPath) $text] - if {![file isdirectory $file]} { + if { [llength $text] > 1 } { + set newtext {} + foreach file $text { + set fullfile [::tk::dialog::file::JoinFile $data(selectPath) $file] + if { ![file isdirectory $fullfile] } { + lappend newtext $file + } + } + set text $newtext + set isDir 0 + } else { + set text [lindex $text 0] + set file [::tk::dialog::file::JoinFile $data(selectPath) $text] + set isDir [file isdirectory $file] + } + if {!$isDir} { $data(ent) delete 0 end $data(ent) insert 0 $text @@ -1440,11 +1675,13 @@ proc ::tk::dialog::file::ListBrowse {w text} { proc ::tk::dialog::file::ListInvoke {w text} { upvar ::tk::dialog::file::[winfo name $w] data - if {[string equal $text ""]} { + if {[llength $text] == 0} { return } - set file [::tk::dialog::file::JoinFile $data(selectPath) $text] + set file [::tk::dialog::file::JoinFile $data(selectPath) \ + [lindex $text 0]] + set class [winfo class $w] if {[string equal $class TkChooseDir] || [file isdirectory $file]} { set appPWD [pwd] @@ -1457,7 +1694,11 @@ proc ::tk::dialog::file::ListInvoke {w text} { set data(selectPath) $file } } else { - set data(selectFile) $file + if {$data(-multiple)} { + set data(selectFile) $text + } else { + set data(selectFile) $file + } ::tk::dialog::file::Done $w } } @@ -1475,18 +1716,29 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { global tkPriv if {[string equal $selectFilePath ""]} { - set selectFilePath [::tk::dialog::file::JoinFile $data(selectPath) \ - $data(selectFile)] + if {$data(-multiple)} { + set selectFilePath {} + foreach f $data(selectFile) { + lappend selectFilePath [::tk::dialog::file::JoinFile \ + $data(selectPath) $f] + } + } else { + set selectFilePath [::tk::dialog::file::JoinFile \ + $data(selectPath) $data(selectFile)] + } + set tkPriv(selectFile) $data(selectFile) set tkPriv(selectPath) $data(selectPath) - if {[file exists $selectFilePath] && [string equal $data(type) save]} { - set reply [tk_messageBox -icon warning -type yesno\ - -parent $w -message "File\ - \"$selectFilePath\" already exists.\nDo\ - you want to overwrite it?"] - if {[string equal $reply "no"]} { - return + if {[string equal $data(type) save]} { + if {[file exists $selectFilePath]} { + set reply [tk_messageBox -icon warning -type yesno\ + -parent $w -message "File\ + \"$selectFilePath\" already exists.\nDo\ + you want to overwrite it?"] + if {[string equal $reply "no"]} { + return + } } } } diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index d202a02..3ed5000 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -4,7 +4,7 @@ # Unix platform. This implementation is used only if the # "tk_strictMotif" flag is set. # -# RCS: @(#) $Id: xmfbox.tcl,v 1.11 2000/03/24 19:38:57 ericm Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.12 2000/06/23 00:22:28 ericm Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Scriptics Corporation @@ -26,10 +26,14 @@ namespace eval ::tk::dialog::file {} # 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" +# 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 tkMotifFDialog {type args} { global tkPriv @@ -102,9 +106,11 @@ proc tkMotifFDialog_Create {dataName type argList} { set data(filterBtn) $w.bot.filter set data(cancelBtn) $w.bot.cancel } + tkMotifFDialog_SetListMode $w wm transient $w $data(-parent) + tkMotifFDialog_FileTypes $w tkMotifFDialog_Update $w # Withdraw the window, then update all the geometry information @@ -117,6 +123,74 @@ proc tkMotifFDialog_Create {dataName type argList} { return $w } +# tkMotifFDialog_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 tkMotifFDialog_FileTypes {w} { + upvar ::tk::dialog::file::[winfo name $w] data + + set f $w.top.f3.types + catch {destroy $f} + + # No file types: use "*" as the filter and display no radio-buttons + if {$data(-filetypes) == ""} { + set data(filter) * + return + } + + # The filetypes radiobuttons + # set data(fileType) $data(-defaulttype) + set data(fileType) 0 + + tkMotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)] + + #don't produce radiobuttons for only one filetype + if {[llength $data(-filetypes)] == 1} { + return + } + + frame $f + set cnt 0 + if {$data(-filetypes) != {}} { + foreach type $data(-filetypes) { + set title [lindex [lindex $type 0] 0] + set filter [lindex $type 1] + radiobutton $f.b$cnt \ + -text $title \ + -variable [winfo name $w](fileType) \ + -value $cnt \ + -command "[list tkMotifFDialog_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 tkMotifFDialog_SetFilter {w type} { + upvar ::tk::dialog::file::[winfo name $w] data + global tkpriv + + set data(filter) [lindex $type 1] + set tkpriv(selectFileType) [lindex [lindex $type 0] 0] + + tkMotifFDialog_Update $w +} + # tkMotifFDialog_Config -- # # Iterates over the optional arguments to determine the option @@ -143,6 +217,7 @@ proc tkMotifFDialog_Config {dataName type argList} { {-initialfile "" "" ""} {-parent "" "" "."} {-title "" "" ""} + {-multiple "" "" "0"} } # 2: default values depending on the type of the dialog @@ -159,7 +234,11 @@ proc tkMotifFDialog_Config {dataName type argList} { if {[string equal $data(-title) ""]} { if {[string equal $type "open"]} { - set data(-title) "Open" + if {$data(-multiple) != 0} { + set data(-title) "Open Multiple Files" + } else { + set data(-title) "Open" + } } else { set data(-title) "Save As" } @@ -170,7 +249,7 @@ proc tkMotifFDialog_Config {dataName type argList} { # if {[string compare $data(-initialdir) ""]} { if {[file isdirectory $data(-initialdir)]} { - set data(selectPath) [glob $data(-initialdir)] + set data(selectPath) [lindex [glob $data(-initialdir)] 0] } else { set data(selectPath) [pwd] } @@ -290,6 +369,18 @@ proc tkMotifFDialog_BuildUI {w} { wm protocol $w WM_DELETE_WINDOW [list tkMotifFDialog_CancelCmd $w] } +proc tkMotifFDialog_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 +} + # tkMotifFDialog_MakeSList -- # # Create a scrolled-listbox and set the keyboard accelerator @@ -307,7 +398,7 @@ proc tkMotifFDialog_BuildUI {w} { 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\ + 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] @@ -324,14 +415,10 @@ proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} { # bindings for the listboxes # set list $f.l - bind $list <Up> [list tkMotifFDialog_Browse$cmdPrefix $w] - bind $list <Down> [list tkMotifFDialog_Browse$cmdPrefix $w] - bind $list <space> [list tkMotifFDialog_Browse$cmdPrefix $w] - bind $list <1> [list tkMotifFDialog_Browse$cmdPrefix $w] - bind $list <B1-Motion> [list tkMotifFDialog_Browse$cmdPrefix $w] + bind $list <<ListboxSelect>> [list tkMotifFDialog_Browse$cmdPrefix $w] bind $list <Double-ButtonRelease-1> \ [list tkMotifFDialog_Activate$cmdPrefix $w] - bind $list <Return> "tkMotifFDialog_Browse$cmdPrefix [list $w]; \ + bind $list <Return> "tkMotifFDialog_Browse$cmdPrefix [list $w]; \ tkMotifFDialog_Activate$cmdPrefix [list $w]" bindtags $list [list Listbox $list [winfo toplevel $list] all] @@ -455,32 +542,31 @@ proc tkMotifFDialog_LoadFiles {w} { return } - # Make the dir list + # Make the dir and file lists # - foreach f [lsort -dictionary [glob -nocomplain .* *]] { - if {[file isdir ./$f]} { - $data(dList) insert end $f - } - } - # Make the file list + # 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. # - if {[string equal $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 + set dlist "" + set flist "" + foreach f [glob -nocomplain .* *] { + if {[file isdir ./$f]} { + lappend dlist $f + } else { + if {[string match $data(filter) $f]} { + if {[string match .* $f]} { + incr top + } + lappend flist $f } } } + eval $data(dList) insert end [lsort -dictionary $dlist] + eval $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 @@ -489,7 +575,7 @@ proc tkMotifFDialog_LoadFiles {w} { cd $appPWD } -# tkMotifFDialog_BrowseFList -- +# tkMotifFDialog_BrowseDList -- # # This procedure is called when the directory list is browsed # (clicked-over) by the user. @@ -598,23 +684,30 @@ proc tkMotifFDialog_BrowseFList {w} { upvar ::tk::dialog::file::[winfo name $w] data focus $data(fList) - if {[string equal [$data(fList) curselection] ""]} { - return + set data(selectFile) "" + foreach item [$data(fList) curselection] { + lappend data(selectFile) [$data(fList) get $item] } - set data(selectFile) [$data(fList) get [$data(fList) curselection]] - if {[string equal $data(selectFile) ""]} { + 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) 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 - $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ - $data(selectFile)] + 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 } @@ -683,55 +776,64 @@ proc tkMotifFDialog_ActivateSEnt {w} { upvar ::tk::dialog::file::[winfo name $w] data set selectFilePath [string trim [$data(sEnt) get]] - set selectFile [file tail $selectFilePath] - set selectPath [file dirname $selectFilePath] if {[string equal $selectFilePath ""]} { tkMotifFDialog_FilterCmd $w return } - if {[file isdirectory $selectFilePath]} { - set data(selectPath) [glob $selectFilePath] - set data(selectFile) "" - tkMotifFDialog_Update $w - return + if {$data(-multiple) == 0} { + set selectFilePath [list $selectFilePath] } - if {[string compare [file pathtype $selectFilePath] "absolute"]} { - tk_messageBox -icon warning -type ok \ - -message "\"$selectFilePath\" must be an absolute pathname" - return - } - - if {![file exists $selectPath]} { - tk_messageBox -icon warning -type ok \ - -message "Directory \"$selectPath\" does not exist." + if {[file isdirectory [lindex $selectFilePath 0]]} { + set data(selectPath) [lindex [glob $selectFilePath] 0] + set data(selectFile) "" + tkMotifFDialog_Update $w return } - if {![file exists $selectFilePath]} { - if {[string equal $data(type) open]} { + set newFileList "" + 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 "File \"$selectFilePath\" does not exist." + -message "Directory \"[file dirname $item]\" does not exist." return } - } else { - if {[string equal $data(type) save]} { - set message [format %s%s \ - "File \"$selectFilePath\" already exists.\n\n" \ - "Replace existing file?"] - set answer [tk_messageBox -icon warning -type yesno \ - -message $message] - if {[string equal $answer "no"]} { + + if {![file exists $item]} { + if {[string equal $data(type) open]} { + tk_messageBox -icon warning -type ok \ + -message "File \"$item\" does not exist." return } + } else { + if {[string equal $data(type) save]} { + set message [format %s%s \ + "File \"$item\" already exists.\n\n" \ + "Replace existing file?"] + set answer [tk_messageBox -icon warning -type yesno \ + -message $message] + if {[string equal $answer "no"]} { + return + } + } } + + lappend newFileList $item } - set tkPriv(selectFilePath) $selectFilePath - set tkPriv(selectFile) $selectFile - set tkPriv(selectPath) $selectPath + if {$data(-multiple) != 0} { + set tkPriv(selectFilePath) $newFileList + } else { + set tkPriv(selectFilePath) [lindex $newFileList 0] + } + + # Set selectFile and selectPath to first item in list + set tkPriv(selectFile) [file tail [lindex $newFileList 0]] + set tkPriv(selectPath) [file dirname [lindex $newFileList 0]] } @@ -786,6 +888,9 @@ proc tkListBoxKeyAccel_Unset {w} { proc tkListBoxKeyAccel_Key {w key} { global tkPriv + if { $key == "" } { + return + } append tkPriv(lbAccel,$w) $key tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w) catch { @@ -818,6 +923,7 @@ proc tkListBoxKeyAccel_Goto {w string} { $w selection set $theIndex $theIndex $w activate $theIndex $w see $theIndex + event generate $w <<ListboxSelect>> } } @@ -827,3 +933,9 @@ proc tkListBoxKeyAccel_Reset {w} { catch {unset tkPriv(lbAccel,$w)} } + +proc tk_getFileType {} { + global tkpriv + + return $tkpriv(selectFileType) +} |