From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 22 Feb 2017 09:20:41 +0000 (-0800)
Subject: Eliminate camel-case procedures.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~20
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b76687a3a137b319c95517312e096b92c27815a8;p=mit-scheme.git

Eliminate camel-case procedures.
---

diff --git a/src/edwin/edwin.pkg b/src/edwin/edwin.pkg
index 8c3c63855..f1b6090c2 100644
--- a/src/edwin/edwin.pkg
+++ b/src/edwin/edwin.pkg
@@ -154,7 +154,6 @@ USA.
 	  (vector-8b? string?)
 	  ascii-string-copy
 	  burst-string
-	  camel-case-string->lisp
 	  char->string
 	  decorated-string-append
 	  error:not-string
@@ -163,7 +162,6 @@ USA.
 	  guarantee-substring
 	  guarantee-substring-end-index
 	  guarantee-substring-start-index
-	  lisp-string->camel-case
 	  list->string
 	  make-string
 	  make-vector-8b
diff --git a/src/edwin/string.scm b/src/edwin/string.scm
index 39d3bc3cf..7b52e5fda 100644
--- a/src/edwin/string.scm
+++ b/src/edwin/string.scm
@@ -756,44 +756,6 @@ USA.
 	  (%substring-upcase! string index (fix:+ index 1))
 	  (%substring-downcase! string (fix:+ index 1) end)))))
 
-;;;; CamelCase support
-
-(define (camel-case-string->lisp string)
-  (call-with-input-string string
-    (lambda (input)
-      (call-with-output-string
-	(lambda (output)
-	  (let loop ((prev #f))
-	    (let ((c (read-char input)))
-	      (if (not (eof-object? c))
-		  (begin
-		    (if (and prev (char-upper-case? c))
-			(write-char #\- output))
-		    (write-char (char-downcase c) output)
-		    (loop c))))))))))
-
-(define (lisp-string->camel-case string #!optional upcase-initial?)
-  (call-with-input-string string
-    (lambda (input)
-      (call-with-output-string
-	(lambda (output)
-	  (let loop
-	      ((upcase?
-		(if (default-object? upcase-initial?)
-		    #t
-		    upcase-initial?)))
-	    (let ((c (read-char input)))
-	      (if (not (eof-object? c))
-		  (if (char-alphabetic? c)
-		      (begin
-			(write-char (if upcase? (char-upcase c) c) output)
-			(loop #f))
-		      (begin
-			(if (or (char-numeric? c)
-				(eq? c #\_))
-			    (write-char c output))
-			(loop #t)))))))))))
-
 ;;;; Replace
 
 (define (string-replace string char1 char2)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index ac633cfc2..cfecd6195 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1033,11 +1033,9 @@ USA.
 	  vector-8b-ref
 	  vector-8b-set!)
   (export ()
-	  camel-case-string->lisp
 	  guarantee-substring
 	  guarantee-substring-end-index
 	  guarantee-substring-start-index
-	  lisp-string->camel-case
 	  reverse-string
 	  reverse-substring
 	  string-compare
diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 20da67acf..6768eb580 100644
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -89,44 +89,6 @@ USA.
 	(string-set! result j (string-ref string i)))
       result)))
 
-;;;; CamelCase support
-
-(define (camel-case-string->lisp string)
-  (call-with-input-string string
-    (lambda (input)
-      (call-with-output-string
-	(lambda (output)
-	  (let loop ((prev #f))
-	    (let ((c (read-char input)))
-	      (if (not (eof-object? c))
-		  (begin
-		    (if (and prev (char-upper-case? c))
-			(write-char #\- output))
-		    (write-char (char-downcase c) output)
-		    (loop c))))))))))
-
-(define (lisp-string->camel-case string #!optional upcase-initial?)
-  (call-with-input-string string
-    (lambda (input)
-      (call-with-output-string
-	(lambda (output)
-	  (let loop
-	      ((upcase?
-		(if (default-object? upcase-initial?)
-		    #t
-		    upcase-initial?)))
-	    (let ((c (read-char input)))
-	      (if (not (eof-object? c))
-		  (if (char-alphabetic? c)
-		      (begin
-			(write-char (if upcase? (char-upcase c) c) output)
-			(loop #f))
-		      (begin
-			(if (or (char-numeric? c)
-				(eq? c #\_))
-			    (write-char c output))
-			(loop #t)))))))))))
-
 ;;;; Replace
 
 (define (string-replace string char1 char2)