;;; -*- Mode:LISP; -*-

;;; Macro support for the world

(declare (special *in-more-break*))

;;; CATCH-**MORE**
;;;  Catch a throw to flush output after a **MORE**.

(defmacro catch-**more** (&body body)
  `(*catch '*can-flush-more*
     (let ((*can-flush-more* t))
       (declare (special *can-flush-more*))
       ,@body)))

;;; DONT-CATCH-**MORE**

(defmacro dont-catch-**more** (&body body)
  `(let ((*can-flush-more* nil))
     (declare (special *can-flush-more*))
     ,@body))

;;; Top level place to go when have problems.

(defmacro catch-complaints (&body body)
  `(*catch 'complaint-handler
     (let ((*complaint-handler* t))
       (declare (special *complaint-handler*))
       ,@body)))

;;; Use system's old obarray

(defmacro with-saved-obarray (&body body)
  `(let ((obarray (or (get 'obarray 'saved-obarray) obarray)))
     ,@body))

;;; File hacking if on TOPS-20
(eval-when (eval compile load)
  (cond ((status feature TOPS-20)
	 (putprop 'teach '(ps kmp/.teach) 'ppn)
	 (putprop 'teach '(ps kmp/.teach) 'ppn))))

;;; Loading in of system files

(defmacro load-module (name &optional (when '(eval load)))
  (let ((inside `(cond ((not (get ',name 'version))
			(load '((teach) ,name))))))
    (cond ((or (equal when '(eval load))
	       (equal when '(load eval)))
	   inside)
	  (t `(eval-when ,when ,inside)))))

;;;; Interrupt character functions.

(defmacro define-interrupt-handler (name &body body)
  (let ((stream-var (gensym))
	(char-var (gensym)))
    `(progn 'compile
	    (defun ,name (,stream-var ,char-var)
	      (declare (special *complaint-handler*))
	      (clear-input ,stream-var)
	      (program-record "User typed ~@:C (~S).~%" ,char-var ',name)
	      (cond ((not *disallow-interrupts*)
		     (let ((*disallow-interrupts* t))
		       (nointerrupt nil)
		       (catch-complaints
			(catch-**more** ,@body))
		       (print '*)
		       (terpri)
		       (if *complaint-handler*  ;maybe quietly return...
			   (complain))))
		    (*in-more-break* nil)
		    (t
		     (recorded-output "~2&Don't type ~@:C when I'm busy~2%"
			     ,char-var)))))))


;;; (WHEN-ABNORMAL-EXIT exp form1 form2 form3 ...)
;;;
;;;  Executes exp, returning its value.
;;;  If an abnormal exit is done from exp, form1, form2, ... are executed.

(defmacro when-abnormal-exit (exp &body abnormal-exit-forms)
  (let ((var (gensym)))
    `(let ((,var t))
       (unwind-protect (prog1 ,exp (setq ,var nil))
		       (cond (,var ,@abnormal-exit-forms))))))

(defmacro cautiously-incrementing-filepos (file &body body)
  `(let ((old-filepos (filepos ,file)))
     (when-abnormal-exit (progn ,@body)
       (filepos ,file old-filepos))))

;;; Local Modes:;
;;; Mode:LISP;
;;; Lisp WHEN-ABNORMAL-EXIT Indent:1;
;;; Lisp CAUTIOUSLY-INCREMENTING-FILEPOS:1;
;;; End:;