;;;-*-LISP-*-

;;; user-query interfaces.

(HERALD USER-QUERY)

(EVAL-WHEN (EVAL COMPILE)
	   (OR (GET 'DO-WITH-TTY-ON 'MACRO)(LOAD '|LIBLSP;TTY FASL|)))


(DEFVAR TTY-RETURN-STACK NIL)

(DEFUN READ-HASH-SEQ ()
       (DO ((K 0 (+ CHAR (* K 256)))
	    (CHAR (TYI TYI)(TYI TYI)))
	   ((= CHAR #\CR) K)))

(DEFUN READ-PASS-WORD ()
       (DO-WITH-TTY-OFF
	(DO ((K1)(K2))
	    (())
	    (*CATCH 'RE-READ-PASS-WORD
		    (LET ((TTY-RETURN-STACK
			   (CONS '(PROGN (TERPRI TYO)
					 (PRINC "Interrupted, try again." TYO)
					 (*THROW 'RE-READ-PASS-WORD NIL))
				 TTY-RETURN-STACK)))
			 (CLEAR-INPUT TYI)
			 (TERPRI TYO)
			 (PRINC '|Input password->| TYO)
			 (SETQ K1 (READ-HASH-SEQ))
			 (PRINC '|again->| TYO)
			 (SETQ K2 (READ-HASH-SEQ))
			 (AND (= K1 K2) (RETURN K1))
			 (PRINC '|passwords didn't match, try again.| TYO))))))


(DEFUN READ-FILE-NAME (&OPTIONAL (PROBE-TEST NIL))
       (DO ((N))
	   (())
	   (SETQ N (READ-UNTIL-CR '|File name->|))
	   (COND ((EQ N '||))
		 (T
		  (SETQ N (ERRSET (NAMELIST N) T))
		  (AND N (COND ((OR (NOT PROBE-TEST) (PROBEF (CAR N)))
				(RETURN (CAR N)))
			       (T
				(PRINC (NAMESTRING (CAR N)) TYO)
				(PRINC '| is not an existing file.| TYO))))))))

(DEFVAR PROMPT)
(DEFVAR INPUT-CHAR-STACK NIL)

(DEFUN RE-DISPLAY ()
       (PROGN (PRINC PROMPT TYO)
	      (MAPC #'(LAMBDA (X) (TYO X TYO))
		    (REVERSE INPUT-CHAR-STACK))))

(DEFUN READ-UNTIL-CR (PROMPT &AUX TTY-RETURN-STACK INPUT-CHAR-STACK)
       (PUSH '(PROGN (CURSORPOS 'A TYO)
		     (RE-DISPLAY))
	     TTY-RETURN-STACK)
       (cursorpos 'a tyo)
       (PRINC PROMPT TYO)
       (DO ((C (TYI TYI)(TYI TYI)))
	   ((= C #\CR)
	    (IMPLODE (NREVERSE INPUT-CHAR-STACK)))
	   (COND ((= C #\RUBOUT)
		  (COND (INPUT-CHAR-STACK
			 (RUBOUT (POP INPUT-CHAR-STACK) TYO))))
		 ((= C #\FF)
		  (RE-DISPLAY))
		 (T (PUSH C INPUT-CHAR-STACK)))))

(DEFUN TTY-RETURN (&REST IGNORED)
       (AND TTY-RETURN-STACK (EVAL (CAR TTY-RETURN-STACK))))

(SETQ TTY-RETURN 'TTY-RETURN)

(DEFUN READ-CHARACTER (PROMPT &AUX INPUT-CHAR-STACK TTY-RETURN-STACK)
       (PUSH '(PROGN (CURSORPOS 'A TYO) (RE-DISPLAY))
	     TTY-RETURN-STACK)
       (RE-DISPLAY)
       (DO ((C (TYI TYI) (TYI TYI)))
	   ((NOT (= C #\FF)) C)
	   (RE-DISPLAY)))

(DEFUN Y-or-n-or-?-p (MESSAGE &OPTIONAL (EXPLAIN))
       (FORMAT TYO "~&~A " MESSAGE)
       (DO ((C))
	   (NIL)
	   (SETQ C (READ-CHARACTER '|(Y or N)?|))
	   (CASEQ C
		  ((#/Y #/y)
		   (PRINC "es." TYO)
		   (RETURN T))
		  ((#/N #/n)
		   (PRINC "o." TYO)
		   (RETURN NIL))
		  ((#/? #/h #/H)
		   (IF EXPLAIN (FORMAT TYO "~&~A~%" EXPLAIN))
		   (FORMAT TYO "~&~A " MESSAGE))
		  (T NIL))))