?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Initial bulk commit for "Git on MSys"
[msysgit/historical-msysgit.git] / mingw / lib / tk8.4 / tkfbox.tcl
blobec37d55234f08ca0763edaf8c5b71d48c6af8146
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.12 2006/07/07 00:38:47 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 #
35 proc ::tk::IconList {w args} {
36 IconList_Config $w $args
37 IconList_Create $w
38 }
39
40 proc ::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
73 proc ::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
157 proc ::tk::IconList_Curselection {w} {
158 upvar ::tk::$w data
159 return $data(selection)
160 }
161
162 proc ::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
181 proc ::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 #
196 proc ::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 #
216 proc ::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 #
288 proc ::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 #
318 proc ::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 #
339 proc ::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 #
387 proc ::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 #
472 proc ::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.
484 proc ::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
532 proc ::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
545 proc ::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
563 proc ::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 #
583 proc ::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
596 proc ::tk::IconList_Double1 {w x y} {
597 upvar ::tk::$w data
598
599 if {[llength $data(selection)]} {
600 IconList_Invoke $w
601 }
602 }
603
604 proc ::tk::IconList_ReturnKey {w} {
605 IconList_Invoke $w
606 }
607
608 proc ::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
616 proc ::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
628 proc ::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 #
640 proc ::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 #
669 proc ::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 #
698 proc ::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
709 proc ::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 ""} {
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
759 proc ::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
771 namespace eval ::tk::dialog {}
772 namespace 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
789 proc ::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 #
912 proc ::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
997 proc ::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
1005 # f1: the frame with the directory option menu
1006 #
1007 set f1 [frame $w.f1]
1008 bind [::tk::AmpWidget label $f1.lab -text "[mc "&Directory:"]" ] \
1009 <<AltUnderlined>> [list focus $f1.menu]
1010
1011 set data(dirMenuBtn) $f1.menu
1012 set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""]
1013 set data(upBtn) [button $f1.up]
1014 if {![info exists Priv(updirImage)]} {
1015 set Priv(updirImage) [image create bitmap -data {
1016 #define updir_width 28
1017 #define updir_height 16
1018 static char updir_bits[] = {
1019 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1020 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1021 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1022 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1023 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1024 0xf0, 0xff, 0xff, 0x01};}]
1025 }
1026 $data(upBtn) configure -image $Priv(updirImage)
1027
1028 $f1.menu configure -takefocus 1 -highlightthickness 2
1029
1030 pack $data(upBtn) -side right -padx 4 -fill both
1031 pack $f1.lab -side left -padx 4 -fill both
1032 pack $f1.menu -expand yes -fill both -padx 4
1033
1034 # data(icons): the IconList that list the files and directories.
1035 #
1036 if { $class eq "TkFDialog" } {
1037 if { $data(-multiple) } {
1038 set fNameCaption [mc "File &names:"]
1039 } else {
1040 set fNameCaption [mc "File &name:"]
1041 }
1042 set fTypeCaption [mc "Files of &type:"]
1043 set iconListCommand [list ::tk::dialog::file::OkCmd $w]
1044 } else {
1045 set fNameCaption [mc "&Selection:"]
1046 set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
1047 }
1048 set data(icons) [::tk::IconList $w.icons \
1049 -command $iconListCommand \
1050 -multiple $data(-multiple)]
1051 bind $data(icons) <<ListboxSelect>> \
1052 [list ::tk::dialog::file::ListBrowse $w]
1053
1054 # f2: the frame with the OK button, cancel button, "file name" field
1055 # and file types field.
1056 #
1057 set f2 [frame $w.f2 -bd 0]
1058 bind [::tk::AmpWidget label $f2.lab -text $fNameCaption -anchor e -pady 0]\
1059 <<AltUnderlined>> [list focus $f2.ent]
1060 set data(ent) [entry $f2.ent]
1061
1062 # The font to use for the icons. The default Canvas font on Unix
1063 # is just deviant.
1064 set ::tk::$w.icons(font) [$data(ent) cget -font]
1065
1066 # Make the file types bits only if this is a File Dialog
1067 if { $class eq "TkFDialog" } {
1068 set data(typeMenuLab) [::tk::AmpWidget label $f2.lab2 \
1069 -text $fTypeCaption -anchor e -pady [$f2.lab cget -pady]]
1070 set data(typeMenuBtn) [menubutton $f2.menu -indicatoron 1 \
1071 -menu $f2.menu.m]
1072 set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
1073 $data(typeMenuBtn) configure -takefocus 1 -highlightthickness 2 \
1074 -relief raised -bd 2 -anchor w
1075 bind $data(typeMenuLab) <<AltUnderlined>> [list \
1076 focus $data(typeMenuBtn)]
1077 }
1078
1079 # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
1080 # is true. Create it disabled so the binding doesn't trigger if it
1081 # isn't shown.
1082 if {$class eq "TkFDialog"} {
1083 set text [mc "Show &Hidden Files and Directories"]
1084 } else {
1085 set text [mc "Show &Hidden Directories"]
1086 }
1087 set data(hiddenBtn) [::tk::AmpWidget checkbutton $f2.hidden \
1088 -text $text -anchor w -padx 3 -state disabled \
1089 -variable ::tk::dialog::file::showHiddenVar \
1090 -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
1091
1092 # the okBtn is created after the typeMenu so that the keyboard traversal
1093 # is in the right order, and add binding so that we find out when the
1094 # dialog is destroyed by the user (added here instead of to the overall
1095 # window so no confusion about how much <Destroy> gets called; exactly
1096 # once will do). [Bug 987169]
1097
1098 set data(okBtn) [::tk::AmpWidget button $f2.ok \
1099 -text [mc "&OK"] -default active -pady 3]
1100 bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w]
1101 set data(cancelBtn) [::tk::AmpWidget button $f2.cancel \
1102 -text [mc "&Cancel"] -default normal -pady 3]
1103
1104 # grid the widgets in f2
1105 #
1106 grid $f2.lab $f2.ent $data(okBtn) -padx 4 -sticky ew
1107 grid configure $f2.ent -padx 2
1108 if { $class eq "TkFDialog" } {
1109 grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
1110 -padx 4 -sticky ew
1111 grid configure $data(typeMenuBtn) -padx 0
1112 grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew
1113 } else {
1114 grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew
1115 }
1116 grid columnconfigure $f2 1 -weight 1
1117
1118 # Pack all the frames together. We are done with widget construction.
1119 #
1120 pack $f1 -side top -fill x -pady 4
1121 pack $f2 -side bottom -fill x
1122 pack $data(icons) -expand yes -fill both -padx 4 -pady 1
1123
1124 # Set up the event handlers that are common to Directory and File Dialogs
1125 #
1126
1127 wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
1128 $data(upBtn) configure -command [list ::tk::dialog::file::UpDirCmd $w]
1129 $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]
1130 bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
1131 bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
1132
1133 # Set up event handlers specific to File or Directory Dialogs
1134 #
1135 if { $class eq "TkFDialog" } {
1136 bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
1137 $data(okBtn) configure -command [list ::tk::dialog::file::OkCmd $w]
1138 bind $w <Alt-t> [format {
1139 if {[%s cget -state] eq "normal"} {
1140 focus %s
1141 }
1142 } $data(typeMenuBtn) $data(typeMenuBtn)]
1143 } else {
1144 set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
1145 bind $data(ent) <Return> $okCmd
1146 $data(okBtn) configure -command $okCmd
1147 bind $w <Alt-s> [list focus $data(ent)]
1148 bind $w <Alt-o> [list tk::ButtonInvoke $data(okBtn)]
1149 }
1150 bind $w <Alt-h> [list $data(hiddenBtn) invoke]
1151
1152 # Build the focus group for all the entries
1153 #
1154 ::tk::FocusGroup_Create $w
1155 ::tk::FocusGroup_BindIn $w $data(ent) [list ::tk::dialog::file::EntFocusIn $w]
1156 ::tk::FocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]
1157 }
1158
1159 # ::tk::dialog::file::SetSelectMode --
1160 #
1161 # Set the select mode of the dialog to single select or multi-select.
1162 #
1163 # Arguments:
1164 # w The dialog path.
1165 # multi 1 if the dialog is multi-select; 0 otherwise.
1166 #
1167 # Results:
1168 # None.
1169
1170 proc ::tk::dialog::file::SetSelectMode {w multi} {
1171 set dataName __tk_filedialog
1172 upvar ::tk::dialog::file::$dataName data
1173 if { $multi } {
1174 set fNameCaption "[mc {File &names:}]"
1175 } else {
1176 set fNameCaption "[mc {File &name:}]"
1177 }
1178 set iconListCommand [list ::tk::dialog::file::OkCmd $w]
1179 ::tk::SetAmpText $w.f2.lab $fNameCaption
1180 ::tk::IconList_Config $data(icons) \
1181 [list -multiple $multi -command $iconListCommand]
1182 return
1183 }
1184
1185 # ::tk::dialog::file::UpdateWhenIdle --
1186 #
1187 # Creates an idle event handler which updates the dialog in idle
1188 # time. This is important because loading the directory may take a long
1189 # time and we don't want to load the same directory for multiple times
1190 # due to multiple concurrent events.
1191 #
1192 proc ::tk::dialog::file::UpdateWhenIdle {w} {
1193 upvar ::tk::dialog::file::[winfo name $w] data
1194
1195 if {[info exists data(updateId)]} {
1196 return
1197 } else {
1198 set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
1199 }
1200 }
1201
1202 # ::tk::dialog::file::Update --
1203 #
1204 # Loads the files and directories into the IconList widget. Also
1205 # sets up the directory option menu for quick access to parent
1206 # directories.
1207 #
1208 proc ::tk::dialog::file::Update {w} {
1209
1210 # This proc may be called within an idle handler. Make sure that the
1211 # window has not been destroyed before this proc is called
1212 if {![winfo exists $w]} {
1213 return
1214 }
1215 set class [winfo class $w]
1216 if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
1217 return
1218 }
1219
1220 set dataName [winfo name $w]
1221 upvar ::tk::dialog::file::$dataName data
1222 variable ::tk::Priv
1223 global tk_library
1224 unset -nocomplain data(updateId)
1225
1226 if {![info exists Priv(folderImage)]} {
1227 set Priv(folderImage) [image create photo -data {
1228 R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
1229 QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
1230 set Priv(fileImage) [image create photo -data {
1231 R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
1232 rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
1233 }
1234 set folder $Priv(folderImage)
1235 set file $Priv(fileImage)
1236
1237 set appPWD [pwd]
1238 if {[catch {
1239 cd $data(selectPath)
1240 }]} {
1241 # We cannot change directory to $data(selectPath). $data(selectPath)
1242 # should have been checked before ::tk::dialog::file::Update is called, so
1243 # we normally won't come to here. Anyways, give an error and abort
1244 # action.
1245 tk_messageBox -type ok -parent $w -icon warning -message \
1246 [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
1247 cd $appPWD
1248 return
1249 }
1250
1251 # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
1252 # so the user may still click and cause havoc ...
1253 #
1254 set entCursor [$data(ent) cget -cursor]
1255 set dlgCursor [$w cget -cursor]
1256 $data(ent) configure -cursor watch
1257 $w configure -cursor watch
1258 update idletasks
1259
1260 ::tk::IconList_DeleteAll $data(icons)
1261
1262 set showHidden $::tk::dialog::file::showHiddenVar
1263
1264 # Make the dir list
1265 # Using -directory [pwd] is better in some VFS cases.
1266 set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
1267 if {$showHidden} { lappend cmd .* }
1268 set dirs [lsort -dictionary -unique [eval $cmd]]
1269 set dirList {}
1270 foreach d $dirs {
1271 if {$d eq "." || $d eq ".."} {
1272 continue
1273 }
1274 lappend dirList $d
1275 }
1276 ::tk::IconList_Add $data(icons) $folder $dirList
1277
1278 if {$class eq "TkFDialog"} {
1279 # Make the file list if this is a File Dialog, selecting all
1280 # but 'd'irectory type files.
1281 #
1282 set cmd [list glob -tails -directory [pwd] \
1283 -type {f b c l p s} -nocomplain]
1284 if {$data(filter) eq "*"} {
1285 lappend cmd *
1286 if {$showHidden} { lappend cmd .* }
1287 } else {
1288 eval [list lappend cmd] $data(filter)
1289 }
1290 set fileList [lsort -dictionary -unique [eval $cmd]]
1291 ::tk::IconList_Add $data(icons) $file $fileList
1292 }
1293
1294 ::tk::IconList_Arrange $data(icons)
1295
1296 # Update the Directory: option menu
1297 #
1298 set list ""
1299 set dir ""
1300 foreach subdir [file split $data(selectPath)] {
1301 set dir [file join $dir $subdir]
1302 lappend list $dir
1303 }
1304
1305 $data(dirMenu) delete 0 end
1306 set var [format %s(selectPath) ::tk::dialog::file::$dataName]
1307 foreach path $list {
1308 $data(dirMenu) add command -label $path -command [list set $var $path]
1309 }
1310
1311 # Restore the PWD to the application's PWD
1312 #
1313 cd $appPWD
1314
1315 if { $class eq "TkFDialog" } {
1316 # Restore the Open/Save Button if this is a File Dialog
1317 #
1318 if {$data(type) eq "open"} {
1319 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1320 } else {
1321 ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1322 }
1323 }
1324
1325 # turn off the busy cursor.
1326 #
1327 $data(ent) configure -cursor $entCursor
1328 $w configure -cursor $dlgCursor
1329 }
1330
1331 # ::tk::dialog::file::SetPathSilently --
1332 #
1333 # Sets data(selectPath) without invoking the trace procedure
1334 #
1335 proc ::tk::dialog::file::SetPathSilently {w path} {
1336 upvar ::tk::dialog::file::[winfo name $w] data
1337
1338 trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
1339 set data(selectPath) $path
1340 trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
1341 }
1342
1343
1344 # This proc gets called whenever data(selectPath) is set
1345 #
1346 proc ::tk::dialog::file::SetPath {w name1 name2 op} {
1347 if {[winfo exists $w]} {
1348 upvar ::tk::dialog::file::[winfo name $w] data
1349 ::tk::dialog::file::UpdateWhenIdle $w
1350 # On directory dialogs, we keep the entry in sync with the currentdir.
1351 if { [winfo class $w] eq "TkChooseDir" } {
1352 $data(ent) delete 0 end
1353 $data(ent) insert end $data(selectPath)
1354 }
1355 }
1356 }
1357
1358 # This proc gets called whenever data(filter) is set
1359 #
1360 proc ::tk::dialog::file::SetFilter {w type} {
1361 upvar ::tk::dialog::file::[winfo name $w] data
1362 upvar ::tk::$data(icons) icons
1363
1364 set data(filter) [lindex $type 1]
1365 $data(typeMenuBtn) configure -text [lindex $type 0] -indicatoron 1
1366
1367 # If we aren't using a default extension, use the one suppled
1368 # by the filter.
1369 if {![info exists data(extUsed)]} {
1370 if {[string length $data(-defaultextension)]} {
1371 set data(extUsed) 1
1372 } else {
1373 set data(extUsed) 0
1374 }
1375 }
1376
1377 if {!$data(extUsed)} {
1378 # Get the first extension in the list that matches {^\*\.\w+$}
1379 # and remove all * from the filter.
1380 set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
1381 if {$index >= 0} {
1382 set data(-defaultextension) \
1383 [string trimleft [lindex $data(filter) $index] "*"]
1384 } else {
1385 # Couldn't find anything! Reset to a safe default...
1386 set data(-defaultextension) ""
1387 }
1388 }
1389
1390 $icons(sbar) set 0.0 0.0
1391
1392 ::tk::dialog::file::UpdateWhenIdle $w
1393 }
1394
1395 # tk::dialog::file::ResolveFile --
1396 #
1397 # Interpret the user's text input in a file selection dialog.
1398 # Performs:
1399 #
1400 # (1) ~ substitution
1401 # (2) resolve all instances of . and ..
1402 # (3) check for non-existent files/directories
1403 # (4) check for chdir permissions
1404 #
1405 # Arguments:
1406 # context: the current directory you are in
1407 # text: the text entered by the user
1408 # defaultext: the default extension to add to files with no extension
1409 #
1410 # Return vaue:
1411 # [list $flag $directory $file]
1412 #
1413 # flag = OK : valid input
1414 # = PATTERN : valid directory/pattern
1415 # = PATH : the directory does not exist
1416 # = FILE : the directory exists by the file doesn't
1417 # exist
1418 # = CHDIR : Cannot change to the directory
1419 # = ERROR : Invalid entry
1420 #
1421 # directory : valid only if flag = OK or PATTERN or FILE
1422 # file : valid only if flag = OK or PATTERN
1423 #
1424 # directory may not be the same as context, because text may contain
1425 # a subdirectory name
1426 #
1427 proc ::tk::dialog::file::ResolveFile {context text defaultext} {
1428
1429 set appPWD [pwd]
1430
1431 set path [::tk::dialog::file::JoinFile $context $text]
1432
1433 # If the file has no extension, append the default. Be careful not
1434 # to do this for directories, otherwise typing a dirname in the box
1435 # will give back "dirname.extension" instead of trying to change dir.
1436 if {![file isdirectory $path] && [file ext $path] eq ""} {
1437 set path "$path$defaultext"
1438 }
1439
1440
1441 if {[catch {file exists $path}]} {
1442 # This "if" block can be safely removed if the following code
1443 # stop generating errors.
1444 #
1445 # file exists ~nonsuchuser
1446 #
1447 return [list ERROR $path ""]
1448 }
1449
1450 if {[file exists $path]} {
1451 if {[file isdirectory $path]} {
1452 if {[catch {cd $path}]} {
1453 return [list CHDIR $path ""]
1454 }
1455 set directory [pwd]
1456 set file ""
1457 set flag OK
1458 cd $appPWD
1459 } else {
1460 if {[catch {cd [file dirname $path]}]} {
1461 return [list CHDIR [file dirname $path] ""]
1462 }
1463 set directory [pwd]
1464 set file [file tail $path]
1465 set flag OK
1466 cd $appPWD
1467 }
1468 } else {
1469 set dirname [file dirname $path]
1470 if {[file exists $dirname]} {
1471 if {[catch {cd $dirname}]} {
1472 return [list CHDIR $dirname ""]
1473 }
1474 set directory [pwd]
1475 set file [file tail $path]
1476 if {[regexp {[*]|[?]} $file]} {
1477 set flag PATTERN
1478 } else {
1479 set flag FILE
1480 }
1481 cd $appPWD
1482 } else {
1483 set directory $dirname
1484 set file [file tail $path]
1485 set flag PATH
1486 }
1487 }
1488
1489 return [list $flag $directory $file]
1490 }
1491
1492
1493 # Gets called when the entry box gets keyboard focus. We clear the selection
1494 # from the icon list . This way the user can be certain that the input in the
1495 # entry box is the selection.
1496 #
1497 proc ::tk::dialog::file::EntFocusIn {w} {
1498 upvar ::tk::dialog::file::[winfo name $w] data
1499
1500 if {[$data(ent) get] ne ""} {
1501 $data(ent) selection range 0 end
1502 $data(ent) icursor end
1503 } else {
1504 $data(ent) selection clear
1505 }
1506
1507 if { [winfo class $w] eq "TkFDialog" } {
1508 # If this is a File Dialog, make sure the buttons are labeled right.
1509 if {$data(type) eq "open"} {
1510 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1511 } else {
1512 ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1513 }
1514 }
1515 }
1516
1517 proc ::tk::dialog::file::EntFocusOut {w} {
1518 upvar ::tk::dialog::file::[winfo name $w] data
1519
1520 $data(ent) selection clear
1521 }
1522
1523
1524 # Gets called when user presses Return in the "File name" entry.
1525 #
1526 proc ::tk::dialog::file::ActivateEnt {w} {
1527 upvar ::tk::dialog::file::[winfo name $w] data
1528
1529 set text [$data(ent) get]
1530 if {$data(-multiple)} {
1531 # For the multiple case we have to be careful to get the file
1532 # names as a true list, watching out for a single file with a
1533 # space in the name. Thus we query the IconList directly.
1534
1535 set selIcos [::tk::IconList_Curselection $data(icons)]
1536 set data(selectFile) ""
1537 if {[llength $selIcos] == 0 && $text ne ""} {
1538 # This assumes the user typed something in without selecting
1539 # files - so assume they only type in a single filename.
1540 ::tk::dialog::file::VerifyFileName $w $text
1541 } else {
1542 foreach item $selIcos {
1543 ::tk::dialog::file::VerifyFileName $w \
1544 [::tk::IconList_Get $data(icons) $item]
1545 }
1546 }
1547 } else {
1548 ::tk::dialog::file::VerifyFileName $w $text
1549 }
1550 }
1551
1552 # Verification procedure
1553 #
1554 proc ::tk::dialog::file::VerifyFileName {w filename} {
1555 upvar ::tk::dialog::file::[winfo name $w] data
1556
1557 set list [::tk::dialog::file::ResolveFile $data(selectPath) $filename \
1558 $data(-defaultextension)]
1559 foreach {flag path file} $list {
1560 break
1561 }
1562
1563 switch -- $flag {
1564 OK {
1565 if {$file eq ""} {
1566 # user has entered an existing (sub)directory
1567 set data(selectPath) $path
1568 $data(ent) delete 0 end
1569 } else {
1570 ::tk::dialog::file::SetPathSilently $w $path
1571 if {$data(-multiple)} {
1572 lappend data(selectFile) $file
1573 } else {
1574 set data(selectFile) $file
1575 }
1576 ::tk::dialog::file::Done $w
1577 }
1578 }
1579 PATTERN {
1580 set data(selectPath) $path
1581 set data(filter) $file
1582 }
1583 FILE {
1584 if {$data(type) eq "open"} {
1585 tk_messageBox -icon warning -type ok -parent $w \
1586 -message "[mc "File \"%1\$s\" does not exist." [file join $path $file]]"
1587 $data(ent) selection range 0 end
1588 $data(ent) icursor end
1589 } else {
1590 ::tk::dialog::file::SetPathSilently $w $path
1591 if {$data(-multiple)} {
1592 lappend data(selectFile) $file
1593 } else {
1594 set data(selectFile) $file
1595 }
1596 ::tk::dialog::file::Done $w
1597 }
1598 }
1599 PATH {
1600 tk_messageBox -icon warning -type ok -parent $w \
1601 -message "[mc "Directory \"%1\$s\" does not exist." $path]"
1602 $data(ent) selection range 0 end
1603 $data(ent) icursor end
1604 }
1605 CHDIR {
1606 tk_messageBox -type ok -parent $w -message \
1607 "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path]"\
1608 -icon warning
1609 $data(ent) selection range 0 end
1610 $data(ent) icursor end
1611 }
1612 ERROR {
1613 tk_messageBox -type ok -parent $w -message \
1614 "[mc "Invalid file name \"%1\$s\"." $path]"\
1615 -icon warning
1616 $data(ent) selection range 0 end
1617 $data(ent) icursor end
1618 }
1619 }
1620 }
1621
1622 # Gets called when user presses the Alt-s or Alt-o keys.
1623 #
1624 proc ::tk::dialog::file::InvokeBtn {w key} {
1625 upvar ::tk::dialog::file::[winfo name $w] data
1626
1627 if {[$data(okBtn) cget -text] eq $key} {
1628 ::tk::ButtonInvoke $data(okBtn)
1629 }
1630 }
1631
1632 # Gets called when user presses the "parent directory" button
1633 #
1634 proc ::tk::dialog::file::UpDirCmd {w} {
1635 upvar ::tk::dialog::file::[winfo name $w] data
1636
1637 if {$data(selectPath) ne "/"} {
1638 set data(selectPath) [file dirname $data(selectPath)]
1639 }
1640 }
1641
1642 # Join a file name to a path name. The "file join" command will break
1643 # if the filename begins with ~
1644 #
1645 proc ::tk::dialog::file::JoinFile {path file} {
1646 if {[string match {~*} $file] && [file exists $path/$file]} {
1647 return [file join $path ./$file]
1648 } else {
1649 return [file join $path $file]
1650 }
1651 }
1652
1653 # Gets called when user presses the "OK" button
1654 #
1655 proc ::tk::dialog::file::OkCmd {w} {
1656 upvar ::tk::dialog::file::[winfo name $w] data
1657
1658 set filenames {}
1659 foreach item [::tk::IconList_Curselection $data(icons)] {
1660 lappend filenames [::tk::IconList_Get $data(icons) $item]
1661 }
1662
1663 if {([llength $filenames] && !$data(-multiple)) || \
1664 ($data(-multiple) && ([llength $filenames] == 1))} {
1665 set filename [lindex $filenames 0]
1666 set file [::tk::dialog::file::JoinFile $data(selectPath) $filename]
1667 if {[file isdirectory $file]} {
1668 ::tk::dialog::file::ListInvoke $w [list $filename]
1669 return
1670 }
1671 }
1672
1673 ::tk::dialog::file::ActivateEnt $w
1674 }
1675
1676 # Gets called when user presses the "Cancel" button
1677 #
1678 proc ::tk::dialog::file::CancelCmd {w} {
1679 upvar ::tk::dialog::file::[winfo name $w] data
1680 variable ::tk::Priv
1681
1682 bind $data(okBtn) <Destroy> {}
1683 set Priv(selectFilePath) ""
1684 }
1685
1686 # Gets called when user destroys the dialog directly [Bug 987169]
1687 #
1688 proc ::tk::dialog::file::Destroyed {w} {
1689 upvar ::tk::dialog::file::[winfo name $w] data
1690 variable ::tk::Priv
1691
1692 set Priv(selectFilePath) ""
1693 }
1694
1695 # Gets called when user browses the IconList widget (dragging mouse, arrow
1696 # keys, etc)
1697 #
1698 proc ::tk::dialog::file::ListBrowse {w} {
1699 upvar ::tk::dialog::file::[winfo name $w] data
1700
1701 set text {}
1702 foreach item [::tk::IconList_Curselection $data(icons)] {
1703 lappend text [::tk::IconList_Get $data(icons) $item]
1704 }
1705 if {[llength $text] == 0} {
1706 return
1707 }
1708 if { [llength $text] > 1 } {
1709 set newtext {}
1710 foreach file $text {
1711 set fullfile [::tk::dialog::file::JoinFile $data(selectPath) $file]
1712 if { ![file isdirectory $fullfile] } {
1713 lappend newtext $file
1714 }
1715 }
1716 set text $newtext
1717 set isDir 0
1718 } else {
1719 set text [lindex $text 0]
1720 set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
1721 set isDir [file isdirectory $file]
1722 }
1723 if {!$isDir} {
1724 $data(ent) delete 0 end
1725 $data(ent) insert 0 $text
1726
1727 if { [winfo class $w] eq "TkFDialog" } {
1728 if {$data(type) eq "open"} {
1729 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1730 } else {
1731 ::tk::SetAmpText $data(okBtn) [mc "&Save"]
1732 }
1733 }
1734 } else {
1735 if { [winfo class $w] eq "TkFDialog" } {
1736 ::tk::SetAmpText $data(okBtn) [mc "&Open"]
1737 }
1738 }
1739 }
1740
1741 # Gets called when user invokes the IconList widget (double-click,
1742 # Return key, etc)
1743 #
1744 proc ::tk::dialog::file::ListInvoke {w filenames} {
1745 upvar ::tk::dialog::file::[winfo name $w] data
1746
1747 if {[llength $filenames] == 0} {
1748 return
1749 }
1750
1751 set file [::tk::dialog::file::JoinFile $data(selectPath) \
1752 [lindex $filenames 0]]
1753
1754 set class [winfo class $w]
1755 if {$class eq "TkChooseDir" || [file isdirectory $file]} {
1756 set appPWD [pwd]
1757 if {[catch {cd $file}]} {
1758 tk_messageBox -type ok -parent $w -message \
1759 "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]"\
1760 -icon warning
1761 } else {
1762 cd $appPWD
1763 set data(selectPath) $file
1764 }
1765 } else {
1766 if {$data(-multiple)} {
1767 set data(selectFile) $filenames
1768 } else {
1769 set data(selectFile) $file
1770 }
1771 ::tk::dialog::file::Done $w
1772 }
1773 }
1774
1775 # ::tk::dialog::file::Done --
1776 #
1777 # Gets called when user has input a valid filename. Pops up a
1778 # dialog box to confirm selection when necessary. Sets the
1779 # tk::Priv(selectFilePath) variable, which will break the "vwait"
1780 # loop in ::tk::dialog::file:: and return the selected filename to the
1781 # script that calls tk_getOpenFile or tk_getSaveFile
1782 #
1783 proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
1784 upvar ::tk::dialog::file::[winfo name $w] data
1785 variable ::tk::Priv
1786
1787 if {$selectFilePath eq ""} {
1788 if {$data(-multiple)} {
1789 set selectFilePath {}
1790 foreach f $data(selectFile) {
1791 lappend selectFilePath [::tk::dialog::file::JoinFile \
1792 $data(selectPath) $f]
1793 }
1794 } else {
1795 set selectFilePath [::tk::dialog::file::JoinFile \
1796 $data(selectPath) $data(selectFile)]
1797 }
1798
1799 set Priv(selectFile) $data(selectFile)
1800 set Priv(selectPath) $data(selectPath)
1801
1802 if {$data(type) eq "save"} {
1803 if {[file exists $selectFilePath]} {
1804 set reply [tk_messageBox -icon warning -type yesno\
1805 -parent $w -message \
1806 "[mc "File \"%1\$s\" already exists.\nDo you want to overwrite it?" $selectFilePath]"]
1807 if {$reply eq "no"} {
1808 return
1809 }
1810 }
1811 }
1812 }
1813 bind $data(okBtn) <Destroy> {}
1814 set Priv(selectFilePath) $selectFilePath
1815 }
The early history of msysgit, preserved for archeologists