Tk Library Source Code

Artifact [c84d1857ce]
Login

Artifact c84d1857cefba53111e134c0f10f2d5f49025887:

Attachment "tcllib.udiff" to ticket [1063774fff] added by andreas_kupries 2005-02-19 07:13:58.
Index: modules/textutil/split.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/split.tcl,v
retrieving revision 1.5
diff -w -u -r1.5 split.tcl
--- modules/textutil/split.tcl	1 May 2003 22:40:19 -0000	1.5
+++ modules/textutil/split.tcl	19 Feb 2005 00:06:39 -0000
@@ -2,16 +2,17 @@
 
     namespace eval split {
 
-	namespace export splitx
+	namespace export splitx splitn
 
 	# This will be redefined later. We need it just to let
 	# a chance for the next import subcommand to work
 	#
 	proc splitx [list str [list regexp "\[\t \r\n\]+"]] {}
+	proc splitn {str {len 1}} {}
     }
 
-    namespace import -force split::splitx
-    namespace export splitx
+    namespace import -force split::splitx split::splitn
+    namespace export splitx splitn
 
 }
 
@@ -100,3 +101,52 @@
     }
     
 }
+
+#
+# splitn --
+#
+# splitn splits the string $str into chunks of length $len.  These
+# chunks are returned as a list.
+#
+# If $str really contains a ByteArray object (as retrieved from binary
+# encoded channels) splitn must honor this by splitting the string
+# into chunks of $len bytes.
+#
+# It is an error to call splitn with a nonpositive $len.
+#
+# If splitn is called with an empty string, it returns the empty list.
+#
+# If the length of $str is not an entire multiple of the chunk length,
+# the last chunk in the generated list will be shorter than $len.
+#
+# The implementation presented here was given by Bryan Oakley, as
+# part of a ``contest'' I staged on c.l.t in July 2004.  I selected
+# this version, as it does not rely on runtime generated code, is
+# very fast for chunk size one, not too bad in all the other cases,
+# and uses [split] or [string range] which have been around for quite
+# some time.
+#
+# -- Robert Suetterlin ([email protected])
+#
+proc ::textutil::split::splitn {str {len 1}} {
+
+    if {$len <= 0} {
+        return -code error "len must be > 0"
+    }
+
+    if {$len == 1} {
+        return [split $str {}]
+    }
+
+    set result [list]
+    set max [string length $str]
+    set i 0
+    set j [expr {$len -1}]
+    while {$i < $max} {
+        lappend result [string range $str $i $j]
+        incr i $len
+        incr j $len
+    }
+
+    return $result
+}
Index: modules/textutil/split.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/textutil/split.test,v
retrieving revision 1.2
diff -w -u -r1.2 split.test
--- modules/textutil/split.test	11 Dec 2001 21:49:43 -0000	1.2
+++ modules/textutil/split.test	19 Feb 2005 00:06:39 -0000
@@ -1,5 +1,5 @@
-# split.test:  tests for the split sub-package of the textutil package.
 # -*- tcl -*-
+# split.test:  tests for the split sub-package of the textutil package.
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
@@ -17,6 +17,37 @@
 
 ###################################################
 
+test splitn-0.1 {split empty string} {
+    ::textutil::splitn ""
+} [list]
+
+test splitn-0.2 {split empty string with explicit lenght 1} {
+    ::textutil::splitn "" 1
+} [list]
+
+test splitn-0.3 {split empty string with explicit lenght 2} {
+    ::textutil::splitn "" 2
+} [list]
+
+test splitn-1.1 {split simple string} {
+    ::textutil::splitn "abc"
+} [list a b c]
+
+test splitn-1.2 {split simple string with explicit length 1} {
+    ::textutil::splitn "abc" 1
+} [list a b c]
+
+test splitn-1.3 {split simple string with explicit length 2} {
+    ::textutil::splitn "abc" 2
+} [list ab c]
+
+test splitn-2.1 {split with nonpositive lenght ->error!} {
+    catch {::textutil::splitn "abc" 0} msg
+    set msg
+} {len must be > 0}
+
+###################################################
+
 test splitx-0.1 {split simple string} {
     ::textutil::splitx "Hello, Word"
 } [ list Hello, Word ]