X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ac5475dacb20d240db27d56199910d8a6fcc90e8..91917dd58ec5278e555b9c693a830749083e8f89:/lisp/emacs-lisp/eieio-compat.el

diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index c2dabf7f44..9f1b8951a1 100644
--- 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)
@@ -181,17 +191,17 @@ Summary:
              (lambda (generic arg &rest args) (apply code arg generic args)))
             (_ code))))
     (cl-generic-define-method
-     method (if kind (list kind)) specializers uses-cnm
+     method (unless (memq kind '(nil :primary)) (list kind))
+     specializers uses-cnm
      (if uses-cnm
          (let* ((docstring (documentation code 'raw))
                 (args (help-function-arglist code 'preserve-names))
                 (doc-only (if docstring
                               (let ((split (help-split-fundoc docstring nil)))
-                                (if split (cdr split) docstring))))
-                (new-docstring (help-add-fundoc-usage doc-only
-                                                      (cons 'cl-cnm args))))
-           ;; FIXME: ¡Add new-docstring to those closures!
+                                (if split (cdr split) docstring)))))
            (lambda (cnm &rest args)
+             (:documentation
+              (help-add-fundoc-usage doc-only (cons 'cl-cnm args)))
              (cl-letf (((symbol-function 'call-next-method) cnm)
                        ((symbol-function 'next-method-p)
                         (lambda () (cl--generic-isnot-nnm-p cnm))))
@@ -201,11 +211,11 @@ Summary:
     ;; applicable but only of the before/after kind.  So if we add a :before
     ;; or :after, make sure there's a matching dummy primary.
     (when (and (memq kind '(:before :after))
-               (not (assoc (cons (mapcar (lambda (arg)
-                                           (if (consp arg) (nth 1 arg) t))
-                                         specializers)
-                                 :primary)
-                           (cl--generic-method-table (cl--generic method)))))
+               ;; FIXME: Use `cl-find-method'?
+               (not (cl-find-method method ()
+                                    (mapcar (lambda (arg)
+                                              (if (consp arg) (nth 1 arg) t))
+                                            specializers))))
       (cl-generic-define-method method () specializers t
                                 (lambda (cnm &rest args)
                                   (if (cl--generic-isnot-nnm-p cnm)
@@ -255,7 +265,7 @@ Summary:
 
 
 ;; Local Variables:
-;; generated-autoload-file: "eieio-core.el"
+;; generated-autoload-file: "eieio-loaddefs.el"
 ;; End:
 
 (provide 'eieio-compat)