From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 22 Feb 2017 05:03:16 +0000 (-0800)
Subject: Eliminate use of legacy string.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~31
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=92964b4a3e6f288576a108efd790e87447b02e12;p=mit-scheme.git

Eliminate use of legacy string.
---

diff --git a/src/runtime/usrint.scm b/src/runtime/usrint.scm
index 255be71f1..10ff5a143 100644
--- a/src/runtime/usrint.scm
+++ b/src/runtime/usrint.scm
@@ -163,7 +163,7 @@ USA.
 	     (beep port)
 	     (flush-output-port port)))
 	 (loop))))))
-
+
 (define (prompt-for-string prompt #!optional port)
   ;; Returns a string (the normal, "cooked" input line) or eof-object.
   (let ((port (if (default-object? port) (interaction-i/o-port) port)))
@@ -182,12 +182,15 @@ USA.
   (with-input-port-terminal-mode port 'COOKED
     (lambda ()
       (read-line port))))
-
+
 (define (call-with-pass-phrase prompt receiver #!optional port)
-  ;; Returns a string or eof-object -- the normal, "cooked but not
-  ;; echoed" input line.
-  (let ((port (if (default-object? port) (interaction-i/o-port) port)))
-    (let ((operation (port/operation port 'CALL-WITH-PASS-PHRASE)))
+  (let ((port
+	 (if (default-object? port)
+	     (interaction-i/o-port)
+	     (begin
+	       (guarantee textual-i/o-port? port 'call-with-pass-phrase)
+	       port))))
+    (let ((operation (port/operation port 'call-with-pass-phrase)))
       (if operation
 	  (operation port prompt receiver)
 	  (default/call-with-pass-phrase port prompt receiver)))))
@@ -196,77 +199,64 @@ USA.
   ;; Kludge: Uses RAW mode and "cooks" #\backspace, #\return, etc.
   ;; without regard for the tty's current "special characters".
   ;; Signals an error if PORT is not an i/o port.
-
-  (define (del-char str)
-    (let ((l (string-length str)))
-      (if (fix:> l 0)
-	  (set-string-length! str (fix:-1+ l))))
-    str)
-
-  (define (add-char str char)
-    (let ((i (string-length str))
-	  (max (if (string-null? str) 0 (string-maximum-length str))))
-      (if (fix:< i max)
-	  (begin
-	    (set-string-length! str (fix:1+ i))
-	    (string-set! str i char)
-	    str)
-	  (let ((new (make-string (fix:+ 10 i))))
-	    (if (not (string-null? str))
-		(begin
-		  (substring-move! str 0 i new 0)
-		  (set-string-length! str (string-maximum-length str))
-		  (string-fill! str #\delete)))
-	    (set-string-length! new (fix:1+ i))
-	    (string-set! new i char)
-	    new))))
-
-  (define-integrable (with-binary-line-ending thunk)
-    (let ((outside))
-      (dynamic-wind
-	  (lambda ()
-	    (if (port/open? port)
-		(begin
-		  (set! outside (port/line-ending port))
-		  (port/set-line-ending port 'BINARY))))
-	  thunk
-	  (lambda ()
-	    (if (port/open? port)
-		(begin
-		  (port/set-line-ending port outside)
-		  (set! outside)))))))
-
-  (guarantee textual-i/o-port? port 'default/call-with-pass-phrase)
-  (with-output-port-terminal-mode port 'COOKED
-    (lambda ()
-      (fresh-line port)
-      (newline port)
-      (write-string (canonicalize-prompt prompt ": ") port)
-      (flush-output-port port)))
-  (let loop ((input ""))
-    (let ((char (with-binary-line-ending
-		 (lambda ()
-		   (with-input-port-terminal-mode port 'RAW
-		     (lambda ()
-		       (read-char port)))))))
-      (cond ((or (eof-object? char)
-		    (char=? char #\return)
-		    (char=? char #\linefeed))
-		(receiver input)
-		(set-string-length! input (string-maximum-length input))
-		(string-fill! input #\delete)
-		(with-output-port-terminal-mode port 'COOKED
+  (let ((buffer (make-string 16))
+	(index 0)
+	(fill-char (integer->char #x155555)))
+    (with-output-port-terminal-mode port 'cooked
+      (lambda ()
+	(fresh-line port)
+	(newline port)
+	(write-string (canonicalize-prompt prompt ": ") port)
+	(flush-output-port port)))
+    (let loop ()
+      (let ((char
+	     (with-binary-line-ending port
+	      (lambda ()
+		(with-input-port-terminal-mode port 'raw
 		  (lambda ()
-		    (newline port)))
-		unspecific)
-	    ((or (char=? char #\backspace)
-		 (char=? char #\delete))
-	     (loop (del-char input)))
-	    ((char=? char #\U+15)
-	     (set-string-length! input 0)
-	     (loop input))
-	    (else
-	     (loop (add-char input char)))))))
+		    (read-char port)))))))
+	(cond ((or (eof-object? char)
+		   (char=? char #\return)
+		   (char=? char #\linefeed))
+	       (with-output-port-terminal-mode port 'cooked
+		 (lambda ()
+		   (newline port)))
+	       (receiver (string-slice buffer 0 index))
+	       (string-fill! buffer fill-char)
+	       unspecific)
+	      ((or (char=? char #\backspace)
+		   (char=? char #\delete))
+	       (if (fix:> index 0)
+		   (set! index (fix:- index 1)))
+	       (loop))
+	      ((char=? char (integer->char #x15)) ;C-w
+	       (set! index 0)
+	       (loop))
+	      (else
+	       (let ((n (string-length buffer)))
+		 (if (not (fix:< index n))
+		     (let ((buffer* (make-string (fix:* 2 n))))
+		       (string-copy! buffer* 0 buffer)
+		       (string-fill! buffer fill-char)
+		       (set! buffer buffer*))))
+	       (string-set! buffer index char)
+	       (set! index (fix:+ index 1))
+	       (loop)))))))
+
+(define (with-binary-line-ending port thunk)
+  (let ((outside))
+    (dynamic-wind
+	(lambda ()
+	  (if (textual-port-open? port)
+	      (begin
+		(set! outside (port/line-ending port))
+		(port/set-line-ending port 'binary))))
+	thunk
+	(lambda ()
+	  (if (textual-port-open? port)
+	      (begin
+		(port/set-line-ending port outside)
+		(set! outside)))))))
 
 (define (canonicalize-prompt prompt suffix)
   (if (let ((length (string-length prompt)))