Changeset 79259

Timestamp:

06/07/11 02:38:40 (4 years ago)

Author:

jmr@…

Message:

allow abbreviation of actions (#27242)

File:

• trunk/base/src/port/port.tcl (modified) (4 diffs)

trunk/base/src/port/port.tcl

@@ -3834 +3834 @@
 ]
 
+# Expand "action".
+# Returns an action proc, or a list of matching action procs, or the action passed in
+proc find_action { action } {
+    global action_array
+    
+    if { ! [info exists action_array($action)] } {
+        set guess [guess_action $action]
+        if { [info exists action_array($guess)] } {
+            return $guess
+        }
+        return $guess
+    }
+    
+    return $action
+}
+
+# Expand action
+# If there's more than one match, return the next possibility
 proc find_action_proc { action } {
+    global action_array
+    
+    set action_proc ""
+    if { [info exists action_array($action)] } {
+        set action_proc [lindex $action_array($action) 0]
+    } else {
+        set action [complete_action $action]
+        if { [info exists action_array($action)] } {
+            set action_proc [lindex $action_array($action) 0]
+        }
+    }
+    
+    return $action_proc
+}
+
+proc get_action_proc { action } {
     global action_array
     
@@ -4121 +4155 @@
         
         # Find an action to execute
-        set action_proc [find_action_proc $action]
-        if { $action_proc == "" } {
-            puts "Unrecognized action \"$action\""
+        set actions [find_action $action]
+        if {[llength $actions] == 1} {
+            set action [lindex $actions 0]
+            set action_proc [get_action_proc $action]
+        } else {
+            if {[llength $actions] > 1} {
+                puts "Ambiguous action \"$action\": could be any of {$actions}."
+            } else {
+                puts "Unrecognized action \"$action\""
+            }
             set action_status 1
             break
@@ -4213 +4254 @@
 
 
+# return text action beginning with $text
 proc complete_action { text state } {   
     global action_array
@@ -4228 +4270 @@
 }
 
+# return all actions beginning with $text
+proc guess_action { text } {   
+    global action_array
+
+    return [array names action_array "[string tolower $text]*"]
+
+    if { [llength $complete_choices ] == 1 } {
+        return [lindex $complete_choices 0]
+    }
+
+    return {}
+}
 
 proc attempt_completion { text word start end } {