X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=strings.lisp;h=4dcda494249b45e44b6166bf304f0c154f0ce8a2;hp=1178b5d5426e24c727f804de200625d6d3e4ed02;hb=251043d4c96c996a35cd48c4452b03fbef2ea21a;hpb=03712fbb06acbb103602bae10f41aeae7fa05127

diff --git a/strings.lisp b/strings.lisp
index 1178b5d..4dcda49 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -7,8 +7,6 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002-2006 by Kevin M. Rosenberg
 ;;;;
 ;;;; KMRCL users are granted the rights to distribute and use this software
@@ -44,7 +42,6 @@
             (setq in-word t))
         (setq in-word nil)))))
 
-;; 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))
@@ -567,6 +564,23 @@ for characters in a string"
       str)))
 
 
+(defun remove-char-string (char str)
+  (declare (character char)
+           (string str))
+  (do* ((len (length str))
+        (out (make-string len))
+        (pos 0 (1+ pos))
+        (opos 0))
+       ((= pos len) (subseq out 0 opos))
+    (declare (fixnum pos opos len)
+             (simple-string out))
+    (let ((c (char str pos)))
+      (declare (character c))
+      (when (char/= c char)
+        (setf (schar out opos) c)
+        (incf opos)))))
+
+
 (defun string-strip-ending (str endings)
   (if (stringp endings)
       (setq endings (list endings)))