;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.250
;;; Reason:
;;;  (describe-flavor) failed to list flavors directly depended upon.
;;; Written 4-May-88 16:06:40 by pld at site Gigamos Cambridge
;;; while running on Azathoth from band 3
;;; with Experimental System 123.249, Experimental Local-File 73.5, Experimental FILE-Server 22.3, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 22.4, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.SYS2; FLAVOR.LISP#316 at 4-May-88 16:06:41
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; FLAVOR  "

(DEFUN DESCRIBE-FLAVOR (FLAVOR-NAME &AUX FL)
  "Prints out descriptive information about FLAVOR-NAME including the combined list of
its component flavors."
  (CHECK-ARG FLAVOR-NAME (EQ 'FLAVOR (TYPEP (SETQ FL (IF (SYMBOLP FLAVOR-NAME)
							 (GET FLAVOR-NAME 'FLAVOR)
							 FLAVOR-NAME))))
	     "a flavor or the name of one")
  (FORMAT T "~&Flavor ~S directly depends on flavors: ~:[none~;~:*~{~<~%   ~3:;~S~>~^, ~}~]~%"
	    FLAVOR-NAME (FLAVOR-DEPENDS-ON FL))
  (AND (FLAVOR-INCLUDES FL)
       (FORMAT T " and directly includes ~{~<~%   ~3:;~S~>~^, ~}~%" (FLAVOR-INCLUDES FL)))
  (AND (FLAVOR-DEPENDED-ON-BY FL)
       (FORMAT T " and is directly depended on by ~{~<~%   ~3:;~S~>~^, ~}~%" (FLAVOR-DEPENDED-ON-BY FL)))
  (AND (FLAVOR-DEPENDS-ON-ALL FL)	;If this has been computed, show it
       (FORMAT T " and directly or indirectly depends on ~{~<~%   ~3:;~S~>~^, ~}~%"
	         (FLAVOR-DEPENDS-ON-ALL FL)))
  (COND ((NOT (NULL (FLAVOR-METHOD-TABLE FL)))
	 (FORMAT T "Not counting inherited methods, the methods for ~S are:~%" FLAVOR-NAME)
	 (DOLIST (M (FLAVOR-METHOD-TABLE FL))
	   (LET ((METHODS (SUBSET 'METH-DEFINEDP (CDDDR M))))
	     (FORMAT T "   ")
	     (DO ((TPL METHODS (CDR TPL))) ((NULL TPL))
	       (IF (METH-METHOD-TYPE (CAR TPL))
		   (FORMAT T ":~A " (METH-METHOD-TYPE (CAR TPL))))
	       (FORMAT T ":~A" (CAR M))
	       (LET ((SUBOP (FIFTH (METH-FUNCTION-SPEC (CAR TPL)))))
		 (WHEN SUBOP (FORMAT T " :~A" SUBOP)))
	       (IF (CDR TPL) (PRINC ", ")))
	     ;; Print the method combination type if there is any.
	     (AND (CADR M)
		  (FORMAT T "    :~A~@[ :~A~]" (CADR M) (CADDR M)))
	     (TERPRI)))))
  (AND (FLAVOR-INSTANCE-SIZE FL)	;If has been composed
       (FORMAT T "Flavor ~S has instance size ~D, " FLAVOR-NAME (FLAVOR-INSTANCE-SIZE FL)))
  (WHEN (FLAVOR-ALL-INSTANCE-VARIABLES FL)
    (OR (FLAVOR-INSTANCE-SIZE FL) (FORMAT T "Flavor ~s has " FLAVOR-NAME))
    (FORMAT T "Instance variables: ~{~<~%   ~3:;~S~>~^, ~}~%" (FLAVOR-ALL-INSTANCE-VARIABLES FL)))
  (AND (FLAVOR-GETTABLE-INSTANCE-VARIABLES FL)
       (FORMAT T "Automatically-generated methods to get instance variables: ~{~<~%   ~3:;~S~>~^, ~}~%"
	         (FLAVOR-GETTABLE-INSTANCE-VARIABLES FL)))
  (AND (FLAVOR-SETTABLE-INSTANCE-VARIABLES FL)
       (FORMAT T "Automatically-generated methods to set instance variables: ~{~<~%   ~3:;~S~>~^, ~}~%"
	         (FLAVOR-SETTABLE-INSTANCE-VARIABLES FL)))
  (AND (FLAVOR-INITTABLE-INSTANCE-VARIABLES FL)
       (FORMAT T "Instance variables that may be set by initialization: ~{~<~%   ~3:;~S~>~^, ~}~%"
	         (MAPCAR #'CDR (FLAVOR-INITTABLE-INSTANCE-VARIABLES FL))))
  (AND (FLAVOR-INIT-KEYWORDS FL)
       (FORMAT T "Keywords in the :INIT message handled by this flavor: ~{~<~%   ~3:;~S~>~^, ~}~%"
	         (FLAVOR-INIT-KEYWORDS FL)))
  (FORMAT T "Defined in package ~A~%" (FLAVOR-PACKAGE FL))
  (WHEN (FLAVOR-PLIST FL)
    (FORMAT T "Properties:~%")
    (DO ((L (FLAVOR-PLIST FL) (CDDR L)))
	((NULL L))
      (FORMAT T "~5T~S:	~S~%" (CAR L) (CADR L))))
  (COND ((NULL (FLAVOR-METHOD-HASH-ARRAY FL))
	 (FORMAT T "Flavor ~S does not yet have a method hash array~%" FLAVOR-NAME))
	((EQ T (FLAVOR-METHOD-HASH-ARRAY FL))
	 (FORMAT T "Flavor ~S has been method-composed but has no hash array since it is an ~S.~%"
		 FLAVOR-NAME :ABSTRACT-FLAVOR))
	(T (FORMAT T "Flavor ~S has method hash array:~%" FLAVOR-NAME)
	   (DESCRIBE (FLAVOR-METHOD-HASH-ARRAY FL)))))

))