;;; -*- Mode:LISP; -*-
;;; stolen from TNP;FORT >

(herald MORE)

(eval-when (eval compile)
  (load '((liblsp) tty)))

(defvar *can-flush-more* nil)
(defvar *in-more-break* nil)

(defun **more** (stream)
  (nointerrupt nil)
  (do-with-tty-off
   (let ((*in-more-break* t))
     (cond (*can-flush-more* (maybe-**more** stream (status ttycons stream)))
	   (t (surely-**more** stream (status ttycons stream)))))))

(defun maybe-**more** (outstream instream)
  (let ((where (cursorpos outstream)))
    (cursorpos 'l outstream)
    (format outstream "--More?--")
    (do ((c (tyi instream) (tyi instream))
	 (flag t))
	(nil)
      (cond ((= c #\rubout)
	     (cursorpos (car where) (cdr where) outstream)
	     (cursorpos 'l outstream)					
	     (format outstream "--Output flushed--~%")
	     (*throw '*can-flush-more* t))
	    ((= c #\space)
	     (cursorpos (car where) (cdr where) outstream)
	     (cursorpos 'l outstream)
	     (format outstream "--Continuing--~%")		
	     (return t))
	    (flag
	     (setq flag nil)
	     (format outstream
		     "(Type SPACE to continue or RUBOUT to flush output)"))))))

(defun surely-**more** (outstream instream)
  (let ((where (cursorpos outstream)))
    (cursorpos 'l outstream)
    (format outstream "--Pause--")
    (do ((c (tyi instream) (tyi instream))
	 (flag t))
	(nil)
      (cond ((= c #\space)
	     (cursorpos (car where) (cdr where) outstream)
	     (cursorpos 'l outstream)
	     (format outstream "--Continuing--~%")		
	     (return t))
	    (flag
	     (setq flag nil)
	     (format outstream
		     "(Type SPACE to continue)"))))))    