fileselectionbox.itk

windows下的GDB insight前端

#
# 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: [e-mail]
#
#  @(#) $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.