* tkcon.tcl (ExpandXotcl): allow for xotcl method name expansion,

	if you change ::tkcon::OPT(expandorder) to include Xotcl before
	Procname

diff --git a/ChangeLog b/ChangeLog
index 92f4ebe3801f1d83cc7ee831e90839acb49cc612..b4728fcd968718fffed59666632cbc85099e4880 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2005-04-06  Jeff Hobbs  <jeffh@ActiveState.com>
+
+       * tkcon.tcl (ExpandXotcl): allow for xotcl method name expansion,
+       if you change ::tkcon::OPT(expandorder) to include Xotcl before
+       Procname
+
 2005-02-21  Jeff Hobbs  <jeffh@ActiveState.com>
 
        * tkcon.tcl (::send::send): propagate -displayof to winfo interps

diff --git a/tkcon.tcl b/tkcon.tcl
index e3dd8fc66ffae4e0cba82be63da4f13b708e4217..2508d3583058684807565b125ec70fb3851610e8 100755 (executable)
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -125,6 +125,7 @@ proc ::tkcon::Init {args} {
        if {![info exists COLOR($key)]} { set COLOR($key) $default }
     }
 
+    # expandorder could also include 'Xotcl' (before Procname)
     foreach {key default} {
        autoload        {}
        blinktime       500
@@ -5585,6 +5586,32 @@ proc ::tkcon::ExpandProcname str {
     return $match
 }
 
+## ::tkcon::ExpandXotcl - expand an xotcl method name based on $str
+# ARGS:        str     - partial proc name to expand
+# Calls:       ::tkcon::ExpandBestMatch
+# Returns:     list containing longest unique match followed by all the
+#              possible further matches
+##
+proc ::tkcon::ExpandXotcl str {
+    # in a first step, get the cmd to check, if we should handle subcommands
+    set cmd [::tkcon::CmdGet $::tkcon::PRIV(console)]
+    # Only do the xotcl magic if there are two cmds and xotcl is loaded
+    if {[llength $cmd] != 2
+       || ![EvalAttached [list info exists ::xotcl::version]]} {
+       return
+    }
+    set obj [lindex $cmd 0]
+    set sub [lindex $cmd 1]
+    set match [EvalAttached [list $obj info methods $sub*]]
+    if {[llength $match] > 1} {
+       regsub -all {([^\\]) } [ExpandBestMatch $match $str] {\1\\ } str
+       set match [linsert $match 0 $str]
+    } else {
+       regsub -all {([^\\]) } $match {\1\\ } match
+    }
+    return $match
+}
+
 ## ::tkcon::ExpandVariable - expand a tcl variable name based on $str
 # ARGS:        str     - partial tcl var name to expand
 # Calls:       ::tkcon::ExpandBestMatch