mdw@git.distorted.org.uk Git - lisp/blob - str.lisp

   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.
  47    If QUOTEDP, then allow quoting and backslashifying; otherwise don't.  The
  48    START and END arguments limit the portion of the string to be processed;
  49    the default to 0 and nil (end of string), as usual."
  50   (setf-default start 0 end (length string))
  51   (let ((i start)
  52         (q nil)
  53         (e nil)
  54         (w (make-array 0
  55                        :element-type 'character
  56                        :adjustable t
  57                        :fill-pointer t)))
  58     ;;
  59     ;; Find the start of the next word.
  60     (loop
  61        (unless (< i end)
  62          (return-from str-next-word (values nil nil)))
  63        (let ((ch (char string i)))
  64          (unless (whitespace-char-p ch)
  65            (return)))
  66        (incf i))
  67     ;;
  68     ;; Now pull off a word.
  69     (loop
  70        (unless (< i end)
  71          (return))
  72        (let ((ch (char string i)))
  73          (cond ((and quotedp (eql ch #\\))
  74                 (setf e t))
  75                (e
  76                 (vector-push-extend ch w)
  77                 (setf e nil))
  78                ((eql ch q)
  79                 (setf q nil))
  80                (q
  81                 (vector-push-extend ch w))
  82                ((whitespace-char-p ch)
  83                 (return))
  84                ((not quotedp)
  85                 (vector-push-extend ch w))
  86                ((or (eql ch #\')
  87                     (eql ch #\"))
  88                 (setf q ch))
  89                ((eql ch #\`)
  90                 (setf q #\'))
  91                (t
  92                 (vector-push-extend ch w))))
  93        (incf i))
  94     ;;
  95     ;; Skip to next word.
  96     (loop
  97        (unless (< i end)
  98          (return))
  99        (let ((ch (char string i)))
 100          (unless (whitespace-char-p ch)
 101            (return)))
 102        (incf i))
 103     ;;
 104     ;; Done.
 105     (values (make-array (length w)
 106                         :element-type 'character
 107                         :initial-contents w)
 108             i)))
 109
 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."
 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
 137 ;;;----- That's all, folks --------------------------------------------------