5 ;;; String utilities of various kinds
7 ;;; (c) 2005 Straylight/Edgeware
10 ;;;----- Licensing notice ---------------------------------------------------
12 ;;; This program is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
17 ;;; This program is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with this program; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
27 (:use #:common-lisp #:mdw.base)
28 (:export #:join-strings #:str-next-word #:str-split-words
29 #:str-beginsp #:str-endsp))
30 (in-package #:mdw.str)
32 (defun join-strings (del strs)
33 "Join together the strings STRS with DEL between them. All the arguments
34 are first converted to strings, as if by `stringify'. Otherwise, this is
35 like Perl's join operator."
36 (setf del (stringify del))
37 (with-output-to-string (s)
40 (princ (stringify (pop strs)) s)
45 (defun str-next-word (string &key quotedp start end)
46 "Extract a whitespace-delimited word from STRING, returning it and the
47 index to continue parsing from. If no word is found, return nil twice.
48 If QUOTEDP, then allow quoting and backslashifying; otherwise don't. The
49 START and END arguments limit the portion of the string to be processed;
50 the default to 0 and nil (end of string), as usual."
51 (setf-default start 0 end (length string))
56 :element-type 'character
60 ;; Find the start of the next word.
63 (return-from str-next-word (values nil nil)))
64 (let ((ch (char string i)))
65 (unless (whitespace-char-p ch)
69 ;; Now pull off a word.
73 (let ((ch (char string i)))
74 (cond ((and quotedp (eql ch #\\))
77 (vector-push-extend ch w)
82 (vector-push-extend ch w))
83 ((whitespace-char-p ch)
86 (vector-push-extend ch w))
93 (vector-push-extend ch w))))
100 (let ((ch (char string i)))
101 (unless (whitespace-char-p ch)
106 (values (make-array (length w)
107 :element-type 'character
111 (defun str-split-words (string &key quotedp start end max)
112 "Break STRING into words, like str-next-word does, returning the list of
113 the individual words. If QUOTEDP, then allow quoting and backslashifying;
114 otherwise don't. No more than MAX `words' are returned: if the maximum is
115 hit, then the last `word' is unbroken, and may still contain quotes and
116 escape characters. The START and END arguments limit the portion of the
117 string to be processed in the usual way."
119 (return-from str-split-words nil))
124 (str-next-word string
130 (when (and max (= (1+ n) max))
131 (push (subseq string start end) l)
133 (setf start nextstart)
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))))
151 (declaim (inline str-endsp))
152 (defun str-endsp (string suffix &key (start1 0) end1 (start2 0) end2)
153 "Returns true if STRING (or the appropriate substring of it) ends with
155 (setf-default end1 (length string)
156 end2 (length suffix))
157 (let ((strlen (- end1 start1))
158 (suflen (- end2 start2)))
159 (and (>= strlen suflen)
160 (string= string suffix
161 :start1 (- end1 suflen) :end1 end1
162 :start2 start2 :end2 end2))))
164 ;;;----- That's all, folks --------------------------------------------------