fileselectionbox.itk

windows下的GDB insight前端

# ------------------------------------------------------------------
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) != {}} {