X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=strings.lisp;h=35a177e9715371cc38eea292eddb09c05d380518;hb=6007424292e8d78977bc90bcc29a20d4451cfa41;hp=ba34182b25c7ca7315f0da4343b42f8b2ab2fec3;hpb=8646b9afb9979064c3b0b79990c064dce7cb12b7;p=kmrcl.git

diff --git a/strings.lisp b/strings.lisp
index ba34182..35a177e 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: strings.lisp,v 1.1 2002/10/12 06:10:17 kevin Exp $
+;;;; $Id: strings.lisp,v 1.7 2003/02/07 14:21:55 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -19,14 +19,12 @@
 
 (in-package :kmrcl)
 (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
+
 ;;; Strings
 
 (defmacro string-append (outputstr &rest args)
   `(setq ,outputstr (concatenate 'string ,outputstr ,@args)))
 
-(defmacro string-field-append (outputstr &rest args)
-  `(setq ,outputstr (concatenate 'string ,outputstr ,@args)))
-
 (defun list-to-string (lst)
   "Converts a list to a string, doesn't include any delimiters between elements"
   (format nil "~{~A~}" lst))
@@ -53,7 +51,7 @@
 
 #-excl
 (defun delimited-string-to-list (sequence &optional (separator #\space))
-"Split a string by a delimitor"
+  "Split a string by a delimitor"
   (loop
       with start = 0
       for end = (position separator sequence :start start)
@@ -68,12 +66,10 @@
 
 #-excl
 (defun list-to-delimited-string (list &optional (separator #\space))
-  (let ((output (when list (format nil "~A" (car list)))))
-    (dolist (obj (rest list))
-      (setq output (concatenate 'string output
-				(format nil "~A" separator)
-				(format nil "~A" obj))))
-    output))
+  (if (consp list)
+      (let ((fmt (format nil "~~A~~{~A~~A~~}" separator)))
+	(format nil fmt (first list) (rest list)))
+      ""))
 
 (defun string-invert (str)
   "Invert case of a string"
@@ -93,7 +89,7 @@
   (substitute-string-for-char s #\\ "\\\\"))
 
 (defun substitute-string-for-char (procstr match-char subst-str) 
-"Substitutes a string for a single matching character of a string"
+  "Substitutes a string for a single matching character of a string"
   (let ((pos (position match-char procstr)))
     (if pos
 	(concatenate 'string
@@ -148,3 +144,82 @@
   (when (stringp str)
     (null (find-if #'not-whitespace? str))))
 
+#+ignore
+(defun string-replace-chars-strings (str repl-alist)
+  "Replace all instances of a chars with a string. repl-alist is an assoc
+list of characters and replacement strings."
+  (let* ((orig-len (length str))
+	 (new-len orign-len))
+    (declare (fixnum orig-len new-len))
+    (dotimes (i orign-len)
+      (declare (fixnum i))
+      (let ((c (schar i str)))
+	)))
+  str)
+
+(defun escape-xml-string (string)
+  "Escape invalid XML characters"
+  (string-replace-char-string
+   (string-replace-char-string string #\& "&")
+   #\< "&lt;"))
+
+(defun string-replace-char-string (string repl-char repl-str)
+  "Replace all occurances of repl-char with repl-str"
+ (declare (simple-string string))
+  (let ((count (count repl-char string)))
+    (declare (fixnum count))
+    (if (zerop count)
+	string
+	(locally (declare (optimize (speed 3) (safety 0)))
+	  (let* ((old-length (length string))
+		 (repl-length (length repl-str))
+		 (new-string (make-string (the fixnum
+					    (+ old-length
+					       (the fixnum
+						 (* count
+						    (the fixnum (1- repl-length)))))))))
+	    (declare (fixnum old-length repl-length)
+		     (simple-string new-string))
+	    (let ((newpos 0))
+	      (declare (fixnum newpos))
+	      (dotimes (oldpos (length string))
+		(declare (fixnum oldpos))
+		(if (char= repl-char (schar string oldpos))
+		    (dotimes (repl-pos repl-length)
+		      (declare (fixnum repl-pos))
+		      (setf (schar new-string newpos) (schar repl-str repl-pos))
+		      (incf newpos))
+		    (progn
+		      (setf (schar new-string newpos) (schar string oldpos))
+		      (incf newpos)))))
+	    new-string)))))
+
+    
+
+(defun make-usb8-array (len)
+  (make-array len :adjustable nil
+	      :fill-pointer nil
+	      :element-type '(unsigned-byte 8)))
+
+(defun usb8-array-to-string (vec)
+  (let* ((len (length vec))
+	 (str (make-string len)))
+    (declare (fixnum len)
+	     (simple-string str)
+	     (optimize (speed 3)))
+    (dotimes (i len)
+      (declare (fixnum i))
+      (setf (schar str i) (code-char (aref vec i))))
+    str))
+
+(defun string-to-usb8-array (str)
+  (let* ((len (length str))
+	 (vec (make-usb8-array len)))
+    (declare (fixnum len)
+	     (type (array fixnum (*)) vec)
+	     (optimize (speed 3)))
+    (dotimes (i len)
+      (declare (fixnum i))
+      (setf (aref vec i) (char-code (schar str i))))
+    vec))
+