1#
2# Fileselectionbox
3# ----------------------------------------------------------------------
4# Implements a file selection box in a style similar to the OSF/Motif
5# standard XmFileselectionbox composite widget.  The Fileselectionbox
6# is composed of directory and file scrolled lists as well as filter
7# and selection entry fields.
8#
9# ----------------------------------------------------------------------
10#  AUTHOR: Mark L. Ulferts               EMAIL: mulferts@spd.dsccc.com
11#
12#  @(#) $Id: fileselectionbox.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
13# ----------------------------------------------------------------------
14#            Copyright (c) 1997 DSC Technologies Corporation
15# ======================================================================
16# Permission to use, copy, modify, distribute and license this software
17# and its documentation for any purpose, and without fee or written
18# agreement with DSC, is hereby granted, provided that the above copyright
19# notice appears in all copies and that both the copyright notice and
20# warranty disclaimer below appear in supporting documentation, and that
21# the names of DSC Technologies Corporation or DSC Communications
22# Corporation not be used in advertising or publicity pertaining to the
23# software without specific, written prior permission.
24#
25# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
26# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
27# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
28# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
29# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
30# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
31# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
32# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
33# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
34# SOFTWARE.
35# ======================================================================
36
37#
38# Usual options.
39#
40itk::usual Fileselectionbox {
41    keep -activebackground -activerelief -background -borderwidth -cursor \
42         -elementborderwidth -foreground -highlightcolor -highlightthickness \
43         -insertbackground -insertborderwidth -insertofftime -insertontime \
44         -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
45         -textbackground -textfont -troughcolor
46}
47
48# ------------------------------------------------------------------
49#                          FILESELECTIONBOX
50# ------------------------------------------------------------------
51itcl::class iwidgets::Fileselectionbox {
52    inherit itk::Widget
53
54    constructor {args} {}
55    destructor {}
56
57    itk_option define -childsitepos childSitePos Position s
58    itk_option define -fileson filesOn FilesOn true
59    itk_option define -dirson dirsOn DirsOn true
60    itk_option define -selectionon selectionOn SelectionOn true
61    itk_option define -filteron filterOn FilterOn true
62    itk_option define -mask mask Mask {*}
63    itk_option define -directory directory Directory {}
64    itk_option define -automount automount Automount {}
65    itk_option define -nomatchstring noMatchString NoMatchString {}
66    itk_option define -dirsearchcommand dirSearchCommand Command {}
67    itk_option define -filesearchcommand fileSearchCommand Command {}
68    itk_option define -selectioncommand selectionCommand Command {}
69    itk_option define -filtercommand filterCommand Command {}
70    itk_option define -selectdircommand selectDirCommand Command {}
71    itk_option define -selectfilecommand selectFileCommand Command {}
72    itk_option define -invalid invalid Command {bell}
73    itk_option define -filetype fileType FileType {regular}
74    itk_option define -width width Width 350
75    itk_option define -height height Height 300
76
77    public {
78	method childsite {}
79	method get {}
80	method filter {}
81    }
82
83    public {
84	method _selectDir {}
85	method _dblSelectDir {}
86	method _selectFile {}
87	method _selectSelection {}
88	method _selectFilter {}
89    }
90
91    protected {
92	method _packComponents {{when later}}
93	method _updateLists {{when later}}
94    }
95
96    private {
97	method _setFilter {}
98	method _setSelection {}
99	method _setDirList {}
100	method _setFileList {}
101
102	method _nPos {}
103	method _sPos {}
104	method _ePos {}
105	method _wPos {}
106	method _topPos {}
107	method _centerPos {}
108	method _bottomPos {}
109
110	variable _packToken ""      ;# non-null => _packComponents pending
111	variable _updateToken ""    ;# non-null => _updateLists pending
112	variable _pwd "."           ;# present working dir
113	variable _interior          ;# original interior setting
114    }
115}
116
117#
118# Provide a lowercased access method for the Fileselectionbox class.
119#
120proc ::iwidgets::fileselectionbox {pathName args} {
121    uplevel ::iwidgets::Fileselectionbox $pathName $args
122}
123
124#
125# Use option database to override default resources of base classes.
126#
127option add *Fileselectionbox.borderWidth 2 widgetDefault
128
129option add *Fileselectionbox.filterLabel Filter widgetDefault
130option add *Fileselectionbox.dirsLabel Directories widgetDefault
131option add *Fileselectionbox.filesLabel Files widgetDefault
132option add *Fileselectionbox.selectionLabel Selection widgetDefault
133
134option add *Fileselectionbox.width 350 widgetDefault
135option add *Fileselectionbox.height 300 widgetDefault
136
137# ------------------------------------------------------------------
138#                        CONSTRUCTOR
139# ------------------------------------------------------------------
140itcl::body iwidgets::Fileselectionbox::constructor {args} {
141    #
142    # Add back to the hull width and height options and make the
143    # borderwidth zero since we don't need it.
144    #
145    itk_option add hull.width hull.height
146    component hull configure -borderwidth 0
147
148    set _interior $itk_interior
149
150    #
151    # Create the filter entry.
152    #
153    itk_component add filter {
154        iwidgets::Entryfield $itk_interior.filter -labelpos nw \
155	    -command [itcl::code $this _selectFilter] -exportselection 0
156    } {
157	usual
158
159        rename -labeltext -filterlabel filterLabel Text
160    }
161
162    #
163    # Create the directory list.
164    #
165    itk_component add dirs {
166        iwidgets::Scrolledlistbox $itk_interior.dirs \
167	    -selectioncommand [itcl::code $this _selectDir] \
168	    -selectmode single -exportselection 0 \
169	    -visibleitems 1x1 -labelpos nw \
170	    -hscrollmode static -vscrollmode static \
171	    -dblclickcommand [itcl::code $this _dblSelectDir]
172    } {
173	usual
174
175        rename -labeltext -dirslabel dirsLabel Text
176    }
177
178    #
179    # Create the files list.
180    #
181    itk_component add files {
182        iwidgets::Scrolledlistbox $itk_interior.files \
183	    -selectioncommand [itcl::code $this _selectFile] \
184	    -selectmode single -exportselection 0 \
185	    -visibleitems 1x1 -labelpos nw \
186	    -hscrollmode static -vscrollmode static
187    } {
188	usual
189
190        rename -labeltext -fileslabel filesLabel Text
191    }
192
193    #
194    # Create the selection entry.
195    #
196    itk_component add selection {
197      iwidgets::Entryfield $itk_interior.selection -labelpos nw \
198	  -command [itcl::code $this _selectSelection] -exportselection 0
199    } {
200	usual
201
202        rename -labeltext -selectionlabel selectionLabel Text
203    }
204
205    #
206    # Create the child site widget.
207    #
208    itk_component add -protected childsite {
209        frame $itk_interior.fsbchildsite
210    }
211
212    #
213    # Set the interior variable to the childsite for derived classes.
214    #
215    set itk_interior $itk_component(childsite)
216
217    #
218    # Explicitly handle configs that may have been ignored earlier.
219    #
220    eval itk_initialize $args
221
222    #
223    # When idle, pack the childsite and update the lists.
224    #
225    _packComponents
226    _updateLists
227}
228
229# ------------------------------------------------------------------
230#                           DESTRUCTOR
231# ------------------------------------------------------------------
232itcl::body iwidgets::Fileselectionbox::destructor {} {
233    if {$_packToken != ""} {after cancel $_packToken}
234    if {$_updateToken != ""} {after cancel $_updateToken}
235}
236
237# ------------------------------------------------------------------
238#                             OPTIONS
239# ------------------------------------------------------------------
240
241# ------------------------------------------------------------------
242# OPTION: -childsitepos
243#
244# Specifies the position of the child site in the selection box.
245# ------------------------------------------------------------------
246itcl::configbody iwidgets::Fileselectionbox::childsitepos {
247    _packComponents
248}
249
250# ------------------------------------------------------------------
251# OPTION: -fileson
252#
253# Specifies whether or not to display the files list.
254# ------------------------------------------------------------------
255itcl::configbody iwidgets::Fileselectionbox::fileson {
256    _packComponents
257}
258
259# ------------------------------------------------------------------
260# OPTION: -dirson
261#
262# Specifies whether or not to display the dirs list.
263# ------------------------------------------------------------------
264itcl::configbody iwidgets::Fileselectionbox::dirson {
265    _packComponents
266}
267
268# ------------------------------------------------------------------
269# OPTION: -selectionon
270#
271# Specifies whether or not to display the selection entry widget.
272# ------------------------------------------------------------------
273itcl::configbody iwidgets::Fileselectionbox::selectionon {
274    _packComponents
275}
276
277# ------------------------------------------------------------------
278# OPTION: -filteron
279#
280# Specifies whether or not to display the filter entry widget.
281# ------------------------------------------------------------------
282itcl::configbody iwidgets::Fileselectionbox::filteron {
283    _packComponents
284}
285
286# ------------------------------------------------------------------
287# OPTION: -mask
288#
289# Specifies the initial file mask string.
290# ------------------------------------------------------------------
291itcl::configbody iwidgets::Fileselectionbox::mask {
292    global tcl_platform
293    set prefix $_pwd
294
295    #
296    # Remove automounter paths.
297    #
298    if {$tcl_platform(platform) == "unix"} {
299        if {$itk_option(-automount) != {}} {
300            foreach autoDir $itk_option(-automount) {
301                # Use catch because we can't be sure exactly what strings
302                # were passed into the -automount option
303                catch {
304                    if {[regsub ^/$autoDir $prefix {} prefix] != 0} {
305                        break
306                    }
307                }
308            }
309        }
310    }
311
312    set curFilter $itk_option(-mask);
313    $itk_component(filter) delete 0 end
314    $itk_component(filter) insert 0 [file join $_pwd $itk_option(-mask)]
315
316    #
317    # Make sure the right most text is visable.
318    #
319    $itk_component(filter) xview moveto 1
320}
321
322# ------------------------------------------------------------------
323# OPTION: -directory
324#
325# Specifies the initial default directory.
326# ------------------------------------------------------------------
327itcl::configbody iwidgets::Fileselectionbox::directory {
328    if {$itk_option(-directory) != {}} {
329        if {! [file exists $itk_option(-directory)]} {
330            error "bad directory option \"$itk_option(-directory)\":\
331                    directory does not exist"
332        }
333
334        set olddir [pwd]
335        cd $itk_option(-directory)
336        set _pwd [pwd]
337        cd $olddir
338
339        configure -mask $itk_option(-mask)
340        _selectFilter
341    }
342}
343
344# ------------------------------------------------------------------
345# OPTION: -automount
346#
347# Specifies list of directory prefixes to ignore. Typically, this
348# option would be used with values such as:
349#   -automount {export tmp_mnt}
350# ------------------------------------------------------------------
351itcl::configbody iwidgets::Fileselectionbox::automount {
352}
353
354# ------------------------------------------------------------------
355# OPTION: -nomatchstring
356#
357# Specifies the string to be displayed in the files list should
358# not regular files exist in the directory.
359# ------------------------------------------------------------------
360itcl::configbody iwidgets::Fileselectionbox::nomatchstring {
361}
362
363# ------------------------------------------------------------------
364# OPTION: -dirsearchcommand
365#
366# Specifies a command to be executed to perform a directory search.
367# The command will receive the current working directory and filter
368# mask as arguments.  The command should return a list of files which
369# will be placed into the directory list.
370# ------------------------------------------------------------------
371itcl::configbody iwidgets::Fileselectionbox::dirsearchcommand {
372}
373
374# ------------------------------------------------------------------
375# OPTION: -filesearchcommand
376#
377# Specifies a command to be executed to perform a file search.
378# The command will receive the current working directory and filter
379# mask as arguments.  The command should return a list of files which
380# will be placed into the file list.
381# ------------------------------------------------------------------
382itcl::configbody iwidgets::Fileselectionbox::filesearchcommand {
383}
384
385# ------------------------------------------------------------------
386# OPTION: -selectioncommand
387#
388# Specifies a command to be executed upon pressing return in the
389# selection entry widget.
390# ------------------------------------------------------------------
391itcl::configbody iwidgets::Fileselectionbox::selectioncommand {
392}
393
394# ------------------------------------------------------------------
395# OPTION: -filtercommand
396#
397# Specifies a command to be executed upon pressing return in the
398# filter entry widget.
399# ------------------------------------------------------------------
400itcl::configbody iwidgets::Fileselectionbox::filtercommand {
401}
402
403# ------------------------------------------------------------------
404# OPTION: -selectdircommand
405#
406# Specifies a command to be executed following selection of a
407# directory in the directory list.
408# ------------------------------------------------------------------
409itcl::configbody iwidgets::Fileselectionbox::selectdircommand {
410}
411
412# ------------------------------------------------------------------
413# OPTION: -selectfilecommand
414#
415# Specifies a command to be executed following selection of a
416# file in the files list.
417# ------------------------------------------------------------------
418itcl::configbody iwidgets::Fileselectionbox::selectfilecommand {
419}
420
421# ------------------------------------------------------------------
422# OPTION: -invalid
423#
424# Specify a command to executed should the filter contents be
425# proven invalid.
426# ------------------------------------------------------------------
427itcl::configbody iwidgets::Fileselectionbox::invalid {
428}
429
430# ------------------------------------------------------------------
431# OPTION: -filetype
432#
433# Specify the type of files which may appear in the file list.
434# ------------------------------------------------------------------
435itcl::configbody iwidgets::Fileselectionbox::filetype {
436    switch $itk_option(-filetype) {
437        regular -
438        directory -
439        any {
440        }
441        default {
442            error "bad filetype option \"$itk_option(-filetype)\":\
443                    should be regular, directory, or any"
444        }
445    }
446
447    _updateLists
448}
449
450# ------------------------------------------------------------------
451# OPTION: -width
452#
453# Specifies the width of the file selection box.  The value may be
454# specified in any of the forms acceptable to Tk_GetPixels.
455# ------------------------------------------------------------------
456itcl::configbody iwidgets::Fileselectionbox::width {
457    #
458    # The width option was added to the hull in the constructor.
459    # So, any width value given is passed automatically to the
460    # hull.  All we have to do is play with the propagation.
461    #
462    if {$itk_option(-width) != 0} {
463	set propagate 0
464    } else {
465	set propagate 1
466    }
467
468    #
469    # Due to a bug in the tk4.2 grid, we have to check the
470    # propagation before setting it.  Setting it to the same
471    # value it already is will cause it to toggle.
472    #
473    if {[grid propagate $itk_component(hull)] != $propagate} {
474	grid propagate $itk_component(hull) $propagate
475    }
476}
477
478# ------------------------------------------------------------------
479# OPTION: -height
480#
481# Specifies the height of the file selection box.  The value may be
482# specified in any of the forms acceptable to Tk_GetPixels.
483# ------------------------------------------------------------------
484itcl::configbody iwidgets::Fileselectionbox::height {
485    #
486    # The height option was added to the hull in the constructor.
487    # So, any height value given is passed automatically to the
488    # hull.  All we have to do is play with the propagation.
489    #
490    if {$itk_option(-height) != 0} {
491	set propagate 0
492    } else {
493	set propagate 1
494    }
495
496    #
497    # Due to a bug in the tk4.2 grid, we have to check the
498    # propagation before setting it.  Setting it to the same
499    # value it already is will cause it to toggle.
500    #
501    if {[grid propagate $itk_component(hull)] != $propagate} {
502	grid propagate $itk_component(hull) $propagate
503    }
504}
505
506# ------------------------------------------------------------------
507#                            METHODS
508# ------------------------------------------------------------------
509
510# ------------------------------------------------------------------
511# METHOD: childsite
512#
513# Returns the path name of the child site widget.
514# ------------------------------------------------------------------
515itcl::body iwidgets::Fileselectionbox::childsite {} {
516    return $itk_component(childsite)
517}
518
519# ------------------------------------------------------------------
520# METHOD: get
521#
522# Returns the current selection.
523# ------------------------------------------------------------------
524itcl::body iwidgets::Fileselectionbox::get {} {
525    return [$itk_component(selection) get]
526}
527
528# ------------------------------------------------------------------
529# METHOD: filter
530#
531# The user has pressed Return in the filter.  Make sure the contents
532# contain a valid directory before setting default to directory.
533# Use the invalid option to warn the user of any problems.
534# ------------------------------------------------------------------
535itcl::body iwidgets::Fileselectionbox::filter {} {
536    set newdir [file dirname [$itk_component(filter) get]]
537
538    if {! [file exists $newdir]} {
539	uplevel #0 "$itk_option(-invalid)"
540	return
541    }
542
543    set _pwd $newdir;
544    if {$_pwd == "."} {set _pwd [pwd]};
545
546    _updateLists
547}
548
549# ------------------------------------------------------------------
550# PRIVATE METHOD: _updateLists ?now?
551#
552# Updates the contents of both the file and directory lists, as well
553# resets the positions of the filter, and lists.
554# ------------------------------------------------------------------
555itcl::body iwidgets::Fileselectionbox::_updateLists {{when "later"}} {
556    switch -- $when {
557        later {
558            if {$_updateToken == ""} {
559                set _updateToken [after idle [itcl::code $this _updateLists now]]
560            }
561        }
562        now {
563            if {$itk_option(-dirson)} {_setDirList}
564            if {$itk_option(-fileson)} {_setFileList}
565
566            if {$itk_option(-filteron)} {
567              _setFilter
568            }
569            if {$itk_option(-selectionon)} {
570                $itk_component(selection) icursor end
571            }
572            if {$itk_option(-dirson)} {
573                $itk_component(dirs) justify left
574            }
575            if {$itk_option(-fileson)} {
576                $itk_component(files) justify left
577            }
578            set _updateToken ""
579        }
580        default {
581            error "bad option \"$when\": should be later or now"
582        }
583    }
584}
585
586# ------------------------------------------------------------------
587# PRIVATE METHOD: _setFilter
588#
589# Set the filter to the current selection in the directory list plus
590# any existing mask in the filter.  Translate the two special cases
591# of '.', and '..' directory names to full path names..
592# ------------------------------------------------------------------
593itcl::body iwidgets::Fileselectionbox::_setFilter {} {
594    global tcl_platform
595    set prefix [$itk_component(dirs) getcurselection]
596    set curFilter [file tail [$itk_component(filter) get]]
597
598    while {[regexp {\.$} $prefix]} {
599	if {[file tail $prefix] == "."} {
600	    if {$prefix == "."} {
601		if {$_pwd == "."} {
602		    set _pwd [pwd]
603		} elseif {$_pwd == ".."} {
604		    set _pwd [file dirname [pwd]]
605		}
606		set prefix $_pwd
607	    } else {
608		set prefix [file dirname $prefix]
609	    }
610	} elseif {[file tail $prefix] == ".."} {
611	    if {$prefix != ".."} {
612		set prefix [file dirname [file dirname $prefix]]
613	    } else {
614		if {$_pwd == "."} {
615		    set _pwd [pwd]
616		} elseif {$_pwd == ".."} {
617		    set _pwd [file dirname [pwd]]
618		}
619		set prefix [file dirname $_pwd]
620	    }
621	} else {
622	    break
623	}
624    }
625
626    if { [file pathtype $prefix] != "absolute" } {
627        set prefix [file join $_pwd $prefix]
628    }
629
630    #
631    # Remove automounter paths.
632    #
633    if {$tcl_platform(platform) == "unix"} {
634        if {$itk_option(-automount) != {}} {
635            foreach autoDir $itk_option(-automount) {
636                # Use catch because we can't be sure exactly what strings
637                # were passed into the -automount option
638                catch {
639                    if {[regsub ^/$autoDir $prefix {} prefix] != 0} {
640                        break
641                    }
642                }
643            }
644        }
645    }
646
647    $itk_component(filter) delete 0 end
648    $itk_component(filter) insert 0 [file join $prefix $curFilter]
649
650    #
651    # Make sure insertion cursor is at the end.
652    #
653    $itk_component(filter) icursor end
654
655    #
656    # Make sure the right most text is visable.
657    #
658    $itk_component(filter) xview moveto 1
659}
660
661# ------------------------------------------------------------------
662# PRIVATE METHOD: _setSelection
663#
664# Set the contents of the selection entry to either the current
665# selection of the file or directory list dependent on which lists
666# are currently mapped.  For the file list, avoid seleciton of the
667# no match string.  As for the directory list, translate file names.
668# ------------------------------------------------------------------
669itcl::body iwidgets::Fileselectionbox::_setSelection {} {
670    global tcl_platform
671    $itk_component(selection) delete 0 end
672
673    if {$itk_option(-fileson)} {
674        set selection [$itk_component(files) getcurselection]
675
676        if {$selection != $itk_option(-nomatchstring)} {
677	    if {[file pathtype $selection] != "absolute"} {
678		set selection [file join $_pwd $selection]
679	    }
680
681	    #
682	    # Remove automounter paths.
683	    #
684        if {$tcl_platform(platform) == "unix"} {
685            if {$itk_option(-automount) != {}} {
686                foreach autoDir $itk_option(-automount) {
687                    # Use catch because we can't be sure exactly what strings
688                    # were passed into the -automount option
689                    catch {
690                        if {[regsub ^/$autoDir $selection {} selection] != 0} {
691                            break
692                        }
693                    }
694                }
695            }
696        }
697
698	    $itk_component(selection) insert 0 $selection
699        } else {
700	    $itk_component(files) selection clear 0 end
701	}
702
703    } else {
704        set selection [$itk_component(dirs) getcurselection]
705
706	if {[file tail $selection] == "."} {
707	    if {$selection != "."} {
708		set selection [file dirname $selection]
709	    } else {
710		set selection $_pwd
711	    }
712	} elseif {[file tail $selection] == ".."} {
713	    if {$selection != ".."} {
714		set selection [file dirname [file dirname $selection]]
715	    } else {
716		set selection [file join $_pwd ..]
717	    }
718	} else {
719	    set selection [file join $_pwd $selection]
720	}
721
722	#
723    # Remove automounter paths.
724	#
725    if {$tcl_platform(platform) == "unix"} {
726        if {$itk_option(-automount) != {}} {
727            foreach autoDir $itk_option(-automount) {
728                # Use catch because we can't be sure exactly what strings
729                # were passed into the -automount option
730                catch {
731                    if {[regsub ^/$autoDir $selection {} selection] != 0} {
732                        break
733                    }
734                }
735            }
736        }
737    }
738
739	$itk_component(selection) delete 0 end
740        $itk_component(selection) insert 0 $selection
741    }
742
743    $itk_component(selection) icursor end
744
745    #
746    # Make sure the right most text is visable.
747    #
748    $itk_component(selection) xview moveto 1
749}
750
751# ------------------------------------------------------------------
752# PRIVATE METHOD: _setDirList
753#
754# Clear the directory list and dependent on whether the user has
755# defined their own search procedure or not fill the list with their
756# results or those of a glob.  Select the first element if it exists.
757# ------------------------------------------------------------------
758itcl::body iwidgets::Fileselectionbox::_setDirList {} {
759    $itk_component(dirs) clear
760
761    if {$itk_option(-dirsearchcommand) == {}} {
762        foreach i [lsort [glob -nocomplain \
763			      [file join $_pwd .*] [file join $_pwd *]]] {
764            if {[file isdirectory $i]} {
765		$itk_component(dirs) insert end [file tail "$i"]
766            }
767        }
768
769    } else {
770        set mask [file tail [$itk_component(filter) get]]
771
772        foreach file [uplevel #0 $itk_option(-dirsearchcommand) $_pwd $mask] {
773            $itk_component(dirs) insert end $file
774        }
775    }
776
777    if {[$itk_component(dirs) size]} {
778        $itk_component(dirs) selection clear 0 end
779        $itk_component(dirs) selection set 0
780    }
781}
782
783# ------------------------------------------------------------------
784# PRIVATE METHOD: _setFileList
785#
786# Clear the file list and dependent on whether the user has defined
787# their own search procedure or not fill the list with their results
788# or those of a 'glob'.  If the files list has no contents, then set
789# the files list to the 'nomatchstring'.  Clear all selections.
790# ------------------------------------------------------------------
791itcl::body iwidgets::Fileselectionbox::_setFileList {} {
792    $itk_component(files) clear
793    set mask [file tail [$itk_component(filter) get]]
794
795    if {$itk_option(-filesearchcommand) == {}} {
796	if {$mask == "*"} {
797	    set files [lsort [glob -nocomplain \
798				  [file join $_pwd .*] [file join $_pwd *]]]
799	} else {
800	    set files [lsort [glob -nocomplain [file join $_pwd $mask]]]
801	}
802
803        foreach i $files {
804            if {($itk_option(-filetype) == "regular" && \
805		    ! [file isdirectory $i]) || \
806		    ($itk_option(-filetype) == "directory" && \
807		    [file isdirectory $i]) || \
808		    ($itk_option(-filetype) == "any")} {
809		$itk_component(files) insert end [file tail "$i"]
810            }
811        }
812
813    } else {
814        foreach file [uplevel #0 $itk_option(-filesearchcommand) $_pwd $mask] {
815            $itk_component(files) insert end $file
816        }
817    }
818
819    if {[$itk_component(files) size] == 0} {
820	if {$itk_option(-nomatchstring) != {}} {
821	    $itk_component(files) insert end $itk_option(-nomatchstring)
822	}
823    }
824
825    $itk_component(files) selection clear 0 end
826}
827
828# ------------------------------------------------------------------
829# PRIVATE METHOD: _selectDir
830#
831# For a selection in the directory list, set the filter and possibly
832# the selection entry based on the fileson option.
833# ------------------------------------------------------------------
834itcl::body iwidgets::Fileselectionbox::_selectDir {} {
835    _setFilter
836
837    if {$itk_option(-fileson)} {} {
838        _setSelection
839    }
840
841    if {$itk_option(-selectdircommand) != {}} {
842        uplevel #0 $itk_option(-selectdircommand)
843    }
844}
845
846# ------------------------------------------------------------------
847# PRIVATE METHOD: _dblSelectDir
848#
849# For a double click event in the directory list, select the
850# directory, set the default to the selection, and update both the
851# file and directory lists.
852# ------------------------------------------------------------------
853itcl::body iwidgets::Fileselectionbox::_dblSelectDir {} {
854    filter
855}
856
857# ------------------------------------------------------------------
858# PRIVATE METHOD: _selectFile
859#
860# The user has selected a file.  Put the current selection in the
861# file list in the selection entry widget.
862# ------------------------------------------------------------------
863itcl::body iwidgets::Fileselectionbox::_selectFile {} {
864    _setSelection
865
866    if {$itk_option(-selectfilecommand) != {}} {
867        uplevel #0 $itk_option(-selectfilecommand)
868    }
869}
870
871# ------------------------------------------------------------------
872# PRIVATE METHOD: _selectSelection
873#
874# The user has pressed Return in the selection entry widget.  Call
875# the defined selection command if it exists.
876# ------------------------------------------------------------------
877itcl::body iwidgets::Fileselectionbox::_selectSelection {} {
878    if {$itk_option(-selectioncommand) != {}} {
879        uplevel #0 $itk_option(-selectioncommand)
880    }
881}
882
883# ------------------------------------------------------------------
884# PRIVATE METHOD: _selectFilter
885#
886# The user has pressed Return in the filter entry widget.  Call the
887# defined selection command if it exists, otherwise just filter.
888# ------------------------------------------------------------------
889itcl::body iwidgets::Fileselectionbox::_selectFilter {} {
890    if {$itk_option(-filtercommand) != {}} {
891        uplevel #0 $itk_option(-filtercommand)
892    } else {
893        filter
894    }
895}
896
897# ------------------------------------------------------------------
898# PRIVATE METHOD: _packComponents
899#
900# Pack the selection, items, and child site widgets based on options.
901# Using the -in option of pack, put the childsite around the frame
902# in the hull for n, s, e, and w positions.  Make sure and raise
903# the child site since using the 'in' option may obscure the site.
904# ------------------------------------------------------------------
905itcl::body iwidgets::Fileselectionbox::_packComponents {{when "later"}} {
906    if {$when == "later"} {
907        if {$_packToken == ""} {
908            set _packToken [after idle [itcl::code $this _packComponents now]]
909        }
910        return
911    } elseif {$when != "now"} {
912        error "bad option \"$when\": should be now or later"
913    }
914
915    set _packToken ""
916
917    #
918    # Forget about any previous placements via the grid and
919    # reset all the possible minsizes and weights for all
920    # the rows and columns.
921    #
922    foreach component {childsite filter dirs files selection} {
923	grid forget $itk_component($component)
924    }
925
926    for {set row 0} {$row < 6} {incr row} {
927	grid rowconfigure $_interior $row -minsize 0 -weight 0
928    }
929
930    for {set col 0} {$col < 4} {incr col} {
931	grid columnconfigure $_interior $col -minsize 0 -weight 0
932    }
933
934    #
935    # Place all the components based on the childsite poisition
936    # option.
937    #
938    switch $itk_option(-childsitepos) {
939        n { _nPos }
940
941        w { _wPos }
942
943        s { _sPos }
944
945        e { _ePos }
946
947	center { _centerPos }
948
949	top { _topPos }
950
951	bottom { _bottomPos }
952
953        default {
954            error "bad childsitepos option \"$itk_option(-childsitepos)\":\
955                    should be n, e, s, w, center, top, or bottom"
956        }
957    }
958}
959
960# ------------------------------------------------------------------
961# PRIVATE METHOD: _nPos
962#
963# Position the childsite to the north and all the other components
964# appropriately based on the individual "on" options.
965# ------------------------------------------------------------------
966itcl::body iwidgets::Fileselectionbox::_nPos {} {
967    grid $itk_component(childsite) -row 0 -column 0 \
968	-columnspan 3 -rowspan 1 -sticky nsew
969
970    if {$itk_option(-filteron)} {
971	grid $itk_component(filter) -row 1 -column 0 \
972	    -columnspan 3 -sticky ew
973	grid rowconfigure $_interior 2 -minsize 7
974    }
975
976    if {$itk_option(-dirson)} {
977	grid $itk_component(dirs) -row 3 -column 0 \
978	    -columnspan 1 -sticky nsew
979    }
980    if {$itk_option(-fileson)} {
981	grid $itk_component(files) -row 3 -column 2 \
982	    -columnspan 1 -sticky nsew
983    }
984    if {$itk_option(-dirson)} {
985	if {$itk_option(-fileson)} {
986	    grid columnconfigure $_interior 1 -minsize 7
987	} else {
988	    grid configure $itk_component(dirs) -columnspan 3 -column 0
989	}
990    } else {
991	if {$itk_option(-fileson)} {
992	    grid configure $itk_component(files) -columnspan 3 -column 0
993	}
994    }
995
996    grid rowconfigure $_interior 3 -weight 1
997
998    if {$itk_option(-selectionon)} {
999	grid rowconfigure $_interior 4 -minsize 7
1000	grid $itk_component(selection) -row 5 -column 0 \
1001	    -columnspan 3 -sticky ew
1002    }
1003
1004    grid columnconfigure $_interior 0 -weight 1
1005    grid columnconfigure $_interior 2 -weight 1
1006}
1007
1008# ------------------------------------------------------------------
1009# PRIVATE METHOD: _sPos
1010#
1011# Position the childsite to the south and all the other components
1012# appropriately based on the individual "on" options.
1013# ------------------------------------------------------------------
1014itcl::body iwidgets::Fileselectionbox::_sPos {} {
1015    if {$itk_option(-filteron)} {
1016	grid $itk_component(filter) -row 0 -column 0 \
1017	    -columnspan 3 -sticky ew
1018	grid rowconfigure $_interior 1 -minsize 7
1019    }
1020
1021    if {$itk_option(-dirson)} {
1022	grid $itk_component(dirs) -row 2 -column 0 \
1023	    -columnspan 1 -sticky nsew
1024    }
1025    if {$itk_option(-fileson)} {
1026	grid $itk_component(files) -row 2 -column 2 \
1027	    -columnspan 1 -sticky nsew
1028    }
1029    if {$itk_option(-dirson)} {
1030	if {$itk_option(-fileson)} {
1031	    grid columnconfigure $_interior 1 -minsize 7
1032	} else {
1033	    grid configure $itk_component(dirs) -columnspan 3 -column 0
1034	}
1035    } else {
1036	if {$itk_option(-fileson)} {
1037	    grid configure $itk_component(files) -columnspan 3 -column 0
1038	}
1039    }
1040
1041    grid rowconfigure $_interior 2 -weight 1
1042
1043    if {$itk_option(-selectionon)} {
1044	grid rowconfigure $_interior 3 -minsize 7
1045	grid $itk_component(selection) -row 4 -column 0 \
1046	    -columnspan 3 -sticky ew
1047    }
1048
1049    grid $itk_component(childsite) -row 5 -column 0 \
1050	-columnspan 3 -rowspan 1 -sticky nsew
1051    grid columnconfigure $_interior 0 -weight 1
1052    grid columnconfigure $_interior 2 -weight 1
1053}
1054
1055# ------------------------------------------------------------------
1056# PRIVATE METHOD: _ePos
1057#
1058# Position the childsite to the east and all the other components
1059# appropriately based on the individual "on" options.
1060# ------------------------------------------------------------------
1061itcl::body iwidgets::Fileselectionbox::_ePos {} {
1062    if {$itk_option(-filteron)} {
1063	grid $itk_component(filter) -row 0 -column 0 \
1064	    -columnspan 3 -sticky ew
1065	grid rowconfigure $_interior 1 -minsize 7
1066    }
1067
1068    if {$itk_option(-dirson)} {
1069	grid $itk_component(dirs) -row 2 -column 0 \
1070	    -columnspan 1 -sticky nsew
1071    }
1072    if {$itk_option(-fileson)} {
1073	grid $itk_component(files) -row 2 -column 2 \
1074	    -columnspan 1 -sticky nsew
1075    }
1076    if {$itk_option(-dirson)} {
1077	if {$itk_option(-fileson)} {
1078	    grid columnconfigure $_interior 1 -minsize 7
1079	} else {
1080	    grid configure $itk_component(dirs) -columnspan 3 -column 0
1081	}
1082    } else {
1083	if {$itk_option(-fileson)} {
1084	    grid configure $itk_component(files) -columnspan 3 -column 0
1085	}
1086    }
1087
1088    grid rowconfigure $_interior 2 -weight 1
1089
1090    if {$itk_option(-selectionon)} {
1091	grid rowconfigure $_interior 3 -minsize 7
1092	grid $itk_component(selection) -row 4 -column 0 \
1093	    -columnspan 3 -sticky ew
1094    }
1095
1096    grid $itk_component(childsite) -row 0 -column 3 \
1097	-rowspan 5 -columnspan 1 -sticky nsew
1098    grid columnconfigure $_interior 0 -weight 1
1099    grid columnconfigure $_interior 2 -weight 1
1100}
1101
1102# ------------------------------------------------------------------
1103# PRIVATE METHOD: _wPos
1104#
1105# Position the childsite to the west and all the other components
1106# appropriately based on the individual "on" options.
1107# ------------------------------------------------------------------
1108itcl::body iwidgets::Fileselectionbox::_wPos {} {
1109    grid $itk_component(childsite) -row 0 -column 0 \
1110	-rowspan 5 -columnspan 1 -sticky nsew
1111
1112    if {$itk_option(-filteron)} {
1113	grid $itk_component(filter) -row 0 -column 1 \
1114	    -columnspan 3 -sticky ew
1115	grid rowconfigure $_interior 1 -minsize 7
1116    }
1117
1118    if {$itk_option(-dirson)} {
1119	grid $itk_component(dirs) -row 2 -column 1 \
1120	    -columnspan 1 -sticky nsew
1121    }
1122    if {$itk_option(-fileson)} {
1123	grid $itk_component(files) -row 2 -column 3 \
1124	    -columnspan 1 -sticky nsew
1125    }
1126    if {$itk_option(-dirson)} {
1127	if {$itk_option(-fileson)} {
1128	    grid columnconfigure $_interior 2 -minsize 7
1129	} else {
1130	    grid configure $itk_component(dirs) -columnspan 3 -column 1
1131	}
1132    } else {
1133	if {$itk_option(-fileson)} {
1134	    grid configure $itk_component(files) -columnspan 3 -column 1
1135	}
1136    }
1137
1138    grid rowconfigure $_interior 2 -weight 1
1139
1140    if {$itk_option(-selectionon)} {
1141	grid rowconfigure $_interior 3 -minsize 7
1142	grid $itk_component(selection) -row 4 -column 1 \
1143	    -columnspan 3 -sticky ew
1144    }
1145
1146    grid columnconfigure $_interior 1 -weight 1
1147    grid columnconfigure $_interior 3 -weight 1
1148}
1149
1150# ------------------------------------------------------------------
1151# PRIVATE METHOD: _topPos
1152#
1153# Position the childsite below the filter but above the lists and
1154# all the other components appropriately based on the individual
1155# "on" options.
1156# ------------------------------------------------------------------
1157itcl::body iwidgets::Fileselectionbox::_topPos {} {
1158    if {$itk_option(-filteron)} {
1159	grid $itk_component(filter) -row 0 -column 0 \
1160	    -columnspan 3 -sticky ew
1161    }
1162
1163    grid $itk_component(childsite) -row 1 -column 0 \
1164	-columnspan 3 -rowspan 1 -sticky nsew
1165
1166    if {$itk_option(-dirson)} {
1167	grid $itk_component(dirs) -row 2 -column 0 -sticky nsew
1168    }
1169    if {$itk_option(-fileson)} {
1170	grid $itk_component(files) -row 2 -column 2 -sticky nsew
1171    }
1172    if {$itk_option(-dirson)} {
1173	if {$itk_option(-fileson)} {
1174	    grid columnconfigure $_interior 1 -minsize 7
1175	} else {
1176	    grid configure $itk_component(dirs) -columnspan 3 -column 0
1177	}
1178    } else {
1179	if {$itk_option(-fileson)} {
1180	    grid configure $itk_component(files) -columnspan 3 -column 0
1181	}
1182    }
1183
1184    grid rowconfigure $_interior 2 -weight 1
1185
1186    if {$itk_option(-selectionon)} {
1187	grid rowconfigure $_interior 3 -minsize 7
1188	grid $itk_component(selection) -row 4 -column 0 \
1189	    -columnspan 3 -sticky ew
1190    }
1191
1192    grid columnconfigure $_interior 0 -weight 1
1193    grid columnconfigure $_interior 2 -weight 1
1194}
1195
1196# ------------------------------------------------------------------
1197# PRIVATE METHOD: _centerPos
1198#
1199# Position the childsite between the lists and all the other
1200# components appropriately based on the individual "on" options.
1201# ------------------------------------------------------------------
1202itcl::body iwidgets::Fileselectionbox::_centerPos {} {
1203    if {$itk_option(-filteron)} {
1204	grid $itk_component(filter) -row 0 -column 0 \
1205	    -columnspan 3 -sticky ew
1206	grid rowconfigure $_interior 1 -minsize 7
1207    }
1208
1209    if {$itk_option(-dirson)} {
1210	grid $itk_component(dirs) -row 2 -column 0 \
1211	    -columnspan 1 -sticky nsew
1212    }
1213    if {$itk_option(-fileson)} {
1214	grid $itk_component(files) -row 2 -column 2 \
1215	    -columnspan 1 -sticky nsew
1216    }
1217    grid $itk_component(childsite) -row 2 \
1218	-columnspan 1 -rowspan 1 -sticky nsew
1219
1220    if {$itk_option(-dirson)} {
1221	if {$itk_option(-fileson)} {
1222	    grid configure $itk_component(childsite) -column 1
1223	    grid columnconfigure $_interior 0 -weight 1
1224	    grid columnconfigure $_interior 2 -weight 1
1225
1226	} else {
1227	    grid configure $itk_component(dirs) -columnspan 2 -column 0
1228	    grid configure $itk_component(childsite) -column 2
1229	    grid columnconfigure $_interior 0 -weight 1
1230	    grid columnconfigure $_interior 1 -weight 1
1231	}
1232    } else {
1233	grid configure $itk_component(childsite) -column 0
1234	if {$itk_option(-fileson)} {
1235	    grid configure $itk_component(files) -columnspan 2 \
1236		-column 1
1237	    grid columnconfigure $_interior 1 -weight 1
1238	    grid columnconfigure $_interior 2 -weight 1
1239	} else {
1240	    grid columnconfigure $_interior 0 -weight 1
1241	}
1242    }
1243
1244    grid rowconfigure $_interior 2 -weight 1
1245
1246    if {$itk_option(-selectionon)} {
1247	grid rowconfigure $_interior 3 -minsize 7
1248	grid $itk_component(selection) -row 4 -column 0 \
1249	    -columnspan 3 -sticky ew
1250    }
1251}
1252
1253# ------------------------------------------------------------------
1254# PRIVATE METHOD: _bottomPos
1255#
1256# Position the childsite below the lists and above the selection
1257# and all the other components appropriately based on the individual
1258# "on" options.
1259# ------------------------------------------------------------------
1260itcl::body iwidgets::Fileselectionbox::_bottomPos {} {
1261    if {$itk_option(-filteron)} {
1262	grid $itk_component(filter) -row 0 -column 0 \
1263	    -columnspan 3 -sticky ew
1264	grid rowconfigure $_interior 1 -minsize 7
1265    }
1266
1267    if {$itk_option(-dirson)} {
1268	grid $itk_component(dirs) -row 2 -column 0 -sticky nsew
1269    }
1270    if {$itk_option(-fileson)} {
1271	grid $itk_component(files) -row 2 -column 2 -sticky nsew
1272    }
1273    if {$itk_option(-dirson)} {
1274	if {$itk_option(-fileson)} {
1275	    grid columnconfigure $_interior 1 -minsize 7
1276	} else {
1277	    grid configure $itk_component(dirs) -columnspan 3 -column 0
1278	}
1279    } else {
1280	if {$itk_option(-fileson)} {
1281	    grid configure $itk_component(files) -columnspan 3 -column 0
1282	}
1283    }
1284    grid rowconfigure $_interior 2 -weight 1
1285
1286    grid $itk_component(childsite) -row 3 -column 0 \
1287	-columnspan 3 -rowspan 1 -sticky nsew
1288
1289    if {$itk_option(-selectionon)} {
1290	grid $itk_component(selection) -row 4 -column 0 \
1291	    -columnspan 3 -sticky ew
1292    }
1293
1294    grid columnconfigure $_interior 0 -weight 1
1295    grid columnconfigure $_interior 2 -weight 1
1296}
1297