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