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