PDP-10.its/src/libdoc/more.kmp15

;;; -*- LISP -*-		Created by KMP, 11/30/80
;;; MORE: A library with a winning more break handler
;;;
;;; Description:
;;;
;;; The function +EXTERNAL-TTY-ENDPAGEFN is defined in this file.
;;; Setting the variable *MORE to a value other than T will turn 
;;; on fancy features. A function *MORE is provided to ensure that
;;; a proper type value is set in the variable *MORE.
;;;
;;; Three states are possible:
;;;
;;; [1] (*MORE = NIL) Ignore More-Interrupts.
;;;     The endpage function will do nothing.
;;;
;;; [2] (*MORE = T)   Simulate normal more-break. 
;;;     Print "##More##" and if char typed is a Space or Rubout, eat the
;;;     char, else leave it around on the input stream for someone else.
;;;
;;; [3] (*MORE = <n>) Pause <n> seconds. (<n> Must be greater than 0
;;;     Print "--m Minute s Second Pause--" and wait. If after that time,
;;;     nothing has been typed, the pause ends and computation resumes
;;;     replacing the "-- ... Pause--" message with a "--Pause Timed Out--"
;;;	message. If a char is typed, it is eaten and computation continues
;;;     unless an Altmode is typed, in which case the timer is turned
;;;     off for that more break, "--Waiting--" will display, and the
;;;     break will continue until a char is typed (which will be eaten).
;;;
;;; Note that the following evil (?) side-effects happen to your lisp...
;;;
;;;  *  The Alarm clock feature is used. Since LISP can only have one
;;;	alarmclock going at any time, using an alarm clock for anything
;;;	else will lose badly.
;;;
;;;  *  ^B is redefined to turn off the alarmclock when it runs.
;;;	If you don't redefine ^B yourself, you won't be bothered by
;;;	it.
;;;

(DECLARE (MUZZLED T))

(DECLARE (SPECIAL *MORE)) ;Compiler declaration

(COND ((NOT (BOUNDP '*MORE))
       (SETQ *MORE T)))

(DEFUN *MORE (X)
   (COND ((AND (FLOATP X) (> X 0.0))
	  (SETQ *MORE X))
	 ((AND (FIXP X) (> X 0.))
	  (SETQ *MORE X))
	 ((OR (EQUAL X 0.) (NULL X))
	  (SETQ *MORE NIL))
	 ((EQ X 'T)
	  (SETQ *MORE T))
	 (T
	  (ERROR '|- Arg to *MORE must be NIL, T, or a positive flonum.| X))))

(SETQ +EXTERNAL-TTY-ENDPAGEFN\OVERSTRIKE?
  (NOT (ZEROP (BOOLE 1. (CAR (SYSCALL 1. 'TTYVAR TYO (CAR (PNGET 'TTYOPT 6))))
		     #o1000000000))))

(DECLARE (SPECIAL +EXTERNAL-TTY-ENDPAGEFN\POS
		  +EXTERNAL-TTY-ENDPAGEFN\SECONDS
		  +EXTERNAL-TTY-ENDPAGEFN\OVERSTRIKE?))

(DEFUN +EXTERNAL-TTY-ENDPAGEFN\ALARM (())
       (LET ((TIME (FIX (-$ +EXTERNAL-TTY-ENDPAGEFN\SECONDS (TIME)))))
	    (COND ((< TIME 1.)
		   (COND ((ZEROP (LISTEN)) (*THROW 'ENDPAGE-EXIT T))
			 (T NIL)))
		  (T
		   (LET ((BASE 10.)
			 (*NOPOINT T)
			 (DAYS)
			 (HOURS)
			 (MINS)
			 (SECS))
			(SETQ DAYS (// TIME 86400.))
			(SETQ TIME (- TIME (* 86400. DAYS)))
			(SETQ HOURS (// TIME 3600.))
			(SETQ TIME (- TIME (* 3600. HOURS)))
			(SETQ MINS (// TIME 60.))
			(SETQ SECS (- TIME (* 60. MINS)))
			(CURSORPOS (CAR +EXTERNAL-TTY-ENDPAGEFN\POS)
				   (CDR +EXTERNAL-TTY-ENDPAGEFN\POS)
				   TYO)
			(IF +EXTERNAL-TTY-ENDPAGEFN\OVERSTRIKE?
			    (CURSORPOS 'L TYO))
			(PRINC '|--| TYO)
			(COND ((> DAYS 0.)
			       (PRINC DAYS TYO)
			       (PRINC '| Day | TYO)))
			(COND ((> HOURS 0.)
			       (PRINC HOURS TYO)
			       (PRINC '| Hour | TYO)))
			(COND ((> MINS 0.)
			       (PRINC MINS TYO)
			       (PRINC '| Minute | TYO)))
			(COND ((> SECS 0.)
			       (PRINC SECS TYO)
			       (PRINC '| Second | TYO)))
			(PRINC '|Pause--| TYO)
			(CURSORPOS 'L TYO))
		   (ALARMCLOCK 'TIME 1.)))))

(DEFUN +EXTERNAL-TTY-ENDPAGEFN (TYO)
       (PROG (ALARMCLOCK POS C
			 +EXTERNAL-TTY-ENDPAGEFN\POS
			 +EXTERNAL-TTY-ENDPAGEFN\SECONDS)
	     (NOINTERRUPT NIL)
	     (COND ((NULL *MORE) ; Ignore interrupt
		    (RETURN T))
		   ((NOT (NUMBERP *MORE)) ; Run Standard More Break Handler
		    (RETURN (+INTERNAL-TTY-ENDPAGEFN TYO))))
	     (SETQ +EXTERNAL-TTY-ENDPAGEFN\POS (SETQ POS (CURSORPOS TYO)))
	     (SETQ +EXTERNAL-TTY-ENDPAGEFN\SECONDS (+$ (FLOAT *MORE) (TIME)))
	     (SETQ ALARMCLOCK '+EXTERNAL-TTY-ENDPAGEFN\ALARM)
	     (+EXTERNAL-TTY-ENDPAGEFN\ALARM NIL)
	     (*CATCH 'ENDPAGE-EXIT
	         (UNWIND-PROTECT
		     (PROGN (ALARMCLOCK 'TIME 1.)
			    (SETQ C (TYI TYI))
			    (COND ((= C 27.)
				   (ALARMCLOCK 'TIME NIL)
				   (CURSORPOS (CAR POS) (CDR POS) TYO)
				   (IF +EXTERNAL-TTY-ENDPAGEFN\OVERSTRIKE?
				       (CURSORPOS 'L TYO))
				   (PRINC '|--Waiting--| TYO)
				   (CURSORPOS 'L TYO)
				   (SETQ C (TYI TYI))))
			    (ALARMCLOCK 'TIME NIL)
			    (CURSORPOS (CAR POS) (CDR POS) TYO)
			    (IF +EXTERNAL-TTY-ENDPAGEFN\OVERSTRIKE?
				(CURSORPOS 'L TYO))
			    (PRINC '|--Continuing--| TYO)
			    (CURSORPOS 'L TYO)
			    (TERPRI TYO)
			    (RETURN T))
		     (ALARMCLOCK 'TIME NIL)))
	     (CURSORPOS (CAR POS) (CDR POS) TYO)
	     (IF +EXTERNAL-TTY-ENDPAGEFN\OVERSTRIKE?
		 (CURSORPOS 'L TYO))
	     (PRINC '|--Pause Timed Out--| TYO)
	     (CURSORPOS 'L TYO)
	     (TERPRI TYO)))

(DEFUN +EXTERNAL-^B-BREAK (() ())
       (ALARMCLOCK 'TIME NIL)
       (NOINTERRUPT NIL)
       (BREAK |^B|))

(SSTATUS TTYINT 2. '+EXTERNAL-^B-BREAK)

(ENDPAGEFN TYO '+EXTERNAL-TTY-ENDPAGEFN)