extfileselectionbox.itk

这是一个Linux下的集成开发环境

# ------------------------------------------------------------------
# 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.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::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.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::filesearchcommand {
}

# ------------------------------------------------------------------
# OPTION: -selectioncommand
#
# Specifies a command to be executed upon pressing return in the
# selection entry widget.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::selectioncommand {
}

# ------------------------------------------------------------------
# OPTION: -filtercommand
#
# Specifies a command to be executed upon pressing return in the
# filter entry widget.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::filtercommand {
}

# ------------------------------------------------------------------
# OPTION: -selectdircommand
#
# Specifies a command to be executed following selection of a
# directory in the directory list.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::selectdircommand {
}

# ------------------------------------------------------------------
# OPTION: -selectfilecommand
#
# Specifies a command to be executed following selection of a
# file in the files list.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::selectfilecommand {
}

# ------------------------------------------------------------------
# OPTION: -invalid
#
# Specify a command to executed should the filter contents be
# proven invalid.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::invalid {
}

# ------------------------------------------------------------------
# OPTION: -filetype
#
# Specify the type of files which may appear in the file list.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::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.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::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.
# ------------------------------------------------------------------
configbody iwidgets::Extfileselectionbox::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.
# ------------------------------------------------------------------
body iwidgets::Extfileselectionbox::childsite {} {
    return $itk_component(childsite)
}

# ------------------------------------------------------------------
# METHOD: get
#
# Returns the current selection.
# ------------------------------------------------------------------
body iwidgets::Extfileselectionbox::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.
# ------------------------------------------------------------------
body iwidgets::Extfileselectionbox::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.
# ------------------------------------------------------------------
body iwidgets::Extfileselectionbox::_updateLists {{when "later"}} {
    switch -- $when {
        later {
            if {$_updateToken == ""} {
                set _updateToken [after idle [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..
# ------------------------------------------------------------------
body iwidgets::Extfileselectionbox::_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"} {
	    regsub {^/(tmp_mnt|export)} $prefix {} prefix
    }

    $itk_component(filter) delete entry 0 end
    $itk_component(filter) insert entry 0 [file join $prefix $curFilter]

    if {[info level -1] != "_selectDir"} {
	$itk_component(filter) insert list 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) component entry] 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.
# ------------------------------------------------------------------
body iwidgets::Extfileselectionbox::_setSelection {} {
    global tcl_platform
    $itk_component(selection) delete entry 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"} {
		regsub {^/(tmp_mnt|export)} $selection {} selection;
	    }

	    $itk_component(selection) insert entry 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"} {
            regsub {^/(tmp_mnt|export)} $selection {} selection;
        }

        $itk_component(selection) insert entry 0 $selection
    }

    $itk_component(selection) insert list 0 $selection
    $itk_component(selection) icursor end

    #
    # Make sure the right most text is visable.
    #
    [$itk_component(selection) component entry] 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.
# ------------------------------------------------------------------
body iwidgets::Extfileselectionbox::_setDirList {} {
    $itk_component(dirs) clear

    if {$itk_option(-dirsearchcommand) == {}} {
        set cwd $_pwd

        foreach i [lsort [glob -nocomplain \