From: Kevin Rosenberg <kevin@rosenberg.net>
Date: Thu, 31 Jan 2008 01:51:18 +0000 (-0700)
Subject: add remove-char-string
X-Git-Tag: v1.98~2
X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=commitdiff_plain;h=373a64e9369c2e96c465eb462a035884c7e08fa6

add remove-char-string
---

diff --git a/ChangeLog b/ChangeLog
index 8c1cb00..a717b52 100644
--- 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 b01bf33..348cf58 100644
--- 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 8ab57ab..14ca9d6 100644
--- 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 1178b5d..9a9f42d 100644
--- 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 4cbc915..0b0daa2 100644
--- 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)