From: Jeff Hobbs <hobbs@users.sourceforge.net>
Date: Sun, 10 Oct 2004 22:55:14 +0000 (+0000)
Subject: 	* tkcon.tcl (::tkcon::Highlight): use ctext for the 'edit' dialog
X-Git-Tag: tkcon-2-5~32
X-Git-Url: http://privyetmir.co.uk/gitweb?a=commitdiff_plain;h=eda16d45ebd20fd56ab7c5e67497503ef94ad3f3;p=tkcon

	* tkcon.tcl (::tkcon::Highlight): use ctext for the 'edit' dialog
	if available
---

diff --git a/ChangeLog b/ChangeLog
index c98a497..8d9f2b0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-10-10  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* tkcon.tcl (::tkcon::Highlight): use ctext for the 'edit' dialog
+	if available
+
 2004-07-26  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	**** TKCON 2.4 TAGGED FOR RELEASE ****
diff --git a/tkcon.tcl b/tkcon.tcl
index 4b403fa..e4857df 100755
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -44,7 +44,9 @@ if {$tcl_version < 8.0} {
     package require -exact Tk $tcl_version
 }
 
-catch {package require bogus-package-name}
+# We need to load some package to get what's available, and we
+# choose ctext because we'll use it if its available in the editor
+catch {package require ctext}
 foreach pkg [info loaded {}] {
     set file [lindex $pkg 0]
     set name [lindex $pkg 1]
@@ -2800,11 +2802,45 @@ proc ::tkcon::Event {int {str {}}} {
     $w see end
 }
 
-## ::tkcon::ErrorHighlight - magic error highlighting
+## ::tkcon::Highlight - magic highlighting
 ## beware: voodoo included
 # ARGS:
 ##
-proc ::tkcon::ErrorHighlight w {
+proc ::tkcon::Highlight {w type} {
+    variable COLOR
+    variable OPT
+
+    switch -exact $type {
+	"error" { HighlightError $w }
+	"tcl" - "test" {
+	    if {[winfo class $w] != "Ctext"} { return }
+
+	    foreach {app type} [tkcon attach] {break}
+	    set cmds [::tkcon::EvalOther $app $type info commands]
+
+	    set classes [list \
+		 [list comment ClassForRegexp "^\\s*#\[^\n\]*" $COLOR(stderr)] \
+		 [list var     ClassWithOnlyCharStart "\$" $COLOR(stdout)] \
+		 [list syntax  ClassForSpecialChars "\[\]{}\"" $COLOR(prompt)] \
+		 [list command Class $cmds $COLOR(proc)] \
+		]
+
+	    # Remove all highlight classes from a widget
+	    ctext::clearHighlightClasses $w
+	    foreach class $classes {
+		foreach {cname ctype cptn ccol} $class break
+		ctext::addHighlight$ctype $w $cname $ccol $cptn
+	    }
+	    $w highlight 1.0 end
+	}
+    }
+}
+
+## ::tkcon::HighlightError - magic error highlighting
+## beware: voodoo included
+# ARGS:
+##
+proc ::tkcon::HighlightError w {
     variable COLOR
     variable OPT
 
@@ -3626,7 +3662,12 @@ proc edit {args} {
 	    wm title $w "$word - tkcon Edit"
 	}
 
-	text $w.text -wrap none \
+	if {[package provide ctext] != ""} {
+	    set txt [ctext $w.text]
+	} else {
+	    set txt [text $w.text]
+	}
+	$w.text configure -wrap none \
 		-xscrollcommand [list $w.sx set] \
 		-yscrollcommand [list $w.sy set] \
 		-foreground $::tkcon::COLOR(stdin) \
@@ -3693,10 +3734,12 @@ proc edit {args} {
 	proc*	{
 	    $w.text insert 1.0 \
 		    [::tkcon::EvalOther $app $type dump proc [list $word]]
+	    after idle [::tkcon::Highlight $w.text tcl]
 	}
 	var*	{
 	    $w.text insert 1.0 \
 		    [::tkcon::EvalOther $app $type dump var [list $word]]
+	    after idle [::tkcon::Highlight $w.text tcl]
 	}
 	file	{
 	    $w.text insert 1.0 [::tkcon::EvalOther $app $type eval \
@@ -3708,10 +3751,12 @@ proc edit {args} {
 		return \$__tkcon(data)
 	    }
 	    ]]
+	    after idle [::tkcon::Highlight $w.text \
+			    [string trimleft [file extension $word] .]]
 	}
 	error*	{
 	    $w.text insert 1.0 [join $args \n]
-	    ::tkcon::ErrorHighlight $w.text
+	    after idle [::tkcon::Highlight $w.text error]
 	}
 	default	{
 	    $w.text insert 1.0 [join $args \n]