;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.58
;;; Reason:
;;;  More informative error message text.
;;; Written 19-Aug-88 15:34:14 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.51, ZWEI 125.16, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.12, SDU ROM 102, kold 4aug88.



; From file DJ: L.SYS; QCDEFS.LISP#247 at 19-Aug-88 15:34:15
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCDEFS  "

(defmacro opening-frames ((dest new-frame) &body body)
  (let ((original-open (gensymbol "ORIGINAL-OPEN-FRAMES"))
	(original-dest (gensymbol "ORIGINAL-DESTINATION"))
	(new-frame-symbol (gensymbol "NEW-FRAME")))
    `(let* ((,original-open *open-frames*)
	    (,original-dest ,dest)
	    (,new-frame-symbol ,new-frame)
	    (,dest (or ,new-frame-symbol ,dest)))
       (multiple-value-prog1
	 (progn (when ,new-frame-symbol
		  (setf (open-frame-idest ,new-frame-symbol) ,original-dest)
		  (add-frame ,new-frame-symbol))
		,@body)
	 (when ,new-frame-symbol
	   (unless (or (not *dropthru*)
		       (eq *open-frames* ,original-open))
	     (fsignal "Internal error: frame botch in OPENING-FRAMES")
	     (clean-up-open-frames ,original-open nil ,dest)))))))

))

; From file DJ: L.SYS; QCDEFS.LISP#247 at 19-Aug-88 15:34:17
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCDEFS  "

(defmacro opening-frames ((dest new-frame) &body body)
  (let ((original-open (gensymbol "ORIGINAL-OPEN-FRAMES"))
	(original-dest (gensymbol "ORIGINAL-DESTINATION"))
	(new-frame-symbol (gensymbol "NEW-FRAME")))
    `(let* ((,original-open *open-frames*)
	    (,original-dest ,dest)
	    (,new-frame-symbol ,new-frame)
	    (,dest (or ,new-frame-symbol ,dest)))
       (multiple-value-prog1
	 (progn (when ,new-frame-symbol
		  (setf (open-frame-idest ,new-frame-symbol) ,original-dest)
		  (add-frame ,new-frame-symbol))
		,@body)
	 (when ,new-frame-symbol
	   (unless (or (not *dropthru*)
		       (eq *open-frames* ,original-open))
	     (fsignal "Internal error: frame botch in OPENING-FRAMES")
	     (clean-up-open-frames ,original-open nil ,dest)))))))

))