!! Obtain passwords and the like with discretion
See also ReadPassword.
----
 #!/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))))))))