[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 59e7fe6: * lisp/emacs-lisp/eieio*.el: Fix up warnin
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master 59e7fe6: * lisp/emacs-lisp/eieio*.el: Fix up warnings and improve compatibility |
|
Date: |
Wed, 21 Jan 2015 19:39:14 +0000 |
branch: master
commit 59e7fe6d0c6988687b53c279941c9ebb3f887eed
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* lisp/emacs-lisp/eieio*.el: Fix up warnings and improve compatibility
Fixes: debbugs:19645
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Add support for `declare'.
(cl--generic-setf-rewrite): Setup the setf expander right away.
(cl-defmethod): Make sure the setf expander is setup before we expand
the body.
(cl-defmethod): Silence byte-compiler warnings.
(cl-generic-define-method): Shuffle code to change return value.
(cl--generic-method-info): New function, extracted from
cl--generic-describe.
(cl--generic-describe): Use it.
* lisp/emacs-lisp/eieio-speedbar.el:
* lisp/emacs-lisp/eieio-datadebug.el:
* lisp/emacs-lisp/eieio-custom.el:
* lisp/emacs-lisp/eieio-base.el: Use cl-defmethod.
* lisp/emacs-lisp/eieio-compat.el (eieio--defmethod): Avoid no-next-method
errors when there's a `before' but no `primary'.
(next-method-p): Return nil rather than signal an error.
(eieio-defgeneric): Remove bogus (fboundp 'method).
* lisp/emacs-lisp/eieio-opt.el: Adapt to cl-generic.
(eieio--specializers-apply-to-class-p): New function.
(eieio-all-generic-functions): Use it.
(eieio-method-documentation): Use it as well as cl--generic-method-info.
Change format of return value.
(eieio-help-class): Adapt accordingly.
* lisp/emacs-lisp/eieio.el: Use cl-defmethod.
(defclass): Generate cl-defmethod calls; use setf methods for :accessor.
(eieio-object-name-string): Declare as obsolete.
* test/automated/cl-generic-tests.el (setf cl--generic-2): Make sure
the setf can be used already in the body of the method.
---
lisp/ChangeLog | 33 ++++++++
lisp/emacs-lisp/cl-generic.el | 122 ++++++++++++++++++-----------
lisp/emacs-lisp/eieio-base.el | 36 ++++----
lisp/emacs-lisp/eieio-compat.el | 33 ++++++--
lisp/emacs-lisp/eieio-custom.el | 12 ++--
lisp/emacs-lisp/eieio-datadebug.el | 4 +-
lisp/emacs-lisp/eieio-opt.el | 113 +++++++++++----------------
lisp/emacs-lisp/eieio-speedbar.el | 20 +++---
lisp/emacs-lisp/eieio.el | 89 ++++++++++-----------
test/ChangeLog | 11 ++-
test/automated/cl-generic-tests.el | 5 +
test/automated/eieio-test-methodinvoke.el | 2 +
12 files changed, 275 insertions(+), 205 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 65c0684..d13bacf 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,36 @@
+2015-01-21 Stefan Monnier <address@hidden>
+
+ * emacs-lisp/eieio.el: Use cl-defmethod.
+ (defclass): Generate cl-defmethod calls; use setf methods for :accessor.
+ (eieio-object-name-string): Declare as obsolete.
+
+ * emacs-lisp/eieio-opt.el: Adapt to cl-generic.
+ (eieio--specializers-apply-to-class-p): New function.
+ (eieio-all-generic-functions): Use it.
+ (eieio-method-documentation): Use it as well as cl--generic-method-info.
+ Change format of return value.
+ (eieio-help-class): Adapt accordingly.
+
+ * emacs-lisp/eieio-compat.el (eieio--defmethod): Avoid no-next-method
+ errors when there's a `before' but no `primary' (bug#19645).
+ (next-method-p): Return nil rather than signal an error.
+ (eieio-defgeneric): Remove bogus (fboundp 'method).
+
+ * emacs-lisp/eieio-speedbar.el:
+ * emacs-lisp/eieio-datadebug.el:
+ * emacs-lisp/eieio-custom.el:
+ * emacs-lisp/eieio-base.el: Use cl-defmethod.
+
+ * emacs-lisp/cl-generic.el (cl-defgeneric): Add support for `declare'.
+ (cl--generic-setf-rewrite): Setup the setf expander right away.
+ (cl-defmethod): Make sure the setf expander is setup before we expand
+ the body.
+ (cl-defmethod): Silence byte-compiler warnings.
+ (cl-generic-define-method): Shuffle code to change return value.
+ (cl--generic-method-info): New function, extracted from
+ cl--generic-describe.
+ (cl--generic-describe): Use it.
+
2015-01-21 Dmitry Gutov <address@hidden>
* progmodes/xref.el (xref--xref-buffer-mode-map): Define before
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 3bbddfc..8dee9a3 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -98,19 +98,20 @@ They should be sorted from most specific to least
specific.")
(:constructor cl--generic-make
(name &optional dispatches method-table))
(:predicate nil))
- (name nil :read-only t) ;Pointer back to the symbol.
+ (name nil :type symbol :read-only t) ;Pointer back to the symbol.
;; `dispatches' holds a list of (ARGNUM . TAGCODES) where ARGNUM is the index
;; of the corresponding argument and TAGCODES is a list of (PRIORITY . EXP)
;; where the EXPs are expressions (to be `or'd together) to compute the tag
;; on which to dispatch and PRIORITY is the priority of each expression to
;; decide in which order to sort them.
;; The most important dispatch is last in the list (and the least is first).
- dispatches
+ (dispatches nil :type (list-of (cons natnum (list-of tagcode))))
;; `method-table' is a list of
;; ((SPECIALIZERS . QUALIFIER) USES-CNM . FUNCTION), where
;; USES-CNM is a boolean indicating if FUNCTION calls `cl-call-next-method'
;; (and hence expects an extra argument holding the next-method).
- method-table)
+ (method-table nil :type (list-of (cons (cons (list-of type) keyword)
+ (cons boolean function)))))
(defmacro cl--generic (name)
`(get ,name 'cl--generic))
@@ -134,15 +135,16 @@ They should be sorted from most specific to least
specific.")
generic))
(defun cl--generic-setf-rewrite (name)
- (let ((setter (intern (format "cl-generic-setter--%s" name))))
- (cons setter
- `(eval-and-compile
- (unless (eq ',setter (get ',name 'cl-generic-setter))
- ;; (when (get ',name 'gv-expander)
- ;; (error "gv-expander conflicts with (setf %S)" ',name))
- (setf (get ',name 'cl-generic-setter) ',setter)
- (gv-define-setter ,name (val &rest args)
- (cons ',setter (cons val args))))))))
+ (let* ((setter (intern (format "cl-generic-setter--%s" name)))
+ (exp `(unless (eq ',setter (get ',name 'cl-generic-setter))
+ ;; (when (get ',name 'gv-expander)
+ ;; (error "gv-expander conflicts with (setf %S)" ',name))
+ (setf (get ',name 'cl-generic-setter) ',setter)
+ (gv-define-setter ,name (val &rest args)
+ (cons ',setter (cons val args))))))
+ ;; Make sure `setf' can be used right away, e.g. in the body of the method.
+ (eval exp t)
+ (cons setter exp)))
;;;###autoload
(defmacro cl-defgeneric (name args &rest options-and-methods)
@@ -151,8 +153,9 @@ DOC-STRING is the base documentation for this class. A
generic
function has no body, as its purpose is to decide which method body
is appropriate to use. Specific methods are defined with `cl-defmethod'.
With this implementation the ARGS are currently ignored.
-OPTIONS-AND-METHODS is currently only used to specify the docstring,
-via (:documentation DOCSTRING)."
+OPTIONS-AND-METHODS currently understands:
+- (:documentation DOCSTRING)
+- (declare DECLARATIONS)"
(declare (indent 2) (doc-string 3))
(let* ((docprop (assq :documentation options-and-methods))
(doc (cond ((stringp (car-safe options-and-methods))
@@ -161,13 +164,26 @@ via (:documentation DOCSTRING)."
(prog1
(cadr docprop)
(setq options-and-methods
- (delq docprop options-and-methods)))))))
+ (delq docprop options-and-methods))))))
+ (declarations (assq 'declare options-and-methods)))
+ (when declarations
+ (setq options-and-methods
+ (delq declarations options-and-methods)))
`(progn
,(when (eq 'setf (car-safe name))
(pcase-let ((`(,setter . ,code) (cl--generic-setf-rewrite
(cadr name))))
(setq name setter)
code))
+ ,@(mapcar (lambda (declaration)
+ (let ((f (cdr (assq (car declaration)
+ defun-declarations-alist))))
+ (cond
+ (f (apply (car f) name args (cdr declaration)))
+ (t (message "Warning: Unknown defun property `%S' in %S"
+ (car declaration) name)
+ nil))))
+ (cdr declarations))
(defalias ',name
(cl-generic-define ',name ',args ',options-and-methods)
,(help-add-fundoc-usage doc args)))))
@@ -292,18 +308,19 @@ which case this method will be invoked when the argument
is `eql' to VAL.
list ; arguments
[ &optional stringp ] ; documentation string
def-body))) ; part to be debugged
- (let ((qualifiers nil))
+ (let ((qualifiers nil)
+ (setfizer (if (eq 'setf (car-safe name))
+ ;; Call it before we call cl--generic-lambda.
+ (cl--generic-setf-rewrite (cadr name)))))
(while (keywordp args)
(push args qualifiers)
(setq args (pop body)))
(pcase-let* ((with-cnm (not (memq (car qualifiers) '(:before :after))))
(`(,uses-cnm . ,fun) (cl--generic-lambda args body with-cnm)))
`(progn
- ,(when (eq 'setf (car-safe name))
- (pcase-let ((`(,setter . ,code) (cl--generic-setf-rewrite
- (cadr name))))
- (setq name setter)
- code))
+ ,(when setfizer
+ (setq name (car setfizer))
+ (cdr setfizer))
,(and (get name 'byte-obsolete-info)
(or (not (fboundp 'byte-compile-warning-enabled-p))
(byte-compile-warning-enabled-p 'obsolete))
@@ -311,6 +328,11 @@ which case this method will be invoked when the argument
is `eql' to VAL.
(macroexp--warn-and-return
(macroexp--obsolete-warning name obsolete "generic function")
nil)))
+ ;; You could argue that `defmethod' modifies rather than defines the
+ ;; function, so warnings like "not known to be defined" are fair game.
+ ;; But in practice, it's common to use `cl-defmethod'
+ ;; without a previous `cl-defgeneric'.
+ (declare-function ,name "")
(cl-generic-define-method ',name ',qualifiers ',args
,uses-cnm ,fun)))))
@@ -344,14 +366,14 @@ which case this method will be invoked when the argument
is `eql' to VAL.
(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.
+ (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
+ current-load-list :test #'equal)
(let ((gfun (cl--generic-make-function generic))
;; Prevent `defalias' from recording this as the definition site of
;; the generic function.
current-load-list)
- (defalias (cl--generic-name generic) gfun))
- (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
- current-load-list :test #'equal)))
+ ;; For aliases, cl--generic-name gives us the actual name.
+ (defalias (cl--generic-name generic) gfun))))
(defmacro cl--generic-with-memoization (place &rest code)
(declare (indent 1) (debug t))
@@ -448,8 +470,12 @@ for all those different tags in the method-cache.")
;; We don't currently have "method objects" like CLOS
;; does so we can't really do it the CLOS way.
;; The closest would be to pass the lambda corresponding
- ;; to the method, but the caller wouldn't be able to do
- ;; much with it anyway. So we pass nil for now.
+ ;; to the method, or maybe the ((SPECIALIZERS
+ ;; . QUALIFIER) USE-CNM . FUNCTION) entry from the method
+ ;; table, but the caller wouldn't be able to do much with
+ ;; it anyway. So we pass nil for now.
+ ;; FIXME: signal `no-primary-method' if there's
+ ;; no primary.
(apply #'cl-no-next-method generic-name nil args)))
;; We use `cdr' to drop the `uses-cnm' annotations.
(before
@@ -566,6 +592,24 @@ Can only be used from within the lexical body of a primary
or around method."
(add-to-list 'find-function-regexp-alist
`(cl-defmethod . ,#'cl--generic-search-method)))
+(defun cl--generic-method-info (method)
+ (pcase-let ((`((,specializers . ,qualifier) ,uses-cnm . ,function) method))
+ (let* ((args (help-function-arglist function 'names))
+ (docstring (documentation function))
+ (doconly (if docstring
+ (let ((split (help-split-fundoc docstring nil)))
+ (if split (cdr split) docstring))))
+ (combined-args ()))
+ (if uses-cnm (setq args (cdr args)))
+ (dolist (specializer specializers)
+ (let ((arg (if (eq '&rest (car args))
+ (intern (format "arg%d" (length combined-args)))
+ (pop args))))
+ (push (if (eq specializer t) arg (list arg specializer))
+ combined-args)))
+ (setq combined-args (append (nreverse combined-args) args))
+ (list qualifier combined-args doconly))))
+
(add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
(defun cl--generic-describe (function)
(let ((generic (if (symbolp function) (cl--generic function))))
@@ -575,25 +619,11 @@ Can only be used from within the lexical body of a
primary or around method."
(insert "\n\nThis is a generic function.\n\n")
(insert (propertize "Implementations:\n\n" 'face 'bold))
;; Loop over fanciful generics
- (pcase-dolist (`((,specializers . ,qualifier) ,uses-cnm . ,method)
- (cl--generic-method-table generic))
- (let* ((args (help-function-arglist method 'names))
- (docstring (documentation method))
- (doconly (if docstring
- (let ((split (help-split-fundoc docstring nil)))
- (if split (cdr split) docstring))))
- (combined-args ()))
- (if uses-cnm (setq args (cdr args)))
- (dolist (specializer specializers)
- (let ((arg (if (eq '&rest (car args))
- (intern (format "arg%d" (length combined-args)))
- (pop args))))
- (push (if (eq specializer t) arg (list arg specializer))
- combined-args)))
- (setq combined-args (append (nreverse combined-args) args))
+ (dolist (method (cl--generic-method-table generic))
+ (let* ((info (cl--generic-method-info method)))
;; FIXME: Add hyperlinks for the types as well.
- (insert (format "%S %S" qualifier combined-args))
- (let* ((met-name (cons function specializers))
+ (insert (format "%S %S" (nth 0 info) (nth 1 info)))
+ (let* ((met-name (cons function (caar method)))
(file (find-lisp-object-file-name met-name 'cl-defmethod)))
(when file
(insert " in `")
@@ -601,7 +631,7 @@ Can only be used from within the lexical body of a primary
or around method."
'help-function-def met-name file
'cl-defmethod)
(insert "'.\n")))
- (insert "\n" (or doconly "Undocumented") "\n\n")))))))
+ (insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
;;; Support for (eql <val>) specializers.
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 9931fbd..feb0671 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -52,7 +52,7 @@ a parent instance. When a slot in the child is referenced,
and has
not been set, use values from the parent."
:abstract t)
-(defmethod slot-unbound ((object eieio-instance-inheritor)
+(cl-defmethod slot-unbound ((object eieio-instance-inheritor)
_class slot-name _fn)
"If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a
signal.
SLOT-NAME is the offending slot. FN is the function signaling the error."
@@ -61,16 +61,16 @@ SLOT-NAME is the offending slot. FN is the function
signaling the error."
;; method if the parent instance's slot is unbound.
(eieio-oref (oref object parent-instance) slot-name)
;; Throw the regular signal.
- (call-next-method)))
+ (cl-call-next-method)))
-(defmethod clone ((obj eieio-instance-inheritor) &rest _params)
+(cl-defmethod clone ((obj eieio-instance-inheritor) &rest _params)
"Clone OBJ, initializing `:parent' to OBJ.
All slots are unbound, except those initialized with PARAMS."
- (let ((nobj (call-next-method)))
+ (let ((nobj (cl-call-next-method)))
(oset nobj parent-instance obj)
nobj))
-(defmethod eieio-instance-inheritor-slot-boundp ((object
eieio-instance-inheritor)
+(cl-defmethod eieio-instance-inheritor-slot-boundp ((object
eieio-instance-inheritor)
slot)
"Return non-nil if the instance inheritor OBJECT's SLOT is bound.
See `slot-boundp' for details on binding slots.
@@ -103,7 +103,7 @@ Inheritors from this class must overload `tracking-symbol'
which is
a variable symbol used to store a list of all instances."
:abstract t)
-(defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
+(cl-defmethod initialize-instance :after ((this eieio-instance-tracker)
&rest _slots)
"Make sure THIS is in our master list of this class.
Optional argument SLOTS are the initialization arguments."
@@ -112,7 +112,7 @@ Optional argument SLOTS are the initialization arguments."
(if (not (memq this (symbol-value sym)))
(set sym (append (symbol-value sym) (list this))))))
-(defmethod delete-instance ((this eieio-instance-tracker))
+(cl-defmethod delete-instance ((this eieio-instance-tracker))
"Remove THIS from the master list of this class."
(set (oref this tracking-symbol)
(delq this (symbol-value (oref this tracking-symbol)))))
@@ -140,7 +140,7 @@ Multiple calls to `make-instance' will return this
object."))
A singleton is a class which will only ever have one instance."
:abstract t)
-(defmethod eieio-constructor :STATIC ((class eieio-singleton) &rest _slots)
+(cl-defmethod eieio-constructor ((class (subclass eieio-singleton)) &rest
_slots)
"Constructor for singleton CLASS.
NAME and SLOTS initialize the new object.
This constructor guarantees that no matter how many you request,
@@ -149,7 +149,7 @@ only one object ever exists."
;; with class allocated slots or default values.
(let ((old (oref-default class singleton)))
(if (eq old eieio-unbound)
- (oset-default class singleton (call-next-method))
+ (oset-default class singleton (cl-call-next-method))
old)))
@@ -198,7 +198,7 @@ object. For this reason, only slots which do not have an
`:initarg'
specified will not be saved."
:abstract t)
-(defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
+(cl-defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
&optional name)
"Prepare to save THIS. Use in an `interactive' statement.
Query user for file name with PROMPT if THIS does not yet specify
@@ -417,17 +417,17 @@ If no class is referenced there, then return nil."
;; No match, not a class.
nil)))
-(defmethod object-write ((this eieio-persistent) &optional comment)
+(cl-defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
Optional argument COMMENT is a header line comment."
- (call-next-method this (or comment (oref this file-header-line))))
+ (cl-call-next-method this (or comment (oref this file-header-line))))
-(defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
+(cl-defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
"For object THIS, make absolute file name FILE relative."
(file-relative-name (expand-file-name file)
(file-name-directory (oref this file))))
-(defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
+(cl-defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
"Save persistent object THIS to disk.
Optional argument FILE overrides the file name specified in the object
instance."
@@ -474,21 +474,21 @@ instance."
"Object with a name."
:abstract t)
-(defmethod eieio-object-name-string ((obj eieio-named))
+(cl-defmethod eieio-object-name-string ((obj eieio-named))
"Return a string which is OBJ's name."
(or (slot-value obj 'object-name)
(symbol-name (eieio-object-class obj))))
-(defmethod eieio-object-set-name-string ((obj eieio-named) name)
+(cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
"Set the string which is OBJ's NAME."
(eieio--check-type stringp name)
(eieio-oset obj 'object-name name))
-(defmethod clone ((obj eieio-named) &rest params)
+(cl-defmethod clone ((obj eieio-named) &rest params)
"Clone OBJ, initializing `:parent' to OBJ.
All slots are unbound, except those initialized with PARAMS."
(let* ((newname (and (stringp (car params)) (pop params)))
- (nobj (apply #'call-next-method obj params))
+ (nobj (apply #'cl-call-next-method obj params))
(nm (slot-value obj 'object-name)))
(eieio-oset obj 'object-name
(or newname
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index 34c06c0..c2dabf7 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -190,13 +190,27 @@ Summary:
(if split (cdr split) docstring))))
(new-docstring (help-add-fundoc-usage doc-only
(cons 'cl-cnm args))))
- ;; FIXME: ¡Add the new-docstring to those closures!
+ ;; FIXME: ¡Add new-docstring to those closures!
(lambda (cnm &rest args)
(cl-letf (((symbol-function 'call-next-method) cnm)
((symbol-function 'next-method-p)
(lambda () (cl--generic-isnot-nnm-p cnm))))
(apply code args))))
- code))))
+ code))
+ ;; The old EIEIO code did not signal an error when there are methods
+ ;; 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)))))
+ (cl-generic-define-method method () specializers t
+ (lambda (cnm &rest args)
+ (if (cl--generic-isnot-nnm-p cnm)
+ (apply cnm args)))))
+ method))
;; Compatibility with code which tries to catch `no-method-definition' errors.
(push 'no-method-definition (get 'cl-no-applicable-method 'error-conditions))
@@ -212,7 +226,12 @@ Summary:
(apply #'cl-no-applicable-method method object args))
(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1")
-(define-obsolete-function-alias 'next-method-p 'cl-next-method-p "25.1")
+(defun next-method-p ()
+ (declare (obsolete cl-next-method-p "25.1"))
+ ;; EIEIO's `next-method-p' just returned nil when called in an
+ ;; invalid context.
+ (message "next-method-p called outside of a primary or around method")
+ nil)
;;;###autoload
(defun eieio-defmethod (method args)
@@ -225,11 +244,9 @@ Summary:
(defun eieio-defgeneric (method doc-string)
"Obsolete work part of an old version of the `defgeneric' macro."
(declare (obsolete cl-defgeneric "24.1"))
- ;; Don't do this over and over.
- (unless (fboundp 'method)
- (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
- ;; Return the method
- 'method))
+ (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
+ ;; Return the method
+ 'method)
;;;###autoload
(defun eieio-defclass (cname superclasses slots options)
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 8ab74ae..0e0b31e 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -322,7 +322,7 @@ Optional argument IGNORE is an extraneous parameter."
;; This is the same object we had before.
obj))
-(defmethod eieio-done-customizing ((_obj eieio-default-superclass))
+(cl-defmethod eieio-done-customizing ((_obj eieio-default-superclass))
"When applying change to a widget, call this method.
This method is called by the default widget-edit commands.
User made commands should also call this method when applying changes.
@@ -345,7 +345,7 @@ Optional argument GROUP is the sub-group of slots to
display."
"Major mode for customizing EIEIO objects.
\\{eieio-custom-mode-map}")
-(defmethod eieio-customize-object ((obj eieio-default-superclass)
+(cl-defmethod eieio-customize-object ((obj eieio-default-superclass)
&optional group)
"Customize OBJ in a specialized custom buffer.
To override call the `eieio-custom-widget-insert' to just insert the
@@ -386,7 +386,7 @@ These groups are specified with the `:group' slot flag."
(make-local-variable 'eieio-cog)
(setq eieio-cog g)))
-(defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
+(cl-defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
"Insert an Apply and Reset button into the object editor.
Argument OBJ is the object being customized."
(widget-create 'push-button
@@ -417,7 +417,7 @@ Argument OBJ is the object being customized."
(bury-buffer))
"Cancel"))
-(defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
+(cl-defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
&rest flags)
"Insert the widget used for editing object OBJ in the current buffer.
Arguments FLAGS are widget compatible flags.
@@ -446,7 +446,7 @@ Must return the created widget."
;; These functions provide the ability to create dynamic menus to
;; customize specific sections of an object. They do not hook directly
;; into a filter, but can be used to create easymenu vectors.
-(defmethod eieio-customize-object-group ((obj eieio-default-superclass))
+(cl-defmethod eieio-customize-object-group ((obj eieio-default-superclass))
"Create a list of vectors for customizing sections of OBJ."
(mapcar (lambda (group)
(vector (concat "Group " (symbol-name group))
@@ -457,7 +457,7 @@ Must return the created widget."
(defvar eieio-read-custom-group-history nil
"History for the custom group reader.")
-(defmethod eieio-read-customization-group ((obj eieio-default-superclass))
+(cl-defmethod eieio-read-customization-group ((obj eieio-default-superclass))
"Do a completing read on the name of a customization group in OBJ.
Return the symbol for the group, or nil"
(let ((g (eieio--class-option (eieio--object-class-object obj)
diff --git a/lisp/emacs-lisp/eieio-datadebug.el
b/lisp/emacs-lisp/eieio-datadebug.el
index ab8d41e..6534bd0 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -79,7 +79,7 @@ PREBUTTONTEXT is some text between PREFIX and the object
button."
;;
;; Each object should have an opportunity to show stuff about itself.
-(defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
+(cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
prefix)
"Insert the slots of OBJ into the current DDEBUG buffer."
(let ((inhibit-read-only t))
@@ -124,7 +124,7 @@ PREBUTTONTEXT is some text between PREFIX and the object
button."
;;
;; A generic function to run DDEBUG on an object and popup a new buffer.
;;
-(defmethod data-debug-show ((obj eieio-default-superclass))
+(cl-defmethod data-debug-show ((obj eieio-default-superclass))
"Run ddebug against any EIEIO object OBJ."
(data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj)))
(data-debug-insert-object-slots obj "]"))
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 13ad120..a131b02 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -122,29 +122,18 @@ If CLASS is actually an object, then also display current
values of that object.
;; Describe all the slots in this class.
(eieio-help-class-slots class)
;; Describe all the methods specific to this class.
- (let ((methods (eieio-all-generic-functions class))
- (type [":STATIC" ":BEFORE" ":PRIMARY" ":AFTER"])
- counter doc)
- (when methods
+ (let ((generics (eieio-all-generic-functions class)))
+ (when generics
(insert (propertize "Specialized Methods:\n\n" 'face 'bold))
- (while methods
- (setq doc (eieio-method-documentation (car methods) class))
- (insert "`")
- (help-insert-xref-button (symbol-name (car methods))
- 'help-function (car methods))
- (insert "'")
- (if (not doc)
- (insert " Undocumented")
- (setq counter 0)
- (dolist (cur doc)
- (when cur
- (insert " " (aref type counter) " "
- (prin1-to-string (car cur) (current-buffer))
- "\n"
- (or (cdr cur) "")))
- (setq counter (1+ counter))))
- (insert "\n\n")
- (setq methods (cdr methods))))))
+ (dolist (generic generics)
+ (insert "`")
+ (help-insert-xref-button (symbol-name generic) 'help-function generic)
+ (insert "'")
+ (pcase-dolist (`(,qualifier ,args ,doc)
+ (eieio-method-documentation generic class))
+ (insert (format " %S %S\n" qualifier args)
+ (or doc "")))
+ (insert "\n\n")))))
(defun eieio-help-class-slots (class)
"Print help description for the slots in CLASS.
@@ -311,6 +300,20 @@ are not abstract."
(eieio-help-class ctr))
))))
+(defun eieio--specializers-apply-to-class-p (specializers class)
+ "Return non-nil if a method with SPECIALIZERS applies to CLASS."
+ (let ((applies nil))
+ (dolist (specializer specializers)
+ (if (eq 'subclass (car-safe specializer))
+ (setq specializer (nth 1 specializer)))
+ ;; Don't include the methods that are "too generic", such as those
+ ;; applying to `eieio-default-superclass'.
+ (and (not (memq specializer '(t eieio-default-superclass)))
+ (class-p specializer)
+ (child-of-class-p class specializer)
+ (setq applies t)))
+ applies))
+
(defun eieio-all-generic-functions (&optional class)
"Return a list of all generic functions.
Optional CLASS argument returns only those functions that contain
@@ -318,53 +321,31 @@ methods for CLASS."
(let ((l nil))
(mapatoms
(lambda (symbol)
- (let ((tree (get symbol 'eieio-method-hashtable)))
- (when tree
- ;; A symbol might be interned for that class in one of
- ;; these three slots in the method-obarray.
- (if (or (not class)
- (car (gethash class (aref tree 0)))
- (car (gethash class (aref tree 1)))
- (car (gethash class (aref tree 2))))
- (setq l (cons symbol l)))))))
+ (let ((generic (and (fboundp symbol) (cl--generic symbol))))
+ (and generic
+ (catch 'found
+ (if (null class) (throw 'found t))
+ (pcase-dolist (`((,specializers . ,_qualifier) . ,_)
+ (cl--generic-method-table generic))
+ (if (eieio--specializers-apply-to-class-p
+ specializers class)
+ (throw 'found t))))
+ (push symbol l)))))
l))
(defun eieio-method-documentation (generic class)
- "Return a list of the specific documentation of GENERIC for CLASS.
-If there is not an explicit method for CLASS in GENERIC, or if that
-function has no documentation, then return nil."
- (let ((tree (get generic 'eieio-method-hashtable)))
- (when tree
- ;; A symbol might be interned for that class in one of
- ;; these three slots in the method-hashtable.
- ;; FIXME: Where do these 0/1/2 come from? Isn't 0 for :static,
- ;; 1 for before, and 2 for primary (and 3 for after)?
- (let ((before (car (gethash class (aref tree 0))))
- (primary (car (gethash class (aref tree 1))))
- (after (car (gethash class (aref tree 2)))))
- (if (not (or before primary after))
- nil
- (list (if before
- (cons (help-function-arglist before)
- (documentation before))
- nil)
- (if primary
- (cons (help-function-arglist primary)
- (documentation primary))
- nil)
- (if after
- (cons (help-function-arglist after)
- (documentation after))
- nil)))))))
-
-(defvar eieio-read-generic nil
- "History of the `eieio-read-generic' prompt.")
-
-(defun eieio-read-generic (prompt &optional historyvar)
- "Read a generic function from the minibuffer with PROMPT.
-Optional argument HISTORYVAR is the variable to use as history."
- (intern (completing-read prompt obarray #'generic-p
- t nil (or historyvar 'eieio-read-generic))))
+ "Return info for all methods of GENERIC applicable to CLASS.
+The value returned is a list of elements of the form
+\(QUALIFIER ARGS DOC)."
+ (let ((generic (cl--generic generic))
+ (docs ()))
+ (when generic
+ (dolist (method (cl--generic-method-table generic))
+ (pcase-let ((`((,specializers . ,_qualifier) . ,_) method))
+ (when (eieio--specializers-apply-to-class-p
+ specializers class)
+ (push (cl--generic-method-info method) docs)))))
+ docs))
;;; METHOD STATS
;;
diff --git a/lisp/emacs-lisp/eieio-speedbar.el
b/lisp/emacs-lisp/eieio-speedbar.el
index b236f0f..a1eabcf 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -196,19 +196,19 @@ that path."
;; when no other methods are found, allowing multiple inheritance to work
;; reliably with eieio-speedbar.
-(defmethod eieio-speedbar-description (object)
+(cl-defmethod eieio-speedbar-description (object)
"Return a string describing OBJECT."
(eieio-object-name-string object))
-(defmethod eieio-speedbar-derive-line-path (_object)
+(cl-defmethod eieio-speedbar-derive-line-path (_object)
"Return the path which OBJECT has something to do with."
nil)
-(defmethod eieio-speedbar-object-buttonname (object)
+(cl-defmethod eieio-speedbar-object-buttonname (object)
"Return a string to use as a speedbar button for OBJECT."
(eieio-object-name-string object))
-(defmethod eieio-speedbar-make-tag-line (object depth)
+(cl-defmethod eieio-speedbar-make-tag-line (object depth)
"Insert a tag line into speedbar at point for OBJECT.
By default, all objects appear as simple TAGS with no need to inherit from
the special `eieio-speedbar' classes. Child classes should redefine this
@@ -221,7 +221,7 @@ Argument DEPTH is the depth at which the tag line is
inserted."
'speedbar-tag-face
depth))
-(defmethod eieio-speedbar-handle-click (object)
+(cl-defmethod eieio-speedbar-handle-click (object)
"Handle a click action on OBJECT in speedbar.
Any object can be represented as a tag in SPEEDBAR without special
attributes. These default objects will be pulled up in a custom
@@ -285,7 +285,7 @@ Add one of the child classes to this class to the parent
list of a class."
;;; Methods to eieio-speedbar-* which do not need to be overridden
;;
-(defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
+(cl-defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
depth)
"Insert a tag line into speedbar at point for OBJECT.
All objects a child of symbol `eieio-speedbar' can be created from
@@ -321,12 +321,12 @@ Argument DEPTH is the depth at which the tag line is
inserted."
(if exp
(eieio-speedbar-expand object (1+ depth))))))
-(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth)
+(cl-defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar)
_depth)
"Base method for creating tag lines for non-object children."
(error "You must implement `eieio-speedbar-child-make-tag-lines' for %s"
(eieio-object-name object)))
-(defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
+(cl-defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
"Expand OBJECT at indentation DEPTH.
Inserts a list of new tag lines representing expanded elements within
OBJECT."
@@ -362,7 +362,7 @@ TOKEN is the object. INDENT is the current indentation
level."
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
-(defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
+(cl-defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
"Return a description for a child of OBJ which is not an object."
(error "You must implement `eieio-speedbar-child-description' for %s"
(eieio-object-name obj)))
@@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at."
;;; Methods to the eieio-speedbar-* classes which need to be overridden.
;;
-(defmethod eieio-speedbar-object-children ((_object eieio-speedbar))
+(cl-defmethod eieio-speedbar-object-children ((_object eieio-speedbar))
"Return a list of children to be displayed in speedbar.
If the return value is a list of OBJECTs, then those objects are
queried for details. If the return list is made of strings,
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index b64eba1..7672d7f 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -179,36 +179,31 @@ and reference them using the function `class-option'."
;; of the specified name, and also performs a `defsetf' if applicable
;; so that users can `setf' the space returned by this function.
(when acces
- ;; FIXME: The defmethod below only defines a part of the generic
- ;; function (good), but the define-setter below affects the whole
- ;; generic function (bad)!
- (push `(gv-define-setter ,acces (store object)
- ;; Apparently, eieio-oset-default doesn't work like
- ;; oref-default and only accept class arguments!
- (list ',(if nil ;; (eq alloc :class)
- 'eieio-oset-default
- 'eieio-oset)
- object '',sname store))
+ (push `(cl-defmethod (setf ,acces) (value (this ,name))
+ (eieio-oset this ',sname value))
accessors)
- (push `(defmethod ,acces ,(if (eq alloc :class) :static :primary)
- ((this ,name))
+ (push `(cl-defmethod ,acces ((this ,name))
,(format
"Retrieve the slot `%S' from an object of class `%S'."
sname name)
- (if (slot-boundp this ',sname)
- ;; Use oref-default for :class allocated slots, since
- ;; these also accept the use of a class argument instead
- ;; of an object argument.
- (,(if (eq alloc :class) 'eieio-oref-default 'eieio-oref)
- this ',sname)
- ;; Else - Some error? nil?
- nil))
- accessors))
+ ;; FIXME: Why is this different from the :reader case?
+ (if (slot-boundp this ',sname) (eieio-oref this ',sname)))
+ accessors)
+ (when (and eieio-backward-compatibility (eq alloc :class))
+ ;; FIXME: How could I declare this *method* as obsolete.
+ (push `(cl-defmethod ,acces ((this (subclass ,name)))
+ ,(format
+ "Retrieve the class slot `%S' from a class `%S'.
+This method is obsolete."
+ sname name)
+ (if (slot-boundp this ',sname)
+ (eieio-oref-default this ',sname)))
+ accessors)))
;; If a writer is defined, then create a generic method of that
;; name whose purpose is to set the value of the slot.
(if writer
- (push `(defmethod ,writer ((this ,name) value)
+ (push `(cl-defmethod ,writer ((this ,name) value)
,(format "Set the slot `%S' of an object of class `%S'."
sname name)
(setf (slot-value this ',sname) value))
@@ -216,7 +211,7 @@ and reference them using the function `class-option'."
;; If a reader is defined, then create a generic method
;; of that name whose purpose is to access this slot value.
(if reader
- (push `(defmethod ,reader ((this ,name))
+ (push `(cl-defmethod ,reader ((this ,name))
,(format "Access the slot `%S' from object of class `%S'."
sname name)
(slot-value this ',sname))
@@ -372,6 +367,10 @@ variable name of the same name as the slot."
(define-obsolete-function-alias
'object-class-fast #'eieio--object-class-name "24.4")
+(cl-defgeneric eieio-object-name-string (obj)
+ "Return a string which is OBJ's name."
+ (declare (obsolete eieio-named "25.1")))
+
(defun eieio-object-name (obj &optional extra)
"Return a Lisp like symbol string for object OBJ.
If EXTRA, include that in the string returned to represent the symbol."
@@ -386,15 +385,13 @@ If EXTRA, include that in the string returned to
represent the symbol."
;; below "for free". Since this field is very rarely used, we got rid of it
;; and instead we keep it in a weak hash-tables, for those very rare objects
;; that use it.
-(defmethod eieio-object-name-string (obj)
- "Return a string which is OBJ's name."
- (declare (obsolete eieio-named "25.1"))
+(cl-defmethod eieio-object-name-string (obj)
(or (gethash obj eieio--object-names)
(symbol-name (eieio-object-class obj))))
(define-obsolete-function-alias
'object-name-string #'eieio-object-name-string "24.4")
-(defmethod eieio-object-set-name-string (obj name)
+(cl-defmethod eieio-object-set-name-string (obj name)
"Set the string which is OBJ's NAME."
(declare (obsolete eieio-named "25.1"))
(eieio--check-type stringp name)
@@ -648,13 +645,13 @@ This class is not stored in the `parent' slot of a class
vector."
(defalias 'standard-class 'eieio-default-superclass)
-(defgeneric eieio-constructor (class &rest slots)
+(cl-defgeneric eieio-constructor (class &rest slots)
"Default constructor for CLASS `eieio-default-superclass'.")
(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
-(defmethod eieio-constructor :static
- ((class eieio-default-superclass) &rest slots)
+(cl-defmethod eieio-constructor
+ ((class (subclass eieio-default-superclass)) &rest slots)
"Default constructor for CLASS `eieio-default-superclass'.
SLOTS are the initialization slots used by `shared-initialize'.
This static method is called when an object is constructed.
@@ -674,11 +671,11 @@ calls `shared-initialize' on that object."
;; Return the created object.
new-object))
-(defgeneric shared-initialize (obj slots)
+(cl-defgeneric shared-initialize (obj slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine.")
-(defmethod shared-initialize ((obj eieio-default-superclass) slots)
+(cl-defmethod shared-initialize ((obj eieio-default-superclass) slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine."
(while slots
@@ -689,10 +686,10 @@ Called from the constructor routine."
(eieio-oset obj rn (car (cdr slots)))))
(setq slots (cdr (cdr slots)))))
-(defgeneric initialize-instance (this &optional slots)
+(cl-defgeneric initialize-instance (this &optional slots)
"Construct the new object THIS based on SLOTS.")
-(defmethod initialize-instance ((this eieio-default-superclass)
+(cl-defmethod initialize-instance ((this eieio-default-superclass)
&optional slots)
"Construct the new object THIS based on SLOTS.
SLOTS is a tagged list where odd numbered elements are tags, and
@@ -724,10 +721,10 @@ dynamically set from SLOTS."
;; Shared initialize will parse our slots for us.
(shared-initialize this slots))
-(defgeneric slot-missing (object slot-name operation &optional new-value)
+(cl-defgeneric slot-missing (object slot-name operation &optional new-value)
"Method invoked when an attempt to access a slot in OBJECT fails.")
-(defmethod slot-missing ((object eieio-default-superclass) slot-name
+(cl-defmethod slot-missing ((object eieio-default-superclass) slot-name
_operation &optional _new-value)
"Method invoked when an attempt to access a slot in OBJECT fails.
SLOT-NAME is the name of the failed slot, OPERATION is the type of access
@@ -739,10 +736,10 @@ directly reference slots in EIEIO objects."
(signal 'invalid-slot-name (list (eieio-object-name object)
slot-name)))
-(defgeneric slot-unbound (object class slot-name fn)
+(cl-defgeneric slot-unbound (object class slot-name fn)
"Slot unbound is invoked during an attempt to reference an unbound slot.")
-(defmethod slot-unbound ((object eieio-default-superclass)
+(cl-defmethod slot-unbound ((object eieio-default-superclass)
class slot-name fn)
"Slot unbound is invoked during an attempt to reference an unbound slot.
OBJECT is the instance of the object being reference. CLASS is the
@@ -757,14 +754,14 @@ EIEIO can only dispatch on the first argument, so the
first two are swapped."
(signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name
object)
slot-name fn)))
-(defgeneric clone (obj &rest params)
+(cl-defgeneric clone (obj &rest params)
"Make a copy of OBJ, and then supply PARAMS.
PARAMS is a parameter list of the same form used by `initialize-instance'.
When overloading `clone', be sure to call `call-next-method'
first and modify the returned object.")
-(defmethod clone ((obj eieio-default-superclass) &rest params)
+(cl-defmethod clone ((obj eieio-default-superclass) &rest params)
"Make a copy of OBJ, and then apply PARAMS."
(let ((nobj (copy-sequence obj)))
(if (stringp (car params))
@@ -773,24 +770,24 @@ first and modify the returned object.")
(if params (shared-initialize nobj params))
nobj))
-(defgeneric destructor (this &rest params)
+(cl-defgeneric destructor (this &rest params)
"Destructor for cleaning up any dynamic links to our object.")
-(defmethod destructor ((_this eieio-default-superclass) &rest _params)
+(cl-defmethod destructor ((_this eieio-default-superclass) &rest _params)
"Destructor for cleaning up any dynamic links to our object.
Argument THIS is the object being destroyed. PARAMS are additional
ignored parameters."
;; No cleanup... yet.
)
-(defgeneric object-print (this &rest strings)
+(cl-defgeneric object-print (this &rest strings)
"Pretty printer for object THIS. Call function `object-name' with STRINGS.
It is sometimes useful to put a summary of the object into the
default #<notation> string when using EIEIO browsing tools.
Implement this method to customize the summary.")
-(defmethod object-print ((this eieio-default-superclass) &rest strings)
+(cl-defmethod object-print ((this eieio-default-superclass) &rest strings)
"Pretty printer for object THIS. Call function `object-name' with STRINGS.
The default method for printing object THIS is to use the
function `object-name'.
@@ -807,11 +804,11 @@ to prepend a space."
(defvar eieio-print-depth 0
"When printing, keep track of the current indentation depth.")
-(defgeneric object-write (this &optional comment)
+(cl-defgeneric object-write (this &optional comment)
"Write out object THIS to the current stream.
Optional COMMENT will add comments to the beginning of the output.")
-(defmethod object-write ((this eieio-default-superclass) &optional comment)
+(cl-defmethod object-write ((this eieio-default-superclass) &optional comment)
"Write object THIS out to the current stream.
This writes out the vector version of this object. Complex and recursive
object are discouraged from being written.
diff --git a/test/ChangeLog b/test/ChangeLog
index dcce0bf..d63a561 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,7 +1,12 @@
+2015-01-21 Stefan Monnier <address@hidden>
+
+ * automated/cl-generic-tests.el (setf cl--generic-2): Make sure
+ the setf can be used already in the body of the method.
+
2015-01-20 Jorgen Schaefer <address@hidden>
* automated/package-test.el (package-test-install-prioritized):
- Removed test due to unreproducable failures.
+ Remove test due to unreproducable failures.
2015-01-20 Michal Nazarewicz <address@hidden>
@@ -15,8 +20,8 @@
A new helper function for testing `tildify-double-space-undos'
behaviour in the `tildify-space' function.
(tildify-space-undo-test-html, tildify-space-undo-test-html-nbsp)
- (tildify-space-undo-test-xml, tildify-space-undo-test-tex): New
- tests for `tildify-doule-space-undos' behaviour.
+ (tildify-space-undo-test-xml, tildify-space-undo-test-tex):
+ New tests for `tildify-doule-space-undos' behaviour.
* automated/tildify-tests.el (tildify-space-test--test):
A new helper function for testing `tildify-space' function.
diff --git a/test/automated/cl-generic-tests.el
b/test/automated/cl-generic-tests.el
index 1c01d9b..bc9a1ec 100644
--- a/test/automated/cl-generic-tests.el
+++ b/test/automated/cl-generic-tests.el
@@ -73,6 +73,11 @@
(should (equal (cl--generic-1 (make-cl-generic-struct-child11) nil)
'("child11" "around""child1" "parent" a))))
+;; I don't know how to put this inside an `ert-test'. This tests that `setf'
+;; can be used directly inside the body of the setf method.
+(cl-defmethod (setf cl--generic-2) (v (y integer) z)
+ (setf (cl--generic-2 (nth y z) z) v))
+
(ert-deftest cl-generic-test-03-setf ()
(cl-defmethod (setf cl--generic-1) (v (y t) z) (list v y z))
(cl-defmethod (setf cl--generic-1) (v (_y (eql 4)) z) (list v "four" z))
diff --git a/test/automated/eieio-test-methodinvoke.el
b/test/automated/eieio-test-methodinvoke.el
index 3918fb9..da5f59a 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -292,6 +292,7 @@
(defmethod initialize-instance :after ((this eitest-Ja) &rest slots)
;(message "+Ja")
+ ;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
(call-next-method))
;(message "-Ja")
@@ -302,6 +303,7 @@
(defmethod initialize-instance :after ((this eitest-Jb) &rest slots)
;(message "+Jb")
+ ;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
(call-next-method))
;(message "-Jb")
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 59e7fe6: * lisp/emacs-lisp/eieio*.el: Fix up warnings and improve compatibility,
Stefan Monnier <=