Eliminate use of legacy string.

diff --git a/src/runtime/usrint.scm b/src/runtime/usrint.scm
index 255be71f165070b71c344ded92e91853ea25be04..10ff5a1434763deea01b926180b06ec52f56ebd0 100644 (file)
--- a/src/runtime/usrint.scm
+++ b/src/runtime/usrint.scm
@@ -163,7 +163,7 @@ USA.
             (beep port)
             (flush-output-port port)))
         (loop))))))
-
+\f
 (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))))
-
+\f
 (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)))))))
 \f
 (define (canonicalize-prompt prompt suffix)
   (if (let ((length (string-length prompt)))