Merge branch 'emacs-25-merge'

[gnu-emacs] / lisp / emacs-lisp / eieio-compat.el

diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index 7468c040e107c2bf4de3b7a7a30c45d90334e093..9f1b8951a1c303b351a583ab9f93259fbfad3a2e 100644 (file)
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -4,6 +4,7 @@
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: OO, lisp
+;; Package: eieio
 
 ;; This file is part of GNU Emacs.
 
@@ -124,30 +125,39 @@ Summary:
        (defgeneric ,method ,args)
        (eieio--defmethod ',method ',key ',class #',code))))
 
-(add-function :before-until cl-generic-tagcode-function
-              #'eieio--generic-static-tagcode)
-(defun eieio--generic-static-tagcode (type name)
-  (and (eq 'eieio--static (car-safe type))
-       `(40 . (cond
-               ((symbolp ,name) (eieio--class-v ,name))
-               ((vectorp ,name) (aref ,name 0))))))
-
-(add-function :around cl-generic-tag-types-function
-              #'eieio--generic-static-tag-types)
-(defun eieio--generic-static-tag-types (orig-fun tag)
-  (cond
-   ((or (eieio--class-p tag)
-        (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))))
-    (let ((superclasses (funcall orig-fun tag))
-          (types ()))
-      ;; Interleave: (subclass <foo>) (eieio--static <foo>) <subclass <bar>) ..
+(defun eieio--generic-static-symbol-specializers (tag &rest _)
+  (cl-assert (or (null tag) (eieio--class-p tag)))
+  (when (eieio--class-p tag)
+    (let ((superclasses (eieio--generic-subclass-specializers tag))
+         (specializers ()))
       (dolist (superclass superclasses)
-        (push superclass types)
-        (push `(eieio--static
-                ,(if (consp superclass) (cadr superclass) superclass))
-              types))
-      (nreverse types)))
-   (t (funcall orig-fun tag))))
+       (push superclass specializers)
+       (push `(eieio--static ,(cadr superclass)) specializers))
+      (nreverse specializers))))
+
+(cl-generic-define-generalizer eieio--generic-static-symbol-generalizer
+  ;; Give it a slightly higher priority than `subclass' so that the
+  ;; interleaved list comes before subclass's non-interleaved list.
+  61 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name)))
+  #'eieio--generic-static-symbol-specializers)
+(cl-generic-define-generalizer eieio--generic-static-object-generalizer
+  ;; Give it a slightly higher priority than `class' so that the
+  ;; interleaved list comes before the class's non-interleaved list.
+  51 #'cl--generic-struct-tag
+  (lambda (tag &rest _)
+    (and (symbolp tag) (boundp tag) (setq tag (symbol-value tag))
+         (eieio--class-p tag)
+         (let ((superclasses (eieio--class-precedence-list tag))
+               (specializers ()))
+           (dolist (superclass superclasses)
+             (setq superclass (eieio--class-name superclass))
+             (push superclass specializers)
+             (push `(eieio--static ,superclass) specializers))
+           (nreverse specializers)))))
+
+(cl-defmethod cl-generic-generalizers ((_specializer (head eieio--static)))
+  (list eieio--generic-static-symbol-generalizer
+        eieio--generic-static-object-generalizer))
 
 ;;;###autoload
 (defun eieio--defgeneric-init-form (method doc-string)
@@ -255,7 +265,7 @@ Summary:
 
 
 ;; Local Variables:
-;; generated-autoload-file: "eieio-core.el"
+;; generated-autoload-file: "eieio-loaddefs.el"
 ;; End:
 
 (provide 'eieio-compat)