1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
|
;;;; string-fun.scm --- string manipulation functions
;;;;
;;;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;
(define-module (ice-9 string-fun))
;;;;
;;;
;;; Various string funcitons, particularly those that take
;;; advantage of the "shared substring" capability.
;;;
;;; {String Fun: Dividing Strings Into Fields}
;;;
;;; The names of these functions are very regular.
;;; Here is a grammar of a call to one of these:
;;;
;;; <string-function-invocation>
;;; := (<action>-<seperator-disposition>-<seperator-determination> <seperator-param> <str> <ret>)
;;;
;;; <str> = the string
;;;
;;; <ret> = The continuation. String functions generally return
;;; multiple values by passing them to this procedure.
;;;
;;; <action> = split
;;; | separate-fields
;;;
;;; "split" means to divide a string into two parts.
;;; <ret> will be called with two arguments.
;;;
;;; "separate-fields" means to divide a string into as many
;;; parts as possible. <ret> will be called with
;;; however many fields are found.
;;;
;;; <seperator-disposition> = before
;;; | after
;;; | discarding
;;;
;;; "before" means to leave the seperator attached to
;;; the beginning of the field to its right.
;;; "after" means to leave the seperator attached to
;;; the end of the field to its left.
;;; "discarding" means to discard seperators.
;;;
;;; Other dispositions might be handy. For example, "isolate"
;;; could mean to treat the separator as a field unto itself.
;;;
;;; <seperator-determination> = char
;;; | predicate
;;;
;;; "char" means to use a particular character as field seperator.
;;; "predicate" means to check each character using a particular predicate.
;;;
;;; Other determinations might be handy. For example, "character-set-member".
;;;
;;; <seperator-param> = A parameter that completes the meaning of the determinations.
;;; For example, if the determination is "char", then this parameter
;;; says which character. If it is "predicate", the parameter is the
;;; predicate.
;;;
;;;
;;; For example:
;;;
;;; (separate-fields-discarding-char #\, "foo, bar, baz, , bat" list)
;;; => ("foo" " bar" " baz" " " " bat")
;;;
;;; (split-after-char #\- 'an-example-of-split list)
;;; => ("an-" "example-of-split")
;;;
;;; As an alternative to using a determination "predicate", or to trying to do anything
;;; complicated with these functions, consider using regular expressions.
;;;
(define-public (split-after-char char str ret)
(let ((end (cond
((string-index str char) => 1+)
(else (string-length str)))))
(ret (make-shared-substring str 0 end)
(make-shared-substring str end))))
(define-public (split-before-char char str ret)
(let ((end (or (string-index str char)
(string-length str))))
(ret (make-shared-substring str 0 end)
(make-shared-substring str end))))
(define-public (split-discarding-char char str ret)
(let ((end (string-index str char)))
(if (not end)
(ret str "")
(ret (make-shared-substring str 0 end)
(make-shared-substring str (1+ end))))))
(define-public (split-after-char-last char str ret)
(let ((end (cond
((string-rindex str char) => 1+)
(else 0))))
(ret (make-shared-substring str 0 end)
(make-shared-substring str end))))
(define-public (split-before-char-last char str ret)
(let ((end (or (string-rindex str char) 0)))
(ret (make-shared-substring str 0 end)
(make-shared-substring str end))))
(define-public (split-discarding-char-last char str ret)
(let ((end (string-rindex str char)))
(if (not end)
(ret str "")
(ret (make-shared-substring str 0 end)
(make-shared-substring str (1+ end))))))
(define (split-before-predicate pred str ret)
(let loop ((n 0))
(cond
((= n (string-length str)) (ret str ""))
((not (pred (string-ref str n))) (loop (1+ n)))
(else (ret (make-shared-substring str 0 n)
(make-shared-substring str n))))))
(define (split-after-predicate pred str ret)
(let loop ((n 0))
(cond
((= n (string-length str)) (ret str ""))
((not (pred (string-ref str n))) (loop (1+ n)))
(else (ret (make-shared-substring str 0 (1+ n))
(make-shared-substring str (1+ n)))))))
(define (split-discarding-predicate pred str ret)
(let loop ((n 0))
(cond
((= n (string-length str)) (ret str ""))
((not (pred (string-ref str n))) (loop (1+ n)))
(else (ret (make-shared-substring str 0 n)
(make-shared-substring str (1+ n)))))))
(define-public (separate-fields-discarding-char ch str ret)
(let loop ((fields '())
(str str))
(cond
((string-rindex str ch)
=> (lambda (w) (loop (cons (make-shared-substring str (+ 1 w)) fields)
(make-shared-substring str 0 w))))
(else (apply ret str fields)))))
(define-public (separate-fields-after-char ch str ret)
(reverse
(let loop ((fields '())
(str str))
(cond
((string-index str ch)
=> (lambda (w) (loop (cons (make-shared-substring str 0 (+ 1 w)) fields)
(make-shared-substring str (+ 1 w)))))
(else (apply ret str fields))))))
(define-public (separate-fields-before-char ch str ret)
(let loop ((fields '())
(str str))
(cond
((string-rindex str ch)
=> (lambda (w) (loop (cons (make-shared-substring str w) fields)
(make-shared-substring str 0 w))))
(else (apply ret str fields)))))
;;; {String Fun: String Prefix Predicates}
;;;
;;; Very simple:
;;;
;;; (define-public ((string-prefix-predicate pred?) prefix str)
;;; (and (<= (string-length prefix) (string-length str))
;;; (pred? prefix (make-shared-substring str 0 (string-length prefix)))))
;;;
;;; (define-public string-prefix=? (string-prefix-predicate string=?))
;;;
(define-public ((string-prefix-predicate pred?) prefix str)
(and (<= (string-length prefix) (string-length str))
(pred? prefix (make-shared-substring str 0 (string-length prefix)))))
(define-public string-prefix=? (string-prefix-predicate string=?))
;;; {String Fun: Strippers}
;;;
;;; <stripper> = sans-<removable-part>
;;;
;;; <removable-part> = surrounding-whitespace
;;; | trailing-whitespace
;;; | leading-whitespace
;;; | final-newline
;;;
(define-public (sans-surrounding-whitespace s)
(let ((st 0)
(end (string-length s)))
(while (and (< st (string-length s))
(char-whitespace? (string-ref s st)))
(set! st (1+ st)))
(while (and (< 0 end)
(char-whitespace? (string-ref s (1- end))))
(set! end (1- end)))
(if (< end st)
""
(make-shared-substring s st end))))
(define-public (sans-trailing-whitespace s)
(let ((st 0)
(end (string-length s)))
(while (and (< 0 end)
(char-whitespace? (string-ref s (1- end))))
(set! end (1- end)))
(if (< end st)
""
(make-shared-substring s st end))))
(define-public (sans-leading-whitespace s)
(let ((st 0)
(end (string-length s)))
(while (and (< st (string-length s))
(char-whitespace? (string-ref s st)))
(set! st (1+ st)))
(if (< end st)
""
(make-shared-substring s st end))))
(define-public (sans-final-newline str)
(cond
((= 0 (string-length str))
str)
((char=? #\nl (string-ref str (1- (string-length str))))
(make-shared-substring str 0 (1- (string-length str))))
(else str)))
;;; {String Fun: has-trailing-newline?}
;;;
(define-public (has-trailing-newline? str)
(and (< 0 (string-length str))
(char=? #\nl (string-ref str (1- (string-length str))))))
;;; {String Fun: with-regexp-parts}
;;; This relies on the older, hairier regexp interface, which we don't
;;; particularly want to implement, and it's not used anywhere, so
;;; we're just going to drop it for now.
;;; (define-public (with-regexp-parts regexp fields str return fail)
;;; (let ((parts (regexec regexp str fields)))
;;; (if (number? parts)
;;; (fail parts)
;;; (apply return parts))))
|