source: proiecte/pmake3d/make3d_original/Make3dSingleImageStanford_version0.1/third_party/vrippack-0.31/src/vrip/lib/tk/tkfbox.tcl @ 37

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

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