* tkcon.tcl: add ::tkcon::OPT(maxlinelen) (default 0 == unlimited)

	and 'tkcon linelength ?value?' to optionally limit long result
	lines.  True result is still captured in $_ (and 'puts $_' works).

diff --git a/ChangeLog b/ChangeLog
index a6f9da96d40b3adc5df6a2261e3c5707ee9e2ec5..3d69473839b79593530d49d382a882c42170c3c3 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2005-07-14  Jeff Hobbs  <jeffh@ActiveState.com>
+
+       * tkcon.tcl: add ::tkcon::OPT(maxlinelen) (default 0 == unlimited)
+       and 'tkcon linelength ?value?' to optionally limit long result
+       lines.  True result is still captured in $_ (and 'puts $_' works).
+
 2005-05-25  Jeff Hobbs  <jeffh@ActiveState.com>
 
        * tkcon.tcl (InitMenus): add ActiveTcl Help menu item, if AT Help

diff --git a/tkcon.tcl b/tkcon.tcl
index 7a30f8fcf6a1f20da96572274ef33540666f2e22..a76ac408ffd5b53775571323bf97cd5488e2690e 100755 (executable)
--- a/tkcon.tcl
+++ b/tkcon.tcl
@@ -131,6 +131,7 @@ proc ::tkcon::Init {args} {
        blinktime       500
        blinkrange      1
        buffer          512
+       maxlinelen      0
        calcmode        0
        cols            80
        debugPrompt     {(level \#$level) debug [history nextid] > }
@@ -430,6 +431,11 @@ proc ::tkcon::Init {args} {
     }
     StateCheckpoint $PRIV(name) slave
 
+    puts "buffer line limit:\
+       [expr {$OPT(buffer)?$OPT(buffer):{unlimited}}]  \
+       max line length:\
+       [expr {$OPT(maxlinelen)?$OPT(maxlinelen):{unlimited}}]"
+
     Prompt "$title console display active (Tcl$::tcl_patchLevel / Tk$::tk_patchLevel)\n"
 }
 
@@ -958,10 +964,18 @@ proc ::tkcon::EvalCmd {w cmd} {
            }
            AddSlaveHistory $cmd
            catch {EvalAttached [list set _ $res]}
+           set maxlen $OPT(maxlinelen)
+           set trailer ""
+           if {($maxlen > 0) && ([string length $res] > $maxlen)} {
+               # If we exceed maximum desired output line length, truncate
+               # the result and add "...+${num}b" in error coloring
+               set trailer ...+[expr {[string length $res]-$maxlen}]b
+               set res [string range $res 0 $maxlen]
+           }
            if {$code} {
                if {$OPT(hoterrors)} {
                    set tag [UniqueTag $w]
-                   $w insert output $res [list stderr $tag] \n stderr
+                   $w insert output $res [list stderr $tag] \n$trailer stderr
                    $w tag bind $tag <Enter> \
                            [list $w tag configure $tag -under 1]
                    $w tag bind $tag <Leave> \
@@ -970,10 +984,10 @@ proc ::tkcon::EvalCmd {w cmd} {
                            "if {!\[info exists tkPriv(mouseMoved)\] || !\$tkPriv(mouseMoved)} \
                            {[list $OPT(edit) -attach [Attach] -type error -- $PRIV(errorInfo)]}"
                } else {
-                   $w insert output $res\n stderr
+                   $w insert output $res\n$trailer stderr
                }
            } elseif {[string compare {} $res]} {
-               $w insert output $res\n stdout
+               $w insert output $res stdout $trailer stderr \n stdout
            }
        }
     }
@@ -1257,7 +1271,7 @@ proc ::tkcon::UniqueTag {w} {
 # Outputs:     may delete data in console widget
 ## 
 proc ::tkcon::ConstrainBuffer {w size} {
-    if {[$w index end] > $size} {
+    if {$size && ([$w index end] > $size)} {
        $w delete 1.0 [expr {int([$w index end])-$size}].0
     }
 }
@@ -3292,6 +3306,17 @@ proc tkcon {cmd args} {
            }
            return $OPT(buffer)
        }
+       linelen* {
+           ## 'linelength' Sets/Query the maximum line length
+           if {[llength $args]} {
+               if {[regexp {^-?[0-9]+$} $args]} {
+                   set OPT(maxlinelen) $args
+               } else {
+                   return -code error "buffer must be a valid integer"
+               }
+           }
+           return $OPT(maxlinelen)
+       }
        bg* {
            ## 'bgerror' Brings up an error dialog
            set errorInfo [lindex $args 1]