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. |
16 | ;;; |
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. |
21 | ;;; |
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) |
28 | (:export #:join-strings #:str-next-word #:str-split-words)) |
29 | (in-package #:mdw.str) |
30 | |
31 | (defun join-strings (del strs) |
32 | "Join together the strings STRS with DEL between them. All the arguments |
33 | are first converted to strings, as if by `stringify'. Otherwise, this is |
34 | like Perl's join operator." |
35 | (setf del (stringify del)) |
36 | (with-output-to-string (s) |
37 | (when strs |
38 | (loop |
39 | (princ (stringify (pop strs)) s) |
40 | (unless strs |
41 | (return)) |
42 | (princ del s))))) |
43 | |
44 | (defun str-next-word (string &key quotedp start end) |
45 | "Extract a whitespace-delimited word from STRING, returning it and the |
46 | index to continue parsing from. If no word is found, return nil twice. If |
47 | QUOTEDP, then allow quoting and backslashifying; otherwise don't. The START |
48 | and END arguments limit the portion of the string to be processed; the |
49 | default to 0 and nil (end of string), as usual." |
50 | (unless start (setf start 0)) |
51 | (unless end (setf end (length string))) |
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 |
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." |
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 | |
138 | ;;;----- That's all, folks -------------------------------------------------- |