add remove-char-string
authorKevin Rosenberg <kevin@rosenberg.net>
Thu, 31 Jan 2008 01:51:18 +0000 (18:51 -0700)
committerKevin Rosenberg <kevin@rosenberg.net>
Thu, 31 Jan 2008 01:51:18 +0000 (18:51 -0700)
ChangeLog
datetime.lisp
package.lisp
strings.lisp
tests.lisp

index 8c1cb00..a717b52 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
index b01bf33..348cf58 100644 (file)
@@ -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)
index 8ab57ab..14ca9d6 100644 (file)
@@ -76,6 +76,7 @@
    #:string->list
    #:trim-non-alphanumeric
    #:binary-sequence-to-hex-string
+   #:remove-char-string
 
    ;; io.lisp
    #:indent-spaces
    #:set-signal-handler
    #:remove-signal-handler
    ))
-
-
-
index 1178b5d..9a9f42d 100644 (file)
@@ -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)))
index 4cbc915..0b0daa2 100644 (file)
 (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)