diff options
| author | Stefan Monnier | 2015-01-18 14:08:13 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2015-01-18 14:08:13 -0500 |
| commit | 1f545d33648f819e8eedb92bafe19b53670eaf91 (patch) | |
| tree | a3b44fa8b6616c1b53bae657b68abd0fff12d10a | |
| parent | 2a61bd0096db23123734db439051c859e42b9606 (diff) | |
| download | emacs-1f545d33648f819e8eedb92bafe19b53670eaf91.tar.gz emacs-1f545d33648f819e8eedb92bafe19b53670eaf91.zip | |
* 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.
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 25 | ||||
| -rw-r--r-- | test/ChangeLog | 8 | ||||
| -rw-r--r-- | test/automated/Makefile.in | 4 | ||||
| -rw-r--r-- | test/automated/eieio-test-methodinvoke.el | 7 |
5 files changed, 48 insertions, 5 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c731551f913..ab4428382fe 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,10 @@ | |||
| 1 | 2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * emacs-lisp/eieio-core.el: Add `subclass' specializer for cl-generic. | ||
| 4 | (eieio--generic-subclass-tagcode, eieio--generic-subclass-tag-types): | ||
| 5 | New functions. | ||
| 6 | (cl-generic-tagcode-function, cl-generic-tag-types-function): Use them. | ||
| 7 | |||
| 3 | * emacs-lisp/eieio.el (defclass): Add obsolescence warning for the | 8 | * emacs-lisp/eieio.el (defclass): Add obsolescence warning for the |
| 4 | `newname' argument. | 9 | `newname' argument. |
| 5 | 10 | ||
| @@ -152,8 +157,8 @@ | |||
| 152 | 2015-01-16 Artur Malabarba <bruce.connor.am@gmail.com> | 157 | 2015-01-16 Artur Malabarba <bruce.connor.am@gmail.com> |
| 153 | 158 | ||
| 154 | * emacs-lisp/package.el (package--read-pkg-desc): | 159 | * emacs-lisp/package.el (package--read-pkg-desc): |
| 155 | New function. Read a `define-package' form in current buffer. Return | 160 | New function. Read a `define-package' form in current buffer. |
| 156 | the pkg-desc, with desc-kind set to KIND. | 161 | Return the pkg-desc, with desc-kind set to KIND. |
| 157 | (package-dir-info): New function. Find package information for a | 162 | (package-dir-info): New function. Find package information for a |
| 158 | directory. The return result is a `package-desc'. | 163 | directory. The return result is a `package-desc'. |
| 159 | (package-install-from-buffer): Install packages from dired buffer. | 164 | (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 a82e887fa0c..e4221e48fe2 100644 --- 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." | |||
| 1227 | 1227 | ||
| 1228 | (require 'cl-generic) | 1228 | (require 'cl-generic) |
| 1229 | 1229 | ||
| 1230 | ;;;; General support to dispatch based on the type of the argument. | ||
| 1231 | |||
| 1230 | (add-function :before-until cl-generic-tagcode-function | 1232 | (add-function :before-until cl-generic-tagcode-function |
| 1231 | #'eieio--generic-tagcode) | 1233 | #'eieio--generic-tagcode) |
| 1232 | (defun eieio--generic-tagcode (type name) | 1234 | (defun eieio--generic-tagcode (type name) |
| @@ -1246,6 +1248,29 @@ method invocation orders of the involved classes." | |||
| 1246 | (mapcar #'eieio--class-symbol | 1248 | (mapcar #'eieio--class-symbol |
| 1247 | (eieio--class-precedence-list (symbol-value tag))))) | 1249 | (eieio--class-precedence-list (symbol-value tag))))) |
| 1248 | 1250 | ||
| 1251 | ;;;; Dispatch for arguments which are classes. | ||
| 1252 | |||
| 1253 | ;; Since EIEIO does not support metaclasses, users can't easily use the | ||
| 1254 | ;; "dispatch on argument type" for class arguments. That's why EIEIO's | ||
| 1255 | ;; `defmethod' added the :static qualifier. For cl-generic, such a qualifier | ||
| 1256 | ;; would not make much sense (e.g. to which argument should it apply?). | ||
| 1257 | ;; Instead, we add a new "subclass" specializer. | ||
| 1258 | |||
| 1259 | (add-function :before-until cl-generic-tagcode-function | ||
| 1260 | #'eieio--generic-subclass-tagcode) | ||
| 1261 | (defun eieio--generic-subclass-tagcode (type name) | ||
| 1262 | (when (eq 'subclass (car-safe type)) | ||
| 1263 | `(60 . (and (symbolp ,name) (eieio--class-v ,name))))) | ||
| 1264 | |||
| 1265 | (add-function :before-until cl-generic-tag-types-function | ||
| 1266 | #'eieio--generic-subclass-tag-types) | ||
| 1267 | (defun eieio--generic-subclass-tag-types (tag) | ||
| 1268 | (when (eieio--class-p tag) | ||
| 1269 | (mapcar (lambda (class) | ||
| 1270 | `(subclass | ||
| 1271 | ,(if (symbolp class) class (eieio--class-symbol class)))) | ||
| 1272 | (eieio--class-precedence-list tag)))) | ||
| 1273 | |||
| 1249 | ;;; Backward compatibility functions | 1274 | ;;; Backward compatibility functions |
| 1250 | ;; To support .elc files compiled for older versions of EIEIO. | 1275 | ;; To support .elc files compiled for older versions of EIEIO. |
| 1251 | 1276 | ||
diff --git a/test/ChangeLog b/test/ChangeLog index e81bfa7d185..4b9e7a92621 100644 --- a/test/ChangeLog +++ b/test/ChangeLog | |||
| @@ -1,5 +1,8 @@ | |||
| 1 | 2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * automated/Makefile.in (EMACS_EXTRAOPT): New var. | ||
| 4 | (EMACSOPT): Use it. | ||
| 5 | |||
| 3 | * automated/cl-generic-tests.el (cl-generic-test-10-weird): New test. | 6 | * automated/cl-generic-tests.el (cl-generic-test-10-weird): New test. |
| 4 | Rename other tests to preserve ordering. | 7 | Rename other tests to preserve ordering. |
| 5 | 8 | ||
| @@ -8,6 +11,11 @@ | |||
| 8 | * automated/seq-tests.el (test-seq-subseq): Add more tests. | 11 | * automated/seq-tests.el (test-seq-subseq): Add more tests. |
| 9 | (Bug#19434) | 12 | (Bug#19434) |
| 10 | 13 | ||
| 14 | 2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 15 | |||
| 16 | * automated/eieio-test-methodinvoke.el (eieio-test-cl-generic-1): | ||
| 17 | Test `subclass' specializer. | ||
| 18 | |||
| 11 | 2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca> | 19 | 2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca> |
| 12 | 20 | ||
| 13 | * automated/eieio-tests.el | 21 | * automated/eieio-tests.el |
diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in index 7243e8af14a..faf0b3d8339 100644 --- a/test/automated/Makefile.in +++ b/test/automated/Makefile.in | |||
| @@ -39,10 +39,12 @@ SEPCHAR = @SEPCHAR@ | |||
| 39 | # directory, we can use emacs --chdir. | 39 | # directory, we can use emacs --chdir. |
| 40 | EMACS = ../../src/emacs | 40 | EMACS = ../../src/emacs |
| 41 | 41 | ||
| 42 | EMACS_EXTRAOPT= | ||
| 43 | |||
| 42 | # Command line flags for Emacs. | 44 | # Command line flags for Emacs. |
| 43 | # Apparently MSYS bash would convert "-L :" to "-L ;" anyway, | 45 | # Apparently MSYS bash would convert "-L :" to "-L ;" anyway, |
| 44 | # but we might as well be explicit. | 46 | # but we might as well be explicit. |
| 45 | EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" | 47 | EMACSOPT = -batch --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT) |
| 46 | 48 | ||
| 47 | # Prevent any settings in the user environment causing problems. | 49 | # Prevent any settings in the user environment causing problems. |
| 48 | unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS | 50 | unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS |
diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el index b6d60b85815..3918fb904fe 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/automated/eieio-test-methodinvoke.el | |||
| @@ -388,10 +388,13 @@ | |||
| 388 | (cons "CNM-0" (cl-call-next-method 7 y))) | 388 | (cons "CNM-0" (cl-call-next-method 7 y))) |
| 389 | (cl-defmethod eieio-test--1 ((_x CNM-1-1) _y) | 389 | (cl-defmethod eieio-test--1 ((_x CNM-1-1) _y) |
| 390 | (cons "CNM-1-1" (cl-call-next-method))) | 390 | (cons "CNM-1-1" (cl-call-next-method))) |
| 391 | (cl-defmethod eieio-test--1 ((_x CNM-1-2) y) | 391 | (cl-defmethod eieio-test--1 ((_x CNM-1-2) _y) |
| 392 | (cons "CNM-1-2" (cl-call-next-method))) | 392 | (cons "CNM-1-2" (cl-call-next-method))) |
| 393 | (cl-defmethod eieio-test--1 ((_x (subclass CNM-1-2)) _y) | ||
| 394 | (cons "subclass CNM-1-2" (cl-call-next-method))) | ||
| 393 | (should (equal (eieio-test--1 4 5) '(4 5))) | 395 | (should (equal (eieio-test--1 4 5) '(4 5))) |
| 394 | (should (equal (eieio-test--1 (make-instance 'CNM-0) 5) | 396 | (should (equal (eieio-test--1 (make-instance 'CNM-0) 5) |
| 395 | '("CNM-0" 7 5))) | 397 | '("CNM-0" 7 5))) |
| 396 | (should (equal (eieio-test--1 (make-instance 'CNM-2) 5) | 398 | (should (equal (eieio-test--1 (make-instance 'CNM-2) 5) |
| 397 | '("CNM-1-1" "CNM-1-2" "CNM-0" 7 5)))) | 399 | '("CNM-1-1" "CNM-1-2" "CNM-0" 7 5))) |
| 400 | (should (equal (eieio-test--1 'CNM-2 6) '("subclass CNM-1-2" CNM-2 6)))) | ||