;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 03/08/90 14:57:51 by ab,
;;; Reason: Fix problem with METAMETHOD-DISPATCH when a user-defined flavor comes BEFORE
;;; a toolbox flavor in the component flavor list.  ab/my/sw 3/8/90.
;;; while running on RAMP-4 from band N214
;;; With SYSTEM 6.30, GC 6.3, VIRTUAL-MEMORY 6.3, MICRONET 6.0, MICRONET-COMM 6.2,
;;;  DISK-IO 6.2, DISK-LABEL 6.0, BASIC-PATHNAME 6.3, MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.2,
;;;  BASIC-NAMESPACE 6.7, BASIC-FILE 6.7, RPC 6.2, NFS-MX 6.4, EH 6.6, MAKE-SYSTEM 6.2,
;;;  MEMORY-AUX 6.0, COMPILER 6.14, TV 6.23, NVRAM 6.2, UCL 6.0, INPUT-EDITOR 6.0,
;;;  MACTOOLBOX 2.13, METER 6.1, ZWEI 6.12, DEBUG-TOOLS 6.4, WINDOW-MX 6.10, PRINTER 6.3,
;;;  MAC-PRINTER-TYPES 6.1, CLIPBOARD 6.1, TI-CLOS 6.37, CLEH 6.5, NETWORK-PATHNAME 6.1,
;;;  NETWORK-NAMESPACE 6.1, DATALINK 6.0, CHAOSNET 6.5, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.2,
;;;  DATALINK-DISPLAYS 6.0, MX-DATALINK 6.1, NAMESPACE-EDITOR 6.4, IP 3.57, NFS-MX-SERVER 6.0,
;;;  MX-SERIAL 6.1, PRINTER-TYPES 6.2, IMAGEN 6.1, MAIL-DAEMON 6.5, MAIL-READER 6.7,
;;;  TELNET 6.1, VT100 6.0, STREAMER-TAPE 6.5, DECNET 1.71, VISIDOC 6.7, PROFILE 6.2,
;;;  Experimental CONFLICT-RESOLUTION 37.0, Experimental SNRL 4.0, Experimental SNRL-ADD-ONS 1.0,
;;;  Experimental SST-WINDOWS 1.0, Experimental QUERY 1.0,  microcode 138, Band Name: Rel6+patches+SNRL (2/14/90)

#!C
; From file GENERIC-TOOLBOX-LIBRARY.LISP#> TOOLBOX-INTERFACE; Hotel:
#10R MACTOOLBOX#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MACTOOLBOX"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: TOOLBOX-INTERFACE; GENERIC-TOOLBOX-LIBRARY.#"

;; *ab* 3/8/90.  Next 4 routines fix problem with adding mixins to TB flavors defined with DEFCLASS.
;; Problem came because METAMETHOD-DISPATCH looked only at class's direct superior chain (single
;; inheritance) in order to find the :NEW meta-method.
(PROCLAIM '(inline flavor-components))
(DEFUN flavor-components (flavor-name)
  (sys:flavor-depends-on (GET flavor-name 'sys:flavor)))

(DEFUN flavor-depends-on-list-breadth-first (flavor-name)
  (LET ((*list-so-far* nil))
    (DECLARE (SPECIAL *list-so-far*))
    (internal-flavor-depends-on-list-breadth-first (LIST flavor-name))
    (NREVERSE (REMOVE-DUPLICATES *list-so-far*))))

(DEFUN internal-flavor-depends-on-list-breadth-first (depends-on-list)
  (DECLARE (SPECIAL *list-so-far*))
  (LOOP FOR fl IN depends-on-list
	FOR flavor-depends-on = (flavor-components fl)
	APPENDING flavor-depends-on INTO next-level
	DOING (PUSHNEW fl *list-so-far*)
	FINALLY
	(WHEN next-level
	  (internal-flavor-depends-on-list-breadth-first next-level))))

;; Fix for the "Unknown meta message" bug when user-defined class is mixed
;; in BEFORE a toolbox-interface class.
(defun metamethod-dispatch (class msg &rest args &aux res)
  (cond ((LOOP FOR cl IN  (flavor-depends-on-list-breadth-first class)
	       FOR mm = (GET cl msg)
	       DOING
	       (cond ((functionp mm)
		      (let ((super		       ;; try to get something that is an ECL-CLASS for SUPER
			      (LOOP FOR flavor-name IN (flavor-components cl)
				    WHEN (GET flavor-name :ecl-class)
				    RETURN flavor-name
				    FINALLY (RETURN (first (sys::flavor-depends-on
							     (get cl 'sys::flavor)))))))
			(setq res (apply mm args)))
		      (return res)))))
	(t (ferror "Unknown meta message: ~s~%" msg))))
))