1
;;;; string-fun.scm --- string manipulation functions
3
;;;; Copyright (C) 1995, 1996, 1997, 1999, 2001, 2006 Free Software Foundation, Inc.
5
;;;; This library is free software; you can redistribute it and/or
6
;;;; modify it under the terms of the GNU Lesser General Public
7
;;;; License as published by the Free Software Foundation; either
8
;;;; version 2.1 of the License, or (at your option) any later version.
10
;;;; This library is distributed in the hope that it will be useful,
11
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13
;;;; Lesser General Public License for more details.
15
;;;; You should have received a copy of the GNU Lesser General Public
16
;;;; License along with this library; if not, write to the Free Software
17
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20
(define-module (ice-9 string-fun)
21
:export (split-after-char split-before-char split-discarding-char
22
split-after-char-last split-before-char-last
23
split-discarding-char-last split-before-predicate
24
split-after-predicate split-discarding-predicate
25
separate-fields-discarding-char separate-fields-after-char
26
separate-fields-before-char string-prefix-predicate string-prefix=?
27
sans-surrounding-whitespace sans-trailing-whitespace
28
sans-leading-whitespace sans-final-newline has-trailing-newline?))
32
;;; Various string funcitons, particularly those that take
33
;;; advantage of the "shared substring" capability.
36
;;; {String Fun: Dividing Strings Into Fields}
38
;;; The names of these functions are very regular.
39
;;; Here is a grammar of a call to one of these:
41
;;; <string-function-invocation>
42
;;; := (<action>-<seperator-disposition>-<seperator-determination> <seperator-param> <str> <ret>)
44
;;; <str> = the string
46
;;; <ret> = The continuation. String functions generally return
47
;;; multiple values by passing them to this procedure.
52
;;; "split" means to divide a string into two parts.
53
;;; <ret> will be called with two arguments.
55
;;; "separate-fields" means to divide a string into as many
56
;;; parts as possible. <ret> will be called with
57
;;; however many fields are found.
59
;;; <seperator-disposition> = before
63
;;; "before" means to leave the seperator attached to
64
;;; the beginning of the field to its right.
65
;;; "after" means to leave the seperator attached to
66
;;; the end of the field to its left.
67
;;; "discarding" means to discard seperators.
69
;;; Other dispositions might be handy. For example, "isolate"
70
;;; could mean to treat the separator as a field unto itself.
72
;;; <seperator-determination> = char
75
;;; "char" means to use a particular character as field seperator.
76
;;; "predicate" means to check each character using a particular predicate.
78
;;; Other determinations might be handy. For example, "character-set-member".
80
;;; <seperator-param> = A parameter that completes the meaning of the determinations.
81
;;; For example, if the determination is "char", then this parameter
82
;;; says which character. If it is "predicate", the parameter is the
88
;;; (separate-fields-discarding-char #\, "foo, bar, baz, , bat" list)
89
;;; => ("foo" " bar" " baz" " " " bat")
91
;;; (split-after-char #\- 'an-example-of-split list)
92
;;; => ("an-" "example-of-split")
94
;;; As an alternative to using a determination "predicate", or to trying to do anything
95
;;; complicated with these functions, consider using regular expressions.
98
(define (split-after-char char str ret)
100
((string-index str char) => 1+)
101
(else (string-length str)))))
102
(ret (substring str 0 end)
103
(substring str end))))
105
(define (split-before-char char str ret)
106
(let ((end (or (string-index str char)
107
(string-length str))))
108
(ret (substring str 0 end)
109
(substring str end))))
111
(define (split-discarding-char char str ret)
112
(let ((end (string-index str char)))
115
(ret (substring str 0 end)
116
(substring str (1+ end))))))
118
(define (split-after-char-last char str ret)
120
((string-rindex str char) => 1+)
122
(ret (substring str 0 end)
123
(substring str end))))
125
(define (split-before-char-last char str ret)
126
(let ((end (or (string-rindex str char) 0)))
127
(ret (substring str 0 end)
128
(substring str end))))
130
(define (split-discarding-char-last char str ret)
131
(let ((end (string-rindex str char)))
134
(ret (substring str 0 end)
135
(substring str (1+ end))))))
137
(define (split-before-predicate pred str ret)
140
((= n (string-length str)) (ret str ""))
141
((not (pred (string-ref str n))) (loop (1+ n)))
142
(else (ret (substring str 0 n)
143
(substring str n))))))
144
(define (split-after-predicate pred str ret)
147
((= n (string-length str)) (ret str ""))
148
((not (pred (string-ref str n))) (loop (1+ n)))
149
(else (ret (substring str 0 (1+ n))
150
(substring str (1+ n)))))))
152
(define (split-discarding-predicate pred str ret)
155
((= n (string-length str)) (ret str ""))
156
((not (pred (string-ref str n))) (loop (1+ n)))
157
(else (ret (substring str 0 n)
158
(substring str (1+ n)))))))
160
(define (separate-fields-discarding-char ch str ret)
161
(let loop ((fields '())
164
((string-rindex str ch)
165
=> (lambda (w) (loop (cons (substring str (+ 1 w)) fields)
166
(substring str 0 w))))
167
(else (apply ret str fields)))))
169
(define (separate-fields-after-char ch str ret)
171
(let loop ((fields '())
174
((string-index str ch)
175
=> (lambda (w) (loop (cons (substring str 0 (+ 1 w)) fields)
176
(substring str (+ 1 w)))))
177
(else (apply ret str fields))))))
179
(define (separate-fields-before-char ch str ret)
180
(let loop ((fields '())
183
((string-rindex str ch)
184
=> (lambda (w) (loop (cons (substring str w) fields)
185
(substring str 0 w))))
186
(else (apply ret str fields)))))
189
;;; {String Fun: String Prefix Predicates}
193
;;; (define-public ((string-prefix-predicate pred?) prefix str)
194
;;; (and (<= (string-length prefix) (string-length str))
195
;;; (pred? prefix (substring str 0 (string-length prefix)))))
197
;;; (define-public string-prefix=? (string-prefix-predicate string=?))
200
(define ((string-prefix-predicate pred?) prefix str)
201
(and (<= (string-length prefix) (string-length str))
202
(pred? prefix (substring str 0 (string-length prefix)))))
204
(define string-prefix=? (string-prefix-predicate string=?))
207
;;; {String Fun: Strippers}
209
;;; <stripper> = sans-<removable-part>
211
;;; <removable-part> = surrounding-whitespace
212
;;; | trailing-whitespace
213
;;; | leading-whitespace
217
(define (sans-surrounding-whitespace s)
219
(end (string-length s)))
220
(while (and (< st (string-length s))
221
(char-whitespace? (string-ref s st)))
223
(while (and (< 0 end)
224
(char-whitespace? (string-ref s (1- end))))
228
(substring s st end))))
230
(define (sans-trailing-whitespace s)
232
(end (string-length s)))
233
(while (and (< 0 end)
234
(char-whitespace? (string-ref s (1- end))))
238
(substring s st end))))
240
(define (sans-leading-whitespace s)
242
(end (string-length s)))
243
(while (and (< st (string-length s))
244
(char-whitespace? (string-ref s st)))
248
(substring s st end))))
250
(define (sans-final-newline str)
252
((= 0 (string-length str))
255
((char=? #\nl (string-ref str (1- (string-length str))))
256
(substring str 0 (1- (string-length str))))
260
;;; {String Fun: has-trailing-newline?}
263
(define (has-trailing-newline? str)
264
(and (< 0 (string-length str))
265
(char=? #\nl (string-ref str (1- (string-length str))))))
269
;;; {String Fun: with-regexp-parts}
271
;;; This relies on the older, hairier regexp interface, which we don't
272
;;; particularly want to implement, and it's not used anywhere, so
273
;;; we're just going to drop it for now.
274
;;; (define-public (with-regexp-parts regexp fields str return fail)
275
;;; (let ((parts (regexec regexp str fields)))
276
;;; (if (number? parts)
278
;;; (apply return parts))))
added
removed
ice-9/string-fun.scm
