mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-20 18:17:20 +00:00
* 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.
This commit is contained in:
Stefan Monnier
parent
41efcf4db1
commit
59e7fe6d0c
@ -1,3 +1,36 @@
|
||||
2015-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* 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 <dgutov@yandex.ru>
|
||||
|
||||
* progmodes/xref.el (xref--xref-buffer-mode-map): Define before
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 "]"))
|
||||
|
||||
@ -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
|
||||
;;
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -1,7 +1,12 @@
|
||||
2015-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* 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 <contact@jorgenschaefer.de>
|
||||
|
||||
* 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 <mina86@mina86.com>
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user