From 8ffbc2df0fde83082610149d24e594c1cd879f4a Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:25 -0800 Subject: Import Upstream version 2a6 --- strcase.scm | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 strcase.scm (limited to 'strcase.scm') diff --git a/strcase.scm b/strcase.scm new file mode 100644 index 0000000..f223527 --- /dev/null +++ b/strcase.scm @@ -0,0 +1,45 @@ +;;; "strcase.scm" String casing functions. +; Written 1992 by Dirk Lutzebaeck (lutzeb@cs.tu-berlin.de) +; +; This code is in the public domain. + +; Modified by Aubrey Jaffer Nov 1992. +; Authors of the original version were Ken Dickey and Aubrey Jaffer. + +;string-upcase, string-downcase, string-capitalize +; are obvious string conversion procedures and are non destructive. +;string-upcase!, string-downcase!, string-capitalize! +; are destructive versions. + +(define (string-upcase! str) + (do ((i (- (string-length str) 1) (- i 1))) + ((< i 0) str) + (string-set! str i (char-upcase (string-ref str i))))) + +(define (string-upcase str) + (string-upcase! (string-copy str))) + +(define (string-downcase! str) + (do ((i (- (string-length str) 1) (- i 1))) + ((< i 0) str) + (string-set! str i (char-downcase (string-ref str i))))) + +(define (string-downcase str) + (string-downcase! (string-copy str))) + +(define (string-capitalize! str) ; "hello" -> "Hello" + (let ((non-first-alpha #f) ; "hELLO" -> "Hello" + (str-len (string-length str))) ; "*hello" -> "*Hello" + (do ((i 0 (+ i 1))) ; "hello you" -> "Hello You" + ((= i str-len) str) + (let ((c (string-ref str i))) + (if (char-alphabetic? c) + (if non-first-alpha + (string-set! str i (char-downcase c)) + (begin + (set! non-first-alpha #t) + (string-set! str i (char-upcase c)))) + (set! non-first-alpha #f)))))) + +(define (string-capitalize str) + (string-capitalize! (string-copy str))) -- cgit v1.2.3