;;;-*-lisp-*-
;;; some readers for interactive use.

(herald reads)

(eval-when (eval compile)
  (or (get 'optdef 'version)
      (load "liblsp;optdef")))

(eval-when (eval compile load)
  (or (get 'prompt 'version)
      (load "liblsp;prompt")))

(eval-when (eval compile load)
  (if (status feature complr)
      (*lexpr read-filename read-number p-read read-sexp-line ok-p)))

;; READ-FILENAME takes a prompt and an optional MEREGEF spec, if the
;; filename is for input purposes.

(defun read-filename (prompt &optional (for-input nil))
  ;; with for-input non-nil we make sure Probef returns non-nil.
  ;; I/O lossage handler then only deals with really bad things.
  (do ((filename)(checked-filename)(probed-filename))(nil)
    (setq filename
	  (maknam (nreverse
		   (cdr (p-read prompt #\stop-chars '(#\CR #\LF))))))
    (terpri query-io-out)
    (setq checked-filename (errset (namestring filename) nil))
    (cond ((null checked-filename)
	   (format query-io-out "Bad filename specification : ~A~%" filename))
	  (for-input
	   (setq checked-filename (mergef (car checked-filename)
					  (if (eq for-input t)
					      ""
					      for-input)))
	   (if (setq probed-filename (probef checked-filename))
	       (return probed-filename)
	       (format query-io-out "File for input ~A cannot be found.~%"
		       checked-filename)))
	  (t
	   (return (car checked-filename))))))

;; READ-NUMBER takes a prompt and an optional validity test predicate,
;; and optional format-args for error message.

(defun read-number (prompt &optional (test nil) (mess "~&Number ~S is not ~A.~%")
			   &rest l
			   &aux (base 10.) (ibase 10.))
  (do ((input)(number))(nil)
    (setq input (nreverse (cdr (p-read prompt #\stop-chars
				       '(#\CR #\LF #\SP)))))
    (terpri query-io-out)
    (setq number (errset (readlist input) nil))
    (cond ((or (null number)
	       (not (numberp (setq number (car number)))))
	   (format query-io-out "Bad numeric specification: ~{~C~}~%" input))
	  ((and test (null (funcall test number)))
	   (lexpr-FUNCALL #'format query-io-out MESS NUMBER l))
	  (t
	   (return number)))))

;; READ-SEXP-LINE. arguments like read-number, very crude.

(defun read-sexp-line (prompt &optional pred (message "~&Bad input, not ~A,~%~S~%")
			      &rest l
			      &aux (base 10.) (ibase 10.))
  ;; only for reading in trivial little things, get P-READ
  ;; interfaced to read correctly eventually.
  (do ((chars)(res))(nil)
    (setq chars (nreverse (cdr (p-read prompt #\stop-chars '(#\CR #\LF)))))x
    (setq res (errset (readlist chars)))
    (cond ((null res)
	   (format msgfiles "~&Syntax error in input~%"))
	  ((funcall pred (setq res (car res)))
	   (return res))
	  (t
	   (lexpr-funcall #'format msgfiles message pred res l)))))

;; OK-P takes a prompt and optional format-args for help message.

(defun ok-p (prompt &optional (help  "~&Please reply /"Y/" or /"N/"~%")
		    &rest l)
  (do ((chars)(bi-prompt prompt) (q-prompt "(Y or N)?"))
      (nil)
    (setq chars (p-read bi-prompt #\NUMBER-OF-CHARS 1 #\STOP-CHARS NIL))
    (cond ((member (car chars) '(#/y #/Y))
	   (princ "es. " query-io-out)
	   (return t))
	  ((member (car chars) '(#/n #/N))
	   (princ "o. " query-io-out)
	   (return nil))
	  ((member (car chars) '(#/h #/H #/?))
	   (lexpr-funcall #'format query-io-out help l)
	   (setq bi-prompt prompt))
	  (t
	   (setq bi-prompt q-prompt)))))