;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 126.100
;;; Reason:
;;;  Make LISP:WARN work with *BREAK-ON-WARNINGS*.  Was blowing out with problem within
;;;  SIGNAL-CONDITION.
;;;  
;;;  This is a quick and dirty fix -- probably not ultimate.  Problems:
;;;  
;;;  1. Works by mixing FERROR into COMMON-LISP-WARNING flavor.  This seems
;;;  like some kind of breach of categories, but using the WARNING flavor
;;;  alone doesn't provide any error handler at all.  (That is what you would
;;;  want for a warning that could never break!)
;;;  
;;;  2. WARN does not really work like the existing doc string, which makes a distinction
;;;  between *BREAK-ON-WARNINGS* and EH:*SIGNAL-ON-WARNINGS*.  The code does not make
;;;  a distinction, maybe the error handler does in SIGNAL-CONDITION, but this is not
;;;  obvious.  Let's leave this for further research.
;;;  
;;;    --Keith & SMH
;;; Written 3-Oct-88 14:59:17 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 126.99, Experimental ZWEI 126.14, Experimental ZMail 74.6, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.DEBUGGER; CONDITION-FLAVORS.LISP#13 at 3-Oct-88 14:59:17
#10R EH#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "EH")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: DEBUGGER; CONDITION-FLAVORS  "

(defflavor common-lisp-warning () (format-condition-mixin warning ferror))

(defmethod (common-lisp-warning :case :proceed-asking-user :no-action) (continuation ignore)
  "Simply proceed from warning."
  (funcall continuation :no-action))

(compile-flavor-methods common-lisp-warning)

(defun warn (format-string &rest format-args)
  "This is the Common Lisp WARN function.  FORMAT-STRING and FORMAT-ARGS are used
to construct a warning message which is output to *ERROR-OUTPUT*. WARN always returns NIL.
Normally, WARN simply produces this output and returns NIL, without using the
condition-handling system.  However, there are two variables which can be used to modify
its behavior.
 *BREAK-ON-WARNINGS*, if not NIL, makes WARN behave like enter a debugger breakpoint.
A message will be printed, and the debugger is entered.  This can give one a chance to
inspect the state of a computation at the point when a warning is generated.
 EH:*SIGNAL-ON-WARNINGS*, if not NIL (as it is by default), causes WARN to signal an
EH:COMMON-LISP-WARNING condition.  This is to permit a sophisticated system to produce its
own warnings, or simply to log them.  If this condition is not handled, then WARN behaves
normally (it prints the error message itself);  otherwise, it simply returns NIL.
 If *BREAK-ON-WARNINGS* is not NIL, then the condition IS signaled --
it is the default interactive handler (which is what decides when to call
the Lisp debugger) which decides whether to break, by looking at both
the type of the condition and *BREAK-ON-WARNINGS*."
  (check-type format-string string)
  (unless (and (or *signal-on-warnings* *break-on-warnings*)
	       (signal-condition
		 (make-condition 'common-lisp-warning
		   :format-string format-string :format-args format-args
		   :proceed-types '(:no-action))
		 '(:no-action)))
    (format *error-output* "~&>>WARNING: ~?~&" format-string format-args))
  nil)

))