From: Jeff Hobbs <hobbs@users.sourceforge.net>
Date: Thu, 7 Apr 2005 05:34:00 +0000 (+0000)
Subject: 	* tkcon.tcl (ExpandXotcl): allow for xotcl method name expansion,
X-Git-Tag: tkcon-2-5~27
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=45c568023aecea5b5f60328271a448c9fbd7ae8e;p=tkcon

	* 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 92f4ebe..b4728fc 100644
--- 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 e3dd8fc..2508d35 100755
--- 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