summaryrefslogtreecommitdiffstats
path: root/library/tkfbox.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/tkfbox.tcl')
-rw-r--r--library/tkfbox.tcl1077
1 files changed, 171 insertions, 906 deletions
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index efde934..0e091ab 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -1,17 +1,16 @@
# tkfbox.tcl --
#
-# Implements the "TK" standard file selection dialog box. This
-# dialog box is used on the Unix platforms whenever the tk_strictMotif
-# flag is not set.
+# Implements the "TK" standard file selection dialog box. This dialog
+# box is used on the Unix platforms whenever the tk_strictMotif flag is
+# not set.
#
-# The "TK" standard file selection dialog box is similar to the
-# file selection dialog box on Win95(TM). The user can navigate
-# the directories by clicking on the folder icons or by
-# selecting the "Directory" option menu. The user can select
-# files by clicking on the file icons or by entering a filename
-# in the "Filename:" entry.
+# The "TK" standard file selection dialog box is similar to the file
+# selection dialog box on Win95(TM). The user can navigate the
+# directories by clicking on the folder icons or by selecting the
+# "Directory" option menu. The user can select files by clicking on the
+# file icons or by entering a filename in the "Filename:" entry.
#
-# RCS: @(#) $Id: tkfbox.tcl,v 1.68.2.5 2010/01/20 23:43:51 patthoyts Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.76 2010/01/19 01:27:41 patthoyts Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -19,794 +18,78 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-package require Ttk
-
-#----------------------------------------------------------------------
-#
-# I C O N L I S T
-#
-# This is a pseudo-widget that implements the icon list inside the
-# ::tk::dialog::file:: dialog box.
-#
-#----------------------------------------------------------------------
-
-# ::tk::IconList --
-#
-# Creates an IconList widget.
-#
-proc ::tk::IconList {w args} {
- IconList_Config $w $args
- IconList_Create $w
-}
-
-proc ::tk::IconList_Index {w i} {
- upvar #0 ::tk::$w data ::tk::$w:itemList itemList
- if {![info exists data(list)]} {
- set data(list) {}
- }
- switch -regexp -- $i {
- "^-?[0-9]+$" {
- if {$i < 0} {
- set i 0
- }
- if {$i >= [llength $data(list)]} {
- set i [expr {[llength $data(list)] - 1}]
- }
- 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 \
- [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
- return [lindex [$data(canvas) itemcget $item -tags] 1]
- }
- }
-}
-
-proc ::tk::IconList_Selection {w op args} {
- upvar ::tk::$w data
- switch -exact -- $op {
- "anchor" {
- if {[llength $args] == 1} {
- set data(index,anchor) [tk::IconList_Index $w [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 [lindex [info level 0] 0] path\
- clear first ?last?"
- }
- set first [IconList_Index $w $first]
- set last [IconList_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
- }
- incr ind
- }
- 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>>
- IconList_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 [lindex [info level 0] 0] path\
- set first ?last?"
- }
-
- set first [IconList_Index $w $first]
- set last [IconList_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>>
- IconList_DrawSelection $w
- }
- }
-}
-
-proc ::tk::IconList_CurSelection {w} {
- upvar ::tk::$w data
- return $data(selection)
-}
-
-proc ::tk::IconList_DrawSelection {w} {
- upvar ::tk::$w data
- upvar ::tk::$w:itemList itemList
-
- $data(canvas) delete selection
- $data(canvas) itemconfigure selectionText -fill black
- $data(canvas) dtag selectionText
- set cbg [ttk::style lookup TEntry -selectbackground focus]
- set cfg [ttk::style lookup TEntry -selectforeground focus]
- 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 $cbg -outline $cbg \
- -tags selection
- $data(canvas) itemconfigure $tTag -fill $cfg -tags selectionText
- }
- $data(canvas) lower selection
- return
-}
-
-proc ::tk::IconList_Get {w item} {
- upvar ::tk::$w data
- upvar ::tk::$w:itemList itemList
- set rTag [lindex [lindex $data(list) $item] 2]
- foreach {iTag tTag text serial} $itemList($rTag) {
- break
- }
- return $text
-}
-
-# ::tk::IconList_Config --
-#
-# Configure the widget variables of IconList, according to the command
-# line arguments.
-#
-proc ::tk::IconList_Config {w argList} {
-
- # 1: the configuration specs
- #
- set specs {
- {-command "" "" ""}
- {-multiple "" "" "0"}
- }
-
- # 2: parse the arguments
- #
- tclParseConfigSpec ::tk::$w $specs "" $argList
-}
-
-# ::tk::IconList_Create --
-#
-# Creates an IconList widget by assembling a canvas widget and a
-# scrollbar widget. Sets all the bindings necessary for the IconList's
-# operations.
-#
-proc ::tk::IconList_Create {w} {
- upvar ::tk::$w data
-
- ttk::frame $w
- ttk::entry $w.cHull -takefocus 0 -cursor {}
- set data(sbar) [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0]
- catch {$data(sbar) configure -highlightthickness 0}
- set data(canvas) [canvas $w.cHull.canvas -highlightthick 0 \
- -width 400 -height 120 -takefocus 1 -background white]
- pack $data(sbar) -side bottom -fill x -padx 2 -in $w.cHull -pady {0 2}
- pack $data(canvas) -expand yes -fill both -padx 2 -pady {2 0}
- pack $w.cHull -expand yes -fill both -ipadx 2 -ipady 2
-
- $data(sbar) configure -command [list $data(canvas) xview]
- $data(canvas) configure -xscrollcommand [list $data(sbar) set]
-
- # Initializes the max icon/text width and height and other variables
- #
- set data(maxIW) 1
- set data(maxIH) 1
- set data(maxTW) 1
- set data(maxTH) 1
- set data(numItems) 0
- set data(noScroll) 1
- set data(selection) {}
- set data(index,anchor) ""
- set fg [option get $data(canvas) foreground Foreground]
- if {$fg eq ""} {
- set data(fill) black
- } else {
- set data(fill) $fg
- }
-
- # Creates the event bindings.
- #
- bind $data(canvas) <Configure> [list tk::IconList_Arrange $w]
-
- bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y]
- bind $data(canvas) <B1-Motion> [list tk::IconList_Motion1 $w %x %y]
- bind $data(canvas) <B1-Leave> [list tk::IconList_Leave1 $w %x %y]
- bind $data(canvas) <Control-1> [list tk::IconList_CtrlBtn1 $w %x %y]
- bind $data(canvas) <Shift-1> [list tk::IconList_ShiftBtn1 $w %x %y]
- bind $data(canvas) <B1-Enter> [list tk::CancelRepeat]
- bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]
- bind $data(canvas) <Double-ButtonRelease-1> \
- [list tk::IconList_Double1 $w %x %y]
-
- bind $data(canvas) <Control-B1-Motion> {;}
- bind $data(canvas) <Shift-B1-Motion> \
- [list tk::IconList_ShiftMotion1 $w %x %y]
-
- bind $data(canvas) <Up> [list tk::IconList_UpDown $w -1]
- bind $data(canvas) <Down> [list tk::IconList_UpDown $w 1]
- bind $data(canvas) <Left> [list tk::IconList_LeftRight $w -1]
- bind $data(canvas) <Right> [list tk::IconList_LeftRight $w 1]
- bind $data(canvas) <Return> [list tk::IconList_ReturnKey $w]
- bind $data(canvas) <KeyPress> [list tk::IconList_KeyPress $w %A]
- bind $data(canvas) <Control-KeyPress> ";"
- bind $data(canvas) <Alt-KeyPress> ";"
-
- bind $data(canvas) <FocusIn> [list tk::IconList_FocusIn $w]
- bind $data(canvas) <FocusOut> [list tk::IconList_FocusOut $w]
-
- return $w
-}
-
-# ::tk::IconList_AutoScan --
-#
-# This procedure is invoked when the mouse leaves an entry window
-# with button 1 down. It scrolls the window up, down, left, or
-# right, depending on where the mouse left the window, and reschedules
-# itself as an "after" command so that the window continues to scroll until
-# the mouse moves back into the window or the mouse button is released.
-#
-# Arguments:
-# w - The IconList window.
-#
-proc ::tk::IconList_AutoScan {w} {
- upvar ::tk::$w data
- variable ::tk::Priv
-
- if {![winfo exists $w]} return
- set x $Priv(x)
- set y $Priv(y)
-
- if {$data(noScroll)} {
- return
- }
- if {$x >= [winfo width $data(canvas)]} {
- $data(canvas) xview scroll 1 units
- } elseif {$x < 0} {
- $data(canvas) xview scroll -1 units
- } elseif {$y >= [winfo height $data(canvas)]} {
- # do nothing
- } elseif {$y < 0} {
- # do nothing
- } else {
- return
- }
-
- IconList_Motion1 $w $x $y
- set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]
-}
-
-# Deletes all the items inside the canvas subwidget and reset the IconList's
-# state.
-#
-proc ::tk::IconList_DeleteAll {w} {
- upvar ::tk::$w data
- upvar ::tk::$w:itemList itemList
-
- $data(canvas) delete all
- unset -nocomplain data(selected) data(rect) data(list) itemList
- set data(maxIW) 1
- set data(maxIH) 1
- set data(maxTW) 1
- set data(maxTH) 1
- set data(numItems) 0
- 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 ::tk::IconList_Add {w image items} {
- upvar ::tk::$w data
- upvar ::tk::$w:itemList itemList
- upvar ::tk::$w:textList textList
-
- foreach text $items {
- set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \
- -tags [list icon $data(numItems) item$data(numItems)]]
- set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \
- -font $data(font) -fill $data(fill) \
- -tags [list text $data(numItems) item$data(numItems)]]
- set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline "" \
- -tags [list rect $data(numItems) item$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
- }
-
- 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
- }
-
- 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.
-#
-proc ::tk::IconList_Arrange {w} {
- upvar ::tk::$w data
-
- if {![info exists data(list)]} {
- if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
- set data(noScroll) 1
- $data(sbar) configure -command ""
- }
- return
- }
-
- set W [winfo width $data(canvas)]
- set H [winfo height $data(canvas)]
- set pad [expr {[$data(canvas) cget -highlightthickness] + \
- [$data(canvas) cget -bd]}]
- if {$pad < 2} {
- set pad 2
- }
-
- incr W -[expr {$pad*2}]
- incr H -[expr {$pad*2}]
-
- set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
- if {$data(maxTH) > $data(maxIH)} {
- set dy $data(maxTH)
- } else {
- set dy $data(maxIH)
- }
- incr dy 2
- set shift [expr {$data(maxIW) + 4}]
-
- set x [expr {$pad * 2}]
- set y [expr {$pad * 1}] ; # Why * 1 ?
- set usedColumn 0
- foreach sublist $data(list) {
- set usedColumn 1
- 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 $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
-
- incr y $dy
- if {($y + $dy) > $H} {
- set y [expr {$pad * 1}] ; # *1 ?
- incr x $dx
- set usedColumn 0
- }
- }
-
- if {$usedColumn} {
- set sW [expr {$x + $dx}]
- } else {
- set sW $x
- }
-
- if {$sW < $W} {
- $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
- $data(sbar) configure -command ""
- $data(canvas) xview moveto 0
- set data(noScroll) 1
- } else {
- $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
- $data(sbar) configure -command [list $data(canvas) xview]
- set data(noScroll) 0
- }
-
- set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
- if {$data(itemsPerColumn) < 1} {
- set data(itemsPerColumn) 1
- }
-
- IconList_DrawSelection $w
-}
-
-# Gets called when the user invokes the IconList (usually by double-clicking
-# or pressing the Return key).
-#
-proc ::tk::IconList_Invoke {w} {
- upvar ::tk::$w data
-
- if {$data(-command) ne "" && [llength $data(selection)]} {
- uplevel #0 $data(-command)
- }
-}
-
-# ::tk::IconList_See --
-#
-# If the item is not (completely) visible, scroll the canvas so that
-# it becomes visible.
-proc ::tk::IconList_See {w rTag} {
- upvar ::tk::$w data
- upvar ::tk::$w:itemList itemList
-
- if {$data(noScroll)} {
- return
- }
- set sRegion [$data(canvas) cget -scrollregion]
- if {$sRegion eq ""} {
- return
- }
-
- if { $rTag < 0 || $rTag >= [llength $data(list)] } {
- return
- }
-
- set bbox [$data(canvas) bbox item$rTag]
- set pad [expr {[$data(canvas) cget -highlightthickness] + \
- [$data(canvas) cget -bd]}]
-
- set x1 [lindex $bbox 0]
- set x2 [lindex $bbox 2]
- incr x1 -[expr {$pad * 2}]
- incr x2 -[expr {$pad * 1}] ; # *1 ?
-
- set cW [expr {[winfo width $data(canvas)] - $pad*2}]
-
- set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
- set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
- set oldDispX $dispX
-
- # check if out of the right edge
- #
- if {($x2 - $dispX) >= $cW} {
- set dispX [expr {$x2 - $cW}]
- }
- # check if out of the left edge
- #
- if {($x1 - $dispX) < 0} {
- set dispX $x1
- }
-
- if {$oldDispX ne $dispX} {
- set fraction [expr {double($dispX)/double($scrollW)}]
- $data(canvas) xview moveto $fraction
- }
-}
-
-proc ::tk::IconList_Btn1 {w x y} {
- upvar ::tk::$w data
-
- focus $data(canvas)
- set i [IconList_Index $w @$x,$y]
- if {$i eq ""} {
- return
- }
- IconList_Selection $w clear 0 end
- IconList_Selection $w set $i
- IconList_Selection $w anchor $i
-}
-
-proc ::tk::IconList_CtrlBtn1 {w x y} {
- upvar ::tk::$w data
-
- if { $data(-multiple) } {
- focus $data(canvas)
- set i [IconList_Index $w @$x,$y]
- if {$i eq ""} {
- return
- }
- if { [IconList_Selection $w includes $i] } {
- IconList_Selection $w clear $i
- } else {
- IconList_Selection $w set $i
- IconList_Selection $w anchor $i
- }
- }
-}
-
-proc ::tk::IconList_ShiftBtn1 {w x y} {
- upvar ::tk::$w data
-
- if { $data(-multiple) } {
- focus $data(canvas)
- set i [IconList_Index $w @$x,$y]
- if {$i eq ""} {
- return
- }
- if {[IconList_Index $w anchor] eq ""} {
- IconList_Selection $w anchor $i
- }
- IconList_Selection $w clear 0 end
- IconList_Selection $w set anchor $i
- }
-}
-
-# Gets called on button-1 motions
-#
-proc ::tk::IconList_Motion1 {w x y} {
- variable ::tk::Priv
- set Priv(x) $x
- set Priv(y) $y
- set i [IconList_Index $w @$x,$y]
- if {$i eq ""} {
- return
- }
- IconList_Selection $w clear 0 end
- IconList_Selection $w set $i
-}
-
-proc ::tk::IconList_ShiftMotion1 {w x y} {
- upvar ::tk::$w data
- variable ::tk::Priv
- set Priv(x) $x
- set Priv(y) $y
- set i [IconList_Index $w @$x,$y]
- if {$i eq ""} {
- return
- }
- IconList_Selection $w clear 0 end
- IconList_Selection $w set anchor $i
-}
-
-proc ::tk::IconList_Double1 {w x y} {
- upvar ::tk::$w data
-
- if {[llength $data(selection)]} {
- IconList_Invoke $w
- }
-}
-
-proc ::tk::IconList_ReturnKey {w} {
- IconList_Invoke $w
-}
-
-proc ::tk::IconList_Leave1 {w x y} {
- variable ::tk::Priv
-
- set Priv(x) $x
- set Priv(y) $y
- IconList_AutoScan $w
-}
-
-proc ::tk::IconList_FocusIn {w} {
- upvar ::tk::$w data
-
- $w.cHull state focus
- if {![info exists data(list)]} {
- return
- }
-
- if {[llength $data(selection)]} {
- IconList_DrawSelection $w
- }
-}
-
-proc ::tk::IconList_FocusOut {w} {
- $w.cHull state !focus
- IconList_Selection $w clear 0 end
-}
-
-# ::tk::IconList_UpDown --
-#
-# Moves the active element up or down by one element
-#
-# Arguments:
-# w - The IconList widget.
-# amount - +1 to move down one item, -1 to move back one item.
-#
-proc ::tk::IconList_UpDown {w amount} {
- upvar ::tk::$w data
-
- if {![info exists data(list)]} {
- return
- }
-
- set curr [tk::IconList_CurSelection $w]
- if { [llength $curr] == 0 } {
- set i 0
- } else {
- set i [tk::IconList_Index $w anchor]
- if {$i eq ""} {
- return
- }
- incr i $amount
- }
- IconList_Selection $w clear 0 end
- IconList_Selection $w set $i
- IconList_Selection $w anchor $i
- IconList_See $w $i
-}
-
-# ::tk::IconList_LeftRight --
-#
-# Moves the active element left or right by one column
-#
-# Arguments:
-# w - The IconList widget.
-# amount - +1 to move right one column, -1 to move left one column.
-#
-proc ::tk::IconList_LeftRight {w amount} {
- upvar ::tk::$w data
-
- if {![info exists data(list)]} {
- return
- }
-
- set curr [IconList_CurSelection $w]
- if { [llength $curr] == 0 } {
- set i 0
- } else {
- set i [IconList_Index $w anchor]
- if {$i eq ""} {
- return
- }
- incr i [expr {$amount*$data(itemsPerColumn)}]
- }
- IconList_Selection $w clear 0 end
- IconList_Selection $w set $i
- IconList_Selection $w anchor $i
- IconList_See $w $i
-}
-
-#----------------------------------------------------------------------
-# Accelerator key bindings
-#----------------------------------------------------------------------
-
-# ::tk::IconList_KeyPress --
-#
-# Gets called when user enters an arbitrary key in the listbox.
-#
-proc ::tk::IconList_KeyPress {w key} {
- variable ::tk::Priv
-
- append Priv(ILAccel,$w) $key
- IconList_Goto $w $Priv(ILAccel,$w)
- catch {
- after cancel $Priv(ILAccel,$w,afterId)
- }
- set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]
-}
-
-proc ::tk::IconList_Goto {w text} {
- upvar ::tk::$w data
- upvar ::tk::$w:textList textList
-
- if {![info exists data(list)]} {
- return
- }
-
- if {$text eq "" || $data(numItems) == 0} {
- return
- }
-
- if {[llength [IconList_CurSelection $w]]} {
- set start [IconList_Index $w anchor]
- } else {
- set start 0
- }
-
- set theIndex -1
- set less 0
- set len [string length $text]
- set len0 [expr {$len-1}]
- set i $start
-
- # Search forward until we find a filename whose prefix is a
- # case-insensitive match with $text
- while {1} {
- if {[string equal -nocase -length $len0 $textList($i) $text]} {
- set theIndex $i
- break
- }
- incr i
- if {$i == $data(numItems)} {
- set i 0
- }
- if {$i == $start} {
- break
- }
- }
-
- if {$theIndex > -1} {
- IconList_Selection $w clear 0 end
- IconList_Selection $w set $theIndex
- IconList_Selection $w anchor $theIndex
- IconList_See $w $theIndex
- }
-}
-
-proc ::tk::IconList_Reset {w} {
- variable ::tk::Priv
-
- unset -nocomplain Priv(ILAccel,$w)
-}
-
-#----------------------------------------------------------------------
-#
-# F I L E D I A L O G
-#
-#----------------------------------------------------------------------
-
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::file {
namespace import -force ::tk::msgcat::*
- set ::tk::dialog::file::showHiddenBtn 0
- set ::tk::dialog::file::showHiddenVar 1
+ variable showHiddenBtn 0
+ variable showHiddenVar 1
+
+ # Create the images if they did not already exist.
+ if {![info exists ::tk::Priv(updirImage)]} {
+ set ::tk::Priv(updirImage) [image create photo -data {
+ iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/gD+AP7rGN
+ SCAAAACXBIWXMAAA3WAAAN1gGQb3mcAAAACXZwQWcAAAAWAAAAFgDcxelYAAAENUlE
+ QVQ4y7WUbWiVZRjHf/f9POcc9+Kc5bC2aIq5sGG0XnTzNU13zAIlFMNc9CEhTCKwCC
+ JIgt7AglaR0RcrolAKg14+GBbiGL6xZiYyy63cmzvu7MVznnOe537rw7bDyvlBoT/c
+ n+6L3/3nf13XLZLJJP+HfICysjKvqqpq+rWKysvLR1tbW+11g+fPn/+bEGIe4KYqCs
+ Owu66u7oG2trah6wJrrRc0NTVhjME5h7Vj5pxzCCE4duxYZUdHx/aGhoZmgJ+yb+wF
+ uCO19RmAffv25f8LFslkktraWtvU1CS6u7vRWmOtxVpbAPu+T0tLS04pFU/J34Wd3S
+ cdFtlfZWeZBU4IcaS5uXn1ZLAEMMY4ay1aa4wx/zpKKYIgoL6+vmjxqoXe5ZLTcsPq
+ bTyycjODpe1y3WMrvDAMV14jCuW0VhhjiJQpOJ5w7Zwjk8/y9R+vsHHNNq6oFMrkeX
+ BxI+8d2sktap3YvOPD0lRQrH+Z81fE7t3WB4gihVKazsuaA20aKSUgAG/seQdy2l6W
+ 37+EyopqTv39I6HJUT2zlnlza2jLdgiTaxwmDov6alLHcZUTzXPGGAauWJbfO4dHl9
+ bgJs3HyfNf0N4ZsOa+jbT3/ownY/hO09p1kBULtjBw+Tvq7xzwauds4dWPDleAcP5E
+ xlprgtBRUZRgYCRPTzoHwEi2g6OnX+eFrW/RM9qBE4p43CeTz5ATaU6nDrFm2cPs/+
+ E1SopqkZ7MFJqntXZaa7IKppckwIEvJbg8LWd28OT6nVihCPQQ8UScWCLGqO4hXuQx
+ qDtJ204eWrqWb1ufRspwtABWaqx5gRKUFSdwDnxPcuLcyyxbuIyaqntIBV34MY9YzC
+ Owg+S9YeJFkniRpGPkCLMrZzG3+jbktA/KClMxFoUhiKC0OAbAhd79CO8i6xe/STyW
+ 4O7KVRgUJ/sP0heeJV4kEVKw/vZd40sFKxat4mLvp6VLdvnb/XHHGGPIKwBBpC1/9n
+ 3DpfRZnn9/AwCxRII9O79kVPdjvByxuET6Ai8mePeTt4lyheXzhOSpCcdWa00uckTG
+ kckbGu76nEhbIm2xznH4VB3OWYaiXqQn8GKSWGIMHuXyPL76LBcupmhp69pz4uMnXi
+ w4VloTGcdQRtGdzmHs1f+RdYZslMZJhzUOHVnceN1ooEiP5JUzdqCQMWCD0JCIeQzn
+ NNpO+clhrCYf5rC+A2cxWmDUWG2oHEOZMEKIwclgMnnLrTeXUV7sUzpNXgU9DmijWV
+ v9LEKCkAIhKIBnlvpks6F21qUZ31u/sbExPa9h0/RzwzMov2nGlG5TmW1YOzzlnSfL
+ mVnyGf19Q7lwZHBp+1fPtflAIgiC7389n9qkihP+lWyeqfUO15ZwQTqlw9H+o2cOvN
+ QJCAHEgEqgYnI0NyALjAJdyWQy7wMa6AEujUdzo3LjcAXwD/XCTKIRjWytAAAAJXRF
+ WHRjcmVhdGUtZGF0ZQAyMDA5LTA0LTA2VDIxOjI1OjQxLTAzOjAw8s+uCAAAACV0RV
+ h0bW9kaWZ5LWRhdGUAMjAwOC0wMS0wM1QxNTowODoyMS0wMjowMJEc/44AAAAZdEVY
+ dFNvZnR3YXJlAHd3dy5pbmtzY2FwZS5vcmeb7jwaAAAAAElFTkSuQmCC
+ }]
+ }
+ if {![info exists ::tk::Priv(folderImage)]} {
+ set ::tk::Priv(folderImage) [image create photo -data {
+ iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiA
+ AAAAlwSFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBl
+ Lm9yZ5vuPBoAAAHCSURBVDiNpZAxa5NRFIafc+9XLCni4BC6FBycMnbrLpkcgtDVX6
+ C70D/g4lZX/4coxLlgxFkpiiSSUGm/JiXfveee45AmNlhawXc53HvPee55X+l2u/yP
+ qt3d3Tfu/viatwt3fzIYDI5uBJhZr9fr3TMzzAx3B+D09PR+v98/7HQ6z5fNOWdCCG
+ U4HH6s67oAVDlnV1UmkwmllBUkhMD29nYHeLuEAkyn06qU8qqu64MrgIyqYmZrkHa7
+ 3drc3KTVahFjJITAaDRiPB4/XFlQVVMtHH5IzJo/P4EA4MyB+erWPQB7++zs7ccYvl
+ U5Z08pMW2cl88eIXLZeDUpXzsBkNQ5eP1+p0opmaoCTgzw6fjs6gLLsp58FB60t0Dc
+ K1Ul54yIEIMQ43Uj68pquDmCeJVztpwzuBNE2LgBoMVpslHMCUEAFgDVxQbzVAiA+a
+ K5uGPmmDtZF3VpoUm2ArhqQaRiUjcMf81p1G60UEVhcjZfAFTVUkrgkS+jc06mDX9n
+ vq4YhJ9nlxZExMwMEaHJRutOdWuIIsJFUoBSuTvHJ4YIfP46unV4qdlsjsBRZRtb/X
+ fHd5+C8+P7+J8BIoxFwovfRxYhnhxjpzEAAAAASUVORK5CYII=
+ }]
+ }
+ if {![info exists ::tk::Priv(fileImage)]} {
+ set ::tk::Priv(fileImage) [image create photo -data {
+ iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gva
+ eTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQWFA84umAmQgAAANpJREFU
+ OMutkj1uhDAQhb8HSLtbISGfgZ+zbJkix0HmFhwhUdocBnMBGvqtTIqIFSReWKK8ai
+ x73nwzHrVt+zEMwwvH9FrX9TsA1trpqKy10+yUzME4jnjvAZB0LzXHkojjmDRNVyh3
+ A+89zrlVwlKSqKrqVy/J8lAUxSZBSMny4ZLgp54iyPM8UPHGNJ2IomibAKDv+9VlWZ
+ bABbgB5/0WQgSSkC4PF2JF4JzbHN430c4vhAm0TyCJruuClefph4yCBCGT3T3Isoy/
+ KDHGfDZNcz2SZIx547/0BVRRX7n8uT/sAAAAAElFTkSuQmCC
+ }]
+ }
}
# ::tk::dialog::file:: --
#
-# Implements the TK file selection dialog. This dialog is used when
-# the tk_strictMotif flag is set to false. This procedure shouldn't
-# be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
+# Implements the TK file selection dialog. This dialog is used when the
+# tk_strictMotif flag is set to false. This procedure shouldn't be
+# called directly. Call tk_getOpenFile or tk_getSaveFile instead.
#
# Arguments:
# type "open" or "save"
@@ -815,6 +98,7 @@ namespace eval ::tk::dialog::file {
proc ::tk::dialog::file:: {type args} {
variable ::tk::Priv
+ variable showHiddenBtn
set dataName __tk_filedialog
upvar ::tk::dialog::file::$dataName data
@@ -847,7 +131,7 @@ proc ::tk::dialog::file:: {type args} {
set data(hiddenBtn) $w.contents.f2.hidden
SetSelectMode $w $data(-multiple)
}
- if {$::tk::dialog::file::showHiddenBtn} {
+ if {$showHiddenBtn} {
$data(hiddenBtn) configure -state normal
grid $data(hiddenBtn)
} else {
@@ -858,12 +142,12 @@ proc ::tk::dialog::file:: {type args} {
# Make sure subseqent uses of this dialog are independent [Bug 845189]
unset -nocomplain data(extUsed)
- # 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.
+ # 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)
@@ -899,7 +183,7 @@ proc ::tk::dialog::file:: {type args} {
set filter [lindex $type 1]
$data(typeMenu) add command -label $title \
-command [list ::tk::dialog::file::SetFilter $w $type]
- # string first avoids glob-pattern char issues
+ # [string first] avoids glob-pattern char issues
if {[string first ${initialTypeName} $title] == 0} {
set initialtype $type
}
@@ -914,9 +198,9 @@ proc ::tk::dialog::file:: {type args} {
}
UpdateWhenIdle $w
- # Withdraw the window, then update all the geometry information
- # so we know how big it wants to be, then center the window in the
- # display and de-iconify it.
+ # 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.
::tk::PlaceWindow $w widget $data(-parent)
wm title $w $data(-title)
@@ -929,11 +213,10 @@ proc ::tk::dialog::file:: {type args} {
$data(ent) selection range 0 end
$data(ent) icursor end
- # Wait for the user to respond, then restore the focus and
- # return the index of the selected button. Restore the focus
- # before deleting the window, since otherwise the window manager
- # may take the focus away so we can't redirect it. Finally,
- # restore any grab that was in effect.
+ # 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)
@@ -943,7 +226,7 @@ proc ::tk::dialog::file:: {type args} {
#
foreach trace [trace info variable data(selectPath)] {
- trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
+ trace remove variable data(selectPath) {*}$trace
}
$data(dirMenuBtn) configure -textvariable {}
@@ -964,7 +247,7 @@ proc ::tk::dialog::file::Config {dataName type argList} {
# if the dialog is now used with a different -parent option.
foreach trace [trace info variable data(selectPath)] {
- trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
+ trace remove variable data(selectPath) {*}$trace
}
# 1: the configuration specs
@@ -1029,8 +312,8 @@ proc ::tk::dialog::file::Config {dataName type argList} {
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.
+ # Set -multiple to a one or zero value (not other boolean types like
+ # "yes") so we can use it in tests more easily.
if {$type eq "save"} {
set data(-multiple) 0
} elseif {$data(-multiple)} {
@@ -1064,21 +347,10 @@ proc ::tk::dialog::file::Create {w class} {
set data(dirMenu) $f1.menu.menu
ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \
-textvariable [format %s(selectPath) ::tk::dialog::file::$dataName]
- [menu $data(dirMenu) -tearoff 0] add radiobutton -label "" -variable \
+ menu $data(dirMenu) -tearoff 0
+ $data(dirMenu) add radiobutton -label "" -variable \
[format %s(selectPath) ::tk::dialog::file::$dataName]
set data(upBtn) [ttk::button $f1.up]
- if {![info exists Priv(updirImage)]} {
- set Priv(updirImage) [image create bitmap -data {
-#define updir_width 28
-#define updir_height 16
-static char updir_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
- 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
- 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
- 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
- 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
- 0xf0, 0xff, 0xff, 0x01};}]
- }
$data(upBtn) configure -image $Priv(updirImage)
$f1.menu configure -takefocus 1;# -highlightthickness 2
@@ -1115,8 +387,8 @@ static char updir_bits[] = {
# -pady 0
set data(ent) [ttk::entry $f2.ent]
- # The font to use for the icons. The default Canvas font on Unix
- # is just deviant.
+ # The font to use for the icons. The default Canvas font on Unix is just
+ # deviant.
set ::tk::$w.contents.icons(font) [$data(ent) cget -font]
# Make the file types bits only if this is a File Dialog
@@ -1133,9 +405,9 @@ static char updir_bits[] = {
focus $data(typeMenuBtn)]
}
- # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
- # is true. Create it disabled so the binding doesn't trigger if it
- # isn't shown.
+ # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn is
+ # true. Create it disabled so the binding doesn't trigger if it isn't
+ # shown.
if {$class eq "TkFDialog"} {
set text [mc "Show &Hidden Files and Directories"]
} else {
@@ -1238,36 +510,32 @@ proc ::tk::dialog::file::SetSelectMode {w multi} {
}
set iconListCommand [list ::tk::dialog::file::OkCmd $w]
::tk::SetAmpText $w.contents.f2.lab $fNameCaption
- ::tk::IconList_Config $data(icons) \
- [list -multiple $multi -command $iconListCommand]
+ $data(icons) configure -multiple $multi -command $iconListCommand
return
}
# ::tk::dialog::file::UpdateWhenIdle --
#
-# Creates an idle event handler which updates the dialog in idle
-# time. This is important because loading the directory may take a long
-# time and we don't want to load the same directory for multiple times
-# due to multiple concurrent events.
+# Creates an idle event handler which updates the dialog in idle time.
+# This is important because loading the directory may take a long time
+# and we don't want to load the same directory for multiple times due to
+# multiple concurrent events.
#
proc ::tk::dialog::file::UpdateWhenIdle {w} {
upvar ::tk::dialog::file::[winfo name $w] data
if {[info exists data(updateId)]} {
return
- } else {
- set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
}
+ set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
}
# ::tk::dialog::file::Update --
#
-# Loads the files and directories into the IconList widget. Also
-# sets up the directory option menu for quick access to parent
-# directories.
+# Loads the files and directories into the IconList widget. Also sets up
+# the directory option menu for quick access to parent directories.
#
proc ::tk::dialog::file::Update {w} {
-
# This proc may be called within an idle handler. Make sure that the
# window has not been destroyed before this proc is called
if {![winfo exists $w]} {
@@ -1281,30 +549,24 @@ proc ::tk::dialog::file::Update {w} {
set dataName [winfo name $w]
upvar ::tk::dialog::file::$dataName data
variable ::tk::Priv
+ variable showHiddenVar
global tk_library
unset -nocomplain data(updateId)
- if {![info exists Priv(folderImage)]} {
- set Priv(folderImage) [image create photo -data {
-R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
-QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
- set Priv(fileImage) [image create photo -data {
-R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
-rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
- }
set folder $Priv(folderImage)
set file $Priv(fileImage)
set appPWD [pwd]
if {[catch {
cd $data(selectPath)
- }]} {
+ }]} then {
# We cannot change directory to $data(selectPath). $data(selectPath)
- # should have been checked before ::tk::dialog::file::Update is called, so
- # we normally won't come to here. Anyways, give an error and abort
- # action.
- tk_messageBox -type ok -parent $w -icon warning -message \
- [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
+ # should have been checked before ::tk::dialog::file::Update is
+ # called, so we normally won't come to here. Anyways, give an error
+ # and abort action.
+ tk_messageBox -type ok -parent $w -icon warning -message [mc \
+ "Cannot change to the directory \"%1\$s\".\nPermission denied."\
+ $data(selectPath)]
cd $appPWD
return
}
@@ -1318,15 +580,17 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
$w configure -cursor watch
update idletasks
- ::tk::IconList_DeleteAll $data(icons)
+ $data(icons) deleteall
- set showHidden $::tk::dialog::file::showHiddenVar
+ set showHidden $showHiddenVar
# Make the dir list
# Using -directory [pwd] is better in some VFS cases.
set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
- if {$showHidden} { lappend cmd .* }
- set dirs [lsort -dictionary -unique [eval $cmd]]
+ if {$showHidden} {
+ lappend cmd .*
+ }
+ set dirs [lsort -dictionary -unique [{*}$cmd]]
set dirList {}
foreach d $dirs {
if {$d eq "." || $d eq ".."} {
@@ -1334,11 +598,11 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
}
lappend dirList $d
}
- ::tk::IconList_Add $data(icons) $folder $dirList
+ $data(icons) add $folder $dirList
if {$class eq "TkFDialog"} {
- # Make the file list if this is a File Dialog, selecting all
- # but 'd'irectory type files.
+ # Make the file list if this is a File Dialog, selecting all but
+ # 'd'irectory type files.
#
set cmd [list glob -tails -directory [pwd] \
-type {f b c l p s} -nocomplain]
@@ -1348,14 +612,12 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
lappend cmd .*
}
} else {
- eval [list lappend cmd] $data(filter)
+ lappend cmd {*}$data(filter)
}
- set fileList [lsort -dictionary -unique [eval $cmd]]
- ::tk::IconList_Add $data(icons) $file $fileList
+ set fileList [lsort -dictionary -unique [{*}$cmd]]
+ $data(icons) add $file $fileList
}
- ::tk::IconList_Arrange $data(icons)
-
# Update the Directory: option menu
#
set list ""
@@ -1398,9 +660,10 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
proc ::tk::dialog::file::SetPathSilently {w path} {
upvar ::tk::dialog::file::[winfo name $w] data
- trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
+ set cb [list ::tk::dialog::file::SetPath $w]
+ trace remove variable data(selectPath) write $cb
set data(selectPath) $path
- trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
+ trace add variable data(selectPath) write $cb
}
@@ -1422,14 +685,13 @@ proc ::tk::dialog::file::SetPath {w name1 name2 op} {
#
proc ::tk::dialog::file::SetFilter {w type} {
upvar ::tk::dialog::file::[winfo name $w] data
- upvar ::tk::$data(icons) icons
set data(filterType) $type
set data(filter) [lindex $type 1]
$data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1
- # If we aren't using a default extension, use the one suppled
- # by the filter.
+ # If we aren't using a default extension, use the one suppled by the
+ # filter.
if {![info exists data(extUsed)]} {
if {[string length $data(-defaultextension)]} {
set data(extUsed) 1
@@ -1439,8 +701,8 @@ proc ::tk::dialog::file::SetFilter {w type} {
}
if {!$data(extUsed)} {
- # Get the first extension in the list that matches {^\*\.\w+$}
- # and remove all * from the filter.
+ # Get the first extension in the list that matches {^\*\.\w+$} and
+ # remove all * from the filter.
set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
if {$index >= 0} {
set data(-defaultextension) \
@@ -1451,15 +713,14 @@ proc ::tk::dialog::file::SetFilter {w type} {
}
}
- $icons(sbar) set 0.0 0.0
+ $data(icons) see 0
UpdateWhenIdle $w
}
# tk::dialog::file::ResolveFile --
#
-# Interpret the user's text input in a file selection dialog.
-# Performs:
+# Interpret the user's text input in a file selection dialog. Performs:
#
# (1) ~ substitution
# (2) resolve all instances of . and ..
@@ -1480,25 +741,24 @@ proc ::tk::dialog::file::SetFilter {w type} {
# flag = OK : valid input
# = PATTERN : valid directory/pattern
# = PATH : the directory does not exist
-# = FILE : the directory exists by the file doesn't
-# exist
+# = FILE : the directory exists by the file doesn't exist
# = CHDIR : Cannot change to the directory
# = ERROR : Invalid entry
#
# directory : valid only if flag = OK or PATTERN or FILE
# file : valid only if flag = OK or PATTERN
#
-# directory may not be the same as context, because text may contain
-# a subdirectory name
+# directory may not be the same as context, because text may contain a
+# subdirectory name
#
proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} {
set appPWD [pwd]
set path [JoinFile $context $text]
- # If the file has no extension, append the default. Be careful not
- # to do this for directories, otherwise typing a dirname in the box
- # will give back "dirname.extension" instead of trying to change dir.
+ # If the file has no extension, append the default. Be careful not to do
+ # this for directories, otherwise typing a dirname in the box will give
+ # back "dirname.extension" instead of trying to change dir.
if {
![file isdirectory $path] && ([file ext $path] eq "") &&
![string match {$*} [file tail $path]]
@@ -1507,8 +767,8 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} {
}
if {[catch {file exists $path}]} {
- # This "if" block can be safely removed if the following code
- # stop generating errors.
+ # This "if" block can be safely removed if the following code stop
+ # generating errors.
#
# file exists ~nonsuchuser
#
@@ -1707,8 +967,8 @@ proc ::tk::dialog::file::UpDirCmd {w} {
}
}
-# Join a file name to a path name. The "file join" command will break
-# if the filename begins with ~
+# Join a file name to a path name. The "file join" command will break if the
+# filename begins with ~
#
proc ::tk::dialog::file::JoinFile {path file} {
if {[string match {~*} $file] && [file exists $path/$file]} {
@@ -1724,12 +984,14 @@ proc ::tk::dialog::file::OkCmd {w} {
upvar ::tk::dialog::file::[winfo name $w] data
set filenames {}
- foreach item [::tk::IconList_CurSelection $data(icons)] {
- lappend filenames [::tk::IconList_Get $data(icons) $item]
+ foreach item [$data(icons) selection get] {
+ lappend filenames [$data(icons) get $item]
}
- if {([llength $filenames] && !$data(-multiple)) || \
- ($data(-multiple) && ([llength $filenames] == 1))} {
+ if {
+ ([llength $filenames] && !$data(-multiple)) ||
+ ($data(-multiple) && ([llength $filenames] == 1))
+ } then {
set filename [lindex $filenames 0]
set file [JoinFile $data(selectPath) $filename]
if {[file isdirectory $file]} {
@@ -1767,8 +1029,8 @@ proc ::tk::dialog::file::ListBrowse {w} {
upvar ::tk::dialog::file::[winfo name $w] data
set text {}
- foreach item [::tk::IconList_CurSelection $data(icons)] {
- lappend text [::tk::IconList_Get $data(icons) $item]
+ foreach item [$data(icons) selection get] {
+ lappend text [$data(icons) get $item]
}
if {[llength $text] == 0} {
return
@@ -1804,8 +1066,8 @@ proc ::tk::dialog::file::ListBrowse {w} {
}
}
-# Gets called when user invokes the IconList widget (double-click,
-# Return key, etc)
+# Gets called when user invokes the IconList widget (double-click, Return key,
+# etc)
#
proc ::tk::dialog::file::ListInvoke {w filenames} {
upvar ::tk::dialog::file::[winfo name $w] data
@@ -1838,11 +1100,11 @@ proc ::tk::dialog::file::ListInvoke {w filenames} {
# ::tk::dialog::file::Done --
#
-# Gets called when user has input a valid filename. Pops up a
-# dialog box to confirm selection when necessary. Sets the
-# tk::Priv(selectFilePath) variable, which will break the "vwait"
-# loop in ::tk::dialog::file:: and return the selected filename to the
-# script that calls tk_getOpenFile or tk_getSaveFile
+# Gets called when user has input a valid filename. Pops up a dialog
+# box to confirm selection when necessary. Sets the
+# tk::Priv(selectFilePath) variable, which will break the "vwait" loop
+# in ::tk::dialog::file:: and return the selected filename to the script
+# that calls tk_getOpenFile or tk_getSaveFile
#
proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
upvar ::tk::dialog::file::[winfo name $w] data
@@ -1869,9 +1131,11 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
return
}
}
- if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
- && [info exists data(-filetypes)] && [llength $data(-filetypes)]
- && [info exists data(filterType)] && $data(filterType) ne ""} {
+ if {
+ [info exists data(-typevariable)] && $data(-typevariable) ne ""
+ && [info exists data(-filetypes)] && [llength $data(-filetypes)]
+ && [info exists data(filterType)] && $data(filterType) ne ""
+ } then {
upvar #0 $data(-typevariable) typeVariable
set typeVariable [lindex $data(filterType) 0]
}
@@ -1881,6 +1145,7 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
}
proc ::tk::dialog::file::CompleteEnt {w} {
+ variable showHiddenVar
upvar ::tk::dialog::file::[winfo name $w] data
set f [$data(ent) get]
if {$data(-multiple)} {
@@ -1897,7 +1162,7 @@ proc ::tk::dialog::file::CompleteEnt {w} {
-nocomplain *]
if {$data(filter) eq "*"} {
lappend globF *
- if {$::tk::dialog::file::showHiddenVar} {
+ if {$showHiddenVar} {
lappend globF .*
lappend globD .*
}
@@ -1908,7 +1173,7 @@ proc ::tk::dialog::file::CompleteEnt {w} {
}
set dirs [lsort -dictionary -unique [{*}$globD]]
} else {
- if {$::tk::dialog::file::showHiddenVar} {
+ if {$showHiddenVar} {
lappend globD .*
}
if {[winfo class $w] eq "TkFDialog"} {