| 1 | # split.tcl -- |
|---|
| 2 | # |
|---|
| 3 | # Various ways of splitting a string. |
|---|
| 4 | # |
|---|
| 5 | # Copyright (c) 2000 by Ajuba Solutions. |
|---|
| 6 | # Copyright (c) 2000 by Eric Melski <ericm@ajubasolutions.com> |
|---|
| 7 | # Copyright (c) 2001 by Reinhard Max <max@suse.de> |
|---|
| 8 | # Copyright (c) 2003 by Pat Thoyts <patthoyts@users.sourceforge.net> |
|---|
| 9 | # Copyright (c) 2001-2006 by Andreas Kupries <andreas_kupries@users.sourceforge.net> |
|---|
| 10 | # |
|---|
| 11 | # See the file "license.terms" for information on usage and redistribution |
|---|
| 12 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
|---|
| 13 | # |
|---|
| 14 | # RCS: @(#) $Id: split.tcl,v 1.7 2006/04/21 04:42:28 andreas_kupries Exp $ |
|---|
| 15 | |
|---|
| 16 | # ### ### ### ######### ######### ######### |
|---|
| 17 | ## Requirements |
|---|
| 18 | |
|---|
| 19 | package require Tcl 8.2 |
|---|
| 20 | |
|---|
| 21 | namespace eval ::textutil::split {} |
|---|
| 22 | |
|---|
| 23 | ######################################################################## |
|---|
| 24 | # This one was written by Bob Techentin (RWT in Tcl'ers Wiki): |
|---|
| 25 | # http://www.techentin.net |
|---|
| 26 | # mailto:techentin.robert@mayo.edu |
|---|
| 27 | # |
|---|
| 28 | # Later, he send me an email stated that I can use it anywhere, because |
|---|
| 29 | # no copyright was added, so the code is defacto in the public domain. |
|---|
| 30 | # |
|---|
| 31 | # You can found it in the Tcl'ers Wiki here: |
|---|
| 32 | # http://mini.net/cgi-bin/wikit/460.html |
|---|
| 33 | # |
|---|
| 34 | # Bob wrote: |
|---|
| 35 | # If you need to split string into list using some more complicated rule |
|---|
| 36 | # than builtin split command allows, use following function. It mimics |
|---|
| 37 | # Perl split operator which allows regexp as element separator, but, |
|---|
| 38 | # like builtin split, it expects string to split as first arg and regexp |
|---|
| 39 | # as second (optional) By default, it splits by any amount of whitespace. |
|---|
| 40 | # Note that if you add parenthesis into regexp, parenthesed part of separator |
|---|
| 41 | # would be added into list as additional element. Just like in Perl. -- cary |
|---|
| 42 | # |
|---|
| 43 | # Speed improvement by Reinhard Max: |
|---|
| 44 | # Instead of repeatedly copying around the not yet matched part of the |
|---|
| 45 | # string, I use [regexp]'s -start option to restrict the match to that |
|---|
| 46 | # part. This reduces the complexity from something like O(n^1.5) to |
|---|
| 47 | # O(n). My test case for that was: |
|---|
| 48 | # |
|---|
| 49 | # foreach i {1 10 100 1000 10000} { |
|---|
| 50 | # set s [string repeat x $i] |
|---|
| 51 | # puts [time {splitx $s .}] |
|---|
| 52 | # } |
|---|
| 53 | # |
|---|
| 54 | |
|---|
| 55 | if {[package vsatisfies [package provide Tcl] 8.3]} { |
|---|
| 56 | |
|---|
| 57 | proc ::textutil::split::splitx {str {regexp {[\t \r\n]+}}} { |
|---|
| 58 | # Bugfix 476988 |
|---|
| 59 | if {[string length $str] == 0} { |
|---|
| 60 | return {} |
|---|
| 61 | } |
|---|
| 62 | if {[string length $regexp] == 0} { |
|---|
| 63 | return [::split $str ""] |
|---|
| 64 | } |
|---|
| 65 | set list {} |
|---|
| 66 | set start 0 |
|---|
| 67 | while {[regexp -start $start -indices -- $regexp $str match submatch]} { |
|---|
| 68 | foreach {subStart subEnd} $submatch break |
|---|
| 69 | foreach {matchStart matchEnd} $match break |
|---|
| 70 | incr matchStart -1 |
|---|
| 71 | incr matchEnd |
|---|
| 72 | lappend list [string range $str $start $matchStart] |
|---|
| 73 | if {$subStart >= $start} { |
|---|
| 74 | lappend list [string range $str $subStart $subEnd] |
|---|
| 75 | } |
|---|
| 76 | set start $matchEnd |
|---|
| 77 | } |
|---|
| 78 | lappend list [string range $str $start end] |
|---|
| 79 | return $list |
|---|
| 80 | } |
|---|
| 81 | |
|---|
| 82 | } else { |
|---|
| 83 | # For tcl <= 8.2 we do not have regexp -start... |
|---|
| 84 | proc ::textutil::split::splitx [list str [list regexp "\[\t \r\n\]+"]] { |
|---|
| 85 | |
|---|
| 86 | if {[string length $str] == 0} { |
|---|
| 87 | return {} |
|---|
| 88 | } |
|---|
| 89 | if {[string length $regexp] == 0} { |
|---|
| 90 | return [::split $str {}] |
|---|
| 91 | } |
|---|
| 92 | |
|---|
| 93 | set list {} |
|---|
| 94 | while {[regexp -indices -- $regexp $str match submatch]} { |
|---|
| 95 | lappend list [string range $str 0 [expr {[lindex $match 0] -1}]] |
|---|
| 96 | if {[lindex $submatch 0] >= 0} { |
|---|
| 97 | lappend list [string range $str [lindex $submatch 0] \ |
|---|
| 98 | [lindex $submatch 1]] |
|---|
| 99 | } |
|---|
| 100 | set str [string range $str [expr {[lindex $match 1]+1}] end] |
|---|
| 101 | } |
|---|
| 102 | lappend list $str |
|---|
| 103 | return $list |
|---|
| 104 | } |
|---|
| 105 | |
|---|
| 106 | } |
|---|
| 107 | |
|---|
| 108 | # |
|---|
| 109 | # splitn -- |
|---|
| 110 | # |
|---|
| 111 | # splitn splits the string $str into chunks of length $len. These |
|---|
| 112 | # chunks are returned as a list. |
|---|
| 113 | # |
|---|
| 114 | # If $str really contains a ByteArray object (as retrieved from binary |
|---|
| 115 | # encoded channels) splitn must honor this by splitting the string |
|---|
| 116 | # into chunks of $len bytes. |
|---|
| 117 | # |
|---|
| 118 | # It is an error to call splitn with a nonpositive $len. |
|---|
| 119 | # |
|---|
| 120 | # If splitn is called with an empty string, it returns the empty list. |
|---|
| 121 | # |
|---|
| 122 | # If the length of $str is not an entire multiple of the chunk length, |
|---|
| 123 | # the last chunk in the generated list will be shorter than $len. |
|---|
| 124 | # |
|---|
| 125 | # The implementation presented here was given by Bryan Oakley, as |
|---|
| 126 | # part of a ``contest'' I staged on c.l.t in July 2004. I selected |
|---|
| 127 | # this version, as it does not rely on runtime generated code, is |
|---|
| 128 | # very fast for chunk size one, not too bad in all the other cases, |
|---|
| 129 | # and uses [split] or [string range] which have been around for quite |
|---|
| 130 | # some time. |
|---|
| 131 | # |
|---|
| 132 | # -- Robert Suetterlin (robert@mpe.mpg.de) |
|---|
| 133 | # |
|---|
| 134 | proc ::textutil::split::splitn {str {len 1}} { |
|---|
| 135 | |
|---|
| 136 | if {$len <= 0} { |
|---|
| 137 | return -code error "len must be > 0" |
|---|
| 138 | } |
|---|
| 139 | |
|---|
| 140 | if {$len == 1} { |
|---|
| 141 | return [split $str {}] |
|---|
| 142 | } |
|---|
| 143 | |
|---|
| 144 | set result [list] |
|---|
| 145 | set max [string length $str] |
|---|
| 146 | set i 0 |
|---|
| 147 | set j [expr {$len -1}] |
|---|
| 148 | while {$i < $max} { |
|---|
| 149 | lappend result [string range $str $i $j] |
|---|
| 150 | incr i $len |
|---|
| 151 | incr j $len |
|---|
| 152 | } |
|---|
| 153 | |
|---|
| 154 | return $result |
|---|
| 155 | } |
|---|
| 156 | |
|---|
| 157 | # ### ### ### ######### ######### ######### |
|---|
| 158 | ## Data structures |
|---|
| 159 | |
|---|
| 160 | namespace eval ::textutil::split { |
|---|
| 161 | namespace export splitx splitn |
|---|
| 162 | } |
|---|
| 163 | |
|---|
| 164 | # ### ### ### ######### ######### ######### |
|---|
| 165 | ## Ready |
|---|
| 166 | |
|---|
| 167 | package provide textutil::split 0.7 |
|---|