Commit | Line | Data |
---|---|---|
861345b4 | 1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; $Id$ | |
4 | ;;; | |
5 | ;;; String utilities of various kinds | |
6 | ;;; | |
7 | ;;; (c) 2005 Straylight/Edgeware | |
8 | ;;; | |
9 | ||
10 | ;;;----- Licensing notice --------------------------------------------------- | |
11 | ;;; | |
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. | |
b2c12b4e | 16 | ;;; |
861345b4 | 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. | |
b2c12b4e | 21 | ;;; |
861345b4 | 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. | |
25 | ||
26 | (defpackage #:mdw.str | |
27 | (:use #:common-lisp #:mdw.base) | |
3cb9d624 MW |
28 | (:export #:join-strings #:str-next-word #:str-split-words |
29 | #:str-beginsp #:str-endsp)) | |
861345b4 | 30 | (in-package #:mdw.str) |
31 | ||
32 | (defun join-strings (del strs) | |
33 | "Join together the strings STRS with DEL between them. All the arguments | |
0ff9df03 MW |
34 | are first converted to strings, as if by `stringify'. Otherwise, this is |
35 | like Perl's join operator." | |
861345b4 | 36 | (setf del (stringify del)) |
37 | (with-output-to-string (s) | |
38 | (when strs | |
39 | (loop | |
40 | (princ (stringify (pop strs)) s) | |
41 | (unless strs | |
42 | (return)) | |
43 | (princ del s))))) | |
44 | ||
45 | (defun str-next-word (string &key quotedp start end) | |
46 | "Extract a whitespace-delimited word from STRING, returning it and the | |
0ff9df03 MW |
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." | |
2af61873 | 51 | (setf-default start 0 end (length string)) |
861345b4 | 52 | (let ((i start) |
53 | (q nil) | |
54 | (e nil) | |
55 | (w (make-array 0 | |
56 | :element-type 'character | |
57 | :adjustable t | |
58 | :fill-pointer t))) | |
59 | ;; | |
60 | ;; Find the start of the next word. | |
61 | (loop | |
62 | (unless (< i end) | |
63 | (return-from str-next-word (values nil nil))) | |
64 | (let ((ch (char string i))) | |
65 | (unless (whitespace-char-p ch) | |
66 | (return))) | |
67 | (incf i)) | |
68 | ;; | |
69 | ;; Now pull off a word. | |
70 | (loop | |
71 | (unless (< i end) | |
72 | (return)) | |
73 | (let ((ch (char string i))) | |
74 | (cond ((and quotedp (eql ch #\\)) | |
75 | (setf e t)) | |
76 | (e | |
77 | (vector-push-extend ch w) | |
78 | (setf e nil)) | |
79 | ((eql ch q) | |
80 | (setf q nil)) | |
81 | (q | |
82 | (vector-push-extend ch w)) | |
83 | ((whitespace-char-p ch) | |
84 | (return)) | |
85 | ((not quotedp) | |
86 | (vector-push-extend ch w)) | |
87 | ((or (eql ch #\') | |
88 | (eql ch #\")) | |
89 | (setf q ch)) | |
90 | ((eql ch #\`) | |
91 | (setf q #\')) | |
92 | (t | |
93 | (vector-push-extend ch w)))) | |
94 | (incf i)) | |
95 | ;; | |
96 | ;; Skip to next word. | |
97 | (loop | |
98 | (unless (< i end) | |
99 | (return)) | |
100 | (let ((ch (char string i))) | |
101 | (unless (whitespace-char-p ch) | |
102 | (return))) | |
103 | (incf i)) | |
104 | ;; | |
105 | ;; Done. | |
106 | (values (make-array (length w) | |
107 | :element-type 'character | |
108 | :initial-contents w) | |
109 | i))) | |
110 | ||
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 | |
0ff9df03 MW |
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." | |
861345b4 | 118 | (when (equal max 0) |
119 | (return-from str-split-words nil)) | |
120 | (let ((l nil) (n 0)) | |
121 | (loop | |
122 | (multiple-value-bind | |
123 | (word nextstart) | |
124 | (str-next-word string | |
125 | :quotedp quotedp | |
126 | :start start | |
127 | :end end) | |
128 | (unless word | |
129 | (return)) | |
130 | (when (and max (= (1+ n) max)) | |
131 | (push (subseq string start end) l) | |
132 | (return)) | |
133 | (setf start nextstart) | |
134 | (push word l) | |
135 | (incf n))) | |
136 | (nreverse l))) | |
137 | ||
3cb9d624 MW |
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 | |
141 | PREFIX." | |
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)))) | |
150 | ||
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 | |
154 | SUFFIX." | |
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)))) | |
163 | ||
861345b4 | 164 | ;;;----- That's all, folks -------------------------------------------------- |