Eliminate "capitalize" string operations, add dummy string-titlecase.

diff --git a/src/runtime/debug.scm b/src/runtime/debug.scm
index a0c06a059916e5a4f6ab62468a82a6ecae59808e..9f8b2d8e9d66cef5665ecebbc2f90d6e6d14cae0 100644 (file)
--- a/src/runtime/debug.scm
+++ b/src/runtime/debug.scm
@@ -953,7 +953,7 @@ using the read-eval-print environment instead.")
   (debugger-failure port "There is no current environment."))
 
 (define (reason+message reason message)
-  (string-capitalize (if reason (string-append reason "; " message) message)))
+  (string-titlecase (if reason (string-append reason "; " message) message)))
 
 (define (debugger-pp expression indentation port)
   (parameterize* (list (cons param:unparser-list-depth-limit

diff --git a/src/runtime/error.scm b/src/runtime/error.scm
index 445d9cadbb2e6ab08a9a7c25e701f7c437d98daf..8e87840a2aebb8a18efab24484c4bea4e97ca65b 100644 (file)
--- a/src/runtime/error.scm
+++ b/src/runtime/error.scm
@@ -1066,7 +1066,7 @@ USA.
              (write-string " because: " port)
              (let ((reason (access-condition condition 'REASON)))
                (if reason
-                   (write-string (string-capitalize reason) port)
+                   (write-string (string-titlecase reason) port)
                    (begin
                      (write-string "No such " port)
                      (write-string noun port))))

diff --git a/src/runtime/recslot.scm b/src/runtime/recslot.scm
index e0ff5a8f614b836a659dafff0fe22f4731d012f3..e82f630e88449998b899ec2e29e5ef4f7b9a1686 100644 (file)
--- a/src/runtime/recslot.scm
+++ b/src/runtime/recslot.scm
@@ -133,7 +133,7 @@ USA.
   (with-restart 'USE-VALUE
       (string-append "Specify a " noun-phrase ".")
       k
-      (string->interactor (string-capitalize noun-phrase))
+      (string->interactor (string-titlecase noun-phrase))
     thunk))
 
 (define ((string->interactor string))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index cb85fb385077a1b6f63a99624e5c9b0166f0f888..ac633cfc228d79c1abf123dcaeee8c75aae757c4 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1040,8 +1040,6 @@ USA.
          lisp-string->camel-case
          reverse-string
          reverse-substring
-         string-capitalize
-         string-capitalized?
          string-compare
          string-compare-ci
          string-match-backward
@@ -1057,7 +1055,6 @@ USA.
          string-trim
          string-trim-left
          string-trim-right
-         substring-capitalized?
          substring-match-backward
          substring-match-backward-ci
          substring-match-forward
@@ -1151,6 +1148,7 @@ USA.
          string-suffix-ci?
          string-suffix?
          string-tail
+         string-titlecase
          string-upcase
          string-upper-case?
          string<=?

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 4414d6c6e9a54bbcee69ef7277b6004ac91ec5b0..20da67acfdace646324bcf3fe3720f234ba2faf5 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -89,78 +89,6 @@ USA.
        (string-set! result j (string-ref string i)))
       result)))
 \f
-;;;; Case
-
-(define (string-capitalized? string)
-  (guarantee-string string 'STRING-CAPITALIZED?)
-  (substring-capitalized? string 0 (string-length string)))
-
-(define (substring-capitalized? string start end)
-  (guarantee-substring string start end 'SUBSTRING-CAPITALIZED?)
-  (%substring-capitalized? string start end))
-
-(define (%substring-capitalized? string start end)
-  ;; Testing for capitalization is somewhat more involved than testing
-  ;; for upper or lower case.  This algorithm requires that the first
-  ;; word be capitalized, and that the subsequent words be either
-  ;; lower case or capitalized.  This is a very general definition of
-  ;; capitalization; if you need something more specific you should
-  ;; call this procedure on the individual words.
-  (letrec
-      ((find-first-word
-       (lambda (start)
-         (and (fix:< start end)
-              (let ((char (string-ref string start)))
-                (if (char-upper-case? char)
-                    (scan-word-tail (fix:+ start 1))
-                    (and (not (char-lower-case? char))
-                         (find-first-word (fix:+ start 1))))))))
-       (scan-word-tail
-       (lambda (start)
-         (or (fix:= start end)
-             (let ((char (string-ref string start)))
-               (if (char-lower-case? char)
-                   (scan-word-tail (fix:+ start 1))
-                   (and (not (char-upper-case? char))
-                        (find-subsequent-word (fix:+ start 1))))))))
-       (find-subsequent-word
-       (lambda (start)
-         (or (fix:= start end)
-             (let ((char (string-ref string start)))
-               (if (char-alphabetic? char)
-                   (scan-word-tail (fix:+ start 1))
-                   (find-subsequent-word (fix:+ start 1))))))))
-    (find-first-word start)))
-
-(define (string-capitalize string)
-  (guarantee-string string 'STRING-CAPITALIZE)
-  (let ((string (string-copy string)))
-    (%substring-capitalize! string 0 (string-length string))
-    string))
-
-(define (%substring-capitalize! string start end)
-  ;; This algorithm capitalizes the first word in the substring and
-  ;; downcases the subsequent words.  This is arbitrary, but seems
-  ;; useful if the substring happens to be a sentence.  Again, if you
-  ;; need finer control, parse the words yourself.
-  (let ((index
-        (substring-find-next-char-in-set string start end
-                                         char-set:alphabetic)))
-    (if index
-       (begin
-         (%substring-upcase! string index (fix:+ index 1))
-         (%substring-downcase! string (fix:+ index 1) end)))))
-
-(define (%substring-upcase! string start end)
-  (do ((i start (fix:+ i 1)))
-      ((fix:= i end))
-    (string-set! string i (char-upcase (string-ref string i)))))
-
-(define (%substring-downcase! string start end)
-  (do ((i start (fix:+ i 1)))
-      ((fix:= i end))
-    (string-set! string i (char-downcase (string-ref string i)))))
-\f
 ;;;; CamelCase support
 
 (define (camel-case-string->lisp string)

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 4df0a2053adac98c24bf8f0545011c69fa0eda7f..664454bfa466082dbb09ce55d205871386516ba8 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -388,6 +388,10 @@ USA.
 (define (string-upcase string)
   (case-transform char-upcase-full string))
 
+(define (string-titlecase string)
+  ;; TODO(cph): implement this
+  (string-copy string))
+
 (define (case-transform transform string)
   (let ((chars (append-map transform (string->list string))))
     (let ((n (length chars)))