#!/tmp/bin/scsh \
-o low-interrupt -e main -s
!#
; the struct LOW-INTERRUPT serves the proc REMOVE-INTERRUPT
(define rest cdr)
;; ASK : input-port output-port -> ...
;; [ shouldn't fool around with control ]
;; Call the interviewer ASK with I/O from/to the control terminal sans
;; echo (so that user input such as passwords doesn't show). (This
;; doesn't work well in Emacs/cmuscheme48 sessions.) Return the
;; result(s) of the ASK call.
;; Cf. Stevens' getpass in his APitUE (p.350 of 1st ed.)
(define (sans-echo* ask)
(let* ((inport (open-file (control-tty-file-name) open/read+write))
(outport (dup->outport inport))
(old-info (tty-info inport))
(new-info (copy-tty-info old-info))
(local-mask (bitwise-not
(bitwise-ior
ttyl/echo
ttyl/visual-delete
ttyl/echo-delete-line
ttyl/echo-nl
ttyl/canonical ; otherwise no immediate output
)))
(blockable-irupts (list interrupt/int
interrupt/tstp)))
(set-port-buffering inport bufpol/none)
(set-port-buffering outport bufpol/none)
;; switch off echo and stuff
(set-tty-info:local-flags new-info
(bitwise-and
(tty-info:local-flags old-info) local-mask))
(set-tty-info/flush inport new-info)
(let ((results (with-enabled-interrupts
(fold (lambda (ir set) (remove-interrupt ir set))
(enabled-interrupts)
blockable-irupts)
(receive tuple (ask inport outport)
(set-tty-info/flush inport old-info)
tuple))))
(close inport)
(close outport)
;; multi-values suck
(apply values results))))
;; example
(define (main args)
(sans-echo*
(lambda (inport outport)
(display "Type shameful secrets\n@ " outport)
(let loop ((out-chars (apply circular-list (string->list "twinkle, ")))
(in-char (read-char inport))
(input '()))
(if (eqv? in-char #\newline)
(format outport "~%You typed ~a~%" (reverse input))
(begin
(write-char (first out-chars) outport)
(loop (rest out-chars)
(read-char inport)
(cons in-char input))))))))
