From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 24 Oct 2018 04:40:42 +0000 (-0700)
Subject: Fix capitalization of error messages.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~179
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b68c95cb557fafe2f5fad2d7e6440cf773748e05;p=mit-scheme.git

Fix capitalization of error messages.
---

diff --git a/src/runtime/error.scm b/src/runtime/error.scm
index cf4459f14..a3c22e250 100644
--- a/src/runtime/error.scm
+++ b/src/runtime/error.scm
@@ -1116,7 +1116,7 @@ USA.
 	      (write-string " because: " port)
 	      (let ((reason (access-condition condition 'reason)))
 		(if reason
-		    (write-string (string-titlecase reason) port)
+		    (write-string (reason-titlecase reason) port)
 		    (begin
 		      (write-string "No such " port)
 		      (write-string noun port))))
@@ -1305,7 +1305,7 @@ USA.
 
 (define error-irritant/noise-tag
   '(error-irritant/noise))
-
+
 (define (ordinal-number-string n)
   (if (not (and (exact-nonnegative-integer? n) (< n 100)))
       (error:wrong-type-argument n "exact integer between 0 and 99"
@@ -1333,4 +1333,15 @@ USA.
   (write (if (primitive-procedure? operator)
 	     (primitive-procedure-name operator)
 	     operator)
-	 port))
\ No newline at end of file
+	 port))
+
+;; Not quite right: it should be using string-word-breaks to find the first
+;; word.  Unfortunately even with the breaks it's still non-trivial to discover
+;; what is a word and what isn't.  So for now we do this simple thing based on
+;; whitespace.
+(define (reason-titlecase reason)
+  (let ((index (string-find-first-index char-whitespace? reason)))
+    (if index
+	(string-append (string-titlecase (string-slice reason 0 index))
+		       (string-slice reason index))
+	(string-titlecase reason))))
\ No newline at end of file