source: proiecte/pmake3d/make3d_original/Make3dSingleImageStanford_version0.1/third_party/vrippack-0.31/lib/linux/tk8.4/tkfbox.tcl @ 37

Last change on this file since 37 was 37, checked in by (none), 14 years ago

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