diff --git a/lib/chibi/snow/interface.scm b/lib/chibi/snow/interface.scm index 0a668f8d..7c6d73eb 100644 --- a/lib/chibi/snow/interface.scm +++ b/lib/chibi/snow/interface.scm @@ -70,24 +70,19 @@ (history-insert! input-history str) (check str (proc str) lp))))))) -(define (input-hidden prompt) - (show #t prompt) - (flush-output-port) - (let ((res (with-stty '(not echo) (lambda () (read-line))))) - (show #t "\n") - res)) - (define (input-password cfg name prompt1 . o) (let ((prompt2 (or (and (pair? o) (car o)) (string-append prompt1 " (confirmation): ")))) (let lp () - (let ((password (input-hidden prompt1))) + (let ((password (edit-line 'hidden?: #t 'prompt: prompt1))) + (newline) (cond ((equal? password "") (show #t "password must be non-empty\n") (lp)) (else - (let ((conf (input-hidden prompt2))) + (let ((conf (edit-line 'hidden?: #t 'prompt: prompt2))) + (newline) (cond ((not (equal? password conf)) (show #t "password didn't match\n") diff --git a/lib/chibi/snow/interface.sld b/lib/chibi/snow/interface.sld index 0be229d5..d5f7ba10 100644 --- a/lib/chibi/snow/interface.sld +++ b/lib/chibi/snow/interface.sld @@ -4,15 +4,15 @@ restore-history save-history) (import (scheme base) (scheme char) (scheme read) (scheme write) (scheme file) (scheme process-context) (srfi 1) - (chibi config) (chibi pathname) (chibi show)) + (chibi config) (chibi pathname) (chibi show) + (chibi term edit-line)) (cond-expand (chibi - (import (chibi filesystem) (chibi stty))) + (import (chibi filesystem))) (chicken - (import posix stty) + (import posix) (begin - (define (create-directory* dir) (create-directory dir #t)) - (define (edit-line )))) + (define (create-directory* dir) (create-directory dir #t)))) (sagittarius (import (only (sagittarius) create-directory) (chibi string)) @@ -30,28 +30,5 @@ (and (not (equal? parent dir)) (not (file-exists? parent)) (create-directory* parent mode) - (create-directory dir mode)))))))) - (define (with-stty spec thunk) - (thunk))))) - (cond-expand - (chibi - (import (chibi term edit-line))) - (else - (begin - (define (get-key ls key . o) - (let ((x (memq key ls))) - (if (and x (pair? (cdr x))) (cadr x) (and (pair? o) (car o))))) - (define (edit-line . args) - (let ((in (if (and (pair? args) (input-port? (car args))) - (car args) - (current-input-port))) - (out (if (and (eq? in (car args)) - (pair? (cdr args)) - (output-port? (cadr args))) - (cadr args) - (current-output-port))) - (prompter (get-key args 'prompt: "> "))) - (display (if (procedure? prompter) (prompter) prompter) out) - (flush-output-port out) - (read-line in)))))) + (create-directory dir mode))))))))))) (include "interface.scm")) diff --git a/lib/chibi/term/edit-line.scm b/lib/chibi/term/edit-line.scm index 35020d34..6e1fe4f2 100644 --- a/lib/chibi/term/edit-line.scm +++ b/lib/chibi/term/edit-line.scm @@ -1,6 +1,6 @@ ;;;; edit-line.scm - pure scheme line editor ;; -;; Copyright (c) 2011-2012 Alex Shinn. All rights reserved. +;; Copyright (c) 2011-2017 Alex Shinn. All rights reserved. ;; BSD-style license: http://synthcode.com/license.txt ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -11,7 +11,7 @@ (write-char #\[ out) (if arg (display arg out)) (write-char ch out) - (flush-output out)) + (flush-output-port out)) ;; we use zero-based columns (define (terminal-goto-col out n) (terminal-escape out #\G (+ n 1))) @@ -430,7 +430,7 @@ (if (< (buffer-row buf) (buffer-max-row buf)) (terminal-up out (- (buffer-max-row buf) (buffer-row buf)))))) (terminal-goto-col out (buffer-col buf)) - (flush-output out) + (flush-output-port out) (buffer-cleared?-set! buf #f))) (define (buffer-refresh buf out) @@ -481,7 +481,7 @@ (not (string-index #\newline x)))) ;; fast path - append to end of buffer w/o wrapping to next line (display x out) - (flush-output out) + (flush-output-port out) (buffer-col-set! buf (+ (buffer-col buf) len)) (buffer-cleared?-set! buf #f)) (else @@ -662,7 +662,7 @@ (((buffer-complete? buf) buf) (command/end-of-line ch buf out return) (display "\r\n" out) - (flush-output out) + (flush-output-port out) (return)) (else (command/self-insert ch buf out return))))) @@ -679,7 +679,7 @@ (display "^C" out) (newline out) (stty out '(icanon isig echo)) - (exit)) + (return '^C)) (define (command/beep ch buf out return) (write-char (integer->char 7) out)) @@ -785,6 +785,7 @@ (single-line? (get-key args 'single-line?: #f)) (fresh-line (get-key args 'fresh-line: #f)) (no-stty? (get-key args 'no-stty?: #f)) + (hidden? (get-key args 'hidden?: #f)) (keymap0 (get-key args 'keymap: (if (get-key args 'catch-control-c?: #f) standard-cancel-keymap @@ -797,6 +798,7 @@ (let* ((width (or terminal-width (get-terminal-width out) 80)) (prompt (if (procedure? prompter) (prompter) prompter)) (done? #f) + (tmp-out (if hidden? (open-output-string) out)) (return (lambda o (set! done? (if (pair? o) (car o) #t))))) ;; Maybe start at a fresh line. (cond @@ -815,7 +817,7 @@ (buffer-single-line?-set! buf single-line?) (if single-line? (buffer-start-set! buf (buffer-min buf))) (buffer-refresh buf out) - (flush-output out) + (flush-output-port out) ((if no-stty? (lambda (out f) (f)) with-raw-io) out (lambda () @@ -833,9 +835,9 @@ (buffer-clear buf out) (print-exception exn out) (buffer-draw buf out))) - (x ch buf out return)) - (flush-output out) - (buffer-refresh buf out) + (x ch buf tmp-out return)) + (flush-output-port tmp-out) + (buffer-refresh buf tmp-out) (if done? (and (not (eq? done? 'eof)) (buffer->string buf)) (lp keymap))) diff --git a/lib/chibi/term/edit-line.sld b/lib/chibi/term/edit-line.sld index 1bb0e996..377c506c 100644 --- a/lib/chibi/term/edit-line.sld +++ b/lib/chibi/term/edit-line.sld @@ -7,5 +7,32 @@ buffer-clear buffer-refresh buffer-draw buffer-row buffer-col make-keymap make-standard-keymap) - (import (chibi) (chibi ast) (chibi stty) (chibi process) (srfi 9) (srfi 33)) + (import (scheme base) (scheme char) (scheme write)) + (cond-expand + ((library (srfi 33)) + (import (srfi 33))) + (else + (import (srfi 60)))) + (cond-expand + (chibi + (import (chibi stty))) + (chicken + (import stty)) + (else + (define (with-stty spec thunk) + (thunk)))) + (cond-expand + (chibi + (import (only (chibi) protect print-exception) + (chibi ast))) + (else + (begin + (define-syntax protect + (syntax-rules () (protect . x) (guard . x))) + (define (print-exception exn . o) + (let ((out (if (pair? o) (car o) (current-error-port)))) + (write exn out) + (newline out))) + (define (exception? x) #f) + (define (exception-kind x) #f)))) (include "edit-line.scm"))