3 ;;; String utilities of various kinds
5 ;;; (c) 2005 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 2 of the License, or
13 ;;; (at your option) any later version.
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software Foundation,
22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
25 (:use #:common-lisp #:mdw.base))
26 (in-package #:mdw.str)
28 (export 'join-strings)
29 (defun join-strings (del strs)
30 "Join together the strings STRS with DEL between them. All the arguments
31 are first converted to strings, as if by `stringify'. Otherwise, this is
32 like Perl's join operator."
33 (setf del (stringify del))
34 (with-output-to-string (s)
37 (princ (stringify (pop strs)) s)
42 (export 'str-next-word)
43 (defun str-next-word (string &key quotedp start end)
44 "Extract a whitespace-delimited word from STRING, returning it and the
45 index to continue parsing from. If no word is found, return nil twice.
46 If QUOTEDP, then allow quoting and backslashifying; otherwise don't. The
47 START and END arguments limit the portion of the string to be processed;
48 the default to 0 and nil (end of string), as usual."
49 (setf-default start 0 end (length string))
54 :element-type 'character
58 ;; Find the start of the next word.
61 (return-from str-next-word (values nil nil)))
62 (let ((ch (char string i)))
63 (unless (whitespace-char-p ch)
67 ;; Now pull off a word.
71 (let ((ch (char string i)))
72 (cond ((and quotedp (eql ch #\\))
75 (vector-push-extend ch w)
80 (vector-push-extend ch w))
81 ((whitespace-char-p ch)
84 (vector-push-extend ch w))
91 (vector-push-extend ch w))))
98 (let ((ch (char string i)))
99 (unless (whitespace-char-p ch)
104 (values (make-array (length w)
105 :element-type 'character
109 (export 'str-split-words)
110 (defun str-split-words (string &key quotedp start end max)
111 "Break STRING into words, like str-next-word does, returning the list of
112 the individual words. If QUOTEDP, then allow quoting and backslashifying;
113 otherwise don't. No more than MAX `words' are returned: if the maximum is
114 hit, then the last `word' is unbroken, and may still contain quotes and
115 escape characters. The START and END arguments limit the portion of the
116 string to be processed in the usual way."
118 (return-from str-split-words nil))
123 (str-next-word string
129 (when (and max (= (1+ n) max))
130 (push (subseq string start end) l)
132 (setf start nextstart)
137 (export 'str-beginsp)
138 (declaim (inline str-beginsp))
139 (defun str-beginsp (string prefix &key (start1 0) end1 (start2 0) end2)
140 "Returns true if STRING (or the appropriate substring of it) begins with
142 (setf-default end1 (length string)
143 end2 (length prefix))
144 (let ((strlen (- end1 start1))
145 (prelen (- end2 start2)))
146 (and (>= strlen prelen)
147 (string= string prefix
148 :start1 start1 :end1 (+ start1 prelen)
149 :start2 start2 :end2 end2))))
152 (declaim (inline str-endsp))
153 (defun str-endsp (string suffix &key (start1 0) end1 (start2 0) end2)
154 "Returns true if STRING (or the appropriate substring of it) ends with
156 (setf-default end1 (length string)
157 end2 (length suffix))
158 (let ((strlen (- end1 start1))
159 (suflen (- end2 start2)))
160 (and (>= strlen suflen)
161 (string= string suffix
162 :start1 (- end1 suflen) :end1 end1
163 :start2 start2 :end2 end2))))
165 ;;;----- That's all, folks --------------------------------------------------