From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 4 Dec 1992 03:04:54 +0000 (+0000)
Subject: Undo last change: a substring cannot be upper or lower case unless
X-Git-Tag: 20090517-FFI~8671
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=04f54a397b05ee95d65acc2e82d8438280a3d79e;p=mit-scheme.git

Undo last change: a substring cannot be upper or lower case unless
there is at least one character of that case in it.  Rewrite
SUBSTRING-CAPITALIZED? to fix the bug properly.
---

diff --git a/v7/src/runtime/string.scm b/v7/src/runtime/string.scm
index 6bfefd28c..134975da2 100644
--- a/v7/src/runtime/string.scm
+++ b/v7/src/runtime/string.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: string.scm,v 14.6 1992/12/01 14:52:03 gjr Exp $
+$Id: string.scm,v 14.7 1992/12/04 03:04:54 cph Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -237,15 +237,15 @@ MIT in each case. |#
 
 (define (substring-upper-case? string start end)
   (let find-upper ((start start))
-    (or (not (fix:< start end))
-	(let ((char (string-ref string start)))
-	  (if (char-upper-case? char)
-	      (let search-rest ((start (fix:+ start 1)))
-		(or (fix:= start end)
-		    (and (not (char-lower-case? (string-ref string start)))
-			 (search-rest (fix:+ start 1)))))
-	      (and (not (char-lower-case? char))
-		   (find-upper (fix:+ start 1))))))))
+    (and (fix:< start end)
+	 (let ((char (string-ref string start)))
+	   (if (char-upper-case? char)
+	       (let search-rest ((start (fix:+ start 1)))
+		 (or (fix:= start end)
+		     (and (not (char-lower-case? (string-ref string start)))
+			  (search-rest (fix:+ start 1)))))
+	       (and (not (char-lower-case? char))
+		    (find-upper (fix:+ start 1))))))))
 
 (define (string-upcase string)
   (let ((string (string-copy string)))
@@ -260,15 +260,15 @@ MIT in each case. |#
 
 (define (substring-lower-case? string start end)
   (let find-lower ((start start))
-    (or (not (fix:< start end))
-	(let ((char (string-ref string start)))
-	  (if (char-lower-case? char)
-	      (let search-rest ((start (fix:+ start 1)))
-		(or (fix:= start end)
-		    (and (not (char-upper-case? (string-ref string start)))
-			 (search-rest (fix:+ start 1)))))
-	      (and (not (char-upper-case? char))
-		   (find-lower (fix:+ start 1))))))))
+    (and (fix:< start end)
+	 (let ((char (string-ref string start)))
+	   (if (char-lower-case? char)
+	       (let search-rest ((start (fix:+ start 1)))
+		 (or (fix:= start end)
+		     (and (not (char-upper-case? (string-ref string start)))
+			  (search-rest (fix:+ start 1)))))
+	       (and (not (char-upper-case? char))
+		    (find-lower (fix:+ start 1))))))))
 
 (define (string-downcase string)
   (let ((string (string-copy string)))
@@ -277,14 +277,42 @@ MIT in each case. |#
 
 (define (string-downcase! string)
   (substring-downcase! string 0 (string-length string)))
-
+
 (define (string-capitalized? string)
   (substring-capitalized? string 0 (string-length string)))
 
 (define (substring-capitalized? string start end)
-  (and (fix:< start end)
-       (char-upper-case? (string-ref string start))
-       (substring-lower-case? string (fix:+ start 1) 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)
   (let ((string (string-copy string)))
@@ -292,10 +320,20 @@ MIT in each case. |#
     string))
 
 (define (string-capitalize! string)
-  (let ((length (string-length string)))
-    (if (zero? length) (error "String must have non-zero length" string))
-    (substring-upcase! string 0 1)
-    (substring-downcase! string 1 length)))
+  (substring-capitalize! string 0 (string-length 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-first-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)))))
 
 ;;;; Replace