home *** CD-ROM | disk | FTP | other *** search
Text File | 2003-09-01 | 40.8 KB | 1,297 lines |
- #
- # Fileselectionbox
- # ----------------------------------------------------------------------
- # Implements a file selection box in a style similar to the OSF/Motif
- # standard XmFileselectionbox composite widget. The Fileselectionbox
- # is composed of directory and file scrolled lists as well as filter
- # and selection entry fields.
- #
- # ----------------------------------------------------------------------
- # AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com
- #
- # @(#) $Id: fileselectionbox.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
- # ----------------------------------------------------------------------
- # Copyright (c) 1997 DSC Technologies Corporation
- # ======================================================================
- # Permission to use, copy, modify, distribute and license this software
- # and its documentation for any purpose, and without fee or written
- # agreement with DSC, is hereby granted, provided that the above copyright
- # notice appears in all copies and that both the copyright notice and
- # warranty disclaimer below appear in supporting documentation, and that
- # the names of DSC Technologies Corporation or DSC Communications
- # Corporation not be used in advertising or publicity pertaining to the
- # software without specific, written prior permission.
- #
- # DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
- # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
- # INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
- # AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
- # SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
- # DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
- # ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
- # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
- # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
- # SOFTWARE.
- # ======================================================================
-
- #
- # Usual options.
- #
- itk::usual Fileselectionbox {
- keep -activebackground -activerelief -background -borderwidth -cursor \
- -elementborderwidth -foreground -highlightcolor -highlightthickness \
- -insertbackground -insertborderwidth -insertofftime -insertontime \
- -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
- -textbackground -textfont -troughcolor
- }
-
- # ------------------------------------------------------------------
- # FILESELECTIONBOX
- # ------------------------------------------------------------------
- itcl::class iwidgets::Fileselectionbox {
- inherit itk::Widget
-
- constructor {args} {}
- destructor {}
-
- itk_option define -childsitepos childSitePos Position s
- itk_option define -fileson filesOn FilesOn true
- itk_option define -dirson dirsOn DirsOn true
- itk_option define -selectionon selectionOn SelectionOn true
- itk_option define -filteron filterOn FilterOn true
- itk_option define -mask mask Mask {*}
- itk_option define -directory directory Directory {}
- itk_option define -automount automount Automount {}
- itk_option define -nomatchstring noMatchString NoMatchString {}
- itk_option define -dirsearchcommand dirSearchCommand Command {}
- itk_option define -filesearchcommand fileSearchCommand Command {}
- itk_option define -selectioncommand selectionCommand Command {}
- itk_option define -filtercommand filterCommand Command {}
- itk_option define -selectdircommand selectDirCommand Command {}
- itk_option define -selectfilecommand selectFileCommand Command {}
- itk_option define -invalid invalid Command {bell}
- itk_option define -filetype fileType FileType {regular}
- itk_option define -width width Width 350
- itk_option define -height height Height 300
-
- public {
- method childsite {}
- method get {}
- method filter {}
- }
-
- public {
- method _selectDir {}
- method _dblSelectDir {}
- method _selectFile {}
- method _selectSelection {}
- method _selectFilter {}
- }
-
- protected {
- method _packComponents {{when later}}
- method _updateLists {{when later}}
- }
-
- private {
- method _setFilter {}
- method _setSelection {}
- method _setDirList {}
- method _setFileList {}
-
- method _nPos {}
- method _sPos {}
- method _ePos {}
- method _wPos {}
- method _topPos {}
- method _centerPos {}
- method _bottomPos {}
-
- variable _packToken "" ;# non-null => _packComponents pending
- variable _updateToken "" ;# non-null => _updateLists pending
- variable _pwd "." ;# present working dir
- variable _interior ;# original interior setting
- }
- }
-
- #
- # Provide a lowercased access method for the Fileselectionbox class.
- #
- proc ::iwidgets::fileselectionbox {pathName args} {
- uplevel ::iwidgets::Fileselectionbox $pathName $args
- }
-
- #
- # Use option database to override default resources of base classes.
- #
- option add *Fileselectionbox.borderWidth 2 widgetDefault
-
- option add *Fileselectionbox.filterLabel Filter widgetDefault
- option add *Fileselectionbox.dirsLabel Directories widgetDefault
- option add *Fileselectionbox.filesLabel Files widgetDefault
- option add *Fileselectionbox.selectionLabel Selection widgetDefault
-
- option add *Fileselectionbox.width 350 widgetDefault
- option add *Fileselectionbox.height 300 widgetDefault
-
- # ------------------------------------------------------------------
- # CONSTRUCTOR
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::constructor {args} {
- #
- # Add back to the hull width and height options and make the
- # borderwidth zero since we don't need it.
- #
- itk_option add hull.width hull.height
- component hull configure -borderwidth 0
-
- set _interior $itk_interior
-
- #
- # Create the filter entry.
- #
- itk_component add filter {
- iwidgets::Entryfield $itk_interior.filter -labelpos nw \
- -command [itcl::code $this _selectFilter] -exportselection 0
- } {
- usual
-
- rename -labeltext -filterlabel filterLabel Text
- }
-
- #
- # Create the directory list.
- #
- itk_component add dirs {
- iwidgets::Scrolledlistbox $itk_interior.dirs \
- -selectioncommand [itcl::code $this _selectDir] \
- -selectmode single -exportselection 0 \
- -visibleitems 1x1 -labelpos nw \
- -hscrollmode static -vscrollmode static \
- -dblclickcommand [itcl::code $this _dblSelectDir]
- } {
- usual
-
- rename -labeltext -dirslabel dirsLabel Text
- }
-
- #
- # Create the files list.
- #
- itk_component add files {
- iwidgets::Scrolledlistbox $itk_interior.files \
- -selectioncommand [itcl::code $this _selectFile] \
- -selectmode single -exportselection 0 \
- -visibleitems 1x1 -labelpos nw \
- -hscrollmode static -vscrollmode static
- } {
- usual
-
- rename -labeltext -fileslabel filesLabel Text
- }
-
- #
- # Create the selection entry.
- #
- itk_component add selection {
- iwidgets::Entryfield $itk_interior.selection -labelpos nw \
- -command [itcl::code $this _selectSelection] -exportselection 0
- } {
- usual
-
- rename -labeltext -selectionlabel selectionLabel Text
- }
-
- #
- # Create the child site widget.
- #
- itk_component add -protected childsite {
- frame $itk_interior.fsbchildsite
- }
-
- #
- # Set the interior variable to the childsite for derived classes.
- #
- set itk_interior $itk_component(childsite)
-
- #
- # Explicitly handle configs that may have been ignored earlier.
- #
- eval itk_initialize $args
-
- #
- # When idle, pack the childsite and update the lists.
- #
- _packComponents
- _updateLists
- }
-
- # ------------------------------------------------------------------
- # DESTRUCTOR
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::destructor {} {
- if {$_packToken != ""} {after cancel $_packToken}
- if {$_updateToken != ""} {after cancel $_updateToken}
- }
-
- # ------------------------------------------------------------------
- # OPTIONS
- # ------------------------------------------------------------------
-
- # ------------------------------------------------------------------
- # OPTION: -childsitepos
- #
- # Specifies the position of the child site in the selection box.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::childsitepos {
- _packComponents
- }
-
- # ------------------------------------------------------------------
- # OPTION: -fileson
- #
- # Specifies whether or not to display the files list.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::fileson {
- _packComponents
- }
-
- # ------------------------------------------------------------------
- # OPTION: -dirson
- #
- # Specifies whether or not to display the dirs list.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::dirson {
- _packComponents
- }
-
- # ------------------------------------------------------------------
- # OPTION: -selectionon
- #
- # Specifies whether or not to display the selection entry widget.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::selectionon {
- _packComponents
- }
-
- # ------------------------------------------------------------------
- # OPTION: -filteron
- #
- # Specifies whether or not to display the filter entry widget.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::filteron {
- _packComponents
- }
-
- # ------------------------------------------------------------------
- # OPTION: -mask
- #
- # Specifies the initial file mask string.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::mask {
- global tcl_platform
- set prefix $_pwd
-
- #
- # Remove automounter paths.
- #
- if {$tcl_platform(platform) == "unix"} {
- if {$itk_option(-automount) != {}} {
- foreach autoDir $itk_option(-automount) {
- # Use catch because we can't be sure exactly what strings
- # were passed into the -automount option
- catch {
- if {[regsub ^/$autoDir $prefix {} prefix] != 0} {
- break
- }
- }
- }
- }
- }
-
- set curFilter $itk_option(-mask);
- $itk_component(filter) delete 0 end
- $itk_component(filter) insert 0 [file join $_pwd $itk_option(-mask)]
-
- #
- # Make sure the right most text is visable.
- #
- $itk_component(filter) xview moveto 1
- }
-
- # ------------------------------------------------------------------
- # OPTION: -directory
- #
- # Specifies the initial default directory.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::directory {
- if {$itk_option(-directory) != {}} {
- if {! [file exists $itk_option(-directory)]} {
- error "bad directory option \"$itk_option(-directory)\":\
- directory does not exist"
- }
-
- set olddir [pwd]
- cd $itk_option(-directory)
- set _pwd [pwd]
- cd $olddir
-
- configure -mask $itk_option(-mask)
- _selectFilter
- }
- }
-
- # ------------------------------------------------------------------
- # OPTION: -automount
- #
- # Specifies list of directory prefixes to ignore. Typically, this
- # option would be used with values such as:
- # -automount {export tmp_mnt}
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::automount {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -nomatchstring
- #
- # Specifies the string to be displayed in the files list should
- # not regular files exist in the directory.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::nomatchstring {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -dirsearchcommand
- #
- # Specifies a command to be executed to perform a directory search.
- # The command will receive the current working directory and filter
- # mask as arguments. The command should return a list of files which
- # will be placed into the directory list.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::dirsearchcommand {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -filesearchcommand
- #
- # Specifies a command to be executed to perform a file search.
- # The command will receive the current working directory and filter
- # mask as arguments. The command should return a list of files which
- # will be placed into the file list.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::filesearchcommand {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -selectioncommand
- #
- # Specifies a command to be executed upon pressing return in the
- # selection entry widget.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::selectioncommand {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -filtercommand
- #
- # Specifies a command to be executed upon pressing return in the
- # filter entry widget.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::filtercommand {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -selectdircommand
- #
- # Specifies a command to be executed following selection of a
- # directory in the directory list.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::selectdircommand {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -selectfilecommand
- #
- # Specifies a command to be executed following selection of a
- # file in the files list.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::selectfilecommand {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -invalid
- #
- # Specify a command to executed should the filter contents be
- # proven invalid.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::invalid {
- }
-
- # ------------------------------------------------------------------
- # OPTION: -filetype
- #
- # Specify the type of files which may appear in the file list.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::filetype {
- switch $itk_option(-filetype) {
- regular -
- directory -
- any {
- }
- default {
- error "bad filetype option \"$itk_option(-filetype)\":\
- should be regular, directory, or any"
- }
- }
-
- _updateLists
- }
-
- # ------------------------------------------------------------------
- # OPTION: -width
- #
- # Specifies the width of the file selection box. The value may be
- # specified in any of the forms acceptable to Tk_GetPixels.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::width {
- #
- # The width option was added to the hull in the constructor.
- # So, any width value given is passed automatically to the
- # hull. All we have to do is play with the propagation.
- #
- if {$itk_option(-width) != 0} {
- set propagate 0
- } else {
- set propagate 1
- }
-
- #
- # Due to a bug in the tk4.2 grid, we have to check the
- # propagation before setting it. Setting it to the same
- # value it already is will cause it to toggle.
- #
- if {[grid propagate $itk_component(hull)] != $propagate} {
- grid propagate $itk_component(hull) $propagate
- }
- }
-
- # ------------------------------------------------------------------
- # OPTION: -height
- #
- # Specifies the height of the file selection box. The value may be
- # specified in any of the forms acceptable to Tk_GetPixels.
- # ------------------------------------------------------------------
- itcl::configbody iwidgets::Fileselectionbox::height {
- #
- # The height option was added to the hull in the constructor.
- # So, any height value given is passed automatically to the
- # hull. All we have to do is play with the propagation.
- #
- if {$itk_option(-height) != 0} {
- set propagate 0
- } else {
- set propagate 1
- }
-
- #
- # Due to a bug in the tk4.2 grid, we have to check the
- # propagation before setting it. Setting it to the same
- # value it already is will cause it to toggle.
- #
- if {[grid propagate $itk_component(hull)] != $propagate} {
- grid propagate $itk_component(hull) $propagate
- }
- }
-
- # ------------------------------------------------------------------
- # METHODS
- # ------------------------------------------------------------------
-
- # ------------------------------------------------------------------
- # METHOD: childsite
- #
- # Returns the path name of the child site widget.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::childsite {} {
- return $itk_component(childsite)
- }
-
- # ------------------------------------------------------------------
- # METHOD: get
- #
- # Returns the current selection.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::get {} {
- return [$itk_component(selection) get]
- }
-
- # ------------------------------------------------------------------
- # METHOD: filter
- #
- # The user has pressed Return in the filter. Make sure the contents
- # contain a valid directory before setting default to directory.
- # Use the invalid option to warn the user of any problems.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::filter {} {
- set newdir [file dirname [$itk_component(filter) get]]
-
- if {! [file exists $newdir]} {
- uplevel #0 "$itk_option(-invalid)"
- return
- }
-
- set _pwd $newdir;
- if {$_pwd == "."} {set _pwd [pwd]};
-
- _updateLists
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _updateLists ?now?
- #
- # Updates the contents of both the file and directory lists, as well
- # resets the positions of the filter, and lists.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_updateLists {{when "later"}} {
- switch -- $when {
- later {
- if {$_updateToken == ""} {
- set _updateToken [after idle [itcl::code $this _updateLists now]]
- }
- }
- now {
- if {$itk_option(-dirson)} {_setDirList}
- if {$itk_option(-fileson)} {_setFileList}
-
- if {$itk_option(-filteron)} {
- _setFilter
- }
- if {$itk_option(-selectionon)} {
- $itk_component(selection) icursor end
- }
- if {$itk_option(-dirson)} {
- $itk_component(dirs) justify left
- }
- if {$itk_option(-fileson)} {
- $itk_component(files) justify left
- }
- set _updateToken ""
- }
- default {
- error "bad option \"$when\": should be later or now"
- }
- }
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _setFilter
- #
- # Set the filter to the current selection in the directory list plus
- # any existing mask in the filter. Translate the two special cases
- # of '.', and '..' directory names to full path names..
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_setFilter {} {
- global tcl_platform
- set prefix [$itk_component(dirs) getcurselection]
- set curFilter [file tail [$itk_component(filter) get]]
-
- while {[regexp {\.$} $prefix]} {
- if {[file tail $prefix] == "."} {
- if {$prefix == "."} {
- if {$_pwd == "."} {
- set _pwd [pwd]
- } elseif {$_pwd == ".."} {
- set _pwd [file dirname [pwd]]
- }
- set prefix $_pwd
- } else {
- set prefix [file dirname $prefix]
- }
- } elseif {[file tail $prefix] == ".."} {
- if {$prefix != ".."} {
- set prefix [file dirname [file dirname $prefix]]
- } else {
- if {$_pwd == "."} {
- set _pwd [pwd]
- } elseif {$_pwd == ".."} {
- set _pwd [file dirname [pwd]]
- }
- set prefix [file dirname $_pwd]
- }
- } else {
- break
- }
- }
-
- if { [file pathtype $prefix] != "absolute" } {
- set prefix [file join $_pwd $prefix]
- }
-
- #
- # Remove automounter paths.
- #
- if {$tcl_platform(platform) == "unix"} {
- if {$itk_option(-automount) != {}} {
- foreach autoDir $itk_option(-automount) {
- # Use catch because we can't be sure exactly what strings
- # were passed into the -automount option
- catch {
- if {[regsub ^/$autoDir $prefix {} prefix] != 0} {
- break
- }
- }
- }
- }
- }
-
- $itk_component(filter) delete 0 end
- $itk_component(filter) insert 0 [file join $prefix $curFilter]
-
- #
- # Make sure insertion cursor is at the end.
- #
- $itk_component(filter) icursor end
-
- #
- # Make sure the right most text is visable.
- #
- $itk_component(filter) xview moveto 1
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _setSelection
- #
- # Set the contents of the selection entry to either the current
- # selection of the file or directory list dependent on which lists
- # are currently mapped. For the file list, avoid seleciton of the
- # no match string. As for the directory list, translate file names.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_setSelection {} {
- global tcl_platform
- $itk_component(selection) delete 0 end
-
- if {$itk_option(-fileson)} {
- set selection [$itk_component(files) getcurselection]
-
- if {$selection != $itk_option(-nomatchstring)} {
- if {[file pathtype $selection] != "absolute"} {
- set selection [file join $_pwd $selection]
- }
-
- #
- # Remove automounter paths.
- #
- if {$tcl_platform(platform) == "unix"} {
- if {$itk_option(-automount) != {}} {
- foreach autoDir $itk_option(-automount) {
- # Use catch because we can't be sure exactly what strings
- # were passed into the -automount option
- catch {
- if {[regsub ^/$autoDir $selection {} selection] != 0} {
- break
- }
- }
- }
- }
- }
-
- $itk_component(selection) insert 0 $selection
- } else {
- $itk_component(files) selection clear 0 end
- }
-
- } else {
- set selection [$itk_component(dirs) getcurselection]
-
- if {[file tail $selection] == "."} {
- if {$selection != "."} {
- set selection [file dirname $selection]
- } else {
- set selection $_pwd
- }
- } elseif {[file tail $selection] == ".."} {
- if {$selection != ".."} {
- set selection [file dirname [file dirname $selection]]
- } else {
- set selection [file join $_pwd ..]
- }
- } else {
- set selection [file join $_pwd $selection]
- }
-
- #
- # Remove automounter paths.
- #
- if {$tcl_platform(platform) == "unix"} {
- if {$itk_option(-automount) != {}} {
- foreach autoDir $itk_option(-automount) {
- # Use catch because we can't be sure exactly what strings
- # were passed into the -automount option
- catch {
- if {[regsub ^/$autoDir $selection {} selection] != 0} {
- break
- }
- }
- }
- }
- }
-
- $itk_component(selection) delete 0 end
- $itk_component(selection) insert 0 $selection
- }
-
- $itk_component(selection) icursor end
-
- #
- # Make sure the right most text is visable.
- #
- $itk_component(selection) xview moveto 1
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _setDirList
- #
- # Clear the directory list and dependent on whether the user has
- # defined their own search procedure or not fill the list with their
- # results or those of a glob. Select the first element if it exists.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_setDirList {} {
- $itk_component(dirs) clear
-
- if {$itk_option(-dirsearchcommand) == {}} {
- foreach i [lsort [glob -nocomplain \
- [file join $_pwd .*] [file join $_pwd *]]] {
- if {[file isdirectory $i]} {
- $itk_component(dirs) insert end [file tail "$i"]
- }
- }
-
- } else {
- set mask [file tail [$itk_component(filter) get]]
-
- foreach file [uplevel #0 $itk_option(-dirsearchcommand) $_pwd $mask] {
- $itk_component(dirs) insert end $file
- }
- }
-
- if {[$itk_component(dirs) size]} {
- $itk_component(dirs) selection clear 0 end
- $itk_component(dirs) selection set 0
- }
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _setFileList
- #
- # Clear the file list and dependent on whether the user has defined
- # their own search procedure or not fill the list with their results
- # or those of a 'glob'. If the files list has no contents, then set
- # the files list to the 'nomatchstring'. Clear all selections.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_setFileList {} {
- $itk_component(files) clear
- set mask [file tail [$itk_component(filter) get]]
-
- if {$itk_option(-filesearchcommand) == {}} {
- if {$mask == "*"} {
- set files [lsort [glob -nocomplain \
- [file join $_pwd .*] [file join $_pwd *]]]
- } else {
- set files [lsort [glob -nocomplain [file join $_pwd $mask]]]
- }
-
- foreach i $files {
- if {($itk_option(-filetype) == "regular" && \
- ! [file isdirectory $i]) || \
- ($itk_option(-filetype) == "directory" && \
- [file isdirectory $i]) || \
- ($itk_option(-filetype) == "any")} {
- $itk_component(files) insert end [file tail "$i"]
- }
- }
-
- } else {
- foreach file [uplevel #0 $itk_option(-filesearchcommand) $_pwd $mask] {
- $itk_component(files) insert end $file
- }
- }
-
- if {[$itk_component(files) size] == 0} {
- if {$itk_option(-nomatchstring) != {}} {
- $itk_component(files) insert end $itk_option(-nomatchstring)
- }
- }
-
- $itk_component(files) selection clear 0 end
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _selectDir
- #
- # For a selection in the directory list, set the filter and possibly
- # the selection entry based on the fileson option.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_selectDir {} {
- _setFilter
-
- if {$itk_option(-fileson)} {} {
- _setSelection
- }
-
- if {$itk_option(-selectdircommand) != {}} {
- uplevel #0 $itk_option(-selectdircommand)
- }
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _dblSelectDir
- #
- # For a double click event in the directory list, select the
- # directory, set the default to the selection, and update both the
- # file and directory lists.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_dblSelectDir {} {
- filter
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _selectFile
- #
- # The user has selected a file. Put the current selection in the
- # file list in the selection entry widget.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_selectFile {} {
- _setSelection
-
- if {$itk_option(-selectfilecommand) != {}} {
- uplevel #0 $itk_option(-selectfilecommand)
- }
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _selectSelection
- #
- # The user has pressed Return in the selection entry widget. Call
- # the defined selection command if it exists.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_selectSelection {} {
- if {$itk_option(-selectioncommand) != {}} {
- uplevel #0 $itk_option(-selectioncommand)
- }
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _selectFilter
- #
- # The user has pressed Return in the filter entry widget. Call the
- # defined selection command if it exists, otherwise just filter.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_selectFilter {} {
- if {$itk_option(-filtercommand) != {}} {
- uplevel #0 $itk_option(-filtercommand)
- } else {
- filter
- }
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _packComponents
- #
- # Pack the selection, items, and child site widgets based on options.
- # Using the -in option of pack, put the childsite around the frame
- # in the hull for n, s, e, and w positions. Make sure and raise
- # the child site since using the 'in' option may obscure the site.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_packComponents {{when "later"}} {
- if {$when == "later"} {
- if {$_packToken == ""} {
- set _packToken [after idle [itcl::code $this _packComponents now]]
- }
- return
- } elseif {$when != "now"} {
- error "bad option \"$when\": should be now or later"
- }
-
- set _packToken ""
-
- #
- # Forget about any previous placements via the grid and
- # reset all the possible minsizes and weights for all
- # the rows and columns.
- #
- foreach component {childsite filter dirs files selection} {
- grid forget $itk_component($component)
- }
-
- for {set row 0} {$row < 6} {incr row} {
- grid rowconfigure $_interior $row -minsize 0 -weight 0
- }
-
- for {set col 0} {$col < 4} {incr col} {
- grid columnconfigure $_interior $col -minsize 0 -weight 0
- }
-
- #
- # Place all the components based on the childsite poisition
- # option.
- #
- switch $itk_option(-childsitepos) {
- n { _nPos }
-
- w { _wPos }
-
- s { _sPos }
-
- e { _ePos }
-
- center { _centerPos }
-
- top { _topPos }
-
- bottom { _bottomPos }
-
- default {
- error "bad childsitepos option \"$itk_option(-childsitepos)\":\
- should be n, e, s, w, center, top, or bottom"
- }
- }
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _nPos
- #
- # Position the childsite to the north and all the other components
- # appropriately based on the individual "on" options.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_nPos {} {
- grid $itk_component(childsite) -row 0 -column 0 \
- -columnspan 3 -rowspan 1 -sticky nsew
-
- if {$itk_option(-filteron)} {
- grid $itk_component(filter) -row 1 -column 0 \
- -columnspan 3 -sticky ew
- grid rowconfigure $_interior 2 -minsize 7
- }
-
- if {$itk_option(-dirson)} {
- grid $itk_component(dirs) -row 3 -column 0 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-fileson)} {
- grid $itk_component(files) -row 3 -column 2 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-dirson)} {
- if {$itk_option(-fileson)} {
- grid columnconfigure $_interior 1 -minsize 7
- } else {
- grid configure $itk_component(dirs) -columnspan 3 -column 0
- }
- } else {
- if {$itk_option(-fileson)} {
- grid configure $itk_component(files) -columnspan 3 -column 0
- }
- }
-
- grid rowconfigure $_interior 3 -weight 1
-
- if {$itk_option(-selectionon)} {
- grid rowconfigure $_interior 4 -minsize 7
- grid $itk_component(selection) -row 5 -column 0 \
- -columnspan 3 -sticky ew
- }
-
- grid columnconfigure $_interior 0 -weight 1
- grid columnconfigure $_interior 2 -weight 1
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _sPos
- #
- # Position the childsite to the south and all the other components
- # appropriately based on the individual "on" options.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_sPos {} {
- if {$itk_option(-filteron)} {
- grid $itk_component(filter) -row 0 -column 0 \
- -columnspan 3 -sticky ew
- grid rowconfigure $_interior 1 -minsize 7
- }
-
- if {$itk_option(-dirson)} {
- grid $itk_component(dirs) -row 2 -column 0 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-fileson)} {
- grid $itk_component(files) -row 2 -column 2 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-dirson)} {
- if {$itk_option(-fileson)} {
- grid columnconfigure $_interior 1 -minsize 7
- } else {
- grid configure $itk_component(dirs) -columnspan 3 -column 0
- }
- } else {
- if {$itk_option(-fileson)} {
- grid configure $itk_component(files) -columnspan 3 -column 0
- }
- }
-
- grid rowconfigure $_interior 2 -weight 1
-
- if {$itk_option(-selectionon)} {
- grid rowconfigure $_interior 3 -minsize 7
- grid $itk_component(selection) -row 4 -column 0 \
- -columnspan 3 -sticky ew
- }
-
- grid $itk_component(childsite) -row 5 -column 0 \
- -columnspan 3 -rowspan 1 -sticky nsew
- grid columnconfigure $_interior 0 -weight 1
- grid columnconfigure $_interior 2 -weight 1
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _ePos
- #
- # Position the childsite to the east and all the other components
- # appropriately based on the individual "on" options.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_ePos {} {
- if {$itk_option(-filteron)} {
- grid $itk_component(filter) -row 0 -column 0 \
- -columnspan 3 -sticky ew
- grid rowconfigure $_interior 1 -minsize 7
- }
-
- if {$itk_option(-dirson)} {
- grid $itk_component(dirs) -row 2 -column 0 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-fileson)} {
- grid $itk_component(files) -row 2 -column 2 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-dirson)} {
- if {$itk_option(-fileson)} {
- grid columnconfigure $_interior 1 -minsize 7
- } else {
- grid configure $itk_component(dirs) -columnspan 3 -column 0
- }
- } else {
- if {$itk_option(-fileson)} {
- grid configure $itk_component(files) -columnspan 3 -column 0
- }
- }
-
- grid rowconfigure $_interior 2 -weight 1
-
- if {$itk_option(-selectionon)} {
- grid rowconfigure $_interior 3 -minsize 7
- grid $itk_component(selection) -row 4 -column 0 \
- -columnspan 3 -sticky ew
- }
-
- grid $itk_component(childsite) -row 0 -column 3 \
- -rowspan 5 -columnspan 1 -sticky nsew
- grid columnconfigure $_interior 0 -weight 1
- grid columnconfigure $_interior 2 -weight 1
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _wPos
- #
- # Position the childsite to the west and all the other components
- # appropriately based on the individual "on" options.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_wPos {} {
- grid $itk_component(childsite) -row 0 -column 0 \
- -rowspan 5 -columnspan 1 -sticky nsew
-
- if {$itk_option(-filteron)} {
- grid $itk_component(filter) -row 0 -column 1 \
- -columnspan 3 -sticky ew
- grid rowconfigure $_interior 1 -minsize 7
- }
-
- if {$itk_option(-dirson)} {
- grid $itk_component(dirs) -row 2 -column 1 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-fileson)} {
- grid $itk_component(files) -row 2 -column 3 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-dirson)} {
- if {$itk_option(-fileson)} {
- grid columnconfigure $_interior 2 -minsize 7
- } else {
- grid configure $itk_component(dirs) -columnspan 3 -column 1
- }
- } else {
- if {$itk_option(-fileson)} {
- grid configure $itk_component(files) -columnspan 3 -column 1
- }
- }
-
- grid rowconfigure $_interior 2 -weight 1
-
- if {$itk_option(-selectionon)} {
- grid rowconfigure $_interior 3 -minsize 7
- grid $itk_component(selection) -row 4 -column 1 \
- -columnspan 3 -sticky ew
- }
-
- grid columnconfigure $_interior 1 -weight 1
- grid columnconfigure $_interior 3 -weight 1
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _topPos
- #
- # Position the childsite below the filter but above the lists and
- # all the other components appropriately based on the individual
- # "on" options.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_topPos {} {
- if {$itk_option(-filteron)} {
- grid $itk_component(filter) -row 0 -column 0 \
- -columnspan 3 -sticky ew
- }
-
- grid $itk_component(childsite) -row 1 -column 0 \
- -columnspan 3 -rowspan 1 -sticky nsew
-
- if {$itk_option(-dirson)} {
- grid $itk_component(dirs) -row 2 -column 0 -sticky nsew
- }
- if {$itk_option(-fileson)} {
- grid $itk_component(files) -row 2 -column 2 -sticky nsew
- }
- if {$itk_option(-dirson)} {
- if {$itk_option(-fileson)} {
- grid columnconfigure $_interior 1 -minsize 7
- } else {
- grid configure $itk_component(dirs) -columnspan 3 -column 0
- }
- } else {
- if {$itk_option(-fileson)} {
- grid configure $itk_component(files) -columnspan 3 -column 0
- }
- }
-
- grid rowconfigure $_interior 2 -weight 1
-
- if {$itk_option(-selectionon)} {
- grid rowconfigure $_interior 3 -minsize 7
- grid $itk_component(selection) -row 4 -column 0 \
- -columnspan 3 -sticky ew
- }
-
- grid columnconfigure $_interior 0 -weight 1
- grid columnconfigure $_interior 2 -weight 1
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _centerPos
- #
- # Position the childsite between the lists and all the other
- # components appropriately based on the individual "on" options.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_centerPos {} {
- if {$itk_option(-filteron)} {
- grid $itk_component(filter) -row 0 -column 0 \
- -columnspan 3 -sticky ew
- grid rowconfigure $_interior 1 -minsize 7
- }
-
- if {$itk_option(-dirson)} {
- grid $itk_component(dirs) -row 2 -column 0 \
- -columnspan 1 -sticky nsew
- }
- if {$itk_option(-fileson)} {
- grid $itk_component(files) -row 2 -column 2 \
- -columnspan 1 -sticky nsew
- }
- grid $itk_component(childsite) -row 2 \
- -columnspan 1 -rowspan 1 -sticky nsew
-
- if {$itk_option(-dirson)} {
- if {$itk_option(-fileson)} {
- grid configure $itk_component(childsite) -column 1
- grid columnconfigure $_interior 0 -weight 1
- grid columnconfigure $_interior 2 -weight 1
-
- } else {
- grid configure $itk_component(dirs) -columnspan 2 -column 0
- grid configure $itk_component(childsite) -column 2
- grid columnconfigure $_interior 0 -weight 1
- grid columnconfigure $_interior 1 -weight 1
- }
- } else {
- grid configure $itk_component(childsite) -column 0
- if {$itk_option(-fileson)} {
- grid configure $itk_component(files) -columnspan 2 \
- -column 1
- grid columnconfigure $_interior 1 -weight 1
- grid columnconfigure $_interior 2 -weight 1
- } else {
- grid columnconfigure $_interior 0 -weight 1
- }
- }
-
- grid rowconfigure $_interior 2 -weight 1
-
- if {$itk_option(-selectionon)} {
- grid rowconfigure $_interior 3 -minsize 7
- grid $itk_component(selection) -row 4 -column 0 \
- -columnspan 3 -sticky ew
- }
- }
-
- # ------------------------------------------------------------------
- # PRIVATE METHOD: _bottomPos
- #
- # Position the childsite below the lists and above the selection
- # and all the other components appropriately based on the individual
- # "on" options.
- # ------------------------------------------------------------------
- itcl::body iwidgets::Fileselectionbox::_bottomPos {} {
- if {$itk_option(-filteron)} {
- grid $itk_component(filter) -row 0 -column 0 \
- -columnspan 3 -sticky ew
- grid rowconfigure $_interior 1 -minsize 7
- }
-
- if {$itk_option(-dirson)} {
- grid $itk_component(dirs) -row 2 -column 0 -sticky nsew
- }
- if {$itk_option(-fileson)} {
- grid $itk_component(files) -row 2 -column 2 -sticky nsew
- }
- if {$itk_option(-dirson)} {
- if {$itk_option(-fileson)} {
- grid columnconfigure $_interior 1 -minsize 7
- } else {
- grid configure $itk_component(dirs) -columnspan 3 -column 0
- }
- } else {
- if {$itk_option(-fileson)} {
- grid configure $itk_component(files) -columnspan 3 -column 0
- }
- }
- grid rowconfigure $_interior 2 -weight 1
-
- grid $itk_component(childsite) -row 3 -column 0 \
- -columnspan 3 -rowspan 1 -sticky nsew
-
- if {$itk_option(-selectionon)} {
- grid $itk_component(selection) -row 4 -column 0 \
- -columnspan 3 -sticky ew
- }
-
- grid columnconfigure $_interior 0 -weight 1
- grid columnconfigure $_interior 2 -weight 1
- }
-