procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/eieio-core.el: Provide support for cl-generic.

Browse source 
(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.

* lisp/emacs-lisp/cl-generic.el (cl-generic-define-method): Fix paren typo.

* test/automated/eieio-test-methodinvoke.el (eieio-test-method-store): Add
keysym arg instead of relying on internal var eieio--generic-call-key.
Update all callers.
(eieio-test-cl-generic-1): New tests.
This commit is contained in:
Stefan Monnier 2015-01-15 00:19:44 -05:00
parent 9def17e92b
commit 483c98a00d
5 changed files with 91 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

8
lisp/emacs-lisp/cl-generic.el
View file

@ -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))

26
lisp/emacs-lisp/eieio-core.el
View file

@ -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)))