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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 538 - (hide 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 ben.allan 528 # 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 ben.allan 538 variable ::tk::Priv
344 ben.allan 528 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 ben.allan 538 set image [ ::tk::CustomImage $image0 $text ]
409 ben.allan 528 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