/[ascend]/trunk/tcltk98/TK/templates/asctkfbox84.tcl
ViewVC logotype

Contents of /trunk/tcltk98/TK/templates/asctkfbox84.tcl

Parent Directory Parent Directory | Revision Log Revision Log


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

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22