Ticket #27242: port.tcl-completion.patch

File port.tcl-completion.patch, 3.2 KB (added by outis, 14 years ago)

adds action completion

  • port.

    old new  
    38253825    \
    38263826    quit        [list action_exit           [ACTION_ARGS_NONE]] \
    38273827    exit        [list action_exit           [ACTION_ARGS_NONE]] \
    38283828]
    38293829
     3830# Expand "action".
     3831# Returns an action proc, or a list of matching action procs, or the action passed in
     3832proc find_action { action } {
     3833    global action_array
     3834   
     3835    if { ! [info exists action_array($action)] } {
     3836        set guess [guess_action $action]
     3837        if { [info exists action_array($guess)] } {
     3838            return $guess
     3839        }
     3840        return $guess
     3841    }
     3842   
     3843    return $action
     3844}
     3845
     3846# Expand action
     3847# If there's more than one match, return the next possibility
    38303848proc find_action_proc { action } {
    38313849    global action_array
    38323850   
    38333851    set action_proc ""
    38343852    if { [info exists action_array($action)] } {
    38353853        set action_proc [lindex $action_array($action) 0]
     3854    } else {
     3855        set action [complete_action $action]
     3856        if { [info exists action_array($action)] } {
     3857            set action_proc [lindex $action_array($action) 0]
     3858        }
     3859    }
     3860   
     3861    return $action_proc
     3862}
     3863
     3864proc get_action_proc { action } {
     3865    global action_array
     3866   
     3867    set action_proc ""
     3868    if { [info exists action_array($action)] } {
     3869        set action_proc [lindex $action_array($action) 0]
    38363870    }
    38373871   
    38383872    return $action_proc
    38393873}
    38403874
     
    41124146        # Reset global_options from base before each action, as we munge it just below...
    41134147        array unset global_options
    41144148        array set global_options $global_options_base
    41154149       
    41164150        # Find an action to execute
    4117         set action_proc [find_action_proc $action]
    4118         if { $action_proc == "" } {
    4119             puts "Unrecognized action \"$action\""
     4151        #set action_proc [find_action_proc $action]
     4152        set actions [find_action $action]
     4153        if {[llength $actions] == 1} {
     4154            set action [lindex $actions 0]
     4155            set action_proc [get_action_proc $action]
     4156        } else {
     4157            if {[llength $actions] > 1} {
     4158                puts "Ambiguous action \"$action\": could be any of {$actions}."
     4159            } else {
     4160                puts "Unrecognized action \"$action\""
     4161            }
    41204162            set action_status 1
    41214163            break
    41224164        }
    41234165
    41244166        # Parse options that will be unique to this action
     
    42044246   
    42054247    return $word
    42064248}
    42074249
    42084250
     4251# return text action beginning with $text
    42094252proc complete_action { text state } {   
    42104253    global action_array
    42114254    global complete_choices complete_position
    42124255
    42134256    if {$state == 0} {
     
    42194262    incr complete_position
    42204263
    42214264    return $word
    42224265}
    42234266
     4267# return all actions beginning with $text
     4268proc guess_action { text } {   
     4269    global action_array
     4270
     4271    return [array names action_array "[string tolower $text]*"]
     4272
     4273    if { [llength $complete_choices ] == 1 } {
     4274        return [lindex $complete_choices 0]
     4275    }
     4276
     4277    return {}
     4278}
    42244279
    42254280proc attempt_completion { text word start end } {
    42264281    # If the word starts with '~', or contains '.' or '/', then use the build-in
    42274282    # completion to complete the word
    42284283    if { [regexp {^~|[/.]} $word] } {