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

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

Added original make3d
File size: 24.7 KB
Line 
1# xmfbox.tcl --
2#
3#       Implements the "Motif" style file selection dialog for the
4#       Unix platform. This implementation is used only if the
5#       "::tk_strictMotif" flag is set.
6#
7# RCS: @(#) $Id: xmfbox.tcl,v 1.25 2003/02/18 21:19:35 hobbs Exp $
8#
9# Copyright (c) 1996 Sun Microsystems, Inc.
10# Copyright (c) 1998-2000 Scriptics Corporation
11#
12# See the file "license.terms" for information on usage and redistribution
13# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14
15namespace eval ::tk::dialog {}
16namespace eval ::tk::dialog::file {}
17
18
19# ::tk::MotifFDialog --
20#
21#       Implements a file dialog similar to the standard Motif file
22#       selection box.
23#
24# Arguments:
25#       type            "open" or "save"
26#       args            Options parsed by the procedure.
27#
28# Results:
29#       When -multiple is set to 0, this returns the absolute pathname
30#       of the selected file. (NOTE: This is not the same as a single
31#       element list.)
32#
33#       When -multiple is set to > 0, this returns a Tcl list of absolute
34#       pathnames. The argument for -multiple is ignored, but for consistency
35#       with Windows it defines the maximum amount of memory to allocate for
36#       the returned filenames.
37
38proc ::tk::MotifFDialog {type args} {
39    variable ::tk::Priv
40    set dataName __tk_filedialog
41    upvar ::tk::dialog::file::$dataName data
42
43    set w [MotifFDialog_Create $dataName $type $args]
44
45    # Set a grab and claim the focus too.
46
47    ::tk::SetFocusGrab $w $data(sEnt)
48    $data(sEnt) selection range 0 end
49
50    # Wait for the user to respond, then restore the focus and
51    # return the index of the selected button.  Restore the focus
52    # before deleting the window, since otherwise the window manager
53    # may take the focus away so we can't redirect it.  Finally,
54    # restore any grab that was in effect.
55
56    vwait ::tk::Priv(selectFilePath)
57    ::tk::RestoreFocusGrab $w $data(sEnt) withdraw
58
59    return $Priv(selectFilePath)
60}
61
62# ::tk::MotifFDialog_Create --
63#
64#       Creates the Motif file dialog (if it doesn't exist yet) and
65#       initialize the internal data structure associated with the
66#       dialog.
67#
68#       This procedure is used by ::tk::MotifFDialog to create the
69#       dialog. It's also used by the test suite to test the Motif
70#       file dialog implementation. User code shouldn't call this
71#       procedure directly.
72#
73# Arguments:
74#       dataName        Name of the global "data" array for the file dialog.
75#       type            "Save" or "Open"
76#       argList         Options parsed by the procedure.
77#
78# Results:
79#       Pathname of the file dialog.
80
81proc ::tk::MotifFDialog_Create {dataName type argList} {
82    upvar ::tk::dialog::file::$dataName data
83
84    MotifFDialog_Config $dataName $type $argList
85
86    if {[string equal $data(-parent) .]} {
87        set w .$dataName
88    } else {
89        set w $data(-parent).$dataName
90    }
91
92    # (re)create the dialog box if necessary
93    #
94    if {![winfo exists $w]} {
95        MotifFDialog_BuildUI $w
96    } elseif {[string compare [winfo class $w] TkMotifFDialog]} {
97        destroy $w
98        MotifFDialog_BuildUI $w
99    } else {
100        set data(fEnt) $w.top.f1.ent
101        set data(dList) $w.top.f2.a.l
102        set data(fList) $w.top.f2.b.l
103        set data(sEnt) $w.top.f3.ent
104        set data(okBtn) $w.bot.ok
105        set data(filterBtn) $w.bot.filter
106        set data(cancelBtn) $w.bot.cancel
107    }
108    MotifFDialog_SetListMode $w
109
110    # Dialog boxes should be transient with respect to their parent,
111    # so that they will always stay on top of their parent window.  However,
112    # some window managers will create the window as withdrawn if the parent
113    # window is withdrawn or iconified.  Combined with the grab we put on the
114    # window, this can hang the entire application.  Therefore we only make
115    # the dialog transient if the parent is viewable.
116
117    if {[winfo viewable [winfo toplevel $data(-parent)]] } {
118        wm transient $w $data(-parent)
119    }
120
121    MotifFDialog_FileTypes $w
122    MotifFDialog_Update $w
123
124    # Withdraw the window, then update all the geometry information
125    # so we know how big it wants to be, then center the window in the
126    # display (Motif style) and de-iconify it.
127
128    ::tk::PlaceWindow $w
129    wm title $w $data(-title)
130
131    return $w
132}
133
134# ::tk::MotifFDialog_FileTypes --
135#
136#       Checks the -filetypes option. If present this adds a list of radio-
137#       buttons to pick the file types from.
138#
139# Arguments:
140#       w               Pathname of the tk_get*File dialogue.
141#
142# Results:
143#       none
144
145proc ::tk::MotifFDialog_FileTypes {w} {
146    upvar ::tk::dialog::file::[winfo name $w] data
147
148    set f $w.top.f3.types
149    catch {destroy $f}
150
151    # No file types: use "*" as the filter and display no radio-buttons
152    if {$data(-filetypes) == ""} {
153        set data(filter) *
154        return
155    }
156
157    # The filetypes radiobuttons
158    # set data(fileType) $data(-defaulttype)
159    set data(fileType) 0
160
161    MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)]
162
163    #don't produce radiobuttons for only one filetype
164    if {[llength $data(-filetypes)] == 1} {
165        return
166    }
167
168    frame $f
169    set cnt 0
170    if {$data(-filetypes) != {}} {
171        foreach type $data(-filetypes) {
172            set title  [lindex [lindex $type 0] 0]
173            set filter [lindex $type 1]
174            radiobutton $f.b$cnt \
175                -text $title \
176                -variable ::tk::dialog::file::[winfo name $w](fileType) \
177                -value $cnt \
178                -command "[list tk::MotifFDialog_SetFilter $w $type]"
179            pack $f.b$cnt -side left
180            incr cnt
181        }
182    }
183    $f.b$data(fileType) invoke
184
185    pack $f -side bottom -fill both
186
187    return
188}
189
190# This proc gets called whenever data(filter) is set
191#
192proc ::tk::MotifFDialog_SetFilter {w type} {
193    upvar ::tk::dialog::file::[winfo name $w] data
194    variable ::tk::Priv
195
196    set data(filter) [lindex $type 1]
197    set Priv(selectFileType) [lindex [lindex $type 0] 0]
198
199    MotifFDialog_Update $w
200}
201
202# ::tk::MotifFDialog_Config --
203#
204#       Iterates over the optional arguments to determine the option
205#       values for the Motif file dialog; gives default values to
206#       unspecified options.
207#
208# Arguments:
209#       dataName        The name of the global variable in which
210#                       data for the file dialog is stored.
211#       type            "Save" or "Open"
212#       argList         Options parsed by the procedure.
213
214proc ::tk::MotifFDialog_Config {dataName type argList} {
215    upvar ::tk::dialog::file::$dataName data
216
217    set data(type) $type
218
219    # 1: the configuration specs
220    #
221    set specs {
222        {-defaultextension "" "" ""}
223        {-filetypes "" "" ""}
224        {-initialdir "" "" ""}
225        {-initialfile "" "" ""}
226        {-parent "" "" "."}
227        {-title "" "" ""}
228    }
229    if { [string equal $type "open"] } {
230        lappend specs {-multiple "" "" "0"}
231    }
232
233    set data(-multiple) 0
234    # 2: default values depending on the type of the dialog
235    #
236    if {![info exists data(selectPath)]} {
237        # first time the dialog has been popped up
238        set data(selectPath) [pwd]
239        set data(selectFile) ""
240    }
241
242    # 3: parse the arguments
243    #
244    tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
245
246    if {[string equal $data(-title) ""]} {
247        if {[string equal $type "open"]} {
248            if {$data(-multiple) != 0} {
249                set data(-title) "[mc {Open Multiple Files}]"
250            } else {
251            set data(-title) [mc "Open"]
252            }
253        } else {
254            set data(-title) [mc "Save As"]
255        }
256    }
257
258    # 4: set the default directory and selection according to the -initial
259    #    settings
260    #
261    if {[string compare $data(-initialdir) ""]} {
262        if {[file isdirectory $data(-initialdir)]} {
263            set data(selectPath) [lindex [glob $data(-initialdir)] 0]
264        } else {
265            set data(selectPath) [pwd]
266        }
267
268        # Convert the initialdir to an absolute path name.
269
270        set old [pwd]
271        cd $data(selectPath)
272        set data(selectPath) [pwd]
273        cd $old
274    }
275    set data(selectFile) $data(-initialfile)
276
277    # 5. Parse the -filetypes option. It is not used by the motif
278    #    file dialog, but we check for validity of the value to make sure
279    #    the application code also runs fine with the TK file dialog.
280    #
281    set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
282
283    if {![info exists data(filter)]} {
284        set data(filter) *
285    }
286    if {![winfo exists $data(-parent)]} {
287        error "bad window path name \"$data(-parent)\""
288    }
289}
290
291# ::tk::MotifFDialog_BuildUI --
292#
293#       Builds the UI components of the Motif file dialog.
294#
295# Arguments:
296#       w               Pathname of the dialog to build.
297#
298# Results:
299#       None.
300
301proc ::tk::MotifFDialog_BuildUI {w} {
302    set dataName [lindex [split $w .] end]
303    upvar ::tk::dialog::file::$dataName data
304
305    # Create the dialog toplevel and internal frames.
306    #
307    toplevel $w -class TkMotifFDialog
308    set top [frame $w.top -relief raised -bd 1]
309    set bot [frame $w.bot -relief raised -bd 1]
310
311    pack $w.bot -side bottom -fill x
312    pack $w.top -side top -expand yes -fill both
313
314    set f1 [frame $top.f1]
315    set f2 [frame $top.f2]
316    set f3 [frame $top.f3]
317
318    pack $f1 -side top    -fill x
319    pack $f3 -side bottom -fill x
320    pack $f2 -expand yes -fill both
321
322    set f2a [frame $f2.a]
323    set f2b [frame $f2.b]
324
325    grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
326        -sticky news
327    grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
328        -sticky news
329    grid rowconfig $f2 0    -minsize 0   -weight 1
330    grid columnconfig $f2 0 -minsize 0   -weight 1
331    grid columnconfig $f2 1 -minsize 150 -weight 2
332
333    # The Filter box
334    #
335    bind [::tk::AmpWidget label $f1.lab -text [mc "Fil&ter:"] -anchor w] \
336        <<AltUnderlined>> [list focus $f1.ent]
337    entry $f1.ent
338    pack $f1.lab -side top -fill x -padx 6 -pady 4
339    pack $f1.ent -side top -fill x -padx 4 -pady 0
340    set data(fEnt) $f1.ent
341
342    # The file and directory lists
343    #
344    set data(dList) [MotifFDialog_MakeSList $w $f2a \
345            [mc "&Directory:"] DList]
346    set data(fList) [MotifFDialog_MakeSList $w $f2b \
347            [mc "Fi&les:"]     FList]
348
349    # The Selection box
350    #
351    bind [::tk::AmpWidget label $f3.lab -text [mc "&Selection:"] -anchor w] \
352        <<AltUnderlined>> [list focus $f3.ent]
353    entry $f3.ent
354    pack $f3.lab -side top -fill x -padx 6 -pady 0
355    pack $f3.ent -side top -fill x -padx 4 -pady 4
356    set data(sEnt) $f3.ent
357
358    # The buttons
359    #
360    set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel]
361    set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
362    set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc "&OK"] \
363            -width $maxWidth \
364            -command [list tk::MotifFDialog_OkCmd $w]]
365    set data(filterBtn) [::tk::AmpWidget button $bot.filter -text [mc "&Filter"] \
366            -width $maxWidth \
367            -command [list tk::MotifFDialog_FilterCmd $w]]
368    set data(cancelBtn) [::tk::AmpWidget button $bot.cancel -text [mc "&Cancel"] \
369            -width $maxWidth \
370            -command [list tk::MotifFDialog_CancelCmd $w]]
371
372    pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
373        -side left
374
375    # Create the bindings:
376    #
377    bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
378
379    bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w]
380    bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w]
381
382    wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w]
383}
384
385proc ::tk::MotifFDialog_SetListMode {w} {
386    upvar ::tk::dialog::file::[winfo name $w] data
387
388    if {$data(-multiple) != 0} {
389        set selectmode extended
390    } else {
391        set selectmode browse
392    }
393    set f $w.top.f2.b
394    $f.l configure -selectmode $selectmode
395}
396
397# ::tk::MotifFDialog_MakeSList --
398#
399#       Create a scrolled-listbox and set the keyboard accelerator
400#       bindings so that the list selection follows what the user
401#       types.
402#
403# Arguments:
404#       w               Pathname of the dialog box.
405#       f               Frame widget inside which to create the scrolled
406#                       listbox. This frame widget already exists.
407#       label           The string to display on top of the listbox.
408#       under           Sets the -under option of the label.
409#       cmdPrefix       Specifies procedures to call when the listbox is
410#                       browsed or activated.
411
412proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} {
413    bind [::tk::AmpWidget label $f.lab -text $label -anchor w] \
414        <<AltUnderlined>> [list focus $f.l]
415    listbox $f.l -width 12 -height 5 -exportselection 0\
416        -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set]
417    scrollbar $f.v -orient vertical   -takefocus 0 -command [list $f.l yview]
418    scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]
419    grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
420        -padx 2 -pady 2
421    grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
422    grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
423    grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
424
425    grid rowconfig    $f 0 -weight 0 -minsize 0
426    grid rowconfig    $f 1 -weight 1 -minsize 0
427    grid columnconfig $f 0 -weight 1 -minsize 0
428
429    # bindings for the listboxes
430    #
431    set list $f.l
432    bind $list <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w]
433    bind $list <Double-ButtonRelease-1> \
434            [list tk::MotifFDialog_Activate$cmdPrefix $w]
435    bind $list <Return> "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \
436            tk::MotifFDialog_Activate$cmdPrefix [list $w]"
437
438    bindtags $list [list Listbox $list [winfo toplevel $list] all]
439    ListBoxKeyAccel_Set $list
440
441    return $f.l
442}
443
444# ::tk::MotifFDialog_InterpFilter --
445#
446#       Interpret the string in the filter entry into two components:
447#       the directory and the pattern. If the string is a relative
448#       pathname, give a warning to the user and restore the pattern
449#       to original.
450#
451# Arguments:
452#       w               pathname of the dialog box.
453#
454# Results:
455#       A list of two elements. The first element is the directory
456#       specified # by the filter. The second element is the filter
457#       pattern itself.
458
459proc ::tk::MotifFDialog_InterpFilter {w} {
460    upvar ::tk::dialog::file::[winfo name $w] data
461
462    set text [string trim [$data(fEnt) get]]
463
464    # Perform tilde substitution
465    #
466    set badTilde 0
467    if {[string equal [string index $text 0] ~]} {
468        set list [file split $text]
469        set tilde [lindex $list 0]
470        if {[catch {set tilde [glob $tilde]}]} {
471            set badTilde 1
472        } else {
473            set text [eval file join [concat $tilde [lrange $list 1 end]]]
474        }
475    }
476
477    # If the string is a relative pathname, combine it
478    # with the current selectPath.
479
480    set relative 0
481    if {[string equal [file pathtype $text] "relative"]} {
482        set relative 1
483    } elseif {$badTilde} {
484        set relative 1 
485    }
486
487    if {$relative} {
488        tk_messageBox -icon warning -type ok \
489            -message "\"$text\" must be an absolute pathname"
490
491        $data(fEnt) delete 0 end
492        $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
493                $data(filter)]
494
495        return [list $data(selectPath) $data(filter)]
496    }
497
498    set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]
499
500    if {[file isdirectory $resolved]} {
501        set dir $resolved
502        set fil $data(filter)
503    } else {
504        set dir [file dirname $resolved]
505        set fil [file tail    $resolved]
506    }
507
508    return [list $dir $fil]
509}
510
511# ::tk::MotifFDialog_Update
512#
513#       Load the files and synchronize the "filter" and "selection" fields
514#       boxes.
515#
516# Arguments:
517#       w               pathname of the dialog box.
518#
519# Results:
520#       None.
521
522proc ::tk::MotifFDialog_Update {w} {
523    upvar ::tk::dialog::file::[winfo name $w] data
524
525    $data(fEnt) delete 0 end
526    $data(fEnt) insert 0 \
527            [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
528    $data(sEnt) delete 0 end
529    $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
530            $data(selectFile)]
531 
532    MotifFDialog_LoadFiles $w
533}
534
535# ::tk::MotifFDialog_LoadFiles --
536#
537#       Loads the files and directories into the two listboxes according
538#       to the filter setting.
539#
540# Arguments:
541#       w               pathname of the dialog box.
542#
543# Results:
544#       None.
545
546proc ::tk::MotifFDialog_LoadFiles {w} {
547    upvar ::tk::dialog::file::[winfo name $w] data
548
549    $data(dList) delete 0 end
550    $data(fList) delete 0 end
551
552    set appPWD [pwd]
553    if {[catch {cd $data(selectPath)}]} {
554        cd $appPWD
555
556        $data(dList) insert end ".."
557        return
558    }
559
560    # Make the dir and file lists
561    #
562    # For speed we only have one glob, which reduces the file system
563    # calls (good for slow NFS networks).
564    #
565    # We also do two smaller sorts (files + dirs) instead of one large sort,
566    # which gives a small speed increase.
567    #
568    set top 0
569    set dlist ""
570    set flist ""
571    foreach f [glob -nocomplain .* *] {
572        if {[file isdir ./$f]} {
573            lappend dlist $f
574        } else {
575            foreach pat $data(filter) {
576                if {[string match $pat $f]} {
577                if {[string match .* $f]} {
578                    incr top
579                }
580                lappend flist $f
581                    break
582            }
583            }
584        }
585    }
586    eval [list $data(dList) insert end] [lsort -dictionary $dlist]
587    eval [list $data(fList) insert end] [lsort -dictionary $flist]
588
589    # The user probably doesn't want to see the . files. We adjust the view
590    # so that the listbox displays all the non-dot files
591    $data(fList) yview $top
592
593    cd $appPWD
594}
595
596# ::tk::MotifFDialog_BrowseDList --
597#
598#       This procedure is called when the directory list is browsed
599#       (clicked-over) by the user.
600#
601# Arguments:
602#       w               The pathname of the dialog box.
603#
604# Results:
605#       None.   
606
607proc ::tk::MotifFDialog_BrowseDList {w} {
608    upvar ::tk::dialog::file::[winfo name $w] data
609
610    focus $data(dList)
611    if {[string equal [$data(dList) curselection] ""]} {
612        return
613    }
614    set subdir [$data(dList) get [$data(dList) curselection]]
615    if {[string equal $subdir ""]} {
616        return
617    }
618
619    $data(fList) selection clear 0 end
620
621    set list [MotifFDialog_InterpFilter $w]
622    set data(filter) [lindex $list 1]
623
624    switch -- $subdir {
625        . {
626            set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
627        }
628        .. {
629            set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
630                $data(filter)]
631        }
632        default {
633            set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
634                    $data(selectPath) $subdir] $data(filter)]
635        }
636    }
637
638    $data(fEnt) delete 0 end
639    $data(fEnt) insert 0 $newSpec
640}
641
642# ::tk::MotifFDialog_ActivateDList --
643#
644#       This procedure is called when the directory list is activated
645#       (double-clicked) by the user.
646#
647# Arguments:
648#       w               The pathname of the dialog box.
649#
650# Results:
651#       None.   
652
653proc ::tk::MotifFDialog_ActivateDList {w} {
654    upvar ::tk::dialog::file::[winfo name $w] data
655
656    if {[string equal [$data(dList) curselection] ""]} {
657        return
658    }
659    set subdir [$data(dList) get [$data(dList) curselection]]
660    if {[string equal $subdir ""]} {
661        return
662    }
663
664    $data(fList) selection clear 0 end
665
666    switch -- $subdir {
667        . {
668            set newDir $data(selectPath)
669        }
670        .. {
671            set newDir [file dirname $data(selectPath)]
672        }
673        default {
674            set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
675        }
676    }
677
678    set data(selectPath) $newDir
679    MotifFDialog_Update $w
680
681    if {[string compare $subdir ..]} {
682        $data(dList) selection set 0
683        $data(dList) activate 0
684    } else {
685        $data(dList) selection set 1
686        $data(dList) activate 1
687    }
688}
689
690# ::tk::MotifFDialog_BrowseFList --
691#
692#       This procedure is called when the file list is browsed
693#       (clicked-over) by the user.
694#
695# Arguments:
696#       w               The pathname of the dialog box.
697#
698# Results:
699#       None.   
700
701proc ::tk::MotifFDialog_BrowseFList {w} {
702    upvar ::tk::dialog::file::[winfo name $w] data
703
704    focus $data(fList)
705    set data(selectFile) ""
706    foreach item [$data(fList) curselection] {
707        lappend data(selectFile) [$data(fList) get $item]
708    }
709    if {[llength $data(selectFile)] == 0} {
710        return
711    }
712
713    $data(dList) selection clear 0 end
714
715    $data(fEnt) delete 0 end
716    $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
717            $data(filter)]
718    $data(fEnt) xview end
719 
720    # if it's a multiple selection box, just put in the filenames
721    # otherwise put in the full path as usual
722    $data(sEnt) delete 0 end
723    if {$data(-multiple) != 0} {
724        $data(sEnt) insert 0 $data(selectFile)
725    } else {
726        $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
727                                  [lindex $data(selectFile) 0]]
728    }
729    $data(sEnt) xview end
730}
731
732# ::tk::MotifFDialog_ActivateFList --
733#
734#       This procedure is called when the file list is activated
735#       (double-clicked) by the user.
736#
737# Arguments:
738#       w               The pathname of the dialog box.
739#
740# Results:
741#       None.   
742
743proc ::tk::MotifFDialog_ActivateFList {w} {
744    upvar ::tk::dialog::file::[winfo name $w] data
745
746    if {[string equal [$data(fList) curselection] ""]} {
747        return
748    }
749    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
750    if {[string equal $data(selectFile) ""]} {
751        return
752    } else {
753        MotifFDialog_ActivateSEnt $w
754    }
755}
756
757# ::tk::MotifFDialog_ActivateFEnt --
758#
759#       This procedure is called when the user presses Return inside
760#       the "filter" entry. It updates the dialog according to the
761#       text inside the filter entry.
762#
763# Arguments:
764#       w               The pathname of the dialog box.
765#
766# Results:
767#       None.   
768
769proc ::tk::MotifFDialog_ActivateFEnt {w} {
770    upvar ::tk::dialog::file::[winfo name $w] data
771
772    set list [MotifFDialog_InterpFilter $w]
773    set data(selectPath) [lindex $list 0]
774    set data(filter)    [lindex $list 1]
775
776    MotifFDialog_Update $w
777}
778
779# ::tk::MotifFDialog_ActivateSEnt --
780#
781#       This procedure is called when the user presses Return inside
782#       the "selection" entry. It sets the ::tk::Priv(selectFilePath)
783#       variable so that the vwait loop in tk::MotifFDialog will be
784#       terminated.
785#
786# Arguments:
787#       w               The pathname of the dialog box.
788#
789# Results:
790#       None.   
791
792proc ::tk::MotifFDialog_ActivateSEnt {w} {
793    variable ::tk::Priv
794    upvar ::tk::dialog::file::[winfo name $w] data
795
796    set selectFilePath [string trim [$data(sEnt) get]]
797
798    if {[string equal $selectFilePath ""]} {
799        MotifFDialog_FilterCmd $w
800        return
801    }
802
803    if {$data(-multiple) == 0} {
804        set selectFilePath [list $selectFilePath]
805    }
806
807    if {[file isdirectory [lindex $selectFilePath 0]]} {
808        set data(selectPath) [lindex [glob $selectFilePath] 0]
809        set data(selectFile) ""
810        MotifFDialog_Update $w
811        return
812    }
813
814    set newFileList ""
815    foreach item $selectFilePath {
816        if {[string compare [file pathtype $item] "absolute"]} {
817            set item [file join $data(selectPath) $item]
818        } elseif {![file exists [file dirname $item]]} {
819            tk_messageBox -icon warning -type ok \
820                    -message [mc {Directory "%1$s" does not exist.} \
821                    [file dirname $item]]
822            return
823        }
824
825        if {![file exists $item]} {
826            if {[string equal $data(type) open]} {
827                tk_messageBox -icon warning -type ok \
828                        -message [mc {File "%1$s" does not exist.} $item]
829                return
830            }
831        } else {
832            if {[string equal $data(type) save]} {
833                set message [format %s%s \
834                        [mc "File \"%1\$s\" already exists.\n\n" \
835                        $selectFilePath] \
836                        [mc {Replace existing file?}]]
837                set answer [tk_messageBox -icon warning -type yesno \
838                        -message $message]
839                if {[string equal $answer "no"]} {
840                    return
841                }
842            }
843        }
844       
845        lappend newFileList $item
846    }
847
848    if {$data(-multiple) != 0} {
849        set Priv(selectFilePath) $newFileList
850    } else {
851        set Priv(selectFilePath) [lindex $newFileList 0]
852    }
853
854    # Set selectFile and selectPath to first item in list
855    set Priv(selectFile)     [file tail    [lindex $newFileList 0]]
856    set Priv(selectPath)     [file dirname [lindex $newFileList 0]]
857}
858
859
860proc ::tk::MotifFDialog_OkCmd {w} {
861    upvar ::tk::dialog::file::[winfo name $w] data
862
863    MotifFDialog_ActivateSEnt $w
864}
865
866proc ::tk::MotifFDialog_FilterCmd {w} {
867    upvar ::tk::dialog::file::[winfo name $w] data
868
869    MotifFDialog_ActivateFEnt $w
870}
871
872proc ::tk::MotifFDialog_CancelCmd {w} {
873    variable ::tk::Priv
874
875    set Priv(selectFilePath) ""
876    set Priv(selectFile)     ""
877    set Priv(selectPath)     ""
878}
879
880proc ::tk::ListBoxKeyAccel_Set {w} {
881    bind Listbox <Any-KeyPress> ""
882    bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w]
883    bind $w <Any-KeyPress> [list tk::ListBoxKeyAccel_Key $w %A]
884}
885
886proc ::tk::ListBoxKeyAccel_Unset {w} {
887    variable ::tk::Priv
888
889    catch {after cancel $Priv(lbAccel,$w,afterId)}
890    catch {unset Priv(lbAccel,$w)}
891    catch {unset Priv(lbAccel,$w,afterId)}
892}
893
894# ::tk::ListBoxKeyAccel_Key--
895#
896#       This procedure maintains a list of recently entered keystrokes
897#       over a listbox widget. It arranges an idle event to move the
898#       selection of the listbox to the entry that begins with the
899#       keystrokes.
900#
901# Arguments:
902#       w               The pathname of the listbox.
903#       key             The key which the user just pressed.
904#
905# Results:
906#       None.   
907
908proc ::tk::ListBoxKeyAccel_Key {w key} {
909    variable ::tk::Priv
910
911    if { $key == "" } {
912        return
913    }
914    append Priv(lbAccel,$w) $key
915    ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w)
916    catch {
917        after cancel $Priv(lbAccel,$w,afterId)
918    }
919    set Priv(lbAccel,$w,afterId) [after 500 \
920            [list tk::ListBoxKeyAccel_Reset $w]]
921}
922
923proc ::tk::ListBoxKeyAccel_Goto {w string} {
924    variable ::tk::Priv
925
926    set string [string tolower $string]
927    set end [$w index end]
928    set theIndex -1
929
930    for {set i 0} {$i < $end} {incr i} {
931        set item [string tolower [$w get $i]]
932        if {[string compare $string $item] >= 0} {
933            set theIndex $i
934        }
935        if {[string compare $string $item] <= 0} {
936            set theIndex $i
937            break
938        }
939    }
940
941    if {$theIndex >= 0} {
942        $w selection clear 0 end
943        $w selection set $theIndex $theIndex
944        $w activate $theIndex
945        $w see $theIndex
946        event generate $w <<ListboxSelect>>
947    }
948}
949
950proc ::tk::ListBoxKeyAccel_Reset {w} {
951    variable ::tk::Priv
952
953    catch {unset Priv(lbAccel,$w)}
954}
955
956proc ::tk_getFileType {} {
957    variable ::tk::Priv
958
959    return $Priv(selectFileType)
960}
961
Note: See TracBrowser for help on using the repository browser.