78112e14f067e13956f2639f9d0703204d842c6f
[msysgit.git] / mingw / lib / tk8.5 / tkfbox.tcl
blob78112e14f067e13956f2639f9d0703204d842c6f
1 # tkfbox.tcl --
3 # Implements the "TK" standard file selection dialog box. This
4 # dialog box is used on the Unix platforms whenever the tk_strictMotif
5 # flag is not set.
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 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
16 # See the file "license.terms" for information on usage and redistribution
17 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
20 package require Ttk
22 #----------------------------------------------------------------------
24 # I C O N L I S T
26 # This is a pseudo-widget that implements the icon list inside the
27 # ::tk::dialog::file:: dialog box.
29 #----------------------------------------------------------------------
31 # ::tk::IconList --
33 # Creates an IconList widget.
35 proc ::tk::IconList {w args} {
36 IconList_Config $w $args
37 IconList_Create $w
40 proc ::tk::IconList_Index {w i} {
41 upvar #0 ::tk::$w data ::tk::$w:itemList itemList
42 if {![info exists data(list)]} {
43 set data(list) {}
45 switch -regexp -- $i {
46 "^-?[0-9]+$" {
47 if {$i < 0} {
48 set i 0
50 if {$i >= [llength $data(list)]} {
51 set i [expr {[llength $data(list)] - 1}]
53 return $i
55 "^active$" {
56 return $data(index,active)
58 "^anchor$" {
59 return $data(index,anchor)
61 "^end$" {
62 return [llength $data(list)]
64 "@-?[0-9]+,-?[0-9]+" {
65 foreach {x y} [scan $i "@%d,%d"] {
66 break
68 set item [$data(canvas) find closest \
69 [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
70 return [lindex [$data(canvas) itemcget $item -tags] 1]
75 proc ::tk::IconList_Selection {w op args} {
76 upvar ::tk::$w data
77 switch -exact -- $op {
78 "anchor" {
79 if {[llength $args] == 1} {
80 set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]
81 } else {
82 return $data(index,anchor)
85 "clear" {
86 if {[llength $args] == 2} {
87 foreach {first last} $args {
88 break
90 } elseif {[llength $args] == 1} {
91 set first [set last [lindex $args 0]]
92 } else {
93 error "wrong # args: should be [lindex [info level 0] 0] path\
94 clear first ?last?"
96 set first [IconList_Index $w $first]
97 set last [IconList_Index $w $last]
98 if {$first > $last} {
99 set tmp $first
100 set first $last
101 set last $tmp
103 set ind 0
104 foreach item $data(selection) {
105 if { $item >= $first } {
106 set first $ind
107 break
109 incr ind
111 set ind [expr {[llength $data(selection)] - 1}]
112 for {} {$ind >= 0} {incr ind -1} {
113 set item [lindex $data(selection) $ind]
114 if { $item <= $last } {
115 set last $ind
116 break
120 if { $first > $last } {
121 return
123 set data(selection) [lreplace $data(selection) $first $last]
124 event generate $w <<ListboxSelect>>
125 IconList_DrawSelection $w
127 "includes" {
128 set index [lsearch -exact $data(selection) [lindex $args 0]]
129 return [expr {$index != -1}]
131 "set" {
132 if { [llength $args] == 2 } {
133 foreach {first last} $args {
134 break
136 } elseif { [llength $args] == 1 } {
137 set last [set first [lindex $args 0]]
138 } else {
139 error "wrong # args: should be [lindex [info level 0] 0] path\
140 set first ?last?"
143 set first [IconList_Index $w $first]
144 set last [IconList_Index $w $last]
145 if { $first > $last } {
146 set tmp $first
147 set first $last
148 set last $tmp
150 for {set i $first} {$i <= $last} {incr i} {
151 lappend data(selection) $i
153 set data(selection) [lsort -integer -unique $data(selection)]
154 event generate $w <<ListboxSelect>>
155 IconList_DrawSelection $w
160 proc ::tk::IconList_CurSelection {w} {
161 upvar ::tk::$w data
162 return $data(selection)
165 proc ::tk::IconList_DrawSelection {w} {
166 upvar ::tk::$w data
167 upvar ::tk::$w:itemList itemList
169 $data(canvas) delete selection
170 $data(canvas) itemconfigure selectionText -fill black
171 $data(canvas) dtag selectionText
172 set cbg [ttk::style lookup TEntry -selectbackground focus]
173 set cfg [ttk::style lookup TEntry -selectforeground focus]
174 foreach item $data(selection) {
175 set rTag [lindex [lindex $data(list) $item] 2]
176 foreach {iTag tTag text serial} $itemList($rTag) {
177 break
180 set bbox [$data(canvas) bbox $tTag]
181 $data(canvas) create rect $bbox -fill $cbg -outline $cbg \
182 -tags selection
183 $data(canvas) itemconfigure $tTag -fill $cfg -tags selectionText
185 $data(canvas) lower selection
186 return
189 proc ::tk::IconList_Get {w item} {
190 upvar ::tk::$w data
191 upvar ::tk::$w:itemList itemList
192 set rTag [lindex [lindex $data(list) $item] 2]
193 foreach {iTag tTag text serial} $itemList($rTag) {
194 break
196 return $text
199 # ::tk::IconList_Config --
201 # Configure the widget variables of IconList, according to the command
202 # line arguments.
204 proc ::tk::IconList_Config {w argList} {
206 # 1: the configuration specs
208 set specs {
209 {-command "" "" ""}
210 {-multiple "" "" "0"}
213 # 2: parse the arguments
215 tclParseConfigSpec ::tk::$w $specs "" $argList
218 # ::tk::IconList_Create --
220 # Creates an IconList widget by assembling a canvas widget and a
221 # scrollbar widget. Sets all the bindings necessary for the IconList's
222 # operations.
224 proc ::tk::IconList_Create {w} {
225 upvar ::tk::$w data
227 ttk::frame $w
228 ttk::entry $w.cHull -takefocus 0 -cursor {}
229 set data(sbar) [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0]
230 catch {$data(sbar) configure -highlightthickness 0}
231 set data(canvas) [canvas $w.cHull.canvas -highlightthick 0 \
232 -width 400 -height 120 -takefocus 1 -background white]
233 pack $data(sbar) -side bottom -fill x -padx 2 -in $w.cHull -pady {0 2}
234 pack $data(canvas) -expand yes -fill both -padx 2 -pady {2 0}
235 pack $w.cHull -expand yes -fill both -ipadx 2 -ipady 2
237 $data(sbar) configure -command [list $data(canvas) xview]
238 $data(canvas) configure -xscrollcommand [list $data(sbar) set]
240 # Initializes the max icon/text width and height and other variables
242 set data(maxIW) 1
243 set data(maxIH) 1
244 set data(maxTW) 1
245 set data(maxTH) 1
246 set data(numItems) 0
247 set data(noScroll) 1
248 set data(selection) {}
249 set data(index,anchor) ""
250 set fg [option get $data(canvas) foreground Foreground]
251 if {$fg eq ""} {
252 set data(fill) black
253 } else {
254 set data(fill) $fg
257 # Creates the event bindings.
259 bind $data(canvas) <Configure> [list tk::IconList_Arrange $w]
261 bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y]
262 bind $data(canvas) <B1-Motion> [list tk::IconList_Motion1 $w %x %y]
263 bind $data(canvas) <B1-Leave> [list tk::IconList_Leave1 $w %x %y]
264 bind $data(canvas) <Control-1> [list tk::IconList_CtrlBtn1 $w %x %y]
265 bind $data(canvas) <Shift-1> [list tk::IconList_ShiftBtn1 $w %x %y]
266 bind $data(canvas) <B1-Enter> [list tk::CancelRepeat]
267 bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]
268 bind $data(canvas) <Double-ButtonRelease-1> \
269 [list tk::IconList_Double1 $w %x %y]
271 bind $data(canvas) <Control-B1-Motion> {;}
272 bind $data(canvas) <Shift-B1-Motion> \
273 [list tk::IconList_ShiftMotion1 $w %x %y]
275 bind $data(canvas) <Up> [list tk::IconList_UpDown $w -1]
276 bind $data(canvas) <Down> [list tk::IconList_UpDown $w 1]
277 bind $data(canvas) <Left> [list tk::IconList_LeftRight $w -1]
278 bind $data(canvas) <Right> [list tk::IconList_LeftRight $w 1]
279 bind $data(canvas) <Return> [list tk::IconList_ReturnKey $w]
280 bind $data(canvas) <KeyPress> [list tk::IconList_KeyPress $w %A]
281 bind $data(canvas) <Control-KeyPress> ";"
282 bind $data(canvas) <Alt-KeyPress> ";"
284 bind $data(canvas) <FocusIn> [list tk::IconList_FocusIn $w]
285 bind $data(canvas) <FocusOut> [list tk::IconList_FocusOut $w]
287 return $w
290 # ::tk::IconList_AutoScan --
292 # This procedure is invoked when the mouse leaves an entry window
293 # with button 1 down. It scrolls the window up, down, left, or
294 # right, depending on where the mouse left the window, and reschedules
295 # itself as an "after" command so that the window continues to scroll until
296 # the mouse moves back into the window or the mouse button is released.
298 # Arguments:
299 # w - The IconList window.
301 proc ::tk::IconList_AutoScan {w} {
302 upvar ::tk::$w data
303 variable ::tk::Priv
305 if {![winfo exists $w]} return
306 set x $Priv(x)
307 set y $Priv(y)
309 if {$data(noScroll)} {
310 return
312 if {$x >= [winfo width $data(canvas)]} {
313 $data(canvas) xview scroll 1 units
314 } elseif {$x < 0} {
315 $data(canvas) xview scroll -1 units
316 } elseif {$y >= [winfo height $data(canvas)]} {
317 # do nothing
318 } elseif {$y < 0} {
319 # do nothing
320 } else {
321 return
324 IconList_Motion1 $w $x $y
325 set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]
328 # Deletes all the items inside the canvas subwidget and reset the IconList's
329 # state.
331 proc ::tk::IconList_DeleteAll {w} {
332 upvar ::tk::$w data
333 upvar ::tk::$w:itemList itemList
335 $data(canvas) delete all
336 unset -nocomplain data(selected) data(rect) data(list) itemList
337 set data(maxIW) 1
338 set data(maxIH) 1
339 set data(maxTW) 1
340 set data(maxTH) 1
341 set data(numItems) 0
342 set data(noScroll) 1
343 set data(selection) {}
344 set data(index,anchor) ""
345 $data(sbar) set 0.0 1.0
346 $data(canvas) xview moveto 0
349 # Adds an icon into the IconList with the designated image and text
351 proc ::tk::IconList_Add {w image items} {
352 upvar ::tk::$w data
353 upvar ::tk::$w:itemList itemList
354 upvar ::tk::$w:textList textList
356 foreach text $items {
357 set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \
358 -tags [list icon $data(numItems) item$data(numItems)]]
359 set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \
360 -font $data(font) -fill $data(fill) \
361 -tags [list text $data(numItems) item$data(numItems)]]
362 set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline "" \
363 -tags [list rect $data(numItems) item$data(numItems)]]
365 foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {
366 break
368 set iW [expr {$x2 - $x1}]
369 set iH [expr {$y2 - $y1}]
370 if {$data(maxIW) < $iW} {
371 set data(maxIW) $iW
373 if {$data(maxIH) < $iH} {
374 set data(maxIH) $iH
377 foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {
378 break
380 set tW [expr {$x2 - $x1}]
381 set tH [expr {$y2 - $y1}]
382 if {$data(maxTW) < $tW} {
383 set data(maxTW) $tW
385 if {$data(maxTH) < $tH} {
386 set data(maxTH) $tH
389 lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \
390 $tH $data(numItems)]
391 set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
392 set textList($data(numItems)) [string tolower $text]
393 incr data(numItems)
397 # Places the icons in a column-major arrangement.
399 proc ::tk::IconList_Arrange {w} {
400 upvar ::tk::$w data
402 if {![info exists data(list)]} {
403 if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
404 set data(noScroll) 1
405 $data(sbar) configure -command ""
407 return
410 set W [winfo width $data(canvas)]
411 set H [winfo height $data(canvas)]
412 set pad [expr {[$data(canvas) cget -highlightthickness] + \
413 [$data(canvas) cget -bd]}]
414 if {$pad < 2} {
415 set pad 2
418 incr W -[expr {$pad*2}]
419 incr H -[expr {$pad*2}]
421 set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
422 if {$data(maxTH) > $data(maxIH)} {
423 set dy $data(maxTH)
424 } else {
425 set dy $data(maxIH)
427 incr dy 2
428 set shift [expr {$data(maxIW) + 4}]
430 set x [expr {$pad * 2}]
431 set y [expr {$pad * 1}] ; # Why * 1 ?
432 set usedColumn 0
433 foreach sublist $data(list) {
434 set usedColumn 1
435 foreach {iTag tTag rTag iW iH tW tH} $sublist {
436 break
439 set i_dy [expr {($dy - $iH)/2}]
440 set t_dy [expr {($dy - $tH)/2}]
442 $data(canvas) coords $iTag $x [expr {$y + $i_dy}]
443 $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
444 $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
446 incr y $dy
447 if {($y + $dy) > $H} {
448 set y [expr {$pad * 1}] ; # *1 ?
449 incr x $dx
450 set usedColumn 0
454 if {$usedColumn} {
455 set sW [expr {$x + $dx}]
456 } else {
457 set sW $x
460 if {$sW < $W} {
461 $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
462 $data(sbar) configure -command ""
463 $data(canvas) xview moveto 0
464 set data(noScroll) 1
465 } else {
466 $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
467 $data(sbar) configure -command [list $data(canvas) xview]
468 set data(noScroll) 0
471 set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
472 if {$data(itemsPerColumn) < 1} {
473 set data(itemsPerColumn) 1
476 IconList_DrawSelection $w
479 # Gets called when the user invokes the IconList (usually by double-clicking
480 # or pressing the Return key).
482 proc ::tk::IconList_Invoke {w} {
483 upvar ::tk::$w data
485 if {$data(-command) ne "" && [llength $data(selection)]} {
486 uplevel #0 $data(-command)
490 # ::tk::IconList_See --
492 # If the item is not (completely) visible, scroll the canvas so that
493 # it becomes visible.
494 proc ::tk::IconList_See {w rTag} {
495 upvar ::tk::$w data
496 upvar ::tk::$w:itemList itemList
498 if {$data(noScroll)} {
499 return
501 set sRegion [$data(canvas) cget -scrollregion]
502 if {$sRegion eq ""} {
503 return
506 if { $rTag < 0 || $rTag >= [llength $data(list)] } {
507 return
510 set bbox [$data(canvas) bbox item$rTag]
511 set pad [expr {[$data(canvas) cget -highlightthickness] + \
512 [$data(canvas) cget -bd]}]
514 set x1 [lindex $bbox 0]
515 set x2 [lindex $bbox 2]
516 incr x1 -[expr {$pad * 2}]
517 incr x2 -[expr {$pad * 1}] ; # *1 ?
519 set cW [expr {[winfo width $data(canvas)] - $pad*2}]
521 set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
522 set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
523 set oldDispX $dispX
525 # check if out of the right edge
527 if {($x2 - $dispX) >= $cW} {
528 set dispX [expr {$x2 - $cW}]
530 # check if out of the left edge
532 if {($x1 - $dispX) < 0} {
533 set dispX $x1
536 if {$oldDispX ne $dispX} {
537 set fraction [expr {double($dispX)/double($scrollW)}]
538 $data(canvas) xview moveto $fraction
542 proc ::tk::IconList_Btn1 {w x y} {
543 upvar ::tk::$w data
545 focus $data(canvas)
546 set i [IconList_Index $w @$x,$y]
547 if {$i eq ""} {
548 return
550 IconList_Selection $w clear 0 end
551 IconList_Selection $w set $i
552 IconList_Selection $w anchor $i
555 proc ::tk::IconList_CtrlBtn1 {w x y} {
556 upvar ::tk::$w data
558 if { $data(-multiple) } {
559 focus $data(canvas)
560 set i [IconList_Index $w @$x,$y]
561 if {$i eq ""} {
562 return
564 if { [IconList_Selection $w includes $i] } {
565 IconList_Selection $w clear $i
566 } else {
567 IconList_Selection $w set $i
568 IconList_Selection $w anchor $i
573 proc ::tk::IconList_ShiftBtn1 {w x y} {
574 upvar ::tk::$w data
576 if { $data(-multiple) } {
577 focus $data(canvas)
578 set i [IconList_Index $w @$x,$y]
579 if {$i eq ""} {
580 return
582 if {[IconList_Index $w anchor] eq ""} {
583 IconList_Selection $w anchor $i
585 IconList_Selection $w clear 0 end
586 IconList_Selection $w set anchor $i
590 # Gets called on button-1 motions
592 proc ::tk::IconList_Motion1 {w x y} {
593 variable ::tk::Priv
594 set Priv(x) $x
595 set Priv(y) $y
596 set i [IconList_Index $w @$x,$y]
597 if {$i eq ""} {
598 return
600 IconList_Selection $w clear 0 end
601 IconList_Selection $w set $i
604 proc ::tk::IconList_ShiftMotion1 {w x y} {
605 upvar ::tk::$w data
606 variable ::tk::Priv
607 set Priv(x) $x
608 set Priv(y) $y
609 set i [IconList_Index $w @$x,$y]
610 if {$i eq ""} {
611 return
613 IconList_Selection $w clear 0 end
614 IconList_Selection $w set anchor $i
617 proc ::tk::IconList_Double1 {w x y} {
618 upvar ::tk::$w data
620 if {[llength $data(selection)]} {
621 IconList_Invoke $w
625 proc ::tk::IconList_ReturnKey {w} {
626 IconList_Invoke $w
629 proc ::tk::IconList_Leave1 {w x y} {
630 variable ::tk::Priv
632 set Priv(x) $x
633 set Priv(y) $y
634 IconList_AutoScan $w
637 proc ::tk::IconList_FocusIn {w} {
638 upvar ::tk::$w data
640 $w.cHull state focus
641 if {![info exists data(list)]} {
642 return
645 if {[llength $data(selection)]} {
646 IconList_DrawSelection $w
650 proc ::tk::IconList_FocusOut {w} {
651 $w.cHull state !focus
652 IconList_Selection $w clear 0 end
655 # ::tk::IconList_UpDown --
657 # Moves the active element up or down by one element
659 # Arguments:
660 # w - The IconList widget.
661 # amount - +1 to move down one item, -1 to move back one item.
663 proc ::tk::IconList_UpDown {w amount} {
664 upvar ::tk::$w data
666 if {![info exists data(list)]} {
667 return
670 set curr [tk::IconList_CurSelection $w]
671 if { [llength $curr] == 0 } {
672 set i 0
673 } else {
674 set i [tk::IconList_Index $w anchor]
675 if {$i eq ""} {
676 return
678 incr i $amount
680 IconList_Selection $w clear 0 end
681 IconList_Selection $w set $i
682 IconList_Selection $w anchor $i
683 IconList_See $w $i
686 # ::tk::IconList_LeftRight --
688 # Moves the active element left or right by one column
690 # Arguments:
691 # w - The IconList widget.
692 # amount - +1 to move right one column, -1 to move left one column.
694 proc ::tk::IconList_LeftRight {w amount} {
695 upvar ::tk::$w data
697 if {![info exists data(list)]} {
698 return
701 set curr [IconList_CurSelection $w]
702 if { [llength $curr] == 0 } {
703 set i 0
704 } else {
705 set i [IconList_Index $w anchor]
706 if {$i eq ""} {
707 return
709 incr i [expr {$amount*$data(itemsPerColumn)}]
711 IconList_Selection $w clear 0 end
712 IconList_Selection $w set $i
713 IconList_Selection $w anchor $i
714 IconList_See $w $i
717 #----------------------------------------------------------------------
718 # Accelerator key bindings
719 #----------------------------------------------------------------------
721 # ::tk::IconList_KeyPress --
723 # Gets called when user enters an arbitrary key in the listbox.
725 proc ::tk::IconList_KeyPress {w key} {
726 variable ::tk::Priv
728 append Priv(ILAccel,$w) $key
729 IconList_Goto $w $Priv(ILAccel,$w)
730 catch {
731 after cancel $Priv(ILAccel,$w,afterId)
733 set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]
736 proc ::tk::IconList_Goto {w text} {
737 upvar ::tk::$w data
738 upvar ::tk::$w:textList textList
740 if {![info exists data(list)]} {
741 return
744 if {$text eq "" || $data(numItems) == 0} {
745 return
748 if {[llength [IconList_CurSelection $w]]} {
749 set start [IconList_Index $w anchor]
750 } else {
751 set start 0
754 set theIndex -1
755 set less 0
756 set len [string length $text]
757 set len0 [expr {$len-1}]
758 set i $start
760 # Search forward until we find a filename whose prefix is a
761 # case-insensitive match with $text
762 while {1} {
763 if {[string equal -nocase -length $len0 $textList($i) $text]} {
764 set theIndex $i
765 break
767 incr i
768 if {$i == $data(numItems)} {
769 set i 0
771 if {$i == $start} {
772 break
776 if {$theIndex > -1} {
777 IconList_Selection $w clear 0 end
778 IconList_Selection $w set $theIndex
779 IconList_Selection $w anchor $theIndex
780 IconList_See $w $theIndex
784 proc ::tk::IconList_Reset {w} {
785 variable ::tk::Priv
787 unset -nocomplain Priv(ILAccel,$w)
790 #----------------------------------------------------------------------
792 # F I L E D I A L O G
794 #----------------------------------------------------------------------
796 namespace eval ::tk::dialog {}
797 namespace eval ::tk::dialog::file {
798 namespace import -force ::tk::msgcat::*
799 set ::tk::dialog::file::showHiddenBtn 0
800 set ::tk::dialog::file::showHiddenVar 1
803 # ::tk::dialog::file:: --
805 # Implements the TK file selection dialog. This dialog is used when
806 # the tk_strictMotif flag is set to false. This procedure shouldn't
807 # be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
809 # Arguments:
810 # type "open" or "save"
811 # args Options parsed by the procedure.
814 proc ::tk::dialog::file:: {type args} {
815 variable ::tk::Priv
816 set dataName __tk_filedialog
817 upvar ::tk::dialog::file::$dataName data
819 Config $dataName $type $args
821 if {$data(-parent) eq "."} {
822 set w .$dataName
823 } else {
824 set w $data(-parent).$dataName
827 # (re)create the dialog box if necessary
829 if {![winfo exists $w]} {
830 Create $w TkFDialog
831 } elseif {[winfo class $w] ne "TkFDialog"} {
832 destroy $w
833 Create $w TkFDialog
834 } else {
835 set data(dirMenuBtn) $w.contents.f1.menu
836 set data(dirMenu) $w.contents.f1.menu.menu
837 set data(upBtn) $w.contents.f1.up
838 set data(icons) $w.contents.icons
839 set data(ent) $w.contents.f2.ent
840 set data(typeMenuLab) $w.contents.f2.lab2
841 set data(typeMenuBtn) $w.contents.f2.menu
842 set data(typeMenu) $data(typeMenuBtn).m
843 set data(okBtn) $w.contents.f2.ok
844 set data(cancelBtn) $w.contents.f2.cancel
845 set data(hiddenBtn) $w.contents.f2.hidden
846 SetSelectMode $w $data(-multiple)
848 if {$::tk::dialog::file::showHiddenBtn} {
849 $data(hiddenBtn) configure -state normal
850 grid $data(hiddenBtn)
851 } else {
852 $data(hiddenBtn) configure -state disabled
853 grid remove $data(hiddenBtn)
856 # Make sure subseqent uses of this dialog are independent [Bug 845189]
857 unset -nocomplain data(extUsed)
859 # Dialog boxes should be transient with respect to their parent,
860 # so that they will always stay on top of their parent window. However,
861 # some window managers will create the window as withdrawn if the parent
862 # window is withdrawn or iconified. Combined with the grab we put on the
863 # window, this can hang the entire application. Therefore we only make
864 # the dialog transient if the parent is viewable.
866 if {[winfo viewable [winfo toplevel $data(-parent)]]} {
867 wm transient $w $data(-parent)
870 # Add traces on the selectPath variable
873 trace add variable data(selectPath) write \
874 [list ::tk::dialog::file::SetPath $w]
875 $data(dirMenuBtn) configure \
876 -textvariable ::tk::dialog::file::${dataName}(selectPath)
878 # Cleanup previous menu
880 $data(typeMenu) delete 0 end
881 $data(typeMenuBtn) configure -state normal -text ""
883 # Initialize the file types menu
885 if {[llength $data(-filetypes)]} {
886 # Default type and name to first entry
887 set initialtype [lindex $data(-filetypes) 0]
888 set initialTypeName [lindex $initialtype 0]
889 if {$data(-typevariable) ne ""} {
890 upvar #0 $data(-typevariable) typeVariable
891 if {[info exists typeVariable]} {
892 set initialTypeName $typeVariable
895 foreach type $data(-filetypes) {
896 set title [lindex $type 0]
897 set filter [lindex $type 1]
898 $data(typeMenu) add command -label $title \
899 -command [list ::tk::dialog::file::SetFilter $w $type]
900 # string first avoids glob-pattern char issues
901 if {[string first ${initialTypeName} $title] == 0} {
902 set initialtype $type
905 SetFilter $w $initialtype
906 $data(typeMenuBtn) configure -state normal
907 $data(typeMenuLab) configure -state normal
908 } else {
909 set data(filter) "*"
910 $data(typeMenuBtn) configure -state disabled -takefocus 0
911 $data(typeMenuLab) configure -state disabled
913 UpdateWhenIdle $w
915 # Withdraw the window, then update all the geometry information
916 # so we know how big it wants to be, then center the window in the
917 # display and de-iconify it.
919 ::tk::PlaceWindow $w widget $data(-parent)
920 wm title $w $data(-title)
922 # Set a grab and claim the focus too.
924 ::tk::SetFocusGrab $w $data(ent)
925 $data(ent) delete 0 end
926 $data(ent) insert 0 $data(selectFile)
927 $data(ent) selection range 0 end
928 $data(ent) icursor end
930 # Wait for the user to respond, then restore the focus and
931 # return the index of the selected button. Restore the focus
932 # before deleting the window, since otherwise the window manager
933 # may take the focus away so we can't redirect it. Finally,
934 # restore any grab that was in effect.
936 vwait ::tk::Priv(selectFilePath)
938 ::tk::RestoreFocusGrab $w $data(ent) withdraw
940 # Cleanup traces on selectPath variable
943 foreach trace [trace info variable data(selectPath)] {
944 trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
946 $data(dirMenuBtn) configure -textvariable {}
948 return $Priv(selectFilePath)
951 # ::tk::dialog::file::Config --
953 # Configures the TK filedialog according to the argument list
955 proc ::tk::dialog::file::Config {dataName type argList} {
956 upvar ::tk::dialog::file::$dataName data
958 set data(type) $type
960 # 0: Delete all variable that were set on data(selectPath) the
961 # last time the file dialog is used. The traces may cause troubles
962 # if the dialog is now used with a different -parent option.
964 foreach trace [trace info variable data(selectPath)] {
965 trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
968 # 1: the configuration specs
970 set specs {
971 {-defaultextension "" "" ""}
972 {-filetypes "" "" ""}
973 {-initialdir "" "" ""}
974 {-initialfile "" "" ""}
975 {-parent "" "" "."}
976 {-title "" "" ""}
977 {-typevariable "" "" ""}
980 # The "-multiple" option is only available for the "open" file dialog.
982 if {$type eq "open"} {
983 lappend specs {-multiple "" "" "0"}
986 # The "-confirmoverwrite" option is only for the "save" file dialog.
988 if {$type eq "save"} {
989 lappend specs {-confirmoverwrite "" "" "1"}
992 # 2: default values depending on the type of the dialog
994 if {![info exists data(selectPath)]} {
995 # first time the dialog has been popped up
996 set data(selectPath) [pwd]
997 set data(selectFile) ""
1000 # 3: parse the arguments
1002 tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
1004 if {$data(-title) eq ""} {
1005 if {$type eq "open"} {
1006 set data(-title) [mc "Open"]
1007 } else {
1008 set data(-title) [mc "Save As"]
1012 # 4: set the default directory and selection according to the -initial
1013 # settings
1015 if {$data(-initialdir) ne ""} {
1016 # Ensure that initialdir is an absolute path name.
1017 if {[file isdirectory $data(-initialdir)]} {
1018 set old [pwd]
1019 cd $data(-initialdir)
1020 set data(selectPath) [pwd]
1021 cd $old
1022 } else {
1023 set data(selectPath) [pwd]
1026 set data(selectFile) $data(-initialfile)
1028 # 5. Parse the -filetypes option
1030 set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
1032 if {![winfo exists $data(-parent)]} {
1033 error "bad window path name \"$data(-parent)\""
1036 # Set -multiple to a one or zero value (not other boolean types
1037 # like "yes") so we can use it in tests more easily.
1038 if {$type eq "save"} {
1039 set data(-multiple) 0
1040 } elseif {$data(-multiple)} {
1041 set data(-multiple) 1
1042 } else {
1043 set data(-multiple) 0
1047 proc ::tk::dialog::file::Create {w class} {
1048 set dataName [lindex [split $w .] end]
1049 upvar ::tk::dialog::file::$dataName data
1050 variable ::tk::Priv
1051 global tk_library
1053 toplevel $w -class $class
1054 if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
1055 pack [ttk::frame $w.contents] -expand 1 -fill both
1056 #set w $w.contents
1058 # f1: the frame with the directory option menu
1060 set f1 [ttk::frame $w.contents.f1]
1061 bind [::tk::AmpWidget ttk::label $f1.lab -text [mc "&Directory:"]] \
1062 <<AltUnderlined>> [list focus $f1.menu]
1064 set data(dirMenuBtn) $f1.menu
1065 if {![info exists data(selectPath)]} {
1066 set data(selectPath) ""
1068 set data(dirMenu) $f1.menu.menu
1069 ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \
1070 -textvariable [format %s(selectPath) ::tk::dialog::file::$dataName]
1071 [menu $data(dirMenu) -tearoff 0] add radiobutton -label "" -variable \
1072 [format %s(selectPath) ::tk::dialog::file::$dataName]
1073 set data(upBtn) [ttk::button $f1.up]
1074 if {![info exists Priv(updirImage)]} {
1075 set Priv(updirImage) [image create bitmap -data {
1076 #define updir_width 28
1077 #define updir_height 16
1078 static char updir_bits[] = {
1079 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1080 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1081 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1082 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1083 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1084 0xf0, 0xff, 0xff, 0x01};}]
1086 $data(upBtn) configure -image $Priv(updirImage)
1088 $f1.menu configure -takefocus 1;# -highlightthickness 2
1090 pack $data(upBtn) -side right -padx 4 -fill both
1091 pack $f1.lab -side left -padx 4 -fill both
1092 pack $f1.menu -expand yes -fill both -padx 4
1094 # data(icons): the IconList that list the files and directories.
1096 if {$class eq "TkFDialog"} {
1097 if { $data(-multiple) } {
1098 set fNameCaption [mc "File &names:"]
1099 } else {
1100 set fNameCaption [mc "File &name:"]
1102 set fTypeCaption [mc "Files of &type:"]
1103 set iconListCommand [list ::tk::dialog::file::OkCmd $w]
1104 } else {
1105 set fNameCaption [mc "&Selection:"]
1106 set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
1108 set data(icons) [::tk::IconList $w.contents.icons \
1109 -command $iconListCommand -multiple $data(-multiple)]
1110 bind $data(icons) <<ListboxSelect>> \
1111 [list ::tk::dialog::file::ListBrowse $w]
1113 # f2: the frame with the OK button, cancel button, "file name" field
1114 # and file types field.
1116 set f2 [ttk::frame $w.contents.f2]
1117 bind [::tk::AmpWidget ttk::label $f2.lab -text $fNameCaption -anchor e]\
1118 <<AltUnderlined>> [list focus $f2.ent]
1119 # -pady 0
1120 set data(ent) [ttk::entry $f2.ent]
1122 # The font to use for the icons. The default Canvas font on Unix
1123 # is just deviant.
1124 set ::tk::$w.contents.icons(font) [$data(ent) cget -font]
1126 # Make the file types bits only if this is a File Dialog
1127 if {$class eq "TkFDialog"} {
1128 set data(typeMenuLab) [::tk::AmpWidget ttk::label $f2.lab2 \
1129 -text $fTypeCaption -anchor e]
1130 # -pady [$f2.lab cget -pady]
1131 set data(typeMenuBtn) [ttk::menubutton $f2.menu \
1132 -menu $f2.menu.m]
1133 # -indicatoron 1
1134 set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
1135 # $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w
1136 bind $data(typeMenuLab) <<AltUnderlined>> [list \
1137 focus $data(typeMenuBtn)]
1140 # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
1141 # is true. Create it disabled so the binding doesn't trigger if it
1142 # isn't shown.
1143 if {$class eq "TkFDialog"} {
1144 set text [mc "Show &Hidden Files and Directories"]
1145 } else {
1146 set text [mc "Show &Hidden Directories"]
1148 set data(hiddenBtn) [::tk::AmpWidget ttk::checkbutton $f2.hidden \
1149 -text $text -state disabled \
1150 -variable ::tk::dialog::file::showHiddenVar \
1151 -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
1152 # -anchor w -padx 3
1154 # the okBtn is created after the typeMenu so that the keyboard traversal
1155 # is in the right order, and add binding so that we find out when the
1156 # dialog is destroyed by the user (added here instead of to the overall
1157 # window so no confusion about how much <Destroy> gets called; exactly
1158 # once will do). [Bug 987169]
1160 set data(okBtn) [::tk::AmpWidget ttk::button $f2.ok \
1161 -text [mc "&OK"] -default active];# -pady 3]
1162 bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w]
1163 set data(cancelBtn) [::tk::AmpWidget ttk::button $f2.cancel \
1164 -text [mc "&Cancel"] -default normal];# -pady 3]
1166 # grid the widgets in f2
1168 grid $f2.lab $f2.ent $data(okBtn) -padx 4 -pady 3 -sticky ew
1169 grid configure $f2.ent -padx 2
1170 if {$class eq "TkFDialog"} {
1171 grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
1172 -padx 4 -sticky ew
1173 grid configure $data(typeMenuBtn) -padx 0
1174 grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew
1175 } else {
1176 grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew
1178 grid columnconfigure $f2 1 -weight 1
1180 # Pack all the frames together. We are done with widget construction.
1182 pack $f1 -side top -fill x -pady 4
1183 pack $f2 -side bottom -pady 4 -fill x
1184 pack $data(icons) -expand yes -fill both -padx 4 -pady 1
1186 # Set up the event handlers that are common to Directory and File Dialogs
1189 wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
1190 $data(upBtn) configure -command [list ::tk::dialog::file::UpDirCmd $w]
1191 $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]
1192 bind $w <KeyPress-Escape> [list $data(cancelBtn) invoke]
1193 bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
1195 # Set up event handlers specific to File or Directory Dialogs
1197 if {$class eq "TkFDialog"} {
1198 bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
1199 $data(okBtn) configure -command [list ::tk::dialog::file::OkCmd $w]
1200 bind $w <Alt-t> [format {
1201 if {[%s cget -state] eq "normal"} {
1202 focus %s
1204 } $data(typeMenuBtn) $data(typeMenuBtn)]
1205 } else {
1206 set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
1207 bind $data(ent) <Return> $okCmd
1208 $data(okBtn) configure -command $okCmd
1209 bind $w <Alt-s> [list focus $data(ent)]
1210 bind $w <Alt-o> [list $data(okBtn) invoke]
1212 bind $w <Alt-h> [list $data(hiddenBtn) invoke]
1213 bind $data(ent) <Tab> [list ::tk::dialog::file::CompleteEnt $w]
1215 # Build the focus group for all the entries
1217 ::tk::FocusGroup_Create $w
1218 ::tk::FocusGroup_BindIn $w $data(ent) [list \
1219 ::tk::dialog::file::EntFocusIn $w]
1220 ::tk::FocusGroup_BindOut $w $data(ent) [list \
1221 ::tk::dialog::file::EntFocusOut $w]
1224 # ::tk::dialog::file::SetSelectMode --
1226 # Set the select mode of the dialog to single select or multi-select.
1228 # Arguments:
1229 # w The dialog path.
1230 # multi 1 if the dialog is multi-select; 0 otherwise.
1232 # Results:
1233 # None.
1235 proc ::tk::dialog::file::SetSelectMode {w multi} {
1236 set dataName __tk_filedialog
1237 upvar ::tk::dialog::file::$dataName data
1238 if { $multi } {
1239 set fNameCaption [mc "File &names:"]
1240 } else {
1241 set fNameCaption [mc "File &name:"]
1243 set iconListCommand [list ::tk::dialog::file::OkCmd $w]
1244 ::tk::SetAmpText $w.contents.f2.lab $fNameCaption
1245 ::tk::IconList_Config $data(icons) \
1246 [list -multiple $multi -command $iconListCommand]
1247 return
1250 # ::tk::dialog::file::UpdateWhenIdle --
1252 # Creates an idle event handler which updates the dialog in idle
1253 # time. This is important because loading the directory may take a long
1254 # time and we don't want to load the same directory for multiple times
1255 # due to multiple concurrent events.
1257 proc ::tk::dialog::file::UpdateWhenIdle {w} {
1258 upvar ::tk::dialog::file::[winfo name $w] data
1260 if {[info exists data(updateId)]} {
1261 return
1262 } else {
1263 set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
1267 # ::tk::dialog::file::Update --
1269 # Loads the files and directories into the IconList widget. Also
1270 # sets up the directory option menu for quick access to parent
1271 # directories.
1273 proc ::tk::dialog::file::Update {w} {
1275 # This proc may be called within an idle handler. Make sure that the
1276 # window has not been destroyed before this proc is called
1277 if {![winfo exists $w]} {
1278 return
1280 set class [winfo class $w]
1281 if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
1282 return
1285 set dataName [winfo name $w]
1286 upvar ::tk::dialog::file::$dataName data
1287 variable ::tk::Priv
1288 global tk_library
1289 unset -nocomplain data(updateId)
1291 if {![info exists Priv(folderImage)]} {
1292 set Priv(folderImage) [image create photo -data {
1293 R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
1294 QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
1295 set Priv(fileImage) [image create photo -data {
1296 R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
1297 rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
1299 set folder $Priv(folderImage)
1300 set file $Priv(fileImage)
1302 set appPWD [pwd]
1303 if {[catch {
1304 cd $data(selectPath)
1305 }]} {
1306 # We cannot change directory to $data(selectPath). $data(selectPath)
1307 # should have been checked before ::tk::dialog::file::Update is called, so
1308 # we normally won't come to here. Anyways, give an error and abort
1309 # action.
1310 tk_messageBox -type ok -parent $w -icon warning -message \
1311 [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
1312 cd $appPWD
1313 return
1316 # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
1317 # so the user may still click and cause havoc ...
1319 set entCursor [$data(ent) cget -cursor]
1320 set dlgCursor [$w cget -cursor]
1321 $data(ent) configure -cursor watch
1322 $w configure -cursor watch
1323 update idletasks
1325 ::tk::IconList_DeleteAll $data(icons)
1327 set showHidden $::tk::dialog::file::showHiddenVar
1329 # Make the dir list
1330 # Using -directory [pwd] is better in some VFS cases.
1331 set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
1332 if {$showHidden} { lappend cmd .* }
1333 set dirs [lsort -dictionary -unique [eval $cmd]]
1334 set dirList {}
1335 foreach d $dirs {
1336 if {$d eq "." || $d eq ".."} {
1337 continue
1339 lappend dirList $d
1341 ::tk::IconList_Add $data(icons) $folder $dirList
1343 if {$class eq "TkFDialog"} {
1344 # Make the file list if this is a File Dialog, selecting all
1345 # but 'd'irectory type files.
1347 set cmd [list glob -tails -directory [pwd] \
1348 -type {f b c l p s} -nocomplain]
1349 if {$data(filter) eq "*"} {
1350 lappend cmd *
1351 if {$showHidden} {
1352 lappend cmd .*
1354 } else {
1355 eval [list lappend cmd] $data(filter)
1357 set fileList [lsort -dictionary -unique [eval $cmd]]
1358 ::tk::IconList_Add $data(icons) $file $fileList
1361 ::tk::IconList_Arrange $data(icons)
1363 # Update the Directory: option menu
1365 set list ""
1366 set dir ""
1367 foreach subdir [file split $data(selectPath)] {
1368 set dir [file join $dir $subdir]
1369 lappend list $dir
1372 $data(dirMenu) delete 0 end
1373 set var [format %s(selectPath) ::tk::dialog::file::$dataName]
1374 foreach path $list {
1375 $data(dirMenu) add command -label $path -command [list set $var $path]
1378 # Restore the PWD to the application's PWD
1380 cd $appPWD
1382 if {$class eq "TkFDialog"} {
1383 # Restore the Open/Save Button if this is a File Dialog
1385 if {$data(type) eq "open"} {
1386 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1387 } else {
1388 ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1392 # turn off the busy cursor.
1394 $data(ent) configure -cursor $entCursor
1395 $w configure -cursor $dlgCursor
1398 # ::tk::dialog::file::SetPathSilently --
1400 # Sets data(selectPath) without invoking the trace procedure
1402 proc ::tk::dialog::file::SetPathSilently {w path} {
1403 upvar ::tk::dialog::file::[winfo name $w] data
1405 trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
1406 set data(selectPath) $path
1407 trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
1411 # This proc gets called whenever data(selectPath) is set
1413 proc ::tk::dialog::file::SetPath {w name1 name2 op} {
1414 if {[winfo exists $w]} {
1415 upvar ::tk::dialog::file::[winfo name $w] data
1416 UpdateWhenIdle $w
1417 # On directory dialogs, we keep the entry in sync with the currentdir.
1418 if {[winfo class $w] eq "TkChooseDir"} {
1419 $data(ent) delete 0 end
1420 $data(ent) insert end $data(selectPath)
1425 # This proc gets called whenever data(filter) is set
1427 proc ::tk::dialog::file::SetFilter {w type} {
1428 upvar ::tk::dialog::file::[winfo name $w] data
1429 upvar ::tk::$data(icons) icons
1431 set data(filterType) $type
1432 set data(filter) [lindex $type 1]
1433 $data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1
1435 # If we aren't using a default extension, use the one suppled
1436 # by the filter.
1437 if {![info exists data(extUsed)]} {
1438 if {[string length $data(-defaultextension)]} {
1439 set data(extUsed) 1
1440 } else {
1441 set data(extUsed) 0
1445 if {!$data(extUsed)} {
1446 # Get the first extension in the list that matches {^\*\.\w+$}
1447 # and remove all * from the filter.
1448 set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
1449 if {$index >= 0} {
1450 set data(-defaultextension) \
1451 [string trimleft [lindex $data(filter) $index] "*"]
1452 } else {
1453 # Couldn't find anything! Reset to a safe default...
1454 set data(-defaultextension) ""
1458 $icons(sbar) set 0.0 0.0
1460 UpdateWhenIdle $w
1463 # tk::dialog::file::ResolveFile --
1465 # Interpret the user's text input in a file selection dialog.
1466 # Performs:
1468 # (1) ~ substitution
1469 # (2) resolve all instances of . and ..
1470 # (3) check for non-existent files/directories
1471 # (4) check for chdir permissions
1472 # (5) conversion of environment variable references to their
1473 # contents (once only)
1475 # Arguments:
1476 # context: the current directory you are in
1477 # text: the text entered by the user
1478 # defaultext: the default extension to add to files with no extension
1479 # expandEnv: whether to expand environment variables (yes by default)
1481 # Return vaue:
1482 # [list $flag $directory $file]
1484 # flag = OK : valid input
1485 # = PATTERN : valid directory/pattern
1486 # = PATH : the directory does not exist
1487 # = FILE : the directory exists by the file doesn't
1488 # exist
1489 # = CHDIR : Cannot change to the directory
1490 # = ERROR : Invalid entry
1492 # directory : valid only if flag = OK or PATTERN or FILE
1493 # file : valid only if flag = OK or PATTERN
1495 # directory may not be the same as context, because text may contain
1496 # a subdirectory name
1498 proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} {
1499 set appPWD [pwd]
1501 set path [JoinFile $context $text]
1503 # If the file has no extension, append the default. Be careful not
1504 # to do this for directories, otherwise typing a dirname in the box
1505 # will give back "dirname.extension" instead of trying to change dir.
1506 if {
1507 ![file isdirectory $path] && ([file ext $path] eq "") &&
1508 ![string match {$*} [file tail $path]]
1509 } then {
1510 set path "$path$defaultext"
1513 if {[catch {file exists $path}]} {
1514 # This "if" block can be safely removed if the following code
1515 # stop generating errors.
1517 # file exists ~nonsuchuser
1519 return [list ERROR $path ""]
1522 if {[file exists $path]} {
1523 if {[file isdirectory $path]} {
1524 if {[catch {cd $path}]} {
1525 return [list CHDIR $path ""]
1527 set directory [pwd]
1528 set file ""
1529 set flag OK
1530 cd $appPWD
1531 } else {
1532 if {[catch {cd [file dirname $path]}]} {
1533 return [list CHDIR [file dirname $path] ""]
1535 set directory [pwd]
1536 set file [file tail $path]
1537 set flag OK
1538 cd $appPWD
1540 } else {
1541 set dirname [file dirname $path]
1542 if {[file exists $dirname]} {
1543 if {[catch {cd $dirname}]} {
1544 return [list CHDIR $dirname ""]
1546 set directory [pwd]
1547 cd $appPWD
1548 set file [file tail $path]
1549 # It's nothing else, so check to see if it is an env-reference
1550 if {$expandEnv && [string match {$*} $file]} {
1551 set var [string range $file 1 end]
1552 if {[info exist ::env($var)]} {
1553 return [ResolveFile $context $::env($var) $defaultext 0]
1556 if {[regexp {[*?]} $file]} {
1557 set flag PATTERN
1558 } else {
1559 set flag FILE
1561 } else {
1562 set directory $dirname
1563 set file [file tail $path]
1564 set flag PATH
1565 # It's nothing else, so check to see if it is an env-reference
1566 if {$expandEnv && [string match {$*} $file]} {
1567 set var [string range $file 1 end]
1568 if {[info exist ::env($var)]} {
1569 return [ResolveFile $context $::env($var) $defaultext 0]
1575 return [list $flag $directory $file]
1579 # Gets called when the entry box gets keyboard focus. We clear the selection
1580 # from the icon list . This way the user can be certain that the input in the
1581 # entry box is the selection.
1583 proc ::tk::dialog::file::EntFocusIn {w} {
1584 upvar ::tk::dialog::file::[winfo name $w] data
1586 if {[$data(ent) get] ne ""} {
1587 $data(ent) selection range 0 end
1588 $data(ent) icursor end
1589 } else {
1590 $data(ent) selection clear
1593 if {[winfo class $w] eq "TkFDialog"} {
1594 # If this is a File Dialog, make sure the buttons are labeled right.
1595 if {$data(type) eq "open"} {
1596 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1597 } else {
1598 ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1603 proc ::tk::dialog::file::EntFocusOut {w} {
1604 upvar ::tk::dialog::file::[winfo name $w] data
1606 $data(ent) selection clear
1610 # Gets called when user presses Return in the "File name" entry.
1612 proc ::tk::dialog::file::ActivateEnt {w} {
1613 upvar ::tk::dialog::file::[winfo name $w] data
1615 set text [$data(ent) get]
1616 if {$data(-multiple)} {
1617 foreach t $text {
1618 VerifyFileName $w $t
1620 } else {
1621 VerifyFileName $w $text
1625 # Verification procedure
1627 proc ::tk::dialog::file::VerifyFileName {w filename} {
1628 upvar ::tk::dialog::file::[winfo name $w] data
1630 set list [ResolveFile $data(selectPath) $filename $data(-defaultextension)]
1631 foreach {flag path file} $list {
1632 break
1635 switch -- $flag {
1636 OK {
1637 if {$file eq ""} {
1638 # user has entered an existing (sub)directory
1639 set data(selectPath) $path
1640 $data(ent) delete 0 end
1641 } else {
1642 SetPathSilently $w $path
1643 if {$data(-multiple)} {
1644 lappend data(selectFile) $file
1645 } else {
1646 set data(selectFile) $file
1648 Done $w
1651 PATTERN {
1652 set data(selectPath) $path
1653 set data(filter) $file
1655 FILE {
1656 if {$data(type) eq "open"} {
1657 tk_messageBox -icon warning -type ok -parent $w \
1658 -message [mc "File \"%1\$s\" does not exist." \
1659 [file join $path $file]]
1660 $data(ent) selection range 0 end
1661 $data(ent) icursor end
1662 } else {
1663 SetPathSilently $w $path
1664 if {$data(-multiple)} {
1665 lappend data(selectFile) $file
1666 } else {
1667 set data(selectFile) $file
1669 Done $w
1672 PATH {
1673 tk_messageBox -icon warning -type ok -parent $w \
1674 -message [mc "Directory \"%1\$s\" does not exist." $path]
1675 $data(ent) selection range 0 end
1676 $data(ent) icursor end
1678 CHDIR {
1679 tk_messageBox -type ok -parent $w -icon warning -message \
1680 [mc "Cannot change to the directory\
1681 \"%1\$s\".\nPermission denied." $path]
1682 $data(ent) selection range 0 end
1683 $data(ent) icursor end
1685 ERROR {
1686 tk_messageBox -type ok -parent $w -icon warning -message \
1687 [mc "Invalid file name \"%1\$s\"." $path]
1688 $data(ent) selection range 0 end
1689 $data(ent) icursor end
1694 # Gets called when user presses the Alt-s or Alt-o keys.
1696 proc ::tk::dialog::file::InvokeBtn {w key} {
1697 upvar ::tk::dialog::file::[winfo name $w] data
1699 if {[$data(okBtn) cget -text] eq $key} {
1700 $data(okBtn) invoke
1704 # Gets called when user presses the "parent directory" button
1706 proc ::tk::dialog::file::UpDirCmd {w} {
1707 upvar ::tk::dialog::file::[winfo name $w] data
1709 if {$data(selectPath) ne "/"} {
1710 set data(selectPath) [file dirname $data(selectPath)]
1714 # Join a file name to a path name. The "file join" command will break
1715 # if the filename begins with ~
1717 proc ::tk::dialog::file::JoinFile {path file} {
1718 if {[string match {~*} $file] && [file exists $path/$file]} {
1719 return [file join $path ./$file]
1720 } else {
1721 return [file join $path $file]
1725 # Gets called when user presses the "OK" button
1727 proc ::tk::dialog::file::OkCmd {w} {
1728 upvar ::tk::dialog::file::[winfo name $w] data
1730 set filenames {}
1731 foreach item [::tk::IconList_CurSelection $data(icons)] {
1732 lappend filenames [::tk::IconList_Get $data(icons) $item]
1735 if {([llength $filenames] && !$data(-multiple)) || \
1736 ($data(-multiple) && ([llength $filenames] == 1))} {
1737 set filename [lindex $filenames 0]
1738 set file [JoinFile $data(selectPath) $filename]
1739 if {[file isdirectory $file]} {
1740 ListInvoke $w [list $filename]
1741 return
1745 ActivateEnt $w
1748 # Gets called when user presses the "Cancel" button
1750 proc ::tk::dialog::file::CancelCmd {w} {
1751 upvar ::tk::dialog::file::[winfo name $w] data
1752 variable ::tk::Priv
1754 bind $data(okBtn) <Destroy> {}
1755 set Priv(selectFilePath) ""
1758 # Gets called when user destroys the dialog directly [Bug 987169]
1760 proc ::tk::dialog::file::Destroyed {w} {
1761 upvar ::tk::dialog::file::[winfo name $w] data
1762 variable ::tk::Priv
1764 set Priv(selectFilePath) ""
1767 # Gets called when user browses the IconList widget (dragging mouse, arrow
1768 # keys, etc)
1770 proc ::tk::dialog::file::ListBrowse {w} {
1771 upvar ::tk::dialog::file::[winfo name $w] data
1773 set text {}
1774 foreach item [::tk::IconList_CurSelection $data(icons)] {
1775 lappend text [::tk::IconList_Get $data(icons) $item]
1777 if {[llength $text] == 0} {
1778 return
1780 if {$data(-multiple)} {
1781 set newtext {}
1782 foreach file $text {
1783 set fullfile [JoinFile $data(selectPath) $file]
1784 if { ![file isdirectory $fullfile] } {
1785 lappend newtext $file
1788 set text $newtext
1789 set isDir 0
1790 } else {
1791 set text [lindex $text 0]
1792 set file [JoinFile $data(selectPath) $text]
1793 set isDir [file isdirectory $file]
1795 if {!$isDir} {
1796 $data(ent) delete 0 end
1797 $data(ent) insert 0 $text
1799 if {[winfo class $w] eq "TkFDialog"} {
1800 if {$data(type) eq "open"} {
1801 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1802 } else {
1803 ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1806 } elseif {[winfo class $w] eq "TkFDialog"} {
1807 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1811 # Gets called when user invokes the IconList widget (double-click,
1812 # Return key, etc)
1814 proc ::tk::dialog::file::ListInvoke {w filenames} {
1815 upvar ::tk::dialog::file::[winfo name $w] data
1817 if {[llength $filenames] == 0} {
1818 return
1821 set file [JoinFile $data(selectPath) [lindex $filenames 0]]
1823 set class [winfo class $w]
1824 if {$class eq "TkChooseDir" || [file isdirectory $file]} {
1825 set appPWD [pwd]
1826 if {[catch {cd $file}]} {
1827 tk_messageBox -type ok -parent $w -icon warning -message \
1828 [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]
1829 } else {
1830 cd $appPWD
1831 set data(selectPath) $file
1833 } else {
1834 if {$data(-multiple)} {
1835 set data(selectFile) $filenames
1836 } else {
1837 set data(selectFile) $file
1839 Done $w
1843 # ::tk::dialog::file::Done --
1845 # Gets called when user has input a valid filename. Pops up a
1846 # dialog box to confirm selection when necessary. Sets the
1847 # tk::Priv(selectFilePath) variable, which will break the "vwait"
1848 # loop in ::tk::dialog::file:: and return the selected filename to the
1849 # script that calls tk_getOpenFile or tk_getSaveFile
1851 proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
1852 upvar ::tk::dialog::file::[winfo name $w] data
1853 variable ::tk::Priv
1855 if {$selectFilePath eq ""} {
1856 if {$data(-multiple)} {
1857 set selectFilePath {}
1858 foreach f $data(selectFile) {
1859 lappend selectFilePath [JoinFile $data(selectPath) $f]
1861 } else {
1862 set selectFilePath [JoinFile $data(selectPath) $data(selectFile)]
1865 set Priv(selectFile) $data(selectFile)
1866 set Priv(selectPath) $data(selectPath)
1868 if {($data(type) eq "save") && $data(-confirmoverwrite) && [file exists $selectFilePath]} {
1869 set reply [tk_messageBox -icon warning -type yesno -parent $w \
1870 -message [mc "File \"%1\$s\" already exists.\nDo you want\
1871 to overwrite it?" $selectFilePath]]
1872 if {$reply eq "no"} {
1873 return
1876 if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
1877 && [info exists data(-filetypes)] && [llength $data(-filetypes)]
1878 && [info exists data(filterType)] && $data(filterType) ne ""} {
1879 upvar #0 $data(-typevariable) typeVariable
1880 set typeVariable [lindex $data(filterType) 0]
1883 bind $data(okBtn) <Destroy> {}
1884 set Priv(selectFilePath) $selectFilePath
1887 proc ::tk::dialog::file::CompleteEnt {w} {
1888 upvar ::tk::dialog::file::[winfo name $w] data
1889 set f [$data(ent) get]
1890 if {$data(-multiple)} {
1891 if {[catch {llength $f} len] || $len != 1} {
1892 return -code break
1894 set f [lindex $f 0]
1897 # Get list of matching filenames and dirnames
1898 set globF [list glob -tails -directory $data(selectPath) \
1899 -type {f b c l p s} -nocomplain]
1900 set globD [list glob -tails -directory $data(selectPath) -type d \
1901 -nocomplain *]
1902 if {$data(filter) eq "*"} {
1903 lappend globF *
1904 if {$::tk::dialog::file::showHiddenVar} {
1905 lappend globF .*
1906 lappend globD .*
1908 if {[winfo class $w] eq "TkFDialog"} {
1909 set files [lsort -dictionary -unique [{*}$globF]]
1910 } else {
1911 set files {}
1913 set dirs [lsort -dictionary -unique [{*}$globD]]
1914 } else {
1915 if {$::tk::dialog::file::showHiddenVar} {
1916 lappend globD .*
1918 if {[winfo class $w] eq "TkFDialog"} {
1919 set files [lsort -dictionary -unique [{*}$globF {*}$data(filter)]]
1920 } else {
1921 set files {}
1923 set dirs [lsort -dictionary -unique [{*}$globD]]
1925 # Filter specials
1926 set dirs [lsearch -all -not -exact -inline $dirs .]
1927 set dirs [lsearch -all -not -exact -inline $dirs ..]
1928 set dirs2 {}
1929 foreach d $dirs {lappend dirs2 $d/}
1931 set targets [concat \
1932 [lsearch -glob -all -inline $files $f*] \
1933 [lsearch -glob -all -inline $dirs2 $f*]]
1935 if {[llength $targets] == 1} {
1936 # We have a winner!
1937 set f [lindex $targets 0]
1938 } elseif {$f in $targets || [llength $targets] == 0} {
1939 if {[string length $f] > 0} {
1940 bell
1942 return
1943 } elseif {[llength $targets] > 1} {
1944 # Multiple possibles
1945 if {[string length $f] == 0} {
1946 return
1948 set t0 [lindex $targets 0]
1949 for {set len [string length $t0]} {$len>0} {} {
1950 set allmatch 1
1951 foreach s $targets {
1952 if {![string equal -length $len $s $t0]} {
1953 set allmatch 0
1954 break
1957 incr len -1
1958 if {$allmatch} break
1960 set f [string range $t0 0 $len]
1963 if {$data(-multiple)} {
1964 set f [list $f]
1966 $data(ent) delete 0 end
1967 $data(ent) insert 0 $f
1968 return -code break