* lisp/emacs-lisp/eieio-core.el: Add `subclass' specializer for cl-generic.

(eieio--generic-subclass-tagcode, eieio--generic-subclass-tag-types):
New functions.
(cl-generic-tagcode-function, cl-generic-tag-types-function): Use them.

* test/automated/eieio-test-methodinvoke.el (eieio-test-cl-generic-1):
Test `subclass' specializer.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c731551f913b4220cd8b4ab5ba9f43979674682c..ab4428382fe75ee15fef19867e5b221964d60602 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
 2015-01-18  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * emacs-lisp/eieio-core.el: Add `subclass' specializer for cl-generic.
+       (eieio--generic-subclass-tagcode, eieio--generic-subclass-tag-types):
+       New functions.
+       (cl-generic-tagcode-function, cl-generic-tag-types-function): Use them.
+
        * emacs-lisp/eieio.el (defclass): Add obsolescence warning for the
        `newname' argument.
 
@@ -152,8 +157,8 @@
 2015-01-16  Artur Malabarba  <bruce.connor.am@gmail.com>
 
        * emacs-lisp/package.el (package--read-pkg-desc):
-       New function. Read a `define-package' form in current buffer. Return
-       the pkg-desc, with desc-kind set to KIND.
+       New function. Read a `define-package' form in current buffer.
+       Return the pkg-desc, with desc-kind set to KIND.
        (package-dir-info): New function. Find package information for a
        directory. The return result is a `package-desc'.
        (package-install-from-buffer): Install packages from dired buffer.

diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index a82e887fa0c6471fef1d06063e647dc0fe0fb50b..e4221e48fe2486dacdc1006642a2eae6d2c8d7f5 100644 (file)
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1227,6 +1227,8 @@ method invocation orders of the involved classes."
 
 (require 'cl-generic)
 
+;;;; General support to dispatch based on the type of the argument.
+
 (add-function :before-until cl-generic-tagcode-function
               #'eieio--generic-tagcode)
 (defun eieio--generic-tagcode (type name)
@@ -1246,6 +1248,29 @@ method invocation orders of the involved classes."
        (mapcar #'eieio--class-symbol
                (eieio--class-precedence-list (symbol-value tag)))))
 
+;;;; Dispatch for arguments which are classes.
+
+;; Since EIEIO does not support metaclasses, users can't easily use the
+;; "dispatch on argument type" for class arguments.  That's why EIEIO's
+;; `defmethod' added the :static qualifier.  For cl-generic, such a qualifier
+;; would not make much sense (e.g. to which argument should it apply?).
+;; Instead, we add a new "subclass" specializer.
+
+(add-function :before-until cl-generic-tagcode-function
+              #'eieio--generic-subclass-tagcode)
+(defun eieio--generic-subclass-tagcode (type name)
+  (when (eq 'subclass (car-safe type))
+    `(60 . (and (symbolp ,name) (eieio--class-v ,name)))))
+
+(add-function :before-until cl-generic-tag-types-function
+              #'eieio--generic-subclass-tag-types)
+(defun eieio--generic-subclass-tag-types (tag)
+  (when (eieio--class-p tag)
+    (mapcar (lambda (class)
+              `(subclass
+                ,(if (symbolp class) class (eieio--class-symbol class))))
+            (eieio--class-precedence-list tag))))
+
 ;;; Backward compatibility functions
 ;; To support .elc files compiled for older versions of EIEIO.
 

diff --git a/test/ChangeLog b/test/ChangeLog
index e81bfa7d185211091cc1b9b0d92ae80bc4a85eb7..4b9e7a926219e489ee49557004aee1e9c025e712 100644 (file)
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,5 +1,8 @@
 2015-01-18  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+       * automated/Makefile.in (EMACS_EXTRAOPT): New var.
+       (EMACSOPT): Use it.
+
        * automated/cl-generic-tests.el (cl-generic-test-10-weird): New test.
        Rename other tests to preserve ordering.
 
@@ -8,6 +11,11 @@
        * automated/seq-tests.el (test-seq-subseq): Add more tests.
        (Bug#19434)
 
+2015-01-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * automated/eieio-test-methodinvoke.el (eieio-test-cl-generic-1):
+       Test `subclass' specializer.
+
 2015-01-17  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * automated/eieio-tests.el

diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in
index 7243e8af14ab06e187decff366a7de1ee2d90d2e..faf0b3d8339d6ace015a833d885f8ef8b691572f 100644 (file)
--- a/test/automated/Makefile.in
+++ b/test/automated/Makefile.in
@@ -39,10 +39,12 @@ SEPCHAR = @SEPCHAR@
 # directory, we can use emacs --chdir.
 EMACS = ../../src/emacs
 
+EMACS_EXTRAOPT=
+
 # Command line flags for Emacs.
 # Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
 # but we might as well be explicit.
-EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)"
+EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
 
 # Prevent any settings in the user environment causing problems.
 unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS

diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el
index b6d60b85815a6031ca38fad506e2dc8f5067e534..3918fb904fe310a5688ef7e44e76f3535192ca45 100644 (file)
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -388,10 +388,13 @@
     (cons "CNM-0" (cl-call-next-method 7 y)))
   (cl-defmethod eieio-test--1 ((_x CNM-1-1) _y)
     (cons "CNM-1-1" (cl-call-next-method)))
-  (cl-defmethod eieio-test--1 ((_x CNM-1-2) y)
+  (cl-defmethod eieio-test--1 ((_x CNM-1-2) _y)
     (cons "CNM-1-2" (cl-call-next-method)))
+  (cl-defmethod eieio-test--1 ((_x (subclass CNM-1-2)) _y)
+    (cons "subclass CNM-1-2" (cl-call-next-method)))
   (should (equal (eieio-test--1 4 5) '(4 5)))
   (should (equal (eieio-test--1 (make-instance 'CNM-0) 5)
                  '("CNM-0" 7 5)))
   (should (equal (eieio-test--1 (make-instance 'CNM-2) 5)
-                 '("CNM-1-1" "CNM-1-2" "CNM-0" 7 5))))
+                 '("CNM-1-1" "CNM-1-2" "CNM-0" 7 5)))
+  (should (equal (eieio-test--1 'CNM-2 6) '("subclass CNM-1-2" CNM-2 6))))