extfileselectionbox.itk

windows下的GDB insight前端

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

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

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

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

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

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

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

# ------------------------------------------------------------------
# METHOD: get
#
# Returns the current selection.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectionbox::_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::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"} {
        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 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.
# ------------------------------------------------------------------
itcl::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"} {
            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 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"} {
        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 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
#