From b68c95cb557fafe2f5fad2d7e6440cf773748e05 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 23 Oct 2018 21:40:42 -0700 Subject: [PATCH] Fix capitalization of error messages. --- src/runtime/error.scm | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) 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 -- 2.25.1