;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Patched (:METHOD STRUCTURE-CLASS :ADD-NAMED-CLASS) to set the precedence-list of a new structure class to NIL,
;;; which forces (:METHOD STRUCTURE-CLASS :COMPOSE-CLASS) to recompute it for a redefined class [SPR 10649].

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 06/08/90 14:42:15 by FLORMAN,
;;; while running on PCAI from band LOD6
;;; With SYSTEM 6.37, VIRTUAL-MEMORY 6.3, EH 6.8, MAKE-SYSTEM 6.3, MICRONET 6.0, LOCAL-FILE 6.2,
;;;  BASIC-PATHNAME 6.5, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8, NETWORK-NAMESPACE 6.1,
;;;  DISK-IO 6.3, DISK-LABEL 6.0, BASIC-FILE 6.13, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2,
;;;  COMPILER 6.18, TV 6.26, DATALINK 6.0, CHAOSNET 6.8, GC 6.4, MEMORY-AUX 6.0, NVRAM 6.3,
;;;  SYSLOG 6.2, STREAMER-TAPE 6.6, UCL 6.0, INPUT-EDITOR 6.0, METER 6.2, ZWEI 6.21,
;;;  DEBUG-TOOLS 6.4, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.7, MAC-PRINTER-TYPES 6.2, PRINTER-TYPES 6.2,
;;;  IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.8, TELNET 6.1, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.5, PROFILE 6.3, VISIDOC 6.7, TI-CLOS 6.50, CLEH 6.5, IP 3.65,
;;;  Experimental CLX 6.11, CLUE 6.104, X11M 6.29, Experimental BUG 11.19, RPC 6.2,
;;;  NFS 3.11,  microcode 483, Band Name: customized Rel 6.1

#!C
; From file STRUCTURE-METACLASS.LISP#> CLOS; Hotel:
#10R TICLOS#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TICLOS"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: CLOS; STRUCTURE-METACLASS.#"


(defmethod (structure-class :add-named-class)
	   (class-name direct-supers direct-slots class-options &optional environment)
  ;; 10/31/88 DNG - Redesigned using CLOS:CLASS-FOR-REDEFINITION and CREATE-CLASS .
  ;;  8/08/89 DNG - Record the defstruct description in the class description.
  ;;		Don't record slots here; they will be computed later if needed.
  ;;		Call ADD-DIRECT-SUBCLASS as part of fix for SPR 9641 and 10225.
  ;; 06/08/90 BAF - Make sure that the class is NOT composed by clearing the class
  ;;                precedence list.  This ensures that it will be recalculated
  ;;                when a structure class is redefined with a different :INCLUDE.
  (declare (ignore direct-slots class-options))
  (let ((existing-class (find-class class-name nil environment))
	class-object)
    (if (and existing-class
	     (or (null environment)
		 (compiler:same-environment-p (class-environment existing-class) environment)))
	(setq class-object
	      (reinitialize-instance
		;; Make sure the old definition was also a structure-class.
		(CLOS:CLASS-FOR-REDEFINITION self existing-class :direct-superclasses direct-supers
					     :environment environment)
		:direct-superclasses direct-supers))
      (progn (setq class-object
		   (create-class class-name (type-of self) 
				 direct-supers nil nil environment))
	     (setf (class-named class-name t environment) class-object)))
    (let ((desc (class-description class-object)))
      (setf (class-description-flavor-bindings desc)	; BAF 6/6/90
	    (compiler:get-from-environment class-name 'si::defstruct-description nil environment)
	    (class-description-class-precedence-list desc)	; BAF 6/8/90
	    nil) )
    (add-direct-subclass (class-named (car direct-supers) nil environment) class-object nil)
    class-object))

))