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

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

Added original make3d
File size: 21.1 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.11 2000/03/24 19:38:57 ericm 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# tkMotifFDialog --
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#       A list of two members. The first member is the absolute
30#       pathname of the selected file or "" if user hits cancel. The
31#       second member is the name of the selected file type, or ""
32#       which stands for "default file type"
33
34proc tkMotifFDialog {type args} {
35    global tkPriv
36    set dataName __tk_filedialog
37    upvar ::tk::dialog::file::$dataName data
38
39    set w [tkMotifFDialog_Create $dataName $type $args]
40
41    # Set a grab and claim the focus too.
42
43    ::tk::SetFocusGrab $w $data(sEnt)
44    $data(sEnt) selection range 0 end
45
46    # Wait for the user to respond, then restore the focus and
47    # return the index of the selected button.  Restore the focus
48    # before deleting the window, since otherwise the window manager
49    # may take the focus away so we can't redirect it.  Finally,
50    # restore any grab that was in effect.
51
52    tkwait variable tkPriv(selectFilePath)
53    ::tk::RestoreFocusGrab $w $data(sEnt) withdraw
54
55    return $tkPriv(selectFilePath)
56}
57
58# tkMotifFDialog_Create --
59#
60#       Creates the Motif file dialog (if it doesn't exist yet) and
61#       initialize the internal data structure associated with the
62#       dialog.
63#
64#       This procedure is used by tkMotifFDialog to create the
65#       dialog. It's also used by the test suite to test the Motif
66#       file dialog implementation. User code shouldn't call this
67#       procedure directly.
68#
69# Arguments:
70#       dataName        Name of the global "data" array for the file dialog.
71#       type            "Save" or "Open"
72#       argList         Options parsed by the procedure.
73#
74# Results:
75#       Pathname of the file dialog.
76
77proc tkMotifFDialog_Create {dataName type argList} {
78    global tkPriv
79    upvar ::tk::dialog::file::$dataName data
80
81    tkMotifFDialog_Config $dataName $type $argList
82
83    if {[string equal $data(-parent) .]} {
84        set w .$dataName
85    } else {
86        set w $data(-parent).$dataName
87    }
88
89    # (re)create the dialog box if necessary
90    #
91    if {![winfo exists $w]} {
92        tkMotifFDialog_BuildUI $w
93    } elseif {[string compare [winfo class $w] TkMotifFDialog]} {
94        destroy $w
95        tkMotifFDialog_BuildUI $w
96    } else {
97        set data(fEnt) $w.top.f1.ent
98        set data(dList) $w.top.f2.a.l
99        set data(fList) $w.top.f2.b.l
100        set data(sEnt) $w.top.f3.ent
101        set data(okBtn) $w.bot.ok
102        set data(filterBtn) $w.bot.filter
103        set data(cancelBtn) $w.bot.cancel
104    }
105
106    wm transient $w $data(-parent)
107
108    tkMotifFDialog_Update $w
109
110    # Withdraw the window, then update all the geometry information
111    # so we know how big it wants to be, then center the window in the
112    # display (Motif style) and de-iconify it.
113
114    ::tk::PlaceWindow $w
115    wm title $w $data(-title)
116
117    return $w
118}
119
120# tkMotifFDialog_Config --
121#
122#       Iterates over the optional arguments to determine the option
123#       values for the Motif file dialog; gives default values to
124#       unspecified options.
125#
126# Arguments:
127#       dataName        The name of the global variable in which
128#                       data for the file dialog is stored.
129#       type            "Save" or "Open"
130#       argList         Options parsed by the procedure.
131
132proc tkMotifFDialog_Config {dataName type argList} {
133    upvar ::tk::dialog::file::$dataName data
134
135    set data(type) $type
136
137    # 1: the configuration specs
138    #
139    set specs {
140        {-defaultextension "" "" ""}
141        {-filetypes "" "" ""}
142        {-initialdir "" "" ""}
143        {-initialfile "" "" ""}
144        {-parent "" "" "."}
145        {-title "" "" ""}
146    }
147
148    # 2: default values depending on the type of the dialog
149    #
150    if {![info exists data(selectPath)]} {
151        # first time the dialog has been popped up
152        set data(selectPath) [pwd]
153        set data(selectFile) ""
154    }
155
156    # 3: parse the arguments
157    #
158    tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
159
160    if {[string equal $data(-title) ""]} {
161        if {[string equal $type "open"]} {
162            set data(-title) "Open"
163        } else {
164            set data(-title) "Save As"
165        }
166    }
167
168    # 4: set the default directory and selection according to the -initial
169    #    settings
170    #
171    if {[string compare $data(-initialdir) ""]} {
172        if {[file isdirectory $data(-initialdir)]} {
173            set data(selectPath) [glob $data(-initialdir)]
174        } else {
175            set data(selectPath) [pwd]
176        }
177
178        # Convert the initialdir to an absolute path name.
179
180        set old [pwd]
181        cd $data(selectPath)
182        set data(selectPath) [pwd]
183        cd $old
184    }
185    set data(selectFile) $data(-initialfile)
186
187    # 5. Parse the -filetypes option. It is not used by the motif
188    #    file dialog, but we check for validity of the value to make sure
189    #    the application code also runs fine with the TK file dialog.
190    #
191    set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
192
193    if {![info exists data(filter)]} {
194        set data(filter) *
195    }
196    if {![winfo exists $data(-parent)]} {
197        error "bad window path name \"$data(-parent)\""
198    }
199}
200
201# tkMotifFDialog_BuildUI --
202#
203#       Builds the UI components of the Motif file dialog.
204#
205# Arguments:
206#       w               Pathname of the dialog to build.
207#
208# Results:
209#       None.
210
211proc tkMotifFDialog_BuildUI {w} {
212    set dataName [lindex [split $w .] end]
213    upvar ::tk::dialog::file::$dataName data
214
215    # Create the dialog toplevel and internal frames.
216    #
217    toplevel $w -class TkMotifFDialog
218    set top [frame $w.top -relief raised -bd 1]
219    set bot [frame $w.bot -relief raised -bd 1]
220
221    pack $w.bot -side bottom -fill x
222    pack $w.top -side top -expand yes -fill both
223
224    set f1 [frame $top.f1]
225    set f2 [frame $top.f2]
226    set f3 [frame $top.f3]
227
228    pack $f1 -side top    -fill x
229    pack $f3 -side bottom -fill x
230    pack $f2 -expand yes -fill both
231
232    set f2a [frame $f2.a]
233    set f2b [frame $f2.b]
234
235    grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
236        -sticky news
237    grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
238        -sticky news
239    grid rowconfig $f2 0    -minsize 0   -weight 1
240    grid columnconfig $f2 0 -minsize 0   -weight 1
241    grid columnconfig $f2 1 -minsize 150 -weight 2
242
243    # The Filter box
244    #
245    label $f1.lab -text "Filter:" -under 3 -anchor w
246    entry $f1.ent
247    pack $f1.lab -side top -fill x -padx 6 -pady 4
248    pack $f1.ent -side top -fill x -padx 4 -pady 0
249    set data(fEnt) $f1.ent
250
251    # The file and directory lists
252    #
253    set data(dList) [tkMotifFDialog_MakeSList $w $f2a Directory: 0 DList]
254    set data(fList) [tkMotifFDialog_MakeSList $w $f2b Files:     2 FList]
255
256    # The Selection box
257    #
258    label $f3.lab -text "Selection:" -under 0 -anchor w
259    entry $f3.ent
260    pack $f3.lab -side top -fill x -padx 6 -pady 0
261    pack $f3.ent -side top -fill x -padx 4 -pady 4
262    set data(sEnt) $f3.ent
263
264    # The buttons
265    #
266    set data(okBtn) [button $bot.ok     -text OK     -width 6 -under 0 \
267        -command [list tkMotifFDialog_OkCmd $w]]
268    set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \
269        -command [list tkMotifFDialog_FilterCmd $w]]
270    set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \
271        -command [list tkMotifFDialog_CancelCmd $w]]
272
273    pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
274        -side left
275
276    # Create the bindings:
277    #
278    bind $w <Alt-t> [list focus $data(fEnt)]
279    bind $w <Alt-d> [list focus $data(dList)]
280    bind $w <Alt-l> [list focus $data(fList)]
281    bind $w <Alt-s> [list focus $data(sEnt)]
282
283    bind $w <Alt-o> [list tkButtonInvoke $bot.ok]
284    bind $w <Alt-f> [list tkButtonInvoke $bot.filter]
285    bind $w <Alt-c> [list tkButtonInvoke $bot.cancel]
286
287    bind $data(fEnt) <Return> [list tkMotifFDialog_ActivateFEnt $w]
288    bind $data(sEnt) <Return> [list tkMotifFDialog_ActivateSEnt $w]
289
290    wm protocol $w WM_DELETE_WINDOW [list tkMotifFDialog_CancelCmd $w]
291}
292
293# tkMotifFDialog_MakeSList --
294#
295#       Create a scrolled-listbox and set the keyboard accelerator
296#       bindings so that the list selection follows what the user
297#       types.
298#
299# Arguments:
300#       w               Pathname of the dialog box.
301#       f               Frame widget inside which to create the scrolled
302#                       listbox. This frame widget already exists.
303#       label           The string to display on top of the listbox.
304#       under           Sets the -under option of the label.
305#       cmdPrefix       Specifies procedures to call when the listbox is
306#                       browsed or activated.
307
308proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {
309    label $f.lab -text $label -under $under -anchor w
310    listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
311        -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set]
312    scrollbar $f.v -orient vertical   -takefocus 0 -command [list $f.l yview]
313    scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]
314    grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
315        -padx 2 -pady 2
316    grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
317    grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
318    grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
319
320    grid rowconfig    $f 0 -weight 0 -minsize 0
321    grid rowconfig    $f 1 -weight 1 -minsize 0
322    grid columnconfig $f 0 -weight 1 -minsize 0
323
324    # bindings for the listboxes
325    #
326    set list $f.l
327    bind $list <Up>             [list tkMotifFDialog_Browse$cmdPrefix $w]
328    bind $list <Down>           [list tkMotifFDialog_Browse$cmdPrefix $w]
329    bind $list <space>          [list tkMotifFDialog_Browse$cmdPrefix $w]
330    bind $list <1>              [list tkMotifFDialog_Browse$cmdPrefix $w]
331    bind $list <B1-Motion>      [list tkMotifFDialog_Browse$cmdPrefix $w]
332    bind $list <Double-ButtonRelease-1> \
333            [list tkMotifFDialog_Activate$cmdPrefix $w]
334    bind $list <Return>    "tkMotifFDialog_Browse$cmdPrefix [list $w]; \
335            tkMotifFDialog_Activate$cmdPrefix [list $w]"
336
337    bindtags $list [list Listbox $list [winfo toplevel $list] all]
338    tkListBoxKeyAccel_Set $list
339
340    return $f.l
341}
342
343# tkMotifFDialog_InterpFilter --
344#
345#       Interpret the string in the filter entry into two components:
346#       the directory and the pattern. If the string is a relative
347#       pathname, give a warning to the user and restore the pattern
348#       to original.
349#
350# Arguments:
351#       w               pathname of the dialog box.
352#
353# Results:
354#       A list of two elements. The first element is the directory
355#       specified # by the filter. The second element is the filter
356#       pattern itself.
357
358proc tkMotifFDialog_InterpFilter {w} {
359    upvar ::tk::dialog::file::[winfo name $w] data
360
361    set text [string trim [$data(fEnt) get]]
362
363    # Perform tilde substitution
364    #
365    set badTilde 0
366    if {[string equal [string index $text 0] ~]} {
367        set list [file split $text]
368        set tilde [lindex $list 0]
369        if {[catch {set tilde [glob $tilde]}]} {
370            set badTilde 1
371        } else {
372            set text [eval file join [concat $tilde [lrange $list 1 end]]]
373        }
374    }
375
376    # If the string is a relative pathname, combine it
377    # with the current selectPath.
378
379    set relative 0
380    if {[string equal [file pathtype $text] "relative"]} {
381        set relative 1
382    } elseif {$badTilde} {
383        set relative 1 
384    }
385
386    if {$relative} {
387        tk_messageBox -icon warning -type ok \
388            -message "\"$text\" must be an absolute pathname"
389
390        $data(fEnt) delete 0 end
391        $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
392                $data(filter)]
393
394        return [list $data(selectPath) $data(filter)]
395    }
396
397    set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]
398
399    if {[file isdirectory $resolved]} {
400        set dir $resolved
401        set fil $data(filter)
402    } else {
403        set dir [file dirname $resolved]
404        set fil [file tail    $resolved]
405    }
406
407    return [list $dir $fil]
408}
409
410# tkMotifFDialog_Update
411#
412#       Load the files and synchronize the "filter" and "selection" fields
413#       boxes.
414#
415# Arguments:
416#       w               pathname of the dialog box.
417#
418# Results:
419#       None.
420
421proc tkMotifFDialog_Update {w} {
422    upvar ::tk::dialog::file::[winfo name $w] data
423
424    $data(fEnt) delete 0 end
425    $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
426    $data(sEnt) delete 0 end
427    $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
428            $data(selectFile)]
429 
430    tkMotifFDialog_LoadFiles $w
431}
432
433# tkMotifFDialog_LoadFiles --
434#
435#       Loads the files and directories into the two listboxes according
436#       to the filter setting.
437#
438# Arguments:
439#       w               pathname of the dialog box.
440#
441# Results:
442#       None.
443
444proc tkMotifFDialog_LoadFiles {w} {
445    upvar ::tk::dialog::file::[winfo name $w] data
446
447    $data(dList) delete 0 end
448    $data(fList) delete 0 end
449
450    set appPWD [pwd]
451    if {[catch {cd $data(selectPath)}]} {
452        cd $appPWD
453
454        $data(dList) insert end ".."
455        return
456    }
457
458    # Make the dir list
459    #
460    foreach f [lsort -dictionary [glob -nocomplain .* *]] {
461        if {[file isdir ./$f]} {
462            $data(dList) insert end $f
463        }
464    }
465    # Make the file list
466    #
467    if {[string equal $data(filter) *]} {
468        set files [lsort -dictionary [glob -nocomplain .* *]]
469    } else {
470        set files [lsort -dictionary \
471            [glob -nocomplain $data(filter)]]
472    }
473
474    set top 0
475    foreach f $files {
476        if {![file isdir ./$f]} {
477            regsub {^[.]/} $f "" f
478            $data(fList) insert end $f
479            if {[string match .* $f]} {
480                incr top
481            }
482        }
483    }
484
485    # The user probably doesn't want to see the . files. We adjust the view
486    # so that the listbox displays all the non-dot files
487    $data(fList) yview $top
488
489    cd $appPWD
490}
491
492# tkMotifFDialog_BrowseFList --
493#
494#       This procedure is called when the directory list is browsed
495#       (clicked-over) by the user.
496#
497# Arguments:
498#       w               The pathname of the dialog box.
499#
500# Results:
501#       None.   
502
503proc tkMotifFDialog_BrowseDList {w} {
504    upvar ::tk::dialog::file::[winfo name $w] data
505
506    focus $data(dList)
507    if {[string equal [$data(dList) curselection] ""]} {
508        return
509    }
510    set subdir [$data(dList) get [$data(dList) curselection]]
511    if {[string equal $subdir ""]} {
512        return
513    }
514
515    $data(fList) selection clear 0 end
516
517    set list [tkMotifFDialog_InterpFilter $w]
518    set data(filter) [lindex $list 1]
519
520    switch -- $subdir {
521        . {
522            set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
523        }
524        .. {
525            set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
526                $data(filter)]
527        }
528        default {
529            set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
530                    $data(selectPath) $subdir] $data(filter)]
531        }
532    }
533
534    $data(fEnt) delete 0 end
535    $data(fEnt) insert 0 $newSpec
536}
537
538# tkMotifFDialog_ActivateDList --
539#
540#       This procedure is called when the directory list is activated
541#       (double-clicked) by the user.
542#
543# Arguments:
544#       w               The pathname of the dialog box.
545#
546# Results:
547#       None.   
548
549proc tkMotifFDialog_ActivateDList {w} {
550    upvar ::tk::dialog::file::[winfo name $w] data
551
552    if {[string equal [$data(dList) curselection] ""]} {
553        return
554    }
555    set subdir [$data(dList) get [$data(dList) curselection]]
556    if {[string equal $subdir ""]} {
557        return
558    }
559
560    $data(fList) selection clear 0 end
561
562    switch -- $subdir {
563        . {
564            set newDir $data(selectPath)
565        }
566        .. {
567            set newDir [file dirname $data(selectPath)]
568        }
569        default {
570            set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
571        }
572    }
573
574    set data(selectPath) $newDir
575    tkMotifFDialog_Update $w
576
577    if {[string compare $subdir ..]} {
578        $data(dList) selection set 0
579        $data(dList) activate 0
580    } else {
581        $data(dList) selection set 1
582        $data(dList) activate 1
583    }
584}
585
586# tkMotifFDialog_BrowseFList --
587#
588#       This procedure is called when the file list is browsed
589#       (clicked-over) by the user.
590#
591# Arguments:
592#       w               The pathname of the dialog box.
593#
594# Results:
595#       None.   
596
597proc tkMotifFDialog_BrowseFList {w} {
598    upvar ::tk::dialog::file::[winfo name $w] data
599
600    focus $data(fList)
601    if {[string equal [$data(fList) curselection] ""]} {
602        return
603    }
604    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
605    if {[string equal $data(selectFile) ""]} {
606        return
607    }
608
609    $data(dList) selection clear 0 end
610
611    $data(fEnt) delete 0 end
612    $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
613    $data(fEnt) xview end
614 
615    $data(sEnt) delete 0 end
616    $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
617            $data(selectFile)]
618    $data(sEnt) xview end
619}
620
621# tkMotifFDialog_ActivateFList --
622#
623#       This procedure is called when the file list is activated
624#       (double-clicked) by the user.
625#
626# Arguments:
627#       w               The pathname of the dialog box.
628#
629# Results:
630#       None.   
631
632proc tkMotifFDialog_ActivateFList {w} {
633    upvar ::tk::dialog::file::[winfo name $w] data
634
635    if {[string equal [$data(fList) curselection] ""]} {
636        return
637    }
638    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
639    if {[string equal $data(selectFile) ""]} {
640        return
641    } else {
642        tkMotifFDialog_ActivateSEnt $w
643    }
644}
645
646# tkMotifFDialog_ActivateFEnt --
647#
648#       This procedure is called when the user presses Return inside
649#       the "filter" entry. It updates the dialog according to the
650#       text inside the filter entry.
651#
652# Arguments:
653#       w               The pathname of the dialog box.
654#
655# Results:
656#       None.   
657
658proc tkMotifFDialog_ActivateFEnt {w} {
659    upvar ::tk::dialog::file::[winfo name $w] data
660
661    set list [tkMotifFDialog_InterpFilter $w]
662    set data(selectPath) [lindex $list 0]
663    set data(filter)    [lindex $list 1]
664
665    tkMotifFDialog_Update $w
666}
667
668# tkMotifFDialog_ActivateSEnt --
669#
670#       This procedure is called when the user presses Return inside
671#       the "selection" entry. It sets the tkPriv(selectFilePath) global
672#       variable so that the vwait loop in tkMotifFDialog will be
673#       terminated.
674#
675# Arguments:
676#       w               The pathname of the dialog box.
677#
678# Results:
679#       None.   
680
681proc tkMotifFDialog_ActivateSEnt {w} {
682    global tkPriv
683    upvar ::tk::dialog::file::[winfo name $w] data
684
685    set selectFilePath [string trim [$data(sEnt) get]]
686    set selectFile     [file tail    $selectFilePath]
687    set selectPath     [file dirname $selectFilePath]
688
689    if {[string equal $selectFilePath ""]} {
690        tkMotifFDialog_FilterCmd $w
691        return
692    }
693
694    if {[file isdirectory $selectFilePath]} {
695        set data(selectPath) [glob $selectFilePath]
696        set data(selectFile) ""
697        tkMotifFDialog_Update $w
698        return
699    }
700
701    if {[string compare [file pathtype $selectFilePath] "absolute"]} {
702        tk_messageBox -icon warning -type ok \
703            -message "\"$selectFilePath\" must be an absolute pathname"
704        return
705    }
706
707    if {![file exists $selectPath]} {
708        tk_messageBox -icon warning -type ok \
709            -message "Directory \"$selectPath\" does not exist."
710        return
711    }
712
713    if {![file exists $selectFilePath]} {
714        if {[string equal $data(type) open]} {
715            tk_messageBox -icon warning -type ok \
716                -message "File \"$selectFilePath\" does not exist."
717            return
718        }
719    } else {
720        if {[string equal $data(type) save]} {
721            set message [format %s%s \
722                "File \"$selectFilePath\" already exists.\n\n" \
723                "Replace existing file?"]
724            set answer [tk_messageBox -icon warning -type yesno \
725                -message $message]
726            if {[string equal $answer "no"]} {
727                return
728            }
729        }
730    }
731
732    set tkPriv(selectFilePath) $selectFilePath
733    set tkPriv(selectFile)     $selectFile
734    set tkPriv(selectPath)     $selectPath
735}
736
737
738proc tkMotifFDialog_OkCmd {w} {
739    upvar ::tk::dialog::file::[winfo name $w] data
740
741    tkMotifFDialog_ActivateSEnt $w
742}
743
744proc tkMotifFDialog_FilterCmd {w} {
745    upvar ::tk::dialog::file::[winfo name $w] data
746
747    tkMotifFDialog_ActivateFEnt $w
748}
749
750proc tkMotifFDialog_CancelCmd {w} {
751    global tkPriv
752
753    set tkPriv(selectFilePath) ""
754    set tkPriv(selectFile)     ""
755    set tkPriv(selectPath)     ""
756}
757
758proc tkListBoxKeyAccel_Set {w} {
759    bind Listbox <Any-KeyPress> ""
760    bind $w <Destroy> [list tkListBoxKeyAccel_Unset $w]
761    bind $w <Any-KeyPress> [list tkListBoxKeyAccel_Key $w %A]
762}
763
764proc tkListBoxKeyAccel_Unset {w} {
765    global tkPriv
766
767    catch {after cancel $tkPriv(lbAccel,$w,afterId)}
768    catch {unset tkPriv(lbAccel,$w)}
769    catch {unset tkPriv(lbAccel,$w,afterId)}
770}
771
772# tkListBoxKeyAccel_Key--
773#
774#       This procedure maintains a list of recently entered keystrokes
775#       over a listbox widget. It arranges an idle event to move the
776#       selection of the listbox to the entry that begins with the
777#       keystrokes.
778#
779# Arguments:
780#       w               The pathname of the listbox.
781#       key             The key which the user just pressed.
782#
783# Results:
784#       None.   
785
786proc tkListBoxKeyAccel_Key {w key} {
787    global tkPriv
788
789    append tkPriv(lbAccel,$w) $key
790    tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)
791    catch {
792        after cancel $tkPriv(lbAccel,$w,afterId)
793    }
794    set tkPriv(lbAccel,$w,afterId) [after 500 \
795            [list tkListBoxKeyAccel_Reset $w]]
796}
797
798proc tkListBoxKeyAccel_Goto {w string} {
799    global tkPriv
800
801    set string [string tolower $string]
802    set end [$w index end]
803    set theIndex -1
804
805    for {set i 0} {$i < $end} {incr i} {
806        set item [string tolower [$w get $i]]
807        if {[string compare $string $item] >= 0} {
808            set theIndex $i
809        }
810        if {[string compare $string $item] <= 0} {
811            set theIndex $i
812            break
813        }
814    }
815
816    if {$theIndex >= 0} {
817        $w selection clear 0 end
818        $w selection set $theIndex $theIndex
819        $w activate $theIndex
820        $w see $theIndex
821    }
822}
823
824proc tkListBoxKeyAccel_Reset {w} {
825    global tkPriv
826
827    catch {unset tkPriv(lbAccel,$w)}
828}
829
Note: See TracBrowser for help on using the repository browser.