1# tkfbox.tcl --
2#
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.
6#
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.
13#
14# RCS: @(#) $Id: tkfbox.tcl,v 1.38.2.13 2007/02/19 23:53:36 hobbs Exp $
15#
16# Copyright (c) 1994-1998 Sun Microsystems, Inc.
17#
18# See the file "license.terms" for information on usage and redistribution
19# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
20#
21
22#----------------------------------------------------------------------
23#
24#		      I C O N   L I S T
25#
26# This is a pseudo-widget that implements the icon list inside the
27# ::tk::dialog::file:: dialog box.
28#
29#----------------------------------------------------------------------
30
31# ::tk::IconList --
32#
33#	Creates an IconList widget.
34#
35proc ::tk::IconList {w args} {
36    IconList_Config $w $args
37    IconList_Create $w
38}
39
40proc ::tk::IconList_Index {w i} {
41    upvar #0 ::tk::$w data
42    upvar #0 ::tk::$w:itemList itemList
43    if {![info exists data(list)]} {set data(list) {}}
44    switch -regexp -- $i {
45	"^-?[0-9]+$" {
46	    if { $i < 0 } {
47		set i 0
48	    }
49	    if { $i >= [llength $data(list)] } {
50		set i [expr {[llength $data(list)] - 1}]
51	    }
52	    return $i
53	}
54	"^active$" {
55	    return $data(index,active)
56	}
57	"^anchor$" {
58	    return $data(index,anchor)
59	}
60	"^end$" {
61	    return [llength $data(list)]
62	}
63	"@-?[0-9]+,-?[0-9]+" {
64	    foreach {x y} [scan $i "@%d,%d"] {
65		break
66	    }
67	    set item [$data(canvas) find closest $x $y]
68	    return [lindex [$data(canvas) itemcget $item -tags] 1]
69	}
70    }
71}
72
73proc ::tk::IconList_Selection {w op args} {
74    upvar ::tk::$w data
75    switch -exact -- $op {
76	"anchor" {
77	    if { [llength $args] == 1 } {
78		set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]
79	    } else {
80		return $data(index,anchor)
81	    }
82	}
83	"clear" {
84	    if { [llength $args] == 2 } {
85		foreach {first last} $args {
86		    break
87		}
88	    } elseif { [llength $args] == 1 } {
89		set first [set last [lindex $args 0]]
90	    } else {
91		error "wrong # args: should be [lindex [info level 0] 0] path\
92			clear first ?last?"
93	    }
94	    set first [IconList_Index $w $first]
95	    set last [IconList_Index $w $last]
96	    if { $first > $last } {
97		set tmp $first
98		set first $last
99		set last $tmp
100	    }
101	    set ind 0
102	    foreach item $data(selection) {
103		if { $item >= $first } {
104		    set first $ind
105		    break
106		}
107	    }
108	    set ind [expr {[llength $data(selection)] - 1}]
109	    for {} {$ind >= 0} {incr ind -1} {
110		set item [lindex $data(selection) $ind]
111		if { $item <= $last } {
112		    set last $ind
113		    break
114		}
115	    }
116
117	    if { $first > $last } {
118		return
119	    }
120	    set data(selection) [lreplace $data(selection) $first $last]
121	    event generate $w <<ListboxSelect>>
122	    IconList_DrawSelection $w
123	}
124	"includes" {
125	    set index [lsearch -exact $data(selection) [lindex $args 0]]
126	    return [expr {$index != -1}]
127	}
128	"set" {
129	    if { [llength $args] == 2 } {
130		foreach {first last} $args {
131		    break
132		}
133	    } elseif { [llength $args] == 1 } {
134		set last [set first [lindex $args 0]]
135	    } else {
136		error "wrong # args: should be [lindex [info level 0] 0] path\
137			set first ?last?"
138	    }
139
140	    set first [IconList_Index $w $first]
141	    set last [IconList_Index $w $last]
142	    if { $first > $last } {
143		set tmp $first
144		set first $last
145		set last $tmp
146	    }
147	    for {set i $first} {$i <= $last} {incr i} {
148		lappend data(selection) $i
149	    }
150	    set data(selection) [lsort -integer -unique $data(selection)]
151	    event generate $w <<ListboxSelect>>
152	    IconList_DrawSelection $w
153	}
154    }
155}
156
157proc ::tk::IconList_Curselection {w} {
158    upvar ::tk::$w data
159    return $data(selection)
160}
161
162proc ::tk::IconList_DrawSelection {w} {
163    upvar ::tk::$w data
164    upvar ::tk::$w:itemList itemList
165
166    $data(canvas) delete selection
167    foreach item $data(selection) {
168	set rTag [lindex [lindex $data(list) $item] 2]
169	foreach {iTag tTag text serial} $itemList($rTag) {
170	    break
171	}
172
173	set bbox [$data(canvas) bbox $tTag]
174        $data(canvas) create rect $bbox -fill \#a0a0ff -outline \#a0a0ff \
175		-tags selection
176    }
177    $data(canvas) lower selection
178    return
179}
180
181proc ::tk::IconList_Get {w item} {
182    upvar ::tk::$w data
183    upvar ::tk::$w:itemList itemList
184    set rTag [lindex [lindex $data(list) $item] 2]
185    foreach {iTag tTag text serial} $itemList($rTag) {
186	break
187    }
188    return $text
189}
190
191# ::tk::IconList_Config --
192#
193#	Configure the widget variables of IconList, according to the command
194#	line arguments.
195#
196proc ::tk::IconList_Config {w argList} {
197
198    # 1: the configuration specs
199    #
200    set specs {
201	{-command "" "" ""}
202	{-multiple "" "" "0"}
203    }
204
205    # 2: parse the arguments
206    #
207    tclParseConfigSpec ::tk::$w $specs "" $argList
208}
209
210# ::tk::IconList_Create --
211#
212#	Creates an IconList widget by assembling a canvas widget and a
213#	scrollbar widget. Sets all the bindings necessary for the IconList's
214#	operations.
215#
216proc ::tk::IconList_Create {w} {
217    upvar ::tk::$w data
218
219    frame $w
220    set data(sbar)   [scrollbar $w.sbar -orient horizontal -takefocus 0]
221    catch {$data(sbar) configure -highlightthickness 0}
222    set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
223	    -width 400 -height 120 -takefocus 1]
224    pack $data(sbar) -side bottom -fill x -padx 2
225    pack $data(canvas) -expand yes -fill both
226
227    $data(sbar) configure -command [list $data(canvas) xview]
228    $data(canvas) configure -xscrollcommand [list $data(sbar) set]
229
230    # Initializes the max icon/text width and height and other variables
231    #
232    set data(maxIW) 1
233    set data(maxIH) 1
234    set data(maxTW) 1
235    set data(maxTH) 1
236    set data(numItems) 0
237    set data(curItem)  {}
238    set data(noScroll) 1
239    set data(selection) {}
240    set data(index,anchor) ""
241    set fg [option get $data(canvas) foreground Foreground]
242    if {$fg eq ""} {
243	set data(fill) black
244    } else {
245	set data(fill) $fg
246    }
247
248    # Creates the event bindings.
249    #
250    bind $data(canvas) <Configure>	[list tk::IconList_Arrange $w]
251
252    bind $data(canvas) <1>		[list tk::IconList_Btn1 $w %x %y]
253    bind $data(canvas) <B1-Motion>	[list tk::IconList_Motion1 $w %x %y]
254    bind $data(canvas) <B1-Leave>	[list tk::IconList_Leave1 $w %x %y]
255    bind $data(canvas) <Control-1>	[list tk::IconList_CtrlBtn1 $w %x %y]
256    bind $data(canvas) <Shift-1>	[list tk::IconList_ShiftBtn1 $w %x %y]
257    bind $data(canvas) <B1-Enter>	[list tk::CancelRepeat]
258    bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]
259    bind $data(canvas) <Double-ButtonRelease-1> \
260	    [list tk::IconList_Double1 $w %x %y]
261
262    bind $data(canvas) <Up>		[list tk::IconList_UpDown $w -1]
263    bind $data(canvas) <Down>		[list tk::IconList_UpDown $w  1]
264    bind $data(canvas) <Left>		[list tk::IconList_LeftRight $w -1]
265    bind $data(canvas) <Right>		[list tk::IconList_LeftRight $w  1]
266    bind $data(canvas) <Return>		[list tk::IconList_ReturnKey $w]
267    bind $data(canvas) <KeyPress>	[list tk::IconList_KeyPress $w %A]
268    bind $data(canvas) <Control-KeyPress> ";"
269    bind $data(canvas) <Alt-KeyPress>	";"
270
271    bind $data(canvas) <FocusIn>	[list tk::IconList_FocusIn $w]
272    bind $data(canvas) <FocusOut>	[list tk::IconList_FocusOut $w]
273
274    return $w
275}
276
277# ::tk::IconList_AutoScan --
278#
279# This procedure is invoked when the mouse leaves an entry window
280# with button 1 down.  It scrolls the window up, down, left, or
281# right, depending on where the mouse left the window, and reschedules
282# itself as an "after" command so that the window continues to scroll until
283# the mouse moves back into the window or the mouse button is released.
284#
285# Arguments:
286# w -		The IconList window.
287#
288proc ::tk::IconList_AutoScan {w} {
289    upvar ::tk::$w data
290    variable ::tk::Priv
291
292    if {![winfo exists $w]} return
293    set x $Priv(x)
294    set y $Priv(y)
295
296    if {$data(noScroll)} {
297	return
298    }
299    if {$x >= [winfo width $data(canvas)]} {
300	$data(canvas) xview scroll 1 units
301    } elseif {$x < 0} {
302	$data(canvas) xview scroll -1 units
303    } elseif {$y >= [winfo height $data(canvas)]} {
304	# do nothing
305    } elseif {$y < 0} {
306	# do nothing
307    } else {
308	return
309    }
310
311    IconList_Motion1 $w $x $y
312    set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]
313}
314
315# Deletes all the items inside the canvas subwidget and reset the IconList's
316# state.
317#
318proc ::tk::IconList_DeleteAll {w} {
319    upvar ::tk::$w data
320    upvar ::tk::$w:itemList itemList
321
322    $data(canvas) delete all
323    unset -nocomplain data(selected) data(rect) data(list) itemList
324    set data(maxIW) 1
325    set data(maxIH) 1
326    set data(maxTW) 1
327    set data(maxTH) 1
328    set data(numItems) 0
329    set data(curItem)  {}
330    set data(noScroll) 1
331    set data(selection) {}
332    set data(index,anchor) ""
333    $data(sbar) set 0.0 1.0
334    $data(canvas) xview moveto 0
335}
336
337# Adds an icon into the IconList with the designated image and text
338#
339proc ::tk::IconList_Add {w image items} {
340    upvar ::tk::$w data
341    upvar ::tk::$w:itemList itemList
342    upvar ::tk::$w:textList textList
343
344    foreach text $items {
345	set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \
346		-tags [list icon $data(numItems) item$data(numItems)]]
347	set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
348		-font $data(font) -fill $data(fill) \
349		-tags [list text $data(numItems) item$data(numItems)]]
350	set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline "" \
351		-tags [list rect $data(numItems) item$data(numItems)]]
352
353	foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {
354	    break
355	}
356	set iW [expr {$x2 - $x1}]
357	set iH [expr {$y2 - $y1}]
358	if {$data(maxIW) < $iW} {
359	    set data(maxIW) $iW
360	}
361	if {$data(maxIH) < $iH} {
362	    set data(maxIH) $iH
363	}
364
365	foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {
366	    break
367	}
368	set tW [expr {$x2 - $x1}]
369	set tH [expr {$y2 - $y1}]
370	if {$data(maxTW) < $tW} {
371	    set data(maxTW) $tW
372	}
373	if {$data(maxTH) < $tH} {
374	    set data(maxTH) $tH
375	}
376
377	lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \
378		$tH $data(numItems)]
379	set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
380	set textList($data(numItems)) [string tolower $text]
381	incr data(numItems)
382    }
383}
384
385# Places the icons in a column-major arrangement.
386#
387proc ::tk::IconList_Arrange {w} {
388    upvar ::tk::$w data
389
390    if {![info exists data(list)]} {
391	if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
392	    set data(noScroll) 1
393	    $data(sbar) configure -command ""
394	}
395	return
396    }
397
398    set W [winfo width  $data(canvas)]
399    set H [winfo height $data(canvas)]
400    set pad [expr {[$data(canvas) cget -highlightthickness] + \
401	    [$data(canvas) cget -bd]}]
402    if {$pad < 2} {
403	set pad 2
404    }
405
406    incr W -[expr {$pad*2}]
407    incr H -[expr {$pad*2}]
408
409    set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
410    if {$data(maxTH) > $data(maxIH)} {
411	set dy $data(maxTH)
412    } else {
413	set dy $data(maxIH)
414    }
415    incr dy 2
416    set shift [expr {$data(maxIW) + 4}]
417
418    set x [expr {$pad * 2}]
419    set y [expr {$pad * 1}] ; # Why * 1 ?
420    set usedColumn 0
421    foreach sublist $data(list) {
422	set usedColumn 1
423	foreach {iTag tTag rTag iW iH tW tH} $sublist {
424	    break
425	}
426
427	set i_dy [expr {($dy - $iH)/2}]
428	set t_dy [expr {($dy - $tH)/2}]
429
430	$data(canvas) coords $iTag $x                    [expr {$y + $i_dy}]
431	$data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]
432	$data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
433
434	incr y $dy
435	if {($y + $dy) > $H} {
436	    set y [expr {$pad * 1}] ; # *1 ?
437	    incr x $dx
438	    set usedColumn 0
439	}
440    }
441
442    if {$usedColumn} {
443	set sW [expr {$x + $dx}]
444    } else {
445	set sW $x
446    }
447
448    if {$sW < $W} {
449	$data(canvas) configure -scrollregion [list $pad $pad $sW $H]
450	$data(sbar) configure -command ""
451	$data(canvas) xview moveto 0
452	set data(noScroll) 1
453    } else {
454	$data(canvas) configure -scrollregion [list $pad $pad $sW $H]
455	$data(sbar) configure -command [list $data(canvas) xview]
456	set data(noScroll) 0
457    }
458
459    set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
460    if {$data(itemsPerColumn) < 1} {
461	set data(itemsPerColumn) 1
462    }
463
464    if {$data(curItem) ne ""} {
465	IconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0
466    }
467}
468
469# Gets called when the user invokes the IconList (usually by double-clicking
470# or pressing the Return key).
471#
472proc ::tk::IconList_Invoke {w} {
473    upvar ::tk::$w data
474
475    if {$data(-command) ne "" && [llength $data(selection)]} {
476	uplevel #0 $data(-command)
477    }
478}
479
480# ::tk::IconList_See --
481#
482#	If the item is not (completely) visible, scroll the canvas so that
483#	it becomes visible.
484proc ::tk::IconList_See {w rTag} {
485    upvar ::tk::$w data
486    upvar ::tk::$w:itemList itemList
487
488    if {$data(noScroll)} {
489	return
490    }
491    set sRegion [$data(canvas) cget -scrollregion]
492    if {$sRegion eq ""} {
493	return
494    }
495
496    if { $rTag < 0 || $rTag >= [llength $data(list)] } {
497	return
498    }
499
500    set bbox [$data(canvas) bbox item$rTag]
501    set pad [expr {[$data(canvas) cget -highlightthickness] + \
502	    [$data(canvas) cget -bd]}]
503
504    set x1 [lindex $bbox 0]
505    set x2 [lindex $bbox 2]
506    incr x1 -[expr {$pad * 2}]
507    incr x2 -[expr {$pad * 1}] ; # *1 ?
508
509    set cW [expr {[winfo width $data(canvas)] - $pad*2}]
510
511    set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
512    set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
513    set oldDispX $dispX
514
515    # check if out of the right edge
516    #
517    if {($x2 - $dispX) >= $cW} {
518	set dispX [expr {$x2 - $cW}]
519    }
520    # check if out of the left edge
521    #
522    if {($x1 - $dispX) < 0} {
523	set dispX $x1
524    }
525
526    if {$oldDispX ne $dispX} {
527	set fraction [expr {double($dispX)/double($scrollW)}]
528	$data(canvas) xview moveto $fraction
529    }
530}
531
532proc ::tk::IconList_Btn1 {w x y} {
533    upvar ::tk::$w data
534
535    focus $data(canvas)
536    set x [expr {int([$data(canvas) canvasx $x])}]
537    set y [expr {int([$data(canvas) canvasy $y])}]
538    set i [IconList_Index $w @${x},${y}]
539    if {$i eq ""} return
540    IconList_Selection $w clear 0 end
541    IconList_Selection $w set $i
542    IconList_Selection $w anchor $i
543}
544
545proc ::tk::IconList_CtrlBtn1 {w x y} {
546    upvar ::tk::$w data
547
548    if { $data(-multiple) } {
549	focus $data(canvas)
550	set x [expr {int([$data(canvas) canvasx $x])}]
551	set y [expr {int([$data(canvas) canvasy $y])}]
552	set i [IconList_Index $w @${x},${y}]
553	if {$i eq ""} return
554	if { [IconList_Selection $w includes $i] } {
555	    IconList_Selection $w clear $i
556	} else {
557	    IconList_Selection $w set $i
558	    IconList_Selection $w anchor $i
559	}
560    }
561}
562
563proc ::tk::IconList_ShiftBtn1 {w x y} {
564    upvar ::tk::$w data
565
566    if { $data(-multiple) } {
567	focus $data(canvas)
568	set x [expr {int([$data(canvas) canvasx $x])}]
569	set y [expr {int([$data(canvas) canvasy $y])}]
570	set i [IconList_Index $w @${x},${y}]
571	if {$i eq ""} return
572	set a [IconList_Index $w anchor]
573	if { $a eq "" } {
574	    set a $i
575	}
576	IconList_Selection $w clear 0 end
577	IconList_Selection $w set $a $i
578    }
579}
580
581# Gets called on button-1 motions
582#
583proc ::tk::IconList_Motion1 {w x y} {
584    upvar ::tk::$w data
585    variable ::tk::Priv
586    set Priv(x) $x
587    set Priv(y) $y
588    set x [expr {int([$data(canvas) canvasx $x])}]
589    set y [expr {int([$data(canvas) canvasy $y])}]
590    set i [IconList_Index $w @${x},${y}]
591    if {$i eq ""} return
592    IconList_Selection $w clear 0 end
593    IconList_Selection $w set $i
594}
595
596proc ::tk::IconList_Double1 {w x y} {
597    upvar ::tk::$w data
598
599    if {[llength $data(selection)]} {
600	IconList_Invoke $w
601    }
602}
603
604proc ::tk::IconList_ReturnKey {w} {
605    IconList_Invoke $w
606}
607
608proc ::tk::IconList_Leave1 {w x y} {
609    variable ::tk::Priv
610
611    set Priv(x) $x
612    set Priv(y) $y
613    IconList_AutoScan $w
614}
615
616proc ::tk::IconList_FocusIn {w} {
617    upvar ::tk::$w data
618
619    if {![info exists data(list)]} {
620	return
621    }
622
623    if {[llength $data(selection)]} {
624	IconList_DrawSelection $w
625    }
626}
627
628proc ::tk::IconList_FocusOut {w} {
629    IconList_Selection $w clear 0 end
630}
631
632# ::tk::IconList_UpDown --
633#
634# Moves the active element up or down by one element
635#
636# Arguments:
637# w -		The IconList widget.
638# amount -	+1 to move down one item, -1 to move back one item.
639#
640proc ::tk::IconList_UpDown {w amount} {
641    upvar ::tk::$w data
642
643    if {![info exists data(list)]} {
644	return
645    }
646
647    set curr [tk::IconList_Curselection $w]
648    if { [llength $curr] == 0 } {
649	set i 0
650    } else {
651	set i [tk::IconList_Index $w anchor]
652	if {$i eq ""} return
653	incr i $amount
654    }
655    IconList_Selection $w clear 0 end
656    IconList_Selection $w set $i
657    IconList_Selection $w anchor $i
658    IconList_See $w $i
659}
660
661# ::tk::IconList_LeftRight --
662#
663# Moves the active element left or right by one column
664#
665# Arguments:
666# w -		The IconList widget.
667# amount -	+1 to move right one column, -1 to move left one column.
668#
669proc ::tk::IconList_LeftRight {w amount} {
670    upvar ::tk::$w data
671
672    if {![info exists data(list)]} {
673	return
674    }
675
676    set curr [IconList_Curselection $w]
677    if { [llength $curr] == 0 } {
678	set i 0
679    } else {
680	set i [IconList_Index $w anchor]
681	if {$i eq ""} return
682	incr i [expr {$amount*$data(itemsPerColumn)}]
683    }
684    IconList_Selection $w clear 0 end
685    IconList_Selection $w set $i
686    IconList_Selection $w anchor $i
687    IconList_See $w $i
688}
689
690#----------------------------------------------------------------------
691#		Accelerator key bindings
692#----------------------------------------------------------------------
693
694# ::tk::IconList_KeyPress --
695#
696#	Gets called when user enters an arbitrary key in the listbox.
697#
698proc ::tk::IconList_KeyPress {w key} {
699    variable ::tk::Priv
700
701    append Priv(ILAccel,$w) $key
702    IconList_Goto $w $Priv(ILAccel,$w)
703    catch {
704	after cancel $Priv(ILAccel,$w,afterId)
705    }
706    set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]
707}
708
709proc ::tk::IconList_Goto {w text} {
710    upvar ::tk::$w data
711    upvar ::tk::$w:textList textList
712
713    if {![info exists data(list)]} {
714	return
715    }
716
717    if {$text eq "" || $data(numItems) == 0} {
718	return
719    }
720
721    if {$data(curItem) eq "" || $data(curItem) == 0} {
722	set start  0
723    } else {
724	set start  $data(curItem)
725    }
726
727    set text [string tolower $text]
728    set theIndex -1
729    set less 0
730    set len [string length $text]
731    set len0 [expr {$len-1}]
732    set i $start
733
734    # Search forward until we find a filename whose prefix is an exact match
735    # with $text
736    while {1} {
737	set sub [string range $textList($i) 0 $len0]
738	if {$text eq $sub} {
739	    set theIndex $i
740	    break
741	}
742	incr i
743	if {$i == $data(numItems)} {
744	    set i 0
745	}
746	if {$i == $start} {
747	    break
748	}
749    }
750
751    if {$theIndex > -1} {
752	IconList_Selection $w clear 0 end
753	IconList_Selection $w set $theIndex
754	IconList_Selection $w anchor $theIndex
755	IconList_See $w $theIndex
756    }
757}
758
759proc ::tk::IconList_Reset {w} {
760    variable ::tk::Priv
761
762    unset -nocomplain Priv(ILAccel,$w)
763}
764
765#----------------------------------------------------------------------
766#
767#		      F I L E   D I A L O G
768#
769#----------------------------------------------------------------------
770
771namespace eval ::tk::dialog {}
772namespace eval ::tk::dialog::file {
773    namespace import -force ::tk::msgcat::*
774    set ::tk::dialog::file::showHiddenBtn 0
775    set ::tk::dialog::file::showHiddenVar 1
776}
777
778# ::tk::dialog::file:: --
779#
780#	Implements the TK file selection dialog. This dialog is used when
781#	the tk_strictMotif flag is set to false. This procedure shouldn't
782#	be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
783#
784# Arguments:
785#	type		"open" or "save"
786#	args		Options parsed by the procedure.
787#
788
789proc ::tk::dialog::file:: {type args} {
790    variable ::tk::Priv
791    set dataName __tk_filedialog
792    upvar ::tk::dialog::file::$dataName data
793
794    ::tk::dialog::file::Config $dataName $type $args
795
796    if {$data(-parent) eq "."} {
797        set w .$dataName
798    } else {
799        set w $data(-parent).$dataName
800    }
801
802    # (re)create the dialog box if necessary
803    #
804    if {![winfo exists $w]} {
805	::tk::dialog::file::Create $w TkFDialog
806    } elseif {[winfo class $w] ne "TkFDialog"} {
807	destroy $w
808	::tk::dialog::file::Create $w TkFDialog
809    } else {
810	set data(dirMenuBtn) $w.f1.menu
811	set data(dirMenu) $w.f1.menu.menu
812	set data(upBtn) $w.f1.up
813	set data(icons) $w.icons
814	set data(ent) $w.f2.ent
815	set data(typeMenuLab) $w.f2.lab2
816	set data(typeMenuBtn) $w.f2.menu
817	set data(typeMenu) $data(typeMenuBtn).m
818	set data(okBtn) $w.f2.ok
819	set data(cancelBtn) $w.f2.cancel
820	set data(hiddenBtn) $w.f2.hidden
821	::tk::dialog::file::SetSelectMode $w $data(-multiple)
822    }
823    if {$::tk::dialog::file::showHiddenBtn} {
824	$data(hiddenBtn) configure -state normal
825	grid $data(hiddenBtn)
826    } else {
827	$data(hiddenBtn) configure -state disabled
828	grid remove $data(hiddenBtn)
829    }
830
831    # Make sure subseqent uses of this dialog are independent [Bug 845189]
832    unset -nocomplain data(extUsed)
833
834    # Dialog boxes should be transient with respect to their parent,
835    # so that they will always stay on top of their parent window.  However,
836    # some window managers will create the window as withdrawn if the parent
837    # window is withdrawn or iconified.  Combined with the grab we put on the
838    # window, this can hang the entire application.  Therefore we only make
839    # the dialog transient if the parent is viewable.
840
841    if {[winfo viewable [winfo toplevel $data(-parent)]]} {
842	wm transient $w $data(-parent)
843    }
844
845    # Add traces on the selectPath variable
846    #
847
848    trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
849    $data(dirMenuBtn) configure \
850	    -textvariable ::tk::dialog::file::${dataName}(selectPath)
851
852    # Initialize the file types menu
853    #
854    if {[llength $data(-filetypes)]} {
855	$data(typeMenu) delete 0 end
856	foreach type $data(-filetypes) {
857	    set title  [lindex $type 0]
858	    set filter [lindex $type 1]
859	    $data(typeMenu) add command -label $title \
860		-command [list ::tk::dialog::file::SetFilter $w $type]
861	}
862	::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0]
863	$data(typeMenuBtn) configure -state normal
864	$data(typeMenuLab) configure -state normal
865    } else {
866	set data(filter) "*"
867	$data(typeMenuBtn) configure -state disabled -takefocus 0
868	$data(typeMenuLab) configure -state disabled
869    }
870    ::tk::dialog::file::UpdateWhenIdle $w
871
872    # Withdraw the window, then update all the geometry information
873    # so we know how big it wants to be, then center the window in the
874    # display and de-iconify it.
875
876    ::tk::PlaceWindow $w widget $data(-parent)
877    wm title $w $data(-title)
878
879    # Set a grab and claim the focus too.
880
881    ::tk::SetFocusGrab $w $data(ent)
882    $data(ent) delete 0 end
883    $data(ent) insert 0 $data(selectFile)
884    $data(ent) selection range 0 end
885    $data(ent) icursor end
886
887    # Wait for the user to respond, then restore the focus and
888    # return the index of the selected button.  Restore the focus
889    # before deleting the window, since otherwise the window manager
890    # may take the focus away so we can't redirect it.  Finally,
891    # restore any grab that was in effect.
892
893    vwait ::tk::Priv(selectFilePath)
894
895    ::tk::RestoreFocusGrab $w $data(ent) withdraw
896
897    # Cleanup traces on selectPath variable
898    #
899
900    foreach trace [trace info variable data(selectPath)] {
901	trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
902    }
903    $data(dirMenuBtn) configure -textvariable {}
904
905    return $Priv(selectFilePath)
906}
907
908# ::tk::dialog::file::Config --
909#
910#	Configures the TK filedialog according to the argument list
911#
912proc ::tk::dialog::file::Config {dataName type argList} {
913    upvar ::tk::dialog::file::$dataName data
914
915    set data(type) $type
916
917    # 0: Delete all variable that were set on data(selectPath) the
918    # last time the file dialog is used. The traces may cause troubles
919    # if the dialog is now used with a different -parent option.
920
921    foreach trace [trace info variable data(selectPath)] {
922	trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
923    }
924
925    # 1: the configuration specs
926    #
927    set specs {
928	{-defaultextension "" "" ""}
929	{-filetypes "" "" ""}
930	{-initialdir "" "" ""}
931	{-initialfile "" "" ""}
932	{-parent "" "" "."}
933	{-title "" "" ""}
934    }
935
936    # The "-multiple" option is only available for the "open" file dialog.
937    #
938    if { $type eq "open" } {
939	lappend specs {-multiple "" "" "0"}
940    }
941
942    # 2: default values depending on the type of the dialog
943    #
944    if {![info exists data(selectPath)]} {
945	# first time the dialog has been popped up
946	set data(selectPath) [pwd]
947	set data(selectFile) ""
948    }
949
950    # 3: parse the arguments
951    #
952    tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
953
954    if {$data(-title) eq ""} {
955	if {$type eq "open"} {
956	    set data(-title) "[mc "Open"]"
957	} else {
958	    set data(-title) "[mc "Save As"]"
959	}
960    }
961
962    # 4: set the default directory and selection according to the -initial
963    #    settings
964    #
965    if {$data(-initialdir) ne ""} {
966	# Ensure that initialdir is an absolute path name.
967	if {[file isdirectory $data(-initialdir)]} {
968	    set old [pwd]
969	    cd $data(-initialdir)
970	    set data(selectPath) [pwd]
971	    cd $old
972	} else {
973	    set data(selectPath) [pwd]
974	}
975    }
976    set data(selectFile) $data(-initialfile)
977
978    # 5. Parse the -filetypes option
979    #
980    set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
981
982    if {![winfo exists $data(-parent)]} {
983	error "bad window path name \"$data(-parent)\""
984    }
985
986    # Set -multiple to a one or zero value (not other boolean types
987    # like "yes") so we can use it in tests more easily.
988    if {$type eq "save"} {
989	set data(-multiple) 0
990    } elseif {$data(-multiple)} {
991	set data(-multiple) 1
992    } else {
993	set data(-multiple) 0
994    }
995}
996
997proc ::tk::dialog::file::Create {w class} {
998    set dataName [lindex [split $w .] end]
999    upvar ::tk::dialog::file::$dataName data
1000    variable ::tk::Priv
1001    global tk_library
1002
1003    toplevel $w -class $class
1004    if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
1005
1006    # f1: the frame with the directory option menu
1007    #
1008    set f1 [frame $w.f1]
1009    bind [::tk::AmpWidget label $f1.lab -text "[mc "&Directory:"]" ] \
1010	<<AltUnderlined>> [list focus $f1.menu]
1011
1012    set data(dirMenuBtn) $f1.menu
1013    set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""]
1014    set data(upBtn) [button $f1.up]
1015    if {![info exists Priv(updirImage)]} {
1016	set Priv(updirImage) [image create bitmap -data {
1017#define updir_width 28
1018#define updir_height 16
1019static char updir_bits[] = {
1020   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1021   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1022   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1023   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1024   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1025   0xf0, 0xff, 0xff, 0x01};}]
1026    }
1027    $data(upBtn) configure -image $Priv(updirImage)
1028
1029    $f1.menu configure -takefocus 1 -highlightthickness 2
1030
1031    pack $data(upBtn) -side right -padx 4 -fill both
1032    pack $f1.lab -side left -padx 4 -fill both
1033    pack $f1.menu -expand yes -fill both -padx 4
1034
1035    # data(icons): the IconList that list the files and directories.
1036    #
1037    if { $class eq "TkFDialog" } {
1038	if { $data(-multiple) } {
1039	    set fNameCaption [mc "File &names:"]
1040	} else {
1041	    set fNameCaption [mc "File &name:"]
1042	}
1043	set fTypeCaption [mc "Files of &type:"]
1044	set iconListCommand [list ::tk::dialog::file::OkCmd $w]
1045    } else {
1046	set fNameCaption [mc "&Selection:"]
1047	set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
1048    }
1049    set data(icons) [::tk::IconList $w.icons \
1050	    -command	$iconListCommand \
1051	    -multiple	$data(-multiple)]
1052    bind $data(icons) <<ListboxSelect>> \
1053	    [list ::tk::dialog::file::ListBrowse $w]
1054
1055    # f2: the frame with the OK button, cancel button, "file name" field
1056    #     and file types field.
1057    #
1058    set f2 [frame $w.f2 -bd 0]
1059    bind [::tk::AmpWidget label $f2.lab -text $fNameCaption -anchor e -pady 0]\
1060	    <<AltUnderlined>> [list focus $f2.ent]
1061    set data(ent) [entry $f2.ent]
1062
1063    # The font to use for the icons. The default Canvas font on Unix
1064    # is just deviant.
1065    set ::tk::$w.icons(font) [$data(ent) cget -font]
1066
1067    # Make the file types bits only if this is a File Dialog
1068    if { $class eq "TkFDialog" } {
1069	set data(typeMenuLab) [::tk::AmpWidget label $f2.lab2 \
1070		-text $fTypeCaption -anchor e -pady [$f2.lab cget -pady]]
1071	set data(typeMenuBtn) [menubutton $f2.menu -indicatoron 1 \
1072		-menu $f2.menu.m]
1073	set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
1074	$data(typeMenuBtn) configure -takefocus 1 -highlightthickness 2 \
1075		-relief raised -bd 2 -anchor w
1076        bind $data(typeMenuLab) <<AltUnderlined>> [list \
1077		focus $data(typeMenuBtn)]
1078    }
1079
1080    # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
1081    # is true.  Create it disabled so the binding doesn't trigger if it
1082    # isn't shown.
1083    if {$class eq "TkFDialog"} {
1084	set text [mc "Show &Hidden Files and Directories"]
1085    } else {
1086	set text [mc "Show &Hidden Directories"]
1087    }
1088    set data(hiddenBtn) [::tk::AmpWidget checkbutton $f2.hidden \
1089	    -text $text -anchor w -padx 3 -state disabled \
1090	    -variable ::tk::dialog::file::showHiddenVar \
1091	    -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
1092
1093    # the okBtn is created after the typeMenu so that the keyboard traversal
1094    # is in the right order, and add binding so that we find out when the
1095    # dialog is destroyed by the user (added here instead of to the overall
1096    # window so no confusion about how much <Destroy> gets called; exactly
1097    # once will do). [Bug 987169]
1098
1099    set data(okBtn)     [::tk::AmpWidget button $f2.ok \
1100	    -text [mc "&OK"]     -default active -pady 3]
1101    bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w]
1102    set data(cancelBtn) [::tk::AmpWidget button $f2.cancel \
1103	    -text [mc "&Cancel"] -default normal -pady 3]
1104
1105    # grid the widgets in f2
1106    #
1107    grid $f2.lab $f2.ent $data(okBtn) -padx 4 -sticky ew
1108    grid configure $f2.ent -padx 2
1109    if { $class eq "TkFDialog" } {
1110	grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
1111		-padx 4 -sticky ew
1112	grid configure $data(typeMenuBtn) -padx 0
1113	grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew
1114    } else {
1115	grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew
1116    }
1117    grid columnconfigure $f2 1 -weight 1
1118
1119    # Pack all the frames together. We are done with widget construction.
1120    #
1121    pack $f1 -side top -fill x -pady 4
1122    pack $f2 -side bottom -fill x
1123    pack $data(icons) -expand yes -fill both -padx 4 -pady 1
1124
1125    # Set up the event handlers that are common to Directory and File Dialogs
1126    #
1127
1128    wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
1129    $data(upBtn)     configure -command [list ::tk::dialog::file::UpDirCmd $w]
1130    $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]
1131    bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
1132    bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
1133
1134    # Set up event handlers specific to File or Directory Dialogs
1135    #
1136    if { $class eq "TkFDialog" } {
1137	bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
1138	$data(okBtn)     configure -command [list ::tk::dialog::file::OkCmd $w]
1139	bind $w <Alt-t> [format {
1140	    if {[%s cget -state] eq "normal"} {
1141		focus %s
1142	    }
1143	} $data(typeMenuBtn) $data(typeMenuBtn)]
1144    } else {
1145	set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
1146	bind $data(ent) <Return> $okCmd
1147	$data(okBtn) configure -command $okCmd
1148	bind $w <Alt-s> [list focus $data(ent)]
1149	bind $w <Alt-o> [list tk::ButtonInvoke $data(okBtn)]
1150    }
1151    bind $w <Alt-h> [list $data(hiddenBtn) invoke]
1152
1153    # Build the focus group for all the entries
1154    #
1155    ::tk::FocusGroup_Create $w
1156    ::tk::FocusGroup_BindIn $w  $data(ent) [list ::tk::dialog::file::EntFocusIn $w]
1157    ::tk::FocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]
1158}
1159
1160# ::tk::dialog::file::SetSelectMode --
1161#
1162#	Set the select mode of the dialog to single select or multi-select.
1163#
1164# Arguments:
1165#	w		The dialog path.
1166#	multi		1 if the dialog is multi-select; 0 otherwise.
1167#
1168# Results:
1169#	None.
1170
1171proc ::tk::dialog::file::SetSelectMode {w multi} {
1172    set dataName __tk_filedialog
1173    upvar ::tk::dialog::file::$dataName data
1174    if { $multi } {
1175	set fNameCaption "[mc {File &names:}]"
1176    } else {
1177	set fNameCaption "[mc {File &name:}]"
1178    }
1179    set iconListCommand [list ::tk::dialog::file::OkCmd $w]
1180    ::tk::SetAmpText $w.f2.lab $fNameCaption
1181    ::tk::IconList_Config $data(icons) \
1182	    [list -multiple $multi -command $iconListCommand]
1183    return
1184}
1185
1186# ::tk::dialog::file::UpdateWhenIdle --
1187#
1188#	Creates an idle event handler which updates the dialog in idle
1189#	time. This is important because loading the directory may take a long
1190#	time and we don't want to load the same directory for multiple times
1191#	due to multiple concurrent events.
1192#
1193proc ::tk::dialog::file::UpdateWhenIdle {w} {
1194    upvar ::tk::dialog::file::[winfo name $w] data
1195
1196    if {[info exists data(updateId)]} {
1197	return
1198    } else {
1199	set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
1200    }
1201}
1202
1203# ::tk::dialog::file::Update --
1204#
1205#	Loads the files and directories into the IconList widget. Also
1206#	sets up the directory option menu for quick access to parent
1207#	directories.
1208#
1209proc ::tk::dialog::file::Update {w} {
1210
1211    # This proc may be called within an idle handler. Make sure that the
1212    # window has not been destroyed before this proc is called
1213    if {![winfo exists $w]} {
1214	return
1215    }
1216    set class [winfo class $w]
1217    if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
1218	return
1219    }
1220
1221    set dataName [winfo name $w]
1222    upvar ::tk::dialog::file::$dataName data
1223    variable ::tk::Priv
1224    global tk_library
1225    unset -nocomplain data(updateId)
1226
1227    if {![info exists Priv(folderImage)]} {
1228	set Priv(folderImage) [image create photo -data {
1229R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
1230QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
1231	set Priv(fileImage)   [image create photo -data {
1232R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
1233rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
1234    }
1235    set folder $Priv(folderImage)
1236    set file   $Priv(fileImage)
1237
1238    set appPWD [pwd]
1239    if {[catch {
1240	cd $data(selectPath)
1241    }]} {
1242	# We cannot change directory to $data(selectPath). $data(selectPath)
1243	# should have been checked before ::tk::dialog::file::Update is called, so
1244	# we normally won't come to here. Anyways, give an error and abort
1245	# action.
1246	tk_messageBox -type ok -parent $w -icon warning -message \
1247	    [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
1248	cd $appPWD
1249	return
1250    }
1251
1252    # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
1253    # so the user may still click and cause havoc ...
1254    #
1255    set entCursor [$data(ent) cget -cursor]
1256    set dlgCursor [$w         cget -cursor]
1257    $data(ent) configure -cursor watch
1258    $w         configure -cursor watch
1259    update idletasks
1260
1261    ::tk::IconList_DeleteAll $data(icons)
1262
1263    set showHidden $::tk::dialog::file::showHiddenVar
1264
1265    # Make the dir list
1266    # Using -directory [pwd] is better in some VFS cases.
1267    set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
1268    if {$showHidden} { lappend cmd .* }
1269    set dirs [lsort -dictionary -unique [eval $cmd]]
1270    set dirList {}
1271    foreach d $dirs {
1272	if {$d eq "." || $d eq ".."} {
1273	    continue
1274	}
1275	lappend dirList $d
1276    }
1277    ::tk::IconList_Add $data(icons) $folder $dirList
1278
1279    if {$class eq "TkFDialog"} {
1280	# Make the file list if this is a File Dialog, selecting all
1281	# but 'd'irectory type files.
1282	#
1283	set cmd [list glob -tails -directory [pwd] \
1284		     -type {f b c l p s} -nocomplain]
1285	if {$data(filter) eq "*"} {
1286	    lappend cmd *
1287	    if {$showHidden} { lappend cmd .* }
1288	} else {
1289	    eval [list lappend cmd] $data(filter)
1290	}
1291	set fileList [lsort -dictionary -unique [eval $cmd]]
1292	::tk::IconList_Add $data(icons) $file $fileList
1293    }
1294
1295    ::tk::IconList_Arrange $data(icons)
1296
1297    # Update the Directory: option menu
1298    #
1299    set list ""
1300    set dir ""
1301    foreach subdir [file split $data(selectPath)] {
1302	set dir [file join $dir $subdir]
1303	lappend list $dir
1304    }
1305
1306    $data(dirMenu) delete 0 end
1307    set var [format %s(selectPath) ::tk::dialog::file::$dataName]
1308    foreach path $list {
1309	$data(dirMenu) add command -label $path -command [list set $var $path]
1310    }
1311
1312    # Restore the PWD to the application's PWD
1313    #
1314    cd $appPWD
1315
1316    if { $class eq "TkFDialog" } {
1317	# Restore the Open/Save Button if this is a File Dialog
1318	#
1319	if {$data(type) eq "open"} {
1320	    ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1321	} else {
1322	    ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1323	}
1324    }
1325
1326    # turn off the busy cursor.
1327    #
1328    $data(ent) configure -cursor $entCursor
1329    $w         configure -cursor $dlgCursor
1330}
1331
1332# ::tk::dialog::file::SetPathSilently --
1333#
1334# 	Sets data(selectPath) without invoking the trace procedure
1335#
1336proc ::tk::dialog::file::SetPathSilently {w path} {
1337    upvar ::tk::dialog::file::[winfo name $w] data
1338
1339    trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
1340    set data(selectPath) $path
1341    trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
1342}
1343
1344
1345# This proc gets called whenever data(selectPath) is set
1346#
1347proc ::tk::dialog::file::SetPath {w name1 name2 op} {
1348    if {[winfo exists $w]} {
1349	upvar ::tk::dialog::file::[winfo name $w] data
1350	::tk::dialog::file::UpdateWhenIdle $w
1351	# On directory dialogs, we keep the entry in sync with the currentdir.
1352	if { [winfo class $w] eq "TkChooseDir" } {
1353	    $data(ent) delete 0 end
1354	    $data(ent) insert end $data(selectPath)
1355	}
1356    }
1357}
1358
1359# This proc gets called whenever data(filter) is set
1360#
1361proc ::tk::dialog::file::SetFilter {w type} {
1362    upvar ::tk::dialog::file::[winfo name $w] data
1363    upvar ::tk::$data(icons) icons
1364
1365    set data(filter) [lindex $type 1]
1366    $data(typeMenuBtn) configure -text [lindex $type 0] -indicatoron 1
1367
1368    # If we aren't using a default extension, use the one suppled
1369    # by the filter.
1370    if {![info exists data(extUsed)]} {
1371	if {[string length $data(-defaultextension)]} {
1372	    set data(extUsed) 1
1373	} else {
1374	    set data(extUsed) 0
1375	}
1376    }
1377
1378    if {!$data(extUsed)} {
1379	# Get the first extension in the list that matches {^\*\.\w+$}
1380	# and remove all * from the filter.
1381	set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
1382	if {$index >= 0} {
1383	    set data(-defaultextension) \
1384		    [string trimleft [lindex $data(filter) $index] "*"]
1385	} else {
1386	    # Couldn't find anything!  Reset to a safe default...
1387	    set data(-defaultextension) ""
1388	}
1389    }
1390
1391    $icons(sbar) set 0.0 0.0
1392
1393    ::tk::dialog::file::UpdateWhenIdle $w
1394}
1395
1396# tk::dialog::file::ResolveFile --
1397#
1398#	Interpret the user's text input in a file selection dialog.
1399#	Performs:
1400#
1401#	(1) ~ substitution
1402#	(2) resolve all instances of . and ..
1403#	(3) check for non-existent files/directories
1404#	(4) check for chdir permissions
1405#
1406# Arguments:
1407#	context:  the current directory you are in
1408#	text:	  the text entered by the user
1409#	defaultext: the default extension to add to files with no extension
1410#
1411# Return vaue:
1412#	[list $flag $directory $file]
1413#
1414#	 flag = OK	: valid input
1415#	      = PATTERN	: valid directory/pattern
1416#	      = PATH	: the directory does not exist
1417#	      = FILE	: the directory exists by the file doesn't
1418#			  exist
1419#	      = CHDIR	: Cannot change to the directory
1420#	      = ERROR	: Invalid entry
1421#
1422#	 directory      : valid only if flag = OK or PATTERN or FILE
1423#	 file           : valid only if flag = OK or PATTERN
1424#
1425#	directory may not be the same as context, because text may contain
1426#	a subdirectory name
1427#
1428proc ::tk::dialog::file::ResolveFile {context text defaultext} {
1429
1430    set appPWD [pwd]
1431
1432    set path [::tk::dialog::file::JoinFile $context $text]
1433
1434    # If the file has no extension, append the default.  Be careful not
1435    # to do this for directories, otherwise typing a dirname in the box
1436    # will give back "dirname.extension" instead of trying to change dir.
1437    if {![file isdirectory $path] && [file ext $path] eq ""} {
1438	set path "$path$defaultext"
1439    }
1440
1441
1442    if {[catch {file exists $path}]} {
1443	# This "if" block can be safely removed if the following code
1444	# stop generating errors.
1445	#
1446	#	file exists ~nonsuchuser
1447	#
1448	return [list ERROR $path ""]
1449    }
1450
1451    if {[file exists $path]} {
1452	if {[file isdirectory $path]} {
1453	    if {[catch {cd $path}]} {
1454		return [list CHDIR $path ""]
1455	    }
1456	    set directory [pwd]
1457	    set file ""
1458	    set flag OK
1459	    cd $appPWD
1460	} else {
1461	    if {[catch {cd [file dirname $path]}]} {
1462		return [list CHDIR [file dirname $path] ""]
1463	    }
1464	    set directory [pwd]
1465	    set file [file tail $path]
1466	    set flag OK
1467	    cd $appPWD
1468	}
1469    } else {
1470	set dirname [file dirname $path]
1471	if {[file exists $dirname]} {
1472	    if {[catch {cd $dirname}]} {
1473		return [list CHDIR $dirname ""]
1474	    }
1475	    set directory [pwd]
1476	    set file [file tail $path]
1477	    if {[regexp {[*]|[?]} $file]} {
1478		set flag PATTERN
1479	    } else {
1480		set flag FILE
1481	    }
1482	    cd $appPWD
1483	} else {
1484	    set directory $dirname
1485	    set file [file tail $path]
1486	    set flag PATH
1487	}
1488    }
1489
1490    return [list $flag $directory $file]
1491}
1492
1493
1494# Gets called when the entry box gets keyboard focus. We clear the selection
1495# from the icon list . This way the user can be certain that the input in the
1496# entry box is the selection.
1497#
1498proc ::tk::dialog::file::EntFocusIn {w} {
1499    upvar ::tk::dialog::file::[winfo name $w] data
1500
1501    if {[$data(ent) get] ne ""} {
1502	$data(ent) selection range 0 end
1503	$data(ent) icursor end
1504    } else {
1505	$data(ent) selection clear
1506    }
1507
1508    if { [winfo class $w] eq "TkFDialog" } {
1509	# If this is a File Dialog, make sure the buttons are labeled right.
1510	if {$data(type) eq "open"} {
1511	    ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1512	} else {
1513	    ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1514	}
1515    }
1516}
1517
1518proc ::tk::dialog::file::EntFocusOut {w} {
1519    upvar ::tk::dialog::file::[winfo name $w] data
1520
1521    $data(ent) selection clear
1522}
1523
1524
1525# Gets called when user presses Return in the "File name" entry.
1526#
1527proc ::tk::dialog::file::ActivateEnt {w} {
1528    upvar ::tk::dialog::file::[winfo name $w] data
1529
1530    set text [$data(ent) get]
1531    if {$data(-multiple)} {
1532	# For the multiple case we have to be careful to get the file
1533	# names as a true list, watching out for a single file with a
1534	# space in the name.  Thus we query the IconList directly.
1535
1536	set selIcos [::tk::IconList_Curselection $data(icons)]
1537	set data(selectFile) ""
1538	if {[llength $selIcos] == 0 && $text ne ""} {
1539	    # This assumes the user typed something in without selecting
1540	    # files - so assume they only type in a single filename.
1541	    ::tk::dialog::file::VerifyFileName $w $text
1542	} else {
1543	    foreach item $selIcos {
1544		::tk::dialog::file::VerifyFileName $w \
1545		    [::tk::IconList_Get $data(icons) $item]
1546	    }
1547	}
1548    } else {
1549	::tk::dialog::file::VerifyFileName $w $text
1550    }
1551}
1552
1553# Verification procedure
1554#
1555proc ::tk::dialog::file::VerifyFileName {w filename} {
1556    upvar ::tk::dialog::file::[winfo name $w] data
1557
1558    set list [::tk::dialog::file::ResolveFile $data(selectPath) $filename \
1559	    $data(-defaultextension)]
1560    foreach {flag path file} $list {
1561	break
1562    }
1563
1564    switch -- $flag {
1565	OK {
1566	    if {$file eq ""} {
1567		# user has entered an existing (sub)directory
1568		set data(selectPath) $path
1569		$data(ent) delete 0 end
1570	    } else {
1571		::tk::dialog::file::SetPathSilently $w $path
1572		if {$data(-multiple)} {
1573		    lappend data(selectFile) $file
1574		} else {
1575		    set data(selectFile) $file
1576		}
1577		::tk::dialog::file::Done $w
1578	    }
1579	}
1580	PATTERN {
1581	    set data(selectPath) $path
1582	    set data(filter) $file
1583	}
1584	FILE {
1585	    if {$data(type) eq "open"} {
1586		tk_messageBox -icon warning -type ok -parent $w \
1587		    -message "[mc "File \"%1\$s\"  does not exist." [file join $path $file]]"
1588		$data(ent) selection range 0 end
1589		$data(ent) icursor end
1590	    } else {
1591		::tk::dialog::file::SetPathSilently $w $path
1592		if {$data(-multiple)} {
1593		    lappend data(selectFile) $file
1594		} else {
1595		    set data(selectFile) $file
1596		}
1597		::tk::dialog::file::Done $w
1598	    }
1599	}
1600	PATH {
1601	    tk_messageBox -icon warning -type ok -parent $w \
1602		-message "[mc "Directory \"%1\$s\" does not exist." $path]"
1603	    $data(ent) selection range 0 end
1604	    $data(ent) icursor end
1605	}
1606	CHDIR {
1607	    tk_messageBox -type ok -parent $w -message \
1608	       "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path]"\
1609		-icon warning
1610	    $data(ent) selection range 0 end
1611	    $data(ent) icursor end
1612	}
1613	ERROR {
1614	    tk_messageBox -type ok -parent $w -message \
1615	       "[mc "Invalid file name \"%1\$s\"." $path]"\
1616		-icon warning
1617	    $data(ent) selection range 0 end
1618	    $data(ent) icursor end
1619	}
1620    }
1621}
1622
1623# Gets called when user presses the Alt-s or Alt-o keys.
1624#
1625proc ::tk::dialog::file::InvokeBtn {w key} {
1626    upvar ::tk::dialog::file::[winfo name $w] data
1627
1628    if {[$data(okBtn) cget -text] eq $key} {
1629	::tk::ButtonInvoke $data(okBtn)
1630    }
1631}
1632
1633# Gets called when user presses the "parent directory" button
1634#
1635proc ::tk::dialog::file::UpDirCmd {w} {
1636    upvar ::tk::dialog::file::[winfo name $w] data
1637
1638    if {$data(selectPath) ne "/"} {
1639	set data(selectPath) [file dirname $data(selectPath)]
1640    }
1641}
1642
1643# Join a file name to a path name. The "file join" command will break
1644# if the filename begins with ~
1645#
1646proc ::tk::dialog::file::JoinFile {path file} {
1647    if {[string match {~*} $file] && [file exists $path/$file]} {
1648	return [file join $path ./$file]
1649    } else {
1650	return [file join $path $file]
1651    }
1652}
1653
1654# Gets called when user presses the "OK" button
1655#
1656proc ::tk::dialog::file::OkCmd {w} {
1657    upvar ::tk::dialog::file::[winfo name $w] data
1658
1659    set filenames {}
1660    foreach item [::tk::IconList_Curselection $data(icons)] {
1661	lappend filenames [::tk::IconList_Get $data(icons) $item]
1662    }
1663
1664    if {([llength $filenames] && !$data(-multiple)) || \
1665	    ($data(-multiple) && ([llength $filenames] == 1))} {
1666	set filename [lindex $filenames 0]
1667	set file [::tk::dialog::file::JoinFile $data(selectPath) $filename]
1668	if {[file isdirectory $file]} {
1669	    ::tk::dialog::file::ListInvoke $w [list $filename]
1670	    return
1671	}
1672    }
1673
1674    ::tk::dialog::file::ActivateEnt $w
1675}
1676
1677# Gets called when user presses the "Cancel" button
1678#
1679proc ::tk::dialog::file::CancelCmd {w} {
1680    upvar ::tk::dialog::file::[winfo name $w] data
1681    variable ::tk::Priv
1682
1683    bind $data(okBtn) <Destroy> {}
1684    set Priv(selectFilePath) ""
1685}
1686
1687# Gets called when user destroys the dialog directly [Bug 987169]
1688#
1689proc ::tk::dialog::file::Destroyed {w} {
1690    upvar ::tk::dialog::file::[winfo name $w] data
1691    variable ::tk::Priv
1692
1693    set Priv(selectFilePath) ""
1694}
1695
1696# Gets called when user browses the IconList widget (dragging mouse, arrow
1697# keys, etc)
1698#
1699proc ::tk::dialog::file::ListBrowse {w} {
1700    upvar ::tk::dialog::file::[winfo name $w] data
1701
1702    set text {}
1703    foreach item [::tk::IconList_Curselection $data(icons)] {
1704	lappend text [::tk::IconList_Get $data(icons) $item]
1705    }
1706    if {[llength $text] == 0} {
1707	return
1708    }
1709    if { [llength $text] > 1 } {
1710	set newtext {}
1711	foreach file $text {
1712	    set fullfile [::tk::dialog::file::JoinFile $data(selectPath) $file]
1713	    if { ![file isdirectory $fullfile] } {
1714		lappend newtext $file
1715	    }
1716	}
1717	set text $newtext
1718	set isDir 0
1719    } else {
1720	set text [lindex $text 0]
1721	set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
1722	set isDir [file isdirectory $file]
1723    }
1724    if {!$isDir} {
1725	$data(ent) delete 0 end
1726	$data(ent) insert 0 $text
1727
1728	if { [winfo class $w] eq "TkFDialog" } {
1729	    if {$data(type) eq "open"} {
1730		::tk::SetAmpText $data(okBtn) [mc "&Open"]
1731	    } else {
1732		::tk::SetAmpText $data(okBtn) [mc "&Save"]
1733	    }
1734	}
1735    } else {
1736	if { [winfo class $w] eq "TkFDialog" } {
1737	    ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1738	}
1739    }
1740}
1741
1742# Gets called when user invokes the IconList widget (double-click,
1743# Return key, etc)
1744#
1745proc ::tk::dialog::file::ListInvoke {w filenames} {
1746    upvar ::tk::dialog::file::[winfo name $w] data
1747
1748    if {[llength $filenames] == 0} {
1749	return
1750    }
1751
1752    set file [::tk::dialog::file::JoinFile $data(selectPath) \
1753	    [lindex $filenames 0]]
1754
1755    set class [winfo class $w]
1756    if {$class eq "TkChooseDir" || [file isdirectory $file]} {
1757	set appPWD [pwd]
1758	if {[catch {cd $file}]} {
1759	    tk_messageBox -type ok -parent $w -message \
1760	       "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]"\
1761		-icon warning
1762	} else {
1763	    cd $appPWD
1764	    set data(selectPath) $file
1765	}
1766    } else {
1767	if {$data(-multiple)} {
1768	    set data(selectFile) $filenames
1769	} else {
1770	    set data(selectFile) $file
1771	}
1772	::tk::dialog::file::Done $w
1773    }
1774}
1775
1776# ::tk::dialog::file::Done --
1777#
1778#	Gets called when user has input a valid filename.  Pops up a
1779#	dialog box to confirm selection when necessary. Sets the
1780#	tk::Priv(selectFilePath) variable, which will break the "vwait"
1781#	loop in ::tk::dialog::file:: and return the selected filename to the
1782#	script that calls tk_getOpenFile or tk_getSaveFile
1783#
1784proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
1785    upvar ::tk::dialog::file::[winfo name $w] data
1786    variable ::tk::Priv
1787
1788    if {$selectFilePath eq ""} {
1789	if {$data(-multiple)} {
1790	    set selectFilePath {}
1791	    foreach f $data(selectFile) {
1792		lappend selectFilePath [::tk::dialog::file::JoinFile \
1793		    $data(selectPath) $f]
1794	    }
1795	} else {
1796	    set selectFilePath [::tk::dialog::file::JoinFile \
1797		    $data(selectPath) $data(selectFile)]
1798	}
1799
1800	set Priv(selectFile)     $data(selectFile)
1801	set Priv(selectPath)     $data(selectPath)
1802
1803	if {$data(type) eq "save"} {
1804	    if {[file exists $selectFilePath]} {
1805	    set reply [tk_messageBox -icon warning -type yesno\
1806		    -parent $w -message \
1807			"[mc "File \"%1\$s\" already exists.\nDo you want to overwrite it?" $selectFilePath]"]
1808	    if {$reply eq "no"} {
1809		return
1810		}
1811	    }
1812	}
1813    }
1814    bind $data(okBtn) <Destroy> {}
1815    set Priv(selectFilePath) $selectFilePath
1816}
1817