diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 11 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 26 |
3 files changed, 40 insertions, 5 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e0fb3cced0c..b7a38af9609 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/eieio-core.el: Provide support for cl-generic. + (eieio--generic-tagcode): New function. + (cl-generic-tagcode-function): Use it. + (eieio--generic-tag-types): New function. + (cl-generic-tag-types-function): Use it. + (eieio-object-p): Tighten up the test. + + * emacs-lisp/cl-generic.el (cl-generic-define-method): Fix paren typo. + 2015-01-14 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/cl-generic.el: New file. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 19e4ce0fbef..d94e4f103ae 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -305,10 +305,10 @@ which case this method will be invoked when the argument is `eql' to VAL. (setq i (1+ i)))) (if me (setcdr me (cons uses-cnm function)) (setf (cl--generic-method-table generic) - (cons `(,key ,uses-cnm . ,function) mt)) - ;; For aliases, cl--generic-name gives us the actual name. - (defalias (cl--generic-name generic) - (cl--generic-make-function generic))))) + (cons `(,key ,uses-cnm . ,function) mt))) + ;; For aliases, cl--generic-name gives us the actual name. + (defalias (cl--generic-name generic) + (cl--generic-make-function generic)))) (defmacro cl--generic-with-memoization (place &rest code) (declare (indent 1) (debug t)) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 0f2da634ff3..bfa922bade6 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -264,7 +264,7 @@ Return nil if that option doesn't exist." (defsubst eieio-object-p (obj) "Return non-nil if OBJ is an EIEIO object." - (and (arrayp obj) + (and (vectorp obj) (condition-case nil (eq (aref (eieio--object-class-object obj) 0) 'defclass) (error nil)))) @@ -1303,10 +1303,34 @@ method invocation orders of the involved classes." (define-error 'unbound-slot "Unbound slot") (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") +;;; Hooking into cl-generic. + +(require 'cl-generic) + +(add-function :before-until cl-generic-tagcode-function + #'eieio--generic-tagcode) +(defun eieio--generic-tagcode (type name) + ;; CLHS says: + ;; A class must be defined before it can be used as a parameter + ;; specializer in a defmethod form. + ;; So we can ignore types that are not known to denote classes. + (and (class-p type) + ;; Prefer (aref ,name 0) over (eieio--class-tag ,name) so that + ;; the tagcode is identical to the tagcode used for cl-struct. + `(50 . (and (vectorp ,name) (aref ,name 0))))) + +(add-function :before-until cl-generic-tag-types-function + #'eieio--generic-tag-types) +(defun eieio--generic-tag-types (tag) + (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)) + (mapcar #'eieio--class-symbol + (eieio--class-precedence-list (symbol-value tag))))) + ;;; Backward compatibility functions ;; To support .elc files compiled for older versions of EIEIO. (defun eieio-defclass (cname superclasses slots options) + (declare (obsolete eieio-defclass-internal "25.1")) (eval `(defclass ,cname ,superclasses ,slots ,@options))) |