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