add remove-char-string

diff --git a/ChangeLog b/ChangeLog
index 8c1cb00828046c03cb5a4afe90ea513cf59fac9b..a717b52895d506bc291119acad1f3bbdb68ccc64 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+28 Jun 2008  Kevin Rosenberg <kevin@rosenberg.net>
+       * Version 1.96
+       * {datetime,strings,tests}.lisp: Add remove-char-string
+
 01 Jun 2007  Kevin Rosenberg <kevin@rosenberg.net>
        * Version 1.95
        * {datetime,package}.lisp: Add day-of-week and pretty-date-ut

diff --git a/datetime.lisp b/datetime.lisp
index b01bf33d323a8b0cb9c601a62a80609244f8a9de..348cf58c60a0f8453cdbc0b672d2fafe8758b297 100644 (file)
--- a/datetime.lisp
+++ b/datetime.lisp
@@ -40,7 +40,7 @@
   (multiple-value-bind (sec min hr dy mn yr) (decode-universal-time tm)
     (pretty-date yr mn dy hr min sec)))
 
-(defun date-string (ut)
+(defun date-string (&optional (ut (get-universal-time)))
   (if (typep ut 'integer)
       (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
           (decode-universal-time ut)

diff --git a/package.lisp b/package.lisp
index 8ab57abbce2de7992e6a64c3bd423ed38fc1eef3..14ca9d66dc7fcc8e7f20677a32c7c29dad9a27b5 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -76,6 +76,7 @@
    #:string->list
    #:trim-non-alphanumeric
    #:binary-sequence-to-hex-string
+   #:remove-char-string
 
    ;; io.lisp
    #:indent-spaces
@@ -319,6 +320,3 @@
    #:set-signal-handler
    #:remove-signal-handler
    ))
-
-
-

diff --git a/strings.lisp b/strings.lisp
index 1178b5d5426e24c727f804de200625d6d3e4ed02..9a9f42d8a354985df274ac5829ad0118b21e1eea 100644 (file)
--- a/strings.lisp
+++ b/strings.lisp
@@ -44,7 +44,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 +566,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)))

diff --git a/tests.lisp b/tests.lisp
index 4cbc915f430f61d6e8f4079c79672b1e769b748e..0b0daa2d4a709c92720a79a9234a1b3d2b8f6019 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -202,6 +202,15 @@
 (deftest :sse.4 (string-strip-ending "abc" '("ab")) "abc")
 (deftest :sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab")
 
+(deftest :rcs.1 (remove-char-string #\space "") "")
+(deftest :rcs.2 (remove-char-string #\space "a") "a")
+(deftest :rcs.3 (remove-char-string #\space "ab") "ab")
+(deftest :rcs.4 (remove-char-string #\space "a b") "ab")
+(deftest :rcs.5 (remove-char-string #\space " a b") "ab")
+(deftest :rcs.6 (remove-char-string #\space "a b ") "ab")
+(deftest :rcs.7 (remove-char-string #\space "a  b   c  ") "abc")
+(deftest :rcs.8 (remove-char-string #\space "a  b   c  d") "abcd")
+
 
 (defun test-color-conversion ()
   (dotimes (ih 11)