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

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