3 # Implements the "TK" standard file selection dialog box. This
4 # dialog box is used on the Unix platforms whenever the tk_strictMotif
7 # The "TK" standard file selection dialog box is similar to the
8 # file selection dialog box on Win95(TM). The user can navigate
9 # the directories by clicking on the folder icons or by
10 # selecting the "Directory" option menu. The user can select
11 # files by clicking on the file icons or by entering a filename
12 # in the "Filename:" entry.
14 # RCS: @(#) $Id: tkfbox.tcl,v 1.68.2.5 2010/01/20 23:43:51 patthoyts Exp $
16 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
18 # See the file "license.terms" for information on usage and redistribution
19 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
24 #----------------------------------------------------------------------
28 # This is a pseudo-widget that implements the icon list inside the
29 # ::tk::dialog::file:: dialog box.
31 #----------------------------------------------------------------------
35 # Creates an IconList widget.
37 proc ::tk::IconList {w args
} {
38 IconList_Config
$w $args
42 proc ::tk::IconList_Index {w i
} {
43 upvar #0 ::tk::$w data ::tk::$w:itemList itemList
44 if {![info exists data
(list)]} {
47 switch -regexp -- $i {
52 if {$i >= [llength $data(list)]} {
53 set i
[expr {[llength $data(list)] - 1}]
58 return $data(index
,active
)
61 return $data(index
,anchor
)
64 return [llength $data(list)]
66 "@-?[0-9]+,-?[0-9]+" {
67 foreach {x y
} [scan $i "@%d,%d"] {
70 set item
[$data(canvas) find closest
\
71 [$data(canvas) canvasx
$x] [$data(canvas) canvasy
$y]]
72 return [lindex [$data(canvas) itemcget
$item -tags] 1]
77 proc ::tk::IconList_Selection {w op args
} {
79 switch -exact -- $op {
81 if {[llength $args] == 1} {
82 set data
(index
,anchor
) [tk::IconList_Index $w [lindex $args 0]]
84 return $data(index
,anchor
)
88 if {[llength $args] == 2} {
89 foreach {first last
} $args {
92 } elseif
{[llength $args] == 1} {
93 set first
[set last
[lindex $args 0]]
95 error "wrong # args: should be [lindex [info level 0] 0] path\
98 set first
[IconList_Index
$w $first]
99 set last
[IconList_Index
$w $last]
100 if {$first > $last} {
106 foreach item
$data(selection) {
107 if { $item >= $first } {
113 set ind
[expr {[llength $data(selection)] - 1}]
114 for {} {$ind >= 0} {incr ind
-1} {
115 set item
[lindex $data(selection) $ind]
116 if { $item <= $last } {
122 if { $first > $last } {
125 set data
(selection) [lreplace $data(selection) $first $last]
126 event generate
$w <<ListboxSelect
>>
127 IconList_DrawSelection
$w
130 set index
[lsearch -exact $data(selection) [lindex $args 0]]
131 return [expr {$index != -1}]
134 if { [llength $args] == 2 } {
135 foreach {first last
} $args {
138 } elseif
{ [llength $args] == 1 } {
139 set last
[set first
[lindex $args 0]]
141 error "wrong # args: should be [lindex [info level 0] 0] path\
145 set first
[IconList_Index
$w $first]
146 set last
[IconList_Index
$w $last]
147 if { $first > $last } {
152 for {set i
$first} {$i <= $last} {incr i
} {
153 lappend data
(selection) $i
155 set data
(selection) [lsort -integer -unique $data(selection)]
156 event generate
$w <<ListboxSelect
>>
157 IconList_DrawSelection
$w
162 proc ::tk::IconList_CurSelection {w
} {
164 return $data(selection)
167 proc ::tk::IconList_DrawSelection {w
} {
169 upvar ::tk::$w:itemList itemList
171 $data(canvas) delete
selection
172 $data(canvas) itemconfigure selectionText
-fill black
173 $data(canvas) dtag selectionText
174 set cbg
[ttk
::style lookup TEntry
-selectbackground focus]
175 set cfg
[ttk
::style lookup TEntry
-selectforeground focus]
176 foreach item
$data(selection) {
177 set rTag
[lindex [lindex $data(list) $item] 2]
178 foreach {iTag tTag
text serial
} $itemList($rTag) {
182 set bbox
[$data(canvas) bbox
$tTag]
183 $data(canvas) create rect
$bbox -fill $cbg -outline $cbg \
185 $data(canvas) itemconfigure
$tTag -fill $cfg -tags selectionText
187 $data(canvas) lower selection
191 proc ::tk::IconList_Get {w item
} {
193 upvar ::tk::$w:itemList itemList
194 set rTag
[lindex [lindex $data(list) $item] 2]
195 foreach {iTag tTag
text serial
} $itemList($rTag) {
201 # ::tk::IconList_Config --
203 # Configure the widget variables of IconList, according to the command
206 proc ::tk::IconList_Config {w argList
} {
208 # 1: the configuration specs
212 {-multiple "" "" "0"}
215 # 2: parse the arguments
217 tclParseConfigSpec
::tk::$w $specs "" $argList
220 # ::tk::IconList_Create --
222 # Creates an IconList widget by assembling a canvas widget and a
223 # scrollbar widget. Sets all the bindings necessary for the IconList's
226 proc ::tk::IconList_Create {w
} {
230 ttk
::entry $w.cHull
-takefocus 0 -cursor {}
231 set data
(sbar
) [ttk
::scrollbar $w.cHull.sbar
-orient horizontal
-takefocus 0]
232 catch {$data(sbar
) configure
-highlightthickness 0}
233 set data
(canvas) [canvas $w.cHull.
canvas -highlightthick 0 \
234 -width 400 -height 120 -takefocus 1 -background white
]
235 pack $data(sbar
) -side bottom
-fill x
-padx 2 -in $w.cHull
-pady {0 2}
236 pack $data(canvas) -expand yes
-fill both
-padx 2 -pady {2 0}
237 pack $w.cHull
-expand yes
-fill both
-ipadx 2 -ipady 2
239 $data(sbar
) configure
-command [list $data(canvas) xview
]
240 $data(canvas) configure
-xscrollcommand [list $data(sbar
) set]
242 # Initializes the max icon/text width and height and other variables
250 set data
(selection) {}
251 set data
(index
,anchor
) ""
252 set fg
[option get
$data(canvas) foreground Foreground
]
259 # Creates the event bindings.
261 bind $data(canvas) <Configure
> [list tk::IconList_Arrange $w]
263 bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x
%y
]
264 bind $data(canvas) <B1-Motion
> [list tk::IconList_Motion1 $w %x
%y
]
265 bind $data(canvas) <B1-Leave
> [list tk::IconList_Leave1 $w %x
%y
]
266 bind $data(canvas) <Control-1
> [list tk::IconList_CtrlBtn1 $w %x
%y
]
267 bind $data(canvas) <Shift-1
> [list tk::IconList_ShiftBtn1 $w %x
%y
]
268 bind $data(canvas) <B1-Enter
> [list tk::CancelRepeat]
269 bind $data(canvas) <ButtonRelease-1
> [list tk::CancelRepeat]
270 bind $data(canvas) <Double-ButtonRelease-1
> \
271 [list tk::IconList_Double1 $w %x
%y
]
273 bind $data(canvas) <Control-B1-Motion
> {;}
274 bind $data(canvas) <Shift-B1-Motion
> \
275 [list tk::IconList_ShiftMotion1 $w %x
%y
]
277 bind $data(canvas) <Up
> [list tk::IconList_UpDown $w -1]
278 bind $data(canvas) <Down
> [list tk::IconList_UpDown $w 1]
279 bind $data(canvas) <Left
> [list tk::IconList_LeftRight $w -1]
280 bind $data(canvas) <Right
> [list tk::IconList_LeftRight $w 1]
281 bind $data(canvas) <Return
> [list tk::IconList_ReturnKey $w]
282 bind $data(canvas) <KeyPress
> [list tk::IconList_KeyPress $w %A
]
283 bind $data(canvas) <Control-KeyPress
> ";"
284 bind $data(canvas) <Alt-KeyPress
> ";"
286 bind $data(canvas) <FocusIn
> [list tk::IconList_FocusIn $w]
287 bind $data(canvas) <FocusOut
> [list tk::IconList_FocusOut $w]
292 # ::tk::IconList_AutoScan --
294 # This procedure is invoked when the mouse leaves an entry window
295 # with button 1 down. It scrolls the window up, down, left, or
296 # right, depending on where the mouse left the window, and reschedules
297 # itself as an "after" command so that the window continues to scroll until
298 # the mouse moves back into the window or the mouse button is released.
301 # w - The IconList window.
303 proc ::tk::IconList_AutoScan {w
} {
307 if {![winfo exists
$w]} return
311 if {$data(noScroll
)} {
314 if {$x >= [winfo width
$data(canvas)]} {
315 $data(canvas) xview scroll
1 units
317 $data(canvas) xview scroll
-1 units
318 } elseif
{$y >= [winfo height
$data(canvas)]} {
326 IconList_Motion1
$w $x $y
327 set Priv
(afterId
) [after 50 [list tk::IconList_AutoScan $w]]
330 # Deletes all the items inside the canvas subwidget and reset the IconList's
333 proc ::tk::IconList_DeleteAll {w
} {
335 upvar ::tk::$w:itemList itemList
337 $data(canvas) delete all
338 unset -nocomplain data
(selected
) data
(rect
) data
(list) itemList
345 set data
(selection) {}
346 set data
(index
,anchor
) ""
347 $data(sbar
) set 0.0 1.0
348 $data(canvas) xview moveto
0
351 # Adds an icon into the IconList with the designated image and text
353 proc ::tk::IconList_Add {w
image items
} {
355 upvar ::tk::$w:itemList itemList
356 upvar ::tk::$w:textList textList
358 foreach text $items {
359 set iTag
[$data(canvas) create
image 0 0 -image $image -anchor nw
\
360 -tags [list icon
$data(numItems
) item
$data(numItems
)]]
361 set tTag
[$data(canvas) create
text 0 0 -text $text -anchor nw
\
362 -font $data(font) -fill $data(fill
) \
363 -tags [list text $data(numItems
) item
$data(numItems
)]]
364 set rTag
[$data(canvas) create rect
0 0 0 0 -fill "" -outline "" \
365 -tags [list rect
$data(numItems
) item
$data(numItems
)]]
367 foreach {x1 y1 x2 y2
} [$data(canvas) bbox
$iTag] {
370 set iW
[expr {$x2 - $x1}]
371 set iH
[expr {$y2 - $y1}]
372 if {$data(maxIW
) < $iW} {
375 if {$data(maxIH
) < $iH} {
379 foreach {x1 y1 x2 y2
} [$data(canvas) bbox
$tTag] {
382 set tW
[expr {$x2 - $x1}]
383 set tH
[expr {$y2 - $y1}]
384 if {$data(maxTW
) < $tW} {
387 if {$data(maxTH
) < $tH} {
391 lappend data
(list) [list $iTag $tTag $rTag $iW $iH $tW \
393 set itemList
($rTag) [list $iTag $tTag $text $data(numItems
)]
394 set textList
($data(numItems
)) [string tolower
$text]
399 # Places the icons in a column-major arrangement.
401 proc ::tk::IconList_Arrange {w
} {
404 if {![info exists data
(list)]} {
405 if {[info exists data
(canvas)] && [winfo exists
$data(canvas)]} {
407 $data(sbar
) configure
-command ""
412 set W
[winfo width
$data(canvas)]
413 set H
[winfo height
$data(canvas)]
414 set pad
[expr {[$data(canvas) cget
-highlightthickness] + \
415 [$data(canvas) cget
-bd]}]
420 incr W
-[expr {$pad*2}]
421 incr H
-[expr {$pad*2}]
423 set dx
[expr {$data(maxIW
) + $data(maxTW
) + 8}]
424 if {$data(maxTH
) > $data(maxIH
)} {
430 set shift
[expr {$data(maxIW
) + 4}]
432 set x
[expr {$pad * 2}]
433 set y
[expr {$pad * 1}] ; # Why * 1 ?
435 foreach sublist
$data(list) {
437 foreach {iTag tTag rTag iW iH tW tH
} $sublist {
441 set i_dy
[expr {($dy - $iH)/2}]
442 set t_dy
[expr {($dy - $tH)/2}]
444 $data(canvas) coords
$iTag $x [expr {$y + $i_dy}]
445 $data(canvas) coords
$tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
446 $data(canvas) coords
$rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
449 if {($y + $dy) > $H} {
450 set y
[expr {$pad * 1}] ; # *1 ?
457 set sW
[expr {$x + $dx}]
463 $data(canvas) configure
-scrollregion [list $pad $pad $sW $H]
464 $data(sbar
) configure
-command ""
465 $data(canvas) xview moveto
0
468 $data(canvas) configure
-scrollregion [list $pad $pad $sW $H]
469 $data(sbar
) configure
-command [list $data(canvas) xview
]
473 set data
(itemsPerColumn
) [expr {($H-$pad)/$dy}]
474 if {$data(itemsPerColumn
) < 1} {
475 set data
(itemsPerColumn
) 1
478 IconList_DrawSelection
$w
481 # Gets called when the user invokes the IconList (usually by double-clicking
482 # or pressing the Return key).
484 proc ::tk::IconList_Invoke {w
} {
487 if {$data(-command) ne
"" && [llength $data(selection)]} {
488 uplevel #0 $data(-command)
492 # ::tk::IconList_See --
494 # If the item is not (completely) visible, scroll the canvas so that
495 # it becomes visible.
496 proc ::tk::IconList_See {w rTag
} {
498 upvar ::tk::$w:itemList itemList
500 if {$data(noScroll
)} {
503 set sRegion
[$data(canvas) cget
-scrollregion]
504 if {$sRegion eq
""} {
508 if { $rTag < 0 ||
$rTag >= [llength $data(list)] } {
512 set bbox
[$data(canvas) bbox item
$rTag]
513 set pad
[expr {[$data(canvas) cget
-highlightthickness] + \
514 [$data(canvas) cget
-bd]}]
516 set x1
[lindex $bbox 0]
517 set x2
[lindex $bbox 2]
518 incr x1
-[expr {$pad * 2}]
519 incr x2
-[expr {$pad * 1}] ; # *1 ?
521 set cW
[expr {[winfo width
$data(canvas)] - $pad*2}]
523 set scrollW
[expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
524 set dispX
[expr {int
([lindex [$data(canvas) xview
] 0]*$scrollW)}]
527 # check if out of the right edge
529 if {($x2 - $dispX) >= $cW} {
530 set dispX
[expr {$x2 - $cW}]
532 # check if out of the left edge
534 if {($x1 - $dispX) < 0} {
538 if {$oldDispX ne
$dispX} {
539 set fraction
[expr {double
($dispX)/double
($scrollW)}]
540 $data(canvas) xview moveto
$fraction
544 proc ::tk::IconList_Btn1 {w x y
} {
548 set i
[IconList_Index
$w @$x,$y]
552 IconList_Selection
$w clear
0 end
553 IconList_Selection
$w set $i
554 IconList_Selection
$w anchor
$i
557 proc ::tk::IconList_CtrlBtn1 {w x y
} {
560 if { $data(-multiple) } {
562 set i
[IconList_Index
$w @$x,$y]
566 if { [IconList_Selection
$w includes
$i] } {
567 IconList_Selection
$w clear
$i
569 IconList_Selection
$w set $i
570 IconList_Selection
$w anchor
$i
575 proc ::tk::IconList_ShiftBtn1 {w x y
} {
578 if { $data(-multiple) } {
580 set i
[IconList_Index
$w @$x,$y]
584 if {[IconList_Index
$w anchor
] eq
""} {
585 IconList_Selection
$w anchor
$i
587 IconList_Selection
$w clear
0 end
588 IconList_Selection
$w set anchor
$i
592 # Gets called on button-1 motions
594 proc ::tk::IconList_Motion1 {w x y
} {
598 set i
[IconList_Index
$w @$x,$y]
602 IconList_Selection
$w clear
0 end
603 IconList_Selection
$w set $i
606 proc ::tk::IconList_ShiftMotion1 {w x y
} {
611 set i
[IconList_Index
$w @$x,$y]
615 IconList_Selection
$w clear
0 end
616 IconList_Selection
$w set anchor
$i
619 proc ::tk::IconList_Double1 {w x y
} {
622 if {[llength $data(selection)]} {
627 proc ::tk::IconList_ReturnKey {w
} {
631 proc ::tk::IconList_Leave1 {w x y
} {
639 proc ::tk::IconList_FocusIn {w
} {
643 if {![info exists data
(list)]} {
647 if {[llength $data(selection)]} {
648 IconList_DrawSelection
$w
652 proc ::tk::IconList_FocusOut {w
} {
653 $w.cHull state
!focus
654 IconList_Selection
$w clear
0 end
657 # ::tk::IconList_UpDown --
659 # Moves the active element up or down by one element
662 # w - The IconList widget.
663 # amount - +1 to move down one item, -1 to move back one item.
665 proc ::tk::IconList_UpDown {w amount
} {
668 if {![info exists data
(list)]} {
672 set curr
[tk::IconList_CurSelection $w]
673 if { [llength $curr] == 0 } {
676 set i
[tk::IconList_Index $w anchor
]
682 IconList_Selection
$w clear
0 end
683 IconList_Selection
$w set $i
684 IconList_Selection
$w anchor
$i
688 # ::tk::IconList_LeftRight --
690 # Moves the active element left or right by one column
693 # w - The IconList widget.
694 # amount - +1 to move right one column, -1 to move left one column.
696 proc ::tk::IconList_LeftRight {w amount
} {
699 if {![info exists data
(list)]} {
703 set curr
[IconList_CurSelection
$w]
704 if { [llength $curr] == 0 } {
707 set i
[IconList_Index
$w anchor
]
711 incr i
[expr {$amount*$data(itemsPerColumn
)}]
713 IconList_Selection
$w clear
0 end
714 IconList_Selection
$w set $i
715 IconList_Selection
$w anchor
$i
719 #----------------------------------------------------------------------
720 # Accelerator key bindings
721 #----------------------------------------------------------------------
723 # ::tk::IconList_KeyPress --
725 # Gets called when user enters an arbitrary key in the listbox.
727 proc ::tk::IconList_KeyPress {w key
} {
730 append Priv
(ILAccel
,$w) $key
731 IconList_Goto
$w $Priv(ILAccel
,$w)
733 after cancel
$Priv(ILAccel
,$w,afterId
)
735 set Priv
(ILAccel
,$w,afterId
) [after 500 [list tk::IconList_Reset $w]]
738 proc ::tk::IconList_Goto {w
text} {
740 upvar ::tk::$w:textList textList
742 if {![info exists data
(list)]} {
746 if {$text eq
"" ||
$data(numItems
) == 0} {
750 if {[llength [IconList_CurSelection
$w]]} {
751 set start
[IconList_Index
$w anchor
]
758 set len
[string length
$text]
759 set len0
[expr {$len-1}]
762 # Search forward until we find a filename whose prefix is a
763 # case-insensitive match with $text
765 if {[string equal
-nocase -length $len0 $textList($i) $text]} {
770 if {$i == $data(numItems
)} {
778 if {$theIndex > -1} {
779 IconList_Selection
$w clear
0 end
780 IconList_Selection
$w set $theIndex
781 IconList_Selection
$w anchor
$theIndex
782 IconList_See
$w $theIndex
786 proc ::tk::IconList_Reset {w
} {
789 unset -nocomplain Priv
(ILAccel
,$w)
792 #----------------------------------------------------------------------
794 # F I L E D I A L O G
796 #----------------------------------------------------------------------
798 namespace eval ::tk::dialog {}
799 namespace eval ::tk::dialog::file {
800 namespace import
-force ::tk::msgcat::*
801 set ::tk::dialog::file::showHiddenBtn 0
802 set ::tk::dialog::file::showHiddenVar 1
805 # ::tk::dialog::file:: --
807 # Implements the TK file selection dialog. This dialog is used when
808 # the tk_strictMotif flag is set to false. This procedure shouldn't
809 # be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
812 # type "open" or "save"
813 # args Options parsed by the procedure.
816 proc ::tk::dialog::file:: {type args
} {
818 set dataName __tk_filedialog
819 upvar ::tk::dialog::file::$dataName data
821 Config
$dataName $type $args
823 if {$data(-parent) eq
"."} {
826 set w
$data(-parent).
$dataName
829 # (re)create the dialog box if necessary
831 if {![winfo exists
$w]} {
833 } elseif
{[winfo class
$w] ne
"TkFDialog"} {
837 set data
(dirMenuBtn
) $w.contents.f1.
menu
838 set data
(dirMenu
) $w.contents.f1.
menu.
menu
839 set data
(upBtn
) $w.contents.f1.up
840 set data
(icons
) $w.contents.icons
841 set data
(ent
) $w.contents.f2.ent
842 set data
(typeMenuLab
) $w.contents.f2.lab2
843 set data
(typeMenuBtn
) $w.contents.f2.
menu
844 set data
(typeMenu
) $data(typeMenuBtn
).m
845 set data
(okBtn
) $w.contents.f2.ok
846 set data
(cancelBtn
) $w.contents.f2.cancel
847 set data
(hiddenBtn
) $w.contents.f2.hidden
848 SetSelectMode
$w $data(-multiple)
850 if {$::tk::dialog::file::showHiddenBtn} {
851 $data(hiddenBtn
) configure
-state normal
852 grid $data(hiddenBtn
)
854 $data(hiddenBtn
) configure
-state disabled
855 grid remove
$data(hiddenBtn
)
858 # Make sure subseqent uses of this dialog are independent [Bug 845189]
859 unset -nocomplain data
(extUsed
)
861 # Dialog boxes should be transient with respect to their parent,
862 # so that they will always stay on top of their parent window. However,
863 # some window managers will create the window as withdrawn if the parent
864 # window is withdrawn or iconified. Combined with the grab we put on the
865 # window, this can hang the entire application. Therefore we only make
866 # the dialog transient if the parent is viewable.
868 if {[winfo viewable
[winfo toplevel $data(-parent)]]} {
869 wm transient
$w $data(-parent)
872 # Add traces on the selectPath variable
875 trace add
variable data
(selectPath
) write
\
876 [list ::tk::dialog::file::SetPath $w]
877 $data(dirMenuBtn
) configure
\
878 -textvariable ::tk::dialog::file::${dataName
}(selectPath
)
880 # Cleanup previous menu
882 $data(typeMenu
) delete
0 end
883 $data(typeMenuBtn
) configure
-state normal
-text ""
885 # Initialize the file types menu
887 if {[llength $data(-filetypes)]} {
888 # Default type and name to first entry
889 set initialtype
[lindex $data(-filetypes) 0]
890 set initialTypeName
[lindex $initialtype 0]
891 if {$data(-typevariable) ne
""} {
892 upvar #0 $data(-typevariable) typeVariable
893 if {[info exists typeVariable
]} {
894 set initialTypeName
$typeVariable
897 foreach type
$data(-filetypes) {
898 set title
[lindex $type 0]
899 set filter
[lindex $type 1]
900 $data(typeMenu
) add command
-label $title \
901 -command [list ::tk::dialog::file::SetFilter $w $type]
902 # string first avoids glob-pattern char issues
903 if {[string first
${initialTypeName
} $title] == 0} {
904 set initialtype
$type
907 SetFilter
$w $initialtype
908 $data(typeMenuBtn
) configure
-state normal
909 $data(typeMenuLab
) configure
-state normal
912 $data(typeMenuBtn
) configure
-state disabled
-takefocus 0
913 $data(typeMenuLab
) configure
-state disabled
917 # Withdraw the window, then update all the geometry information
918 # so we know how big it wants to be, then center the window in the
919 # display and de-iconify it.
921 ::tk::PlaceWindow $w widget
$data(-parent)
922 wm title
$w $data(-title)
924 # Set a grab and claim the focus too.
926 ::tk::SetFocusGrab $w $data(ent
)
927 $data(ent
) delete
0 end
928 $data(ent
) insert
0 $data(selectFile
)
929 $data(ent
) selection range
0 end
930 $data(ent
) icursor end
932 # Wait for the user to respond, then restore the focus and
933 # return the index of the selected button. Restore the focus
934 # before deleting the window, since otherwise the window manager
935 # may take the focus away so we can't redirect it. Finally,
936 # restore any grab that was in effect.
938 vwait ::tk::Priv(selectFilePath
)
940 ::tk::RestoreFocusGrab $w $data(ent
) withdraw
942 # Cleanup traces on selectPath variable
945 foreach trace [trace info variable data
(selectPath
)] {
946 trace remove
variable data
(selectPath
) [lindex $trace 0] [lindex $trace 1]
948 $data(dirMenuBtn
) configure
-textvariable {}
950 return $Priv(selectFilePath
)
953 # ::tk::dialog::file::Config --
955 # Configures the TK filedialog according to the argument list
957 proc ::tk::dialog::file::Config {dataName type argList
} {
958 upvar ::tk::dialog::file::$dataName data
962 # 0: Delete all variable that were set on data(selectPath) the
963 # last time the file dialog is used. The traces may cause troubles
964 # if the dialog is now used with a different -parent option.
966 foreach trace [trace info variable data
(selectPath
)] {
967 trace remove
variable data
(selectPath
) [lindex $trace 0] [lindex $trace 1]
970 # 1: the configuration specs
973 {-defaultextension "" "" ""}
974 {-filetypes "" "" ""}
975 {-initialdir "" "" ""}
976 {-initialfile "" "" ""}
979 {-typevariable "" "" ""}
982 # The "-multiple" option is only available for the "open" file dialog.
984 if {$type eq
"open"} {
985 lappend specs
{-multiple "" "" "0"}
988 # 2: default values depending on the type of the dialog
990 if {![info exists data
(selectPath
)]} {
991 # first time the dialog has been popped up
992 set data
(selectPath
) [pwd]
993 set data
(selectFile
) ""
996 # 3: parse the arguments
998 tclParseConfigSpec
::tk::dialog::file::$dataName $specs "" $argList
1000 if {$data(-title) eq
""} {
1001 if {$type eq
"open"} {
1002 set data
(-title) [mc
"Open"]
1004 set data
(-title) [mc
"Save As"]
1008 # 4: set the default directory and selection according to the -initial
1011 if {$data(-initialdir) ne
""} {
1012 # Ensure that initialdir is an absolute path name.
1013 if {[file isdirectory
$data(-initialdir)]} {
1015 cd $data(-initialdir)
1016 set data
(selectPath
) [pwd]
1019 set data
(selectPath
) [pwd]
1022 set data
(selectFile
) $data(-initialfile)
1024 # 5. Parse the -filetypes option
1026 set data
(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
1028 if {![winfo exists
$data(-parent)]} {
1029 error "bad window path name \"$data(-parent)\""
1032 # Set -multiple to a one or zero value (not other boolean types
1033 # like "yes") so we can use it in tests more easily.
1034 if {$type eq
"save"} {
1035 set data
(-multiple) 0
1036 } elseif
{$data(-multiple)} {
1037 set data
(-multiple) 1
1039 set data
(-multiple) 0
1043 proc ::tk::dialog::file::Create {w class
} {
1044 set dataName
[lindex [split $w .
] end
]
1045 upvar ::tk::dialog::file::$dataName data
1049 toplevel $w -class $class
1050 if {[tk windowingsystem
] eq
"x11"} {wm attributes
$w -type dialog
}
1051 pack [ttk
::frame $w.contents
] -expand 1 -fill both
1054 # f1: the frame with the directory option menu
1056 set f1
[ttk
::frame $w.contents.f1
]
1057 bind [::tk::AmpWidget ttk
::label $f1.lab
-text [mc
"&Directory:"]] \
1058 <<AltUnderlined
>> [list focus $f1.
menu]
1060 set data
(dirMenuBtn
) $f1.
menu
1061 if {![info exists data
(selectPath
)]} {
1062 set data
(selectPath
) ""
1064 set data
(dirMenu
) $f1.
menu.
menu
1065 ttk
::menubutton $f1.
menu -menu $data(dirMenu
) -direction flush \
1066 -textvariable [format %s
(selectPath
) ::tk::dialog::file::$dataName]
1067 [menu $data(dirMenu
) -tearoff 0] add
radiobutton -label "" -variable \
1068 [format %s
(selectPath
) ::tk::dialog::file::$dataName]
1069 set data
(upBtn
) [ttk
::button $f1.up
]
1070 if {![info exists Priv
(updirImage
)]} {
1071 set Priv
(updirImage
) [image create
bitmap -data {
1072 #define updir_width 28
1073 #define updir_height 16
1074 static char updir_bits
[] = {
1075 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1076 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1077 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1078 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1079 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1080 0xf0, 0xff, 0xff, 0x01};}]
1082 $data(upBtn
) configure
-image $Priv(updirImage
)
1084 $f1.
menu configure
-takefocus 1;# -highlightthickness 2
1086 pack $data(upBtn
) -side right
-padx 4 -fill both
1087 pack $f1.lab
-side left
-padx 4 -fill both
1088 pack $f1.
menu -expand yes
-fill both
-padx 4
1090 # data(icons): the IconList that list the files and directories.
1092 if {$class eq
"TkFDialog"} {
1093 if { $data(-multiple) } {
1094 set fNameCaption
[mc
"File &names:"]
1096 set fNameCaption
[mc
"File &name:"]
1098 set fTypeCaption
[mc
"Files of &type:"]
1099 set iconListCommand
[list ::tk::dialog::file::OkCmd $w]
1101 set fNameCaption
[mc
"&Selection:"]
1102 set iconListCommand
[list ::tk::dialog::file::chooseDir::DblClick $w]
1104 set data
(icons
) [::tk::IconList $w.contents.icons
\
1105 -command $iconListCommand -multiple $data(-multiple)]
1106 bind $data(icons
) <<ListboxSelect
>> \
1107 [list ::tk::dialog::file::ListBrowse $w]
1109 # f2: the frame with the OK button, cancel button, "file name" field
1110 # and file types field.
1112 set f2
[ttk
::frame $w.contents.f2
]
1113 bind [::tk::AmpWidget ttk
::label $f2.lab
-text $fNameCaption -anchor e
]\
1114 <<AltUnderlined
>> [list focus $f2.ent
]
1116 set data
(ent
) [ttk
::entry $f2.ent
]
1118 # The font to use for the icons. The default Canvas font on Unix
1120 set ::tk::$w.contents.icons
(font) [$data(ent
) cget
-font]
1122 # Make the file types bits only if this is a File Dialog
1123 if {$class eq
"TkFDialog"} {
1124 set data
(typeMenuLab
) [::tk::AmpWidget ttk
::label $f2.lab2
\
1125 -text $fTypeCaption -anchor e
]
1126 # -pady [$f2.lab cget -pady]
1127 set data
(typeMenuBtn
) [ttk
::menubutton $f2.
menu \
1130 set data
(typeMenu
) [menu $data(typeMenuBtn
).m
-tearoff 0]
1131 # $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w
1132 bind $data(typeMenuLab
) <<AltUnderlined
>> [list \
1133 focus $data(typeMenuBtn
)]
1136 # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
1137 # is true. Create it disabled so the binding doesn't trigger if it
1139 if {$class eq
"TkFDialog"} {
1140 set text [mc
"Show &Hidden Files and Directories"]
1142 set text [mc
"Show &Hidden Directories"]
1144 set data
(hiddenBtn
) [::tk::AmpWidget ttk
::checkbutton $f2.hidden
\
1145 -text $text -state disabled
\
1146 -variable ::tk::dialog::file::showHiddenVar \
1147 -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
1150 # the okBtn is created after the typeMenu so that the keyboard traversal
1151 # is in the right order, and add binding so that we find out when the
1152 # dialog is destroyed by the user (added here instead of to the overall
1153 # window so no confusion about how much <Destroy> gets called; exactly
1154 # once will do). [Bug 987169]
1156 set data
(okBtn
) [::tk::AmpWidget ttk
::button $f2.ok
\
1157 -text [mc
"&OK"] -default active
];# -pady 3]
1158 bind $data(okBtn
) <Destroy
> [list ::tk::dialog::file::Destroyed $w]
1159 set data
(cancelBtn
) [::tk::AmpWidget ttk
::button $f2.cancel
\
1160 -text [mc
"&Cancel"] -default normal
];# -pady 3]
1162 # grid the widgets in f2
1164 grid $f2.lab
$f2.ent
$data(okBtn
) -padx 4 -pady 3 -sticky ew
1165 grid configure
$f2.ent
-padx 2
1166 if {$class eq
"TkFDialog"} {
1167 grid $data(typeMenuLab
) $data(typeMenuBtn
) $data(cancelBtn
) \
1169 grid configure
$data(typeMenuBtn
) -padx 0
1170 grid $data(hiddenBtn
) -columnspan 2 -padx 4 -sticky ew
1172 grid $data(hiddenBtn
) - $data(cancelBtn
) -padx 4 -sticky ew
1174 grid columnconfigure
$f2 1 -weight 1
1176 # Pack all the frames together. We are done with widget construction.
1178 pack $f1 -side top
-fill x
-pady 4
1179 pack $f2 -side bottom
-pady 4 -fill x
1180 pack $data(icons
) -expand yes
-fill both
-padx 4 -pady 1
1182 # Set up the event handlers that are common to Directory and File Dialogs
1185 wm protocol
$w WM_DELETE_WINDOW
[list ::tk::dialog::file::CancelCmd $w]
1186 $data(upBtn
) configure
-command [list ::tk::dialog::file::UpDirCmd $w]
1187 $data(cancelBtn
) configure
-command [list ::tk::dialog::file::CancelCmd $w]
1188 bind $w <KeyPress-Escape
> [list $data(cancelBtn
) invoke
]
1189 bind $w <Alt-Key
> [list tk::AltKeyInDialog $w %A
]
1191 # Set up event handlers specific to File or Directory Dialogs
1193 if {$class eq
"TkFDialog"} {
1194 bind $data(ent
) <Return
> [list ::tk::dialog::file::ActivateEnt $w]
1195 $data(okBtn
) configure
-command [list ::tk::dialog::file::OkCmd $w]
1196 bind $w <Alt-t
> [format {
1197 if {[%s cget
-state] eq
"normal"} {
1200 } $data(typeMenuBtn
) $data(typeMenuBtn
)]
1202 set okCmd
[list ::tk::dialog::file::chooseDir::OkCmd $w]
1203 bind $data(ent
) <Return
> $okCmd
1204 $data(okBtn
) configure
-command $okCmd
1205 bind $w <Alt-s
> [list focus $data(ent
)]
1206 bind $w <Alt-o
> [list $data(okBtn
) invoke
]
1208 bind $w <Alt-h
> [list $data(hiddenBtn
) invoke
]
1209 bind $data(ent
) <Tab
> [list ::tk::dialog::file::CompleteEnt $w]
1211 # Build the focus group for all the entries
1213 ::tk::FocusGroup_Create $w
1214 ::tk::FocusGroup_BindIn $w $data(ent
) [list \
1215 ::tk::dialog::file::EntFocusIn $w]
1216 ::tk::FocusGroup_BindOut $w $data(ent
) [list \
1217 ::tk::dialog::file::EntFocusOut $w]
1220 # ::tk::dialog::file::SetSelectMode --
1222 # Set the select mode of the dialog to single select or multi-select.
1225 # w The dialog path.
1226 # multi 1 if the dialog is multi-select; 0 otherwise.
1231 proc ::tk::dialog::file::SetSelectMode {w multi
} {
1232 set dataName __tk_filedialog
1233 upvar ::tk::dialog::file::$dataName data
1235 set fNameCaption
[mc
"File &names:"]
1237 set fNameCaption
[mc
"File &name:"]
1239 set iconListCommand
[list ::tk::dialog::file::OkCmd $w]
1240 ::tk::SetAmpText $w.contents.f2.lab
$fNameCaption
1241 ::tk::IconList_Config $data(icons
) \
1242 [list -multiple $multi -command $iconListCommand]
1246 # ::tk::dialog::file::UpdateWhenIdle --
1248 # Creates an idle event handler which updates the dialog in idle
1249 # time. This is important because loading the directory may take a long
1250 # time and we don't want to load the same directory for multiple times
1251 # due to multiple concurrent events.
1253 proc ::tk::dialog::file::UpdateWhenIdle {w
} {
1254 upvar ::tk::dialog::file::[winfo name
$w] data
1256 if {[info exists data
(updateId
)]} {
1259 set data
(updateId
) [after idle
[list ::tk::dialog::file::Update $w]]
1263 # ::tk::dialog::file::Update --
1265 # Loads the files and directories into the IconList widget. Also
1266 # sets up the directory option menu for quick access to parent
1269 proc ::tk::dialog::file::Update {w
} {
1271 # This proc may be called within an idle handler. Make sure that the
1272 # window has not been destroyed before this proc is called
1273 if {![winfo exists
$w]} {
1276 set class
[winfo class
$w]
1277 if {($class ne
"TkFDialog") && ($class ne
"TkChooseDir")} {
1281 set dataName
[winfo name
$w]
1282 upvar ::tk::dialog::file::$dataName data
1285 unset -nocomplain data
(updateId
)
1287 if {![info exists Priv
(folderImage
)]} {
1288 set Priv
(folderImage
) [image create
photo -data {
1289 R0lGODlhEAAMAKEAAAD
//wAAAPD
/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
1290 QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw
==}]
1291 set Priv
(fileImage
) [image create
photo -data {
1292 R0lGODlhDAAMAKEAALLA3AAAAP
//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha
+IfWHsO
1293 rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw
==}]
1295 set folder
$Priv(folderImage
)
1296 set file $Priv(fileImage
)
1300 cd $data(selectPath
)
1302 # We cannot change directory to $data(selectPath). $data(selectPath)
1303 # should have been checked before ::tk::dialog::file::Update is called, so
1304 # we normally won't come to here. Anyways, give an error and abort
1306 tk_messageBox -type ok
-parent $w -icon warning
-message \
1307 [mc
"Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath
)]
1312 # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
1313 # so the user may still click and cause havoc ...
1315 set entCursor
[$data(ent
) cget
-cursor]
1316 set dlgCursor
[$w cget
-cursor]
1317 $data(ent
) configure
-cursor watch
1318 $w configure
-cursor watch
1321 ::tk::IconList_DeleteAll $data(icons
)
1323 set showHidden
$::tk::dialog::file::showHiddenVar
1326 # Using -directory [pwd] is better in some VFS cases.
1327 set cmd
[list glob -tails -directory [pwd] -type d
-nocomplain *]
1328 if {$showHidden} { lappend cmd .
* }
1329 set dirs
[lsort -dictionary -unique [eval $cmd]]
1332 if {$d eq
"." ||
$d eq
".."} {
1337 ::tk::IconList_Add $data(icons
) $folder $dirList
1339 if {$class eq
"TkFDialog"} {
1340 # Make the file list if this is a File Dialog, selecting all
1341 # but 'd'irectory type files.
1343 set cmd
[list glob -tails -directory [pwd] \
1344 -type {f b c l p s
} -nocomplain]
1345 if {$data(filter
) eq
"*"} {
1351 eval [list lappend cmd
] $data(filter
)
1353 set fileList
[lsort -dictionary -unique [eval $cmd]]
1354 ::tk::IconList_Add $data(icons
) $file $fileList
1357 ::tk::IconList_Arrange $data(icons
)
1359 # Update the Directory: option menu
1363 foreach subdir
[file split $data(selectPath
)] {
1364 set dir
[file join $dir $subdir]
1368 $data(dirMenu
) delete
0 end
1369 set var
[format %s
(selectPath
) ::tk::dialog::file::$dataName]
1370 foreach path
$list {
1371 $data(dirMenu
) add command
-label $path -command [list set $var $path]
1374 # Restore the PWD to the application's PWD
1378 if {$class eq
"TkFDialog"} {
1379 # Restore the Open/Save Button if this is a File Dialog
1381 if {$data(type
) eq
"open"} {
1382 ::tk::SetAmpText $data(okBtn
) [mc
"&Open"]
1384 ::tk::SetAmpText $data(okBtn
) [mc
"&Save"]
1388 # turn off the busy cursor.
1390 $data(ent
) configure
-cursor $entCursor
1391 $w configure
-cursor $dlgCursor
1394 # ::tk::dialog::file::SetPathSilently --
1396 # Sets data(selectPath) without invoking the trace procedure
1398 proc ::tk::dialog::file::SetPathSilently {w path
} {
1399 upvar ::tk::dialog::file::[winfo name
$w] data
1401 trace remove
variable data
(selectPath
) write
[list ::tk::dialog::file::SetPath $w]
1402 set data
(selectPath
) $path
1403 trace add
variable data
(selectPath
) write
[list ::tk::dialog::file::SetPath $w]
1407 # This proc gets called whenever data(selectPath) is set
1409 proc ::tk::dialog::file::SetPath {w name1 name2 op
} {
1410 if {[winfo exists
$w]} {
1411 upvar ::tk::dialog::file::[winfo name
$w] data
1413 # On directory dialogs, we keep the entry in sync with the currentdir.
1414 if {[winfo class
$w] eq
"TkChooseDir"} {
1415 $data(ent
) delete
0 end
1416 $data(ent
) insert end
$data(selectPath
)
1421 # This proc gets called whenever data(filter) is set
1423 proc ::tk::dialog::file::SetFilter {w type
} {
1424 upvar ::tk::dialog::file::[winfo name
$w] data
1425 upvar ::tk::$data(icons
) icons
1427 set data
(filterType
) $type
1428 set data
(filter
) [lindex $type 1]
1429 $data(typeMenuBtn
) configure
-text [lindex $type 0] ;#-indicatoron 1
1431 # If we aren't using a default extension, use the one suppled
1433 if {![info exists data
(extUsed
)]} {
1434 if {[string length
$data(-defaultextension)]} {
1441 if {!$data(extUsed
)} {
1442 # Get the first extension in the list that matches {^\*\.\w+$}
1443 # and remove all * from the filter.
1444 set index
[lsearch -regexp $data(filter
) {^
\*\.
\w
+$}]
1446 set data
(-defaultextension) \
1447 [string trimleft
[lindex $data(filter
) $index] "*"]
1449 # Couldn't find anything! Reset to a safe default...
1450 set data
(-defaultextension) ""
1454 $icons(sbar
) set 0.0 0.0
1459 # tk::dialog::file::ResolveFile --
1461 # Interpret the user's text input in a file selection dialog.
1464 # (1) ~ substitution
1465 # (2) resolve all instances of . and ..
1466 # (3) check for non-existent files/directories
1467 # (4) check for chdir permissions
1468 # (5) conversion of environment variable references to their
1469 # contents (once only)
1472 # context: the current directory you are in
1473 # text: the text entered by the user
1474 # defaultext: the default extension to add to files with no extension
1475 # expandEnv: whether to expand environment variables (yes by default)
1478 # [list $flag $directory $file]
1480 # flag = OK : valid input
1481 # = PATTERN : valid directory/pattern
1482 # = PATH : the directory does not exist
1483 # = FILE : the directory exists by the file doesn't
1485 # = CHDIR : Cannot change to the directory
1486 # = ERROR : Invalid entry
1488 # directory : valid only if flag = OK or PATTERN or FILE
1489 # file : valid only if flag = OK or PATTERN
1491 # directory may not be the same as context, because text may contain
1492 # a subdirectory name
1494 proc ::tk::dialog::file::ResolveFile {context
text defaultext
{expandEnv
1}} {
1497 set path
[JoinFile
$context $text]
1499 # If the file has no extension, append the default. Be careful not
1500 # to do this for directories, otherwise typing a dirname in the box
1501 # will give back "dirname.extension" instead of trying to change dir.
1503 ![file isdirectory
$path] && ([file ext
$path] eq
"") &&
1504 ![string match
{$*} [file tail
$path]]
1506 set path
"$path$defaultext"
1509 if {[catch {file exists
$path}]} {
1510 # This "if" block can be safely removed if the following code
1511 # stop generating errors.
1513 # file exists ~nonsuchuser
1515 return [list ERROR
$path ""]
1518 if {[file exists
$path]} {
1519 if {[file isdirectory
$path]} {
1520 if {[catch {cd $path}]} {
1521 return [list CHDIR
$path ""]
1528 if {[catch {cd [file dirname
$path]}]} {
1529 return [list CHDIR
[file dirname
$path] ""]
1532 set file [file tail
$path]
1537 set dirname
[file dirname
$path]
1538 if {[file exists
$dirname]} {
1539 if {[catch {cd $dirname}]} {
1540 return [list CHDIR
$dirname ""]
1544 set file [file tail
$path]
1545 # It's nothing else, so check to see if it is an env-reference
1546 if {$expandEnv && [string match
{$*} $file]} {
1547 set var
[string range
$file 1 end
]
1548 if {[info exist
::env($var)]} {
1549 return [ResolveFile
$context $::env($var) $defaultext 0]
1552 if {[regexp {[*?
]} $file]} {
1558 set directory
$dirname
1559 set file [file tail
$path]
1561 # It's nothing else, so check to see if it is an env-reference
1562 if {$expandEnv && [string match
{$*} $file]} {
1563 set var
[string range
$file 1 end
]
1564 if {[info exist
::env($var)]} {
1565 return [ResolveFile
$context $::env($var) $defaultext 0]
1571 return [list $flag $directory $file]
1575 # Gets called when the entry box gets keyboard focus. We clear the selection
1576 # from the icon list . This way the user can be certain that the input in the
1577 # entry box is the selection.
1579 proc ::tk::dialog::file::EntFocusIn {w
} {
1580 upvar ::tk::dialog::file::[winfo name
$w] data
1582 if {[$data(ent
) get
] ne
""} {
1583 $data(ent
) selection range
0 end
1584 $data(ent
) icursor end
1586 $data(ent
) selection clear
1589 if {[winfo class
$w] eq
"TkFDialog"} {
1590 # If this is a File Dialog, make sure the buttons are labeled right.
1591 if {$data(type
) eq
"open"} {
1592 ::tk::SetAmpText $data(okBtn
) [mc
"&Open"]
1594 ::tk::SetAmpText $data(okBtn
) [mc
"&Save"]
1599 proc ::tk::dialog::file::EntFocusOut {w
} {
1600 upvar ::tk::dialog::file::[winfo name
$w] data
1602 $data(ent
) selection clear
1606 # Gets called when user presses Return in the "File name" entry.
1608 proc ::tk::dialog::file::ActivateEnt {w
} {
1609 upvar ::tk::dialog::file::[winfo name
$w] data
1611 set text [$data(ent
) get
]
1612 if {$data(-multiple)} {
1614 VerifyFileName
$w $t
1617 VerifyFileName
$w $text
1621 # Verification procedure
1623 proc ::tk::dialog::file::VerifyFileName {w
filename} {
1624 upvar ::tk::dialog::file::[winfo name
$w] data
1626 set list [ResolveFile
$data(selectPath
) $filename $data(-defaultextension)]
1627 foreach {flag path
file} $list {
1634 # user has entered an existing (sub)directory
1635 set data
(selectPath
) $path
1636 $data(ent
) delete
0 end
1638 SetPathSilently
$w $path
1639 if {$data(-multiple)} {
1640 lappend data
(selectFile
) $file
1642 set data
(selectFile
) $file
1648 set data
(selectPath
) $path
1649 set data
(filter
) $file
1652 if {$data(type
) eq
"open"} {
1653 tk_messageBox -icon warning
-type ok
-parent $w \
1654 -message [mc
"File \"%1\$s\" does not exist." \
1655 [file join $path $file]]
1656 $data(ent
) selection range
0 end
1657 $data(ent
) icursor end
1659 SetPathSilently
$w $path
1660 if {$data(-multiple)} {
1661 lappend data
(selectFile
) $file
1663 set data
(selectFile
) $file
1669 tk_messageBox -icon warning
-type ok
-parent $w \
1670 -message [mc
"Directory \"%1\$s\" does not exist." $path]
1671 $data(ent
) selection range
0 end
1672 $data(ent
) icursor end
1675 tk_messageBox -type ok
-parent $w -icon warning
-message \
1676 [mc
"Cannot change to the directory\
1677 \"%1\$s\".\nPermission denied." $path]
1678 $data(ent
) selection range
0 end
1679 $data(ent
) icursor end
1682 tk_messageBox -type ok
-parent $w -icon warning
-message \
1683 [mc
"Invalid file name \"%1\$s\"." $path]
1684 $data(ent
) selection range
0 end
1685 $data(ent
) icursor end
1690 # Gets called when user presses the Alt-s or Alt-o keys.
1692 proc ::tk::dialog::file::InvokeBtn {w key
} {
1693 upvar ::tk::dialog::file::[winfo name
$w] data
1695 if {[$data(okBtn
) cget
-text] eq
$key} {
1700 # Gets called when user presses the "parent directory" button
1702 proc ::tk::dialog::file::UpDirCmd {w
} {
1703 upvar ::tk::dialog::file::[winfo name
$w] data
1705 if {$data(selectPath
) ne
"/"} {
1706 set data
(selectPath
) [file dirname
$data(selectPath
)]
1710 # Join a file name to a path name. The "file join" command will break
1711 # if the filename begins with ~
1713 proc ::tk::dialog::file::JoinFile {path
file} {
1714 if {[string match
{~
*} $file] && [file exists
$path/$file]} {
1715 return [file join $path .
/$file]
1717 return [file join $path $file]
1721 # Gets called when user presses the "OK" button
1723 proc ::tk::dialog::file::OkCmd {w
} {
1724 upvar ::tk::dialog::file::[winfo name
$w] data
1727 foreach item
[::tk::IconList_CurSelection $data(icons
)] {
1728 lappend filenames
[::tk::IconList_Get $data(icons
) $item]
1731 if {([llength $filenames] && !$data(-multiple)) ||
\
1732 ($data(-multiple) && ([llength $filenames] == 1))} {
1733 set filename [lindex $filenames 0]
1734 set file [JoinFile
$data(selectPath
) $filename]
1735 if {[file isdirectory
$file]} {
1736 ListInvoke
$w [list $filename]
1744 # Gets called when user presses the "Cancel" button
1746 proc ::tk::dialog::file::CancelCmd {w
} {
1747 upvar ::tk::dialog::file::[winfo name
$w] data
1750 bind $data(okBtn
) <Destroy
> {}
1751 set Priv
(selectFilePath
) ""
1754 # Gets called when user destroys the dialog directly [Bug 987169]
1756 proc ::tk::dialog::file::Destroyed {w
} {
1757 upvar ::tk::dialog::file::[winfo name
$w] data
1760 set Priv
(selectFilePath
) ""
1763 # Gets called when user browses the IconList widget (dragging mouse, arrow
1766 proc ::tk::dialog::file::ListBrowse {w
} {
1767 upvar ::tk::dialog::file::[winfo name
$w] data
1770 foreach item
[::tk::IconList_CurSelection $data(icons
)] {
1771 lappend text [::tk::IconList_Get $data(icons
) $item]
1773 if {[llength $text] == 0} {
1776 if {$data(-multiple)} {
1778 foreach file $text {
1779 set fullfile
[JoinFile
$data(selectPath
) $file]
1780 if { ![file isdirectory
$fullfile] } {
1781 lappend newtext
$file
1787 set text [lindex $text 0]
1788 set file [JoinFile
$data(selectPath
) $text]
1789 set isDir
[file isdirectory
$file]
1792 $data(ent
) delete
0 end
1793 $data(ent
) insert
0 $text
1795 if {[winfo class
$w] eq
"TkFDialog"} {
1796 if {$data(type
) eq
"open"} {
1797 ::tk::SetAmpText $data(okBtn
) [mc
"&Open"]
1799 ::tk::SetAmpText $data(okBtn
) [mc
"&Save"]
1802 } elseif
{[winfo class
$w] eq
"TkFDialog"} {
1803 ::tk::SetAmpText $data(okBtn
) [mc
"&Open"]
1807 # Gets called when user invokes the IconList widget (double-click,
1810 proc ::tk::dialog::file::ListInvoke {w filenames
} {
1811 upvar ::tk::dialog::file::[winfo name
$w] data
1813 if {[llength $filenames] == 0} {
1817 set file [JoinFile
$data(selectPath
) [lindex $filenames 0]]
1819 set class
[winfo class
$w]
1820 if {$class eq
"TkChooseDir" ||
[file isdirectory
$file]} {
1822 if {[catch {cd $file}]} {
1823 tk_messageBox -type ok
-parent $w -icon warning
-message \
1824 [mc
"Cannot change to the directory \"%1\$s\".\nPermission denied." $file]
1827 set data
(selectPath
) $file
1830 if {$data(-multiple)} {
1831 set data
(selectFile
) $filenames
1833 set data
(selectFile
) $file
1839 # ::tk::dialog::file::Done --
1841 # Gets called when user has input a valid filename. Pops up a
1842 # dialog box to confirm selection when necessary. Sets the
1843 # tk::Priv(selectFilePath) variable, which will break the "vwait"
1844 # loop in ::tk::dialog::file:: and return the selected filename to the
1845 # script that calls tk_getOpenFile or tk_getSaveFile
1847 proc ::tk::dialog::file::Done {w
{selectFilePath
""}} {
1848 upvar ::tk::dialog::file::[winfo name
$w] data
1851 if {$selectFilePath eq
""} {
1852 if {$data(-multiple)} {
1853 set selectFilePath
{}
1854 foreach f
$data(selectFile
) {
1855 lappend selectFilePath
[JoinFile
$data(selectPath
) $f]
1858 set selectFilePath
[JoinFile
$data(selectPath
) $data(selectFile
)]
1861 set Priv
(selectFile
) $data(selectFile
)
1862 set Priv
(selectPath
) $data(selectPath
)
1864 if {($data(type
) eq
"save") && [file exists
$selectFilePath]} {
1865 set reply
[tk_messageBox -icon warning
-type yesno
-parent $w \
1866 -message [mc
"File \"%1\$s\" already exists.\nDo you want\
1867 to overwrite it?" $selectFilePath]]
1868 if {$reply eq
"no"} {
1872 if {[info exists data
(-typevariable)] && $data(-typevariable) ne
""
1873 && [info exists data
(-filetypes)] && [llength $data(-filetypes)]
1874 && [info exists data
(filterType
)] && $data(filterType
) ne
""} {
1875 upvar #0 $data(-typevariable) typeVariable
1876 set typeVariable
[lindex $data(filterType
) 0]
1879 bind $data(okBtn
) <Destroy
> {}
1880 set Priv
(selectFilePath
) $selectFilePath
1883 proc ::tk::dialog::file::CompleteEnt {w
} {
1884 upvar ::tk::dialog::file::[winfo name
$w] data
1885 set f
[$data(ent
) get
]
1886 if {$data(-multiple)} {
1887 if {[catch {llength $f} len
] ||
$len != 1} {
1893 # Get list of matching filenames and dirnames
1894 set globF
[list glob -tails -directory $data(selectPath
) \
1895 -type {f b c l p s
} -nocomplain]
1896 set globD
[list glob -tails -directory $data(selectPath
) -type d
\
1898 if {$data(filter
) eq
"*"} {
1900 if {$::tk::dialog::file::showHiddenVar} {
1904 if {[winfo class
$w] eq
"TkFDialog"} {
1905 set files
[lsort -dictionary -unique [{*}$globF]]
1909 set dirs
[lsort -dictionary -unique [{*}$globD]]
1911 if {$::tk::dialog::file::showHiddenVar} {
1914 if {[winfo class
$w] eq
"TkFDialog"} {
1915 set files
[lsort -dictionary -unique [{*}$globF {*}$data(filter
)]]
1919 set dirs
[lsort -dictionary -unique [{*}$globD]]
1922 set dirs
[lsearch -all -not -exact -inline $dirs .
]
1923 set dirs
[lsearch -all -not -exact -inline $dirs ..
]
1925 foreach d
$dirs {lappend dirs2
$d/}
1927 set targets
[concat \
1928 [lsearch -glob -all -inline $files $f*] \
1929 [lsearch -glob -all -inline $dirs2 $f*]]
1931 if {[llength $targets] == 1} {
1933 set f
[lindex $targets 0]
1934 } elseif
{$f in
$targets ||
[llength $targets] == 0} {
1935 if {[string length
$f] > 0} {
1939 } elseif
{[llength $targets] > 1} {
1940 # Multiple possibles
1941 if {[string length
$f] == 0} {
1944 set t0
[lindex $targets 0]
1945 for {set len
[string length
$t0]} {$len>0} {} {
1947 foreach s
$targets {
1948 if {![string equal
-length $len $s $t0]} {
1954 if {$allmatch} break
1956 set f
[string range
$t0 0 $len]
1959 if {$data(-multiple)} {
1962 $data(ent
) delete
0 end
1963 $data(ent
) insert
0 $f