NSTRING-UPCASE, NSTRING-DOWNCASE, NSTRING-CAPITALIZE.

diff --git a/src/string.lisp b/src/string.lisp
index 3059b4e..c9267f0 100644 (file)
--- a/src/string.lisp
+++ b/src/string.lisp
@@ -117,7 +117,7 @@
     (!reduce #'concat-two strs "")))
 
 
-(defun string-upcase (string &key start end)
+(defun string-upcase (string &key (start 0) end)
   (let* ((string (string string))
          (new (make-string (length string))))
     (dotimes (i (length string) new)
@@ -127,7 +127,13 @@
                 (char-upcase (char string i))
               (char string i))))))
 
-(defun string-downcase (string &key start end)
+(defun nstring-upcase (string &key (start 0) end)
+  (let ((end (or end (length string))))
+    (dotimes (i (- end start) string)
+      (aset string (+ start i)
+           (char-upcase (char string (+ start i)))))))
+
+(defun string-downcase (string &key (start 0) end)
   (let* ((string (string string))
          (new (make-string (length string))))
     (dotimes (i (length string) new)
@@ -137,7 +143,13 @@
                 (char-downcase (char string i))
               (char string i))))))
 
-(defun string-capitalize (string &key start end)
+(defun nstring-downcase (string &key (start 0) end)
+  (let ((end (or end (length string))))
+    (dotimes (i (- end start) string)
+      (aset string (+ start i)
+           (char-downcase (char string (+ start i)))))))
+
+(defun string-capitalize (string &key (start 0) end)
   (let* ((string (string string))
         (new (make-string (length string)))
         (just-saw-alphanum-p nil))
@@ -146,16 +158,23 @@
            (cond ((or (and start (< i start))
                       (and end (> i end)))
                   (char string i))
-                 ((or (= i (or start 0))
+                 ((or (= i start)
                       (not just-saw-alphanum-p))
                   (char-upcase (char string i)))
                  (t
                   (char-downcase (char string i)))))
       (setq just-saw-alphanum-p (alphanumericp (char string i))))))
 
-;; TODO: NSTRING-{UPCASE,DOWNCASE,CAPITALIZE}
-;; - Q: can i just extract the above functions without the MAKE-STRING call, and then have the STRING-* variants do MAKE-STRING + NSTRING-*?
-;; - NOTE: sacla's tests depend on COPY-SEQ, which doesn't exist yet.
+(defun nstring-capitalize (string &key (start 0) end)
+  (let ((end (or end (length string)))
+       (just-saw-alphanum-p nil))
+    (dotimes (i (- end start) string)
+      (aset string (+ start i)
+           (if (or (zerop i)
+                   (not just-saw-alphanum-p))
+               (char-upcase (char string (+ start i)))
+             (char-downcase (char string (+ start i)))))
+      (setq just-saw-alphanum-p (alphanumericp (char string (+ start i)))))))
 
 (defun string-equal (s1 s2 &key start1 end1 start2 end2)
   (let* ((s1 (string s1))

diff --git a/tests/strings.lisp b/tests/strings.lisp
index 3507f54..43f1337 100644 (file)
--- a/tests/strings.lisp
+++ b/tests/strings.lisp
@@ -130,64 +130,69 @@
 (test (string= (string-capitalize "pipe 13a, foo16c") "Pipe 13a, Foo16c"))
 (test (string= (string-capitalize "a fool" :start 2 :end nil) "a Fool"))
 
-;; JSCL: no COPY-SEQ yet
-;; (test (let ((str (copy-seq "0123ABCD890a")))
-;;   (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a")
-;;        (string= str "0123AbcD890a"))))
-
-;; (test (let* ((str0 (copy-seq "abcde"))
-;;        (str  (nstring-upcase str0)))
-;;   (and (eq str0 str)
-;;        (string= str "ABCDE"))))
-;; (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
-;;        (str  (nstring-upcase str0)))
-;;   (and (eq str0 str)
-;;        (string= str "DR. LIVINGSTON, I PRESUME?"))))
-;; (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
-;;        (str  (nstring-upcase str0 :start 6 :end 10)))
-;;   (and (eq str0 str)
-;;        (string= str "Dr. LiVINGston, I presume?"))))
-
-;; (test (let* ((str0 (copy-seq "abcde"))
-;;        (str (nstring-upcase str0 :start 2 :end nil)))
-;;   (string= str "abCDE")))
-
-
-
-;; (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
-;;        (str  (nstring-downcase str0)))
-;;   (and (eq str0 str)
-;;        (string= str "dr. livingston, i presume?"))))
-;; (test (let* ((str0 (copy-seq "ABCDE"))
-;;        (str (nstring-downcase str0 :start 2 :end nil)))
-;;   (string= str "ABcde")))
-
-;; (test (let* ((str0 (copy-seq "elm 13c arthur;fig don't"))
-;;        (str  (nstring-capitalize str0)))
-;;   (and (eq str0 str)
-;;        (string= str "Elm 13c Arthur;Fig Don'T"))))
-
-;; (test (let* ((str0 (copy-seq " hello "))
-;;        (str  (nstring-capitalize str0)))
-;;   (and (eq str0 str)
-;;        (string= str " Hello "))))
-;; (test (let* ((str0 (copy-seq
-;;           "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION"))
-;;        (str  (nstring-capitalize str0)))
-;;   (and (eq str0 str)
-;;        (string= str
-;;             "Occluded Casements Forestall Inadvertent Defenestration"))))
-;; (test (let* ((str0 (copy-seq "DON'T!"))
-;;        (str  (nstring-capitalize str0)))
-;;   (and (eq str0 str)
-;;        (string= str "Don'T!"))))    ;not "Don't!"
-;; (test (let* ((str0 (copy-seq "pipe 13a, foo16c"))
-;;        (str  (nstring-capitalize str0)))
-;;   (and (eq str0 str)
-;;        (string= str "Pipe 13a, Foo16c"))))
-;; (test (let* ((str0 (copy-seq "a fool"))
-;;        (str (nstring-capitalize str0 :start 2 :end nil)))
-;;   (string= str "a Fool")))
+;; JSCL HACK: a simple COPY-SEQ for testing string functions, since we don't have a real one yet
+(defun copy-seq (string)
+  (let ((copy (make-string (length string))))
+    (dotimes (i (length string) copy)
+      (aset copy i (char string i)))))
+
+(test (let ((str (copy-seq "0123ABCD890a")))
+  (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a")
+       (string= str "0123AbcD890a"))))
+
+(test (let* ((str0 (copy-seq "abcde"))
+       (str  (nstring-upcase str0)))
+  (and (eq str0 str)
+       (string= str "ABCDE"))))
+(test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
+       (str  (nstring-upcase str0)))
+  (and (eq str0 str)
+       (string= str "DR. LIVINGSTON, I PRESUME?"))))
+(test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
+       (str  (nstring-upcase str0 :start 6 :end 10)))
+  (and (eq str0 str)
+       (string= str "Dr. LiVINGston, I presume?"))))
+
+(test (let* ((str0 (copy-seq "abcde"))
+       (str (nstring-upcase str0 :start 2 :end nil)))
+  (string= str "abCDE")))
+
+
+
+(test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
+       (str  (nstring-downcase str0)))
+  (and (eq str0 str)
+       (string= str "dr. livingston, i presume?"))))
+(test (let* ((str0 (copy-seq "ABCDE"))
+       (str (nstring-downcase str0 :start 2 :end nil)))
+  (string= str "ABcde")))
+
+(test (let* ((str0 (copy-seq "elm 13c arthur;fig don't"))
+       (str  (nstring-capitalize str0)))
+  (and (eq str0 str)
+       (string= str "Elm 13c Arthur;Fig Don'T"))))
+
+(test (let* ((str0 (copy-seq " hello "))
+       (str  (nstring-capitalize str0)))
+  (and (eq str0 str)
+       (string= str " Hello "))))
+(test (let* ((str0 (copy-seq
+             "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION"))
+       (str  (nstring-capitalize str0)))
+  (and (eq str0 str)
+       (string= str
+               "Occluded Casements Forestall Inadvertent Defenestration"))))
+(test (let* ((str0 (copy-seq "DON'T!"))
+       (str  (nstring-capitalize str0)))
+  (and (eq str0 str)
+       (string= str "Don'T!"))))    ;not "Don't!"
+(test (let* ((str0 (copy-seq "pipe 13a, foo16c"))
+       (str  (nstring-capitalize str0)))
+  (and (eq str0 str)
+       (string= str "Pipe 13a, Foo16c"))))
+(test (let* ((str0 (copy-seq "a fool"))
+       (str (nstring-capitalize str0 :start 2 :end nil)))
+  (string= str "a Fool")))