;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: strings.lisp,v 1.11 2003/04/29 00:23:21 kevin Exp $
+;;;; $Id: strings.lisp,v 1.25 2003/05/09 00:05:13 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(setq in-word nil))))
n-words))
-#+excl
-(defun delimited-string-to-list (string &optional (separator #\space))
- (excl:delimited-string-to-list string separator))
-
-#-excl
-(defun delimited-string-to-list (sequence &optional (separator #\space))
- "Split a string by a delimitor"
- (loop
- with start = 0
- for end = (position separator sequence :start start)
- collect (subseq sequence start end)
- until (null end)
- do
- (setf start (1+ end))))
-
-#+excl
-(defun list-to-delimited-string (list &optional (separator #\space))
- (excl:list-to-delimited-string list separator))
+;; From Larry Hunter with modifications
+(defun position-char (char string start max)
+ (declare (optimize (speed 3) (safety 0) (space 0))
+ (fixnum start max) (simple-string string))
+ (do* ((i start (1+ i)))
+ ((= i max) nil)
+ (declare (fixnum i))
+ (when (char= char (schar string i)) (return i))))
+
+(defun delimited-string-to-list (string &optional (separator #\space)
+ skip-terminal)
+ "split a string with delimiter"
+ (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))
+ (type string string)
+ (type character separator))
+ (do* ((len (length string))
+ (output '())
+ (pos 0)
+ (end (position-char separator string pos len)
+ (position-char separator string pos len)))
+ ((null end)
+ (if (< pos len)
+ (push (subseq string pos) output)
+ (when (or (not skip-terminal) (zerop len))
+ (push "" output)))
+ (nreverse output))
+ (declare (type fixnum pos len)
+ (type (or null fixnum) end))
+ (push (subseq string pos end) output)
+ (setq pos (1+ end))))
+
-#-excl
(defun list-to-delimited-string (list &optional (separator #\space))
- (if (consp list)
- (let ((fmt (format nil "~~A~~{~A~~A~~}" separator)))
- (format nil fmt (first list) (rest list)))
- ""))
+ (format nil (format nil "~~{~~A~~^~A~~}" separator) list))
(defun string-invert (str)
"Invert case of a string"
(defun string-trim-last-character (s)
"Return the string less the last character"
- (aif (plusp (length s))
- (subseq s 0 (1- it))
- s))
+ (let ((len (length s)))
+ (if (plusp len)
+ (subseq s 0 (1- len))
+ s)))
+
+(defun nstring-trim-last-character (s)
+ "Return the string less the last character"
+ (let ((len (length s)))
+ (if (plusp len)
+ (nsubseq s 0 (1- len))
+ s)))
(defun string-hash (str &optional (bitmask 65535))
(let ((hash 0))
(defun escape-xml-string (string)
"Escape invalid XML characters"
(substitute-chars-strings
- string '((#\& . "&") (#\> . ">") (#\< . "<"))))
+ string '((#\& . "&") (#\> . ">") (#\< . "<") (#\" . """))))
(defun make-usb8-array (len)
(setf (aref vec i) (char-code (schar str i))))
vec))
+(defun concat-separated-strings (separator &rest lists)
+ (format nil (format nil "~~{~~A~~^~A~~}" separator) (append-sublists lists)))
+
+(defun only-null-list-elements-p (lst)
+ (or (null lst) (every #'null lst)))
+
+(defun print-separated-strings (strm separator &rest lists)
+ (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)
+ (compilation-speed 0)))
+ (do* ((rest-lists lists (cdr rest-lists))
+ (list (car rest-lists) (car rest-lists))
+ (last-list (only-null-list-elements-p (cdr rest-lists))
+ (only-null-list-elements-p (cdr rest-lists))))
+ ((null rest-lists) strm)
+ (do* ((lst list (cdr lst))
+ (elem (car lst) (car lst))
+ (last-elem (null (cdr lst)) (null (cdr lst))))
+ ((null lst))
+ (write-string elem strm)
+ (unless (and last-elem last-list)
+ (write-string separator strm)))))