tkcon OO hot error patch

--- tkcon.tcl	2014-12-06 13:39:41.000000000 +0100
+++ tkcon_patched.tcl	2014-12-06 15:07:30.000000000 +0100
@@ -2156,6 +2156,21 @@
     return [expr {[llength [$w tag ranges find]]/2}]
 }
 
+## ::tkcon::Goto - highlights a line in the text widget
+## If $str is empty, it just deletes any highlighting
+# ARGS: w	- text widget
+#	pos	- line to highlight
+##
+proc ::tkcon::Goto {w pos} {
+    $w tag remove gotopos 1.0 end
+    set truth {^(1|yes|true|on)$}
+    if {$pos eq ""} { return }
+
+    $w tag add gotopos ${pos}.0 ${pos}.end
+    $w tag configure gotopos -background $::tkcon::COLOR(blink)
+    catch {$w see gotopos.first}
+}
+
 ## ::tkcon::Attach - called to attach tkcon to an interpreter
 # ARGS:	name	- application name to which tkcon sends commands
 #		  This is either a slave interperter name or tk appname.
@@ -3105,6 +3120,26 @@
 		    {[list $OPT(edit) -attach $app -type proc -- $cmd]}"
 	}
     }
+    
+    # do voodoo for class methods, less vodoo than for procs
+    set info [$w get 1.0 end-1c]
+    # Check for specific line error in a proc
+    set exp(method) {\(class\s+"([^"]*)"\s+method\s+"([^"]*)"\s+line\s+(\d+)\)}
+    set positions [regexp -inline -all -indices $exp(method) $info]
+    set pieces [regexp -inline -all  $exp(method) $info]
+
+    foreach {all _ _ _} $positions {_ class method line} $pieces {
+	lassign $all start end
+	set tag [UniqueTag $w]
+	if {$end <= $start} { incr end }
+
+	$w tag add $tag 1.0+${start}c 1.0+${end}c
+	$w tag configure $tag -foreground $COLOR(stdout)
+	$w tag bind $tag <Enter> [list $w tag configure $tag -under 1]
+	$w tag bind $tag <Leave> [list $w tag configure $tag -under 0]
+	$w tag bind $tag <ButtonRelease-1> "if {!\$tk::Priv(mouseMoved)} \
+	    {[list $OPT(edit) -attach $app -type oomethod -goto $line -- [list $class $method]]}"
+    }
 }
 
 proc ::tkcon::ExpectInit {{termcap 1} {terminfo 1}} {
@@ -3847,10 +3882,11 @@
     variable ::tkcon::COLOR
     variable ::tkcon::OPT
 
-    array set opts {-find {} -type {} -attach {} -wrap {none}}
+    array set opts {-find {} -type {} -attach {} -wrap {none} -goto {}}
     while {[string match -* [lindex $args 0]]} {
 	switch -glob -- [lindex $args 0] {
 	    -f*	{ set opts(-find) [lindex $args 1] }
+	    -g*	{ set opts(-goto) [lindex $args 1] }
 	    -a*	{ set opts(-attach) [lindex $args 1] }
 	    -t*	{ set opts(-type) [lindex $args 1] }
 	    -w*	{ set opts(-wrap) [lindex $args 1] }
@@ -3970,6 +4006,14 @@
 		    [::tkcon::EvalOther $app $type dump proc [list $word]]
 	    after idle [::tkcon::Highlight $w.text tcl]
 	}
+	oomethod {
+	    # a method from TclOO
+	    $w.text insert 1.0 \
+		    [::tkcon::EvalOther $app $type dump oomethod [list $word]]
+	    after idle [::tkcon::Highlight $w.text tcl]
+
+	}
+
 	var*	{
 	    $w.text insert 1.0 \
 		    [::tkcon::EvalOther $app $type dump var [list $word]]
@@ -4001,6 +4045,10 @@
     if {[string compare $opts(-find) {}]} {
 	::tkcon::Find $w.text $opts(-find) -case 1
     }
+    if {[string compare $opts(-goto) {}]} {
+	# mark the line indicated by goto and place the cursor there
+	::tkcon::Goto $w.text $opts(-goto)	
+    }
 }
 interp alias {} ::more {} ::edit
 interp alias {} ::less {} ::edit
@@ -4212,6 +4260,15 @@
 		}
 	    }
 	}
+	oomethod {
+	    set classmethod [lindex $args 0 0]
+	    lassign $classmethod class method
+	    set code [catch {info class definition {*}$classmethod} res]
+	    if {!$code} {
+		set res "oo::define [list $class] [list $method] $res"
+	    }
+	}
+
 	w* {
 	    # widget
 	    ## The user should have Tk loaded