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

	if available

diff --git a/ChangeLog b/ChangeLog
index c98a497df23bfc7f31be0e2b1e0fcc74c085ba85..8d9f2b081b5c5e6ce6ba384304c5dab9ebef387b 100644 (file)
--- 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 4b403fa1551fb608b30ea88889522c4021a3b56c..e4857df17852077c3cfeb29e128fed801e3429d9 100755 (executable)
--- 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]