From: Jeff Hobbs <hobbs@users.sourceforge.net>
Date: Thu, 14 Jul 2005 22:57:44 +0000 (+0000)
Subject: 	* tkcon.tcl: add ::tkcon::OPT(maxlinelen) (default 0 == unlimited)
X-Git-Tag: tkcon-2-5~25
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=7c444e0736e854e8c7e4f5146df8faef500455df;p=tkcon

	* 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 a6f9da9..3d69473 100644
--- 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 7a30f8f..a76ac40 100755
--- 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]