mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-20 18:17:20 +00:00
* lisp/emacs-lisp/cl-generic.el: Add support for cl-next-method-p.
(cl-defmethod): Add edebug spec. (cl--generic-build-combined-method): Fix call to cl-no-applicable-method. (cl--generic-nnm-sample, cl--generic-cnm-sample): New constant. (cl--generic-isnot-nnm-p): New function. (cl--generic-lambda): Use it to add support for cl-next-method-p. (cl-no-next-method, cl-no-applicable-method): Simplify arg list. (cl-next-method-p): New function.
This commit is contained in:
Stefan Monnier
parent
3065125d31
commit
909126de0f
@ -1,3 +1,19 @@
|
||||
2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/cl-macs.el (cl-defstruct): Minor optimization when include
|
||||
or print is nil.
|
||||
(cl-struct-type-p): New function.
|
||||
|
||||
* emacs-lisp/cl-generic.el: Add support for cl-next-method-p.
|
||||
(cl-defmethod): Add edebug spec.
|
||||
(cl--generic-build-combined-method): Fix call to
|
||||
cl-no-applicable-method.
|
||||
(cl--generic-nnm-sample, cl--generic-cnm-sample): New constant.
|
||||
(cl--generic-isnot-nnm-p): New function.
|
||||
(cl--generic-lambda): Use it to add support for cl-next-method-p.
|
||||
(cl-no-next-method, cl-no-applicable-method): Simplify arg list.
|
||||
(cl-next-method-p): New function.
|
||||
|
||||
2015-01-17 Ulrich Müller <ulm@gentoo.org>
|
||||
|
||||
* version.el (emacs-repository-get-version): Update docstring.
|
||||
@ -14,8 +30,8 @@
|
||||
in place of the file name while working on non-file buffers, just
|
||||
like hack-dir-local-variables already does. (Bug#19140)
|
||||
|
||||
* textmodes/enriched.el (enriched-encode): Use
|
||||
inhibit-point-motion-hooks in addition to inhibit-read-only.
|
||||
* textmodes/enriched.el (enriched-encode):
|
||||
Use inhibit-point-motion-hooks in addition to inhibit-read-only.
|
||||
(Bug#18246)
|
||||
|
||||
* desktop.el (desktop-read): Do not call desktop-clear when no
|
||||
|
||||
@ -26,8 +26,7 @@
|
||||
;; The main entry points are: `cl-defgeneric' and `cl-defmethod'.
|
||||
|
||||
;; Missing elements:
|
||||
;; - We don't support next-method-p, make-method, call-method,
|
||||
;; define-method-combination.
|
||||
;; - We don't support make-method, call-method, define-method-combination.
|
||||
;; - Method and generic function objects: CLOS defines methods as objects
|
||||
;; (same for generic functions), whereas we don't offer such an abstraction.
|
||||
;; - `no-next-method' should receive the "calling method" object, but since we
|
||||
@ -133,7 +132,7 @@ They should be sorted from most specific to least specific.")
|
||||
"Create a generic function NAME.
|
||||
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 `defmethod'.
|
||||
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)."
|
||||
@ -223,8 +222,10 @@ This macro can only be used within the lexical scope of a cl-generic method."
|
||||
(let* ((doc-string (and doc-string (stringp (car body))
|
||||
(pop body)))
|
||||
(cnm (make-symbol "cl--cnm"))
|
||||
(nmp (make-symbol "cl--nmp"))
|
||||
(nbody (macroexpand-all
|
||||
`(cl-flet ((cl-call-next-method ,cnm))
|
||||
`(cl-flet ((cl-call-next-method ,cnm)
|
||||
(cl-next-method-p ,nmp))
|
||||
,@body)
|
||||
macroenv))
|
||||
;; FIXME: Rather than `grep' after the fact, the
|
||||
@ -232,11 +233,15 @@ This macro can only be used within the lexical scope of a cl-generic method."
|
||||
;; is used.
|
||||
;; FIXME: Also, optimize the case where call-next-method is
|
||||
;; only called with explicit arguments.
|
||||
(uses-cnm (cl--generic-fgrep (list cnm) nbody)))
|
||||
(uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
|
||||
(cons (not (not uses-cnm))
|
||||
`#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
|
||||
,@(if doc-string (list doc-string))
|
||||
,nbody))))
|
||||
,(if (not (memq nmp uses-cnm))
|
||||
nbody
|
||||
`(let ((,nmp (lambda ()
|
||||
(cl--generic-isnot-nnm-p ,cnm))))
|
||||
,nbody))))))
|
||||
(f (error "Unexpected macroexpansion result: %S" f))))))))
|
||||
|
||||
|
||||
@ -261,7 +266,15 @@ Other than a type, TYPE can also be of the form `(eql VAL)' in
|
||||
which case this method will be invoked when the argument is `eql' to VAL.
|
||||
|
||||
\(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)"
|
||||
(declare (doc-string 3) (indent 2))
|
||||
(declare (doc-string 3) (indent 2)
|
||||
(debug
|
||||
(&define ; this means we are defining something
|
||||
[&or name ("setf" :name setf name)]
|
||||
;; ^^ This is the methods symbol
|
||||
[ &optional keywordp ] ; this is key :before etc
|
||||
list ; arguments
|
||||
[ &optional stringp ] ; documentation string
|
||||
def-body))) ; part to be debugged
|
||||
(let ((qualifiers nil))
|
||||
(while (keywordp args)
|
||||
(push args qualifiers)
|
||||
@ -402,7 +415,8 @@ for all those different tags in the method-cache.")
|
||||
cl--generic-combined-method-memoization)
|
||||
(cond
|
||||
((null mets-by-qual) (lambda (&rest args)
|
||||
(cl-no-applicable-method generic-name args)))
|
||||
(apply #'cl-no-applicable-method
|
||||
generic-name args)))
|
||||
(t
|
||||
(let* ((fun (lambda (&rest args)
|
||||
;; FIXME: CLOS passes as second arg the "calling method".
|
||||
@ -428,6 +442,38 @@ for all those different tags in the method-cache.")
|
||||
(apply af args)))))))
|
||||
(cl--generic-nest fun (alist-get :around mets-by-qual))))))))
|
||||
|
||||
(defconst cl--generic-nnm-sample
|
||||
(cl--generic-build-combined-method nil '(((specializer . :qualifier)))))
|
||||
(defconst cl--generic-cnm-sample
|
||||
(funcall (cl--generic-build-combined-method
|
||||
nil `(((specializer . :primary) t . ,#'identity)))))
|
||||
|
||||
(defun cl--generic-isnot-nnm-p (cnm)
|
||||
"Return non-nil if CNM is the function that calls `cl-no-next-method'."
|
||||
;; ¡Big Gross Ugly Hack!
|
||||
;; `next-method-p' just sucks, we should let it die. But EIEIO did support
|
||||
;; it, and some packages use it, so we need to support it.
|
||||
(catch 'found
|
||||
(cl-assert (function-equal cnm cl--generic-cnm-sample))
|
||||
(if (byte-code-function-p cnm)
|
||||
(let ((cnm-constants (aref cnm 2))
|
||||
(sample-constants (aref cl--generic-cnm-sample 2)))
|
||||
(dotimes (i (length sample-constants))
|
||||
(when (function-equal (aref sample-constants i)
|
||||
cl--generic-nnm-sample)
|
||||
(throw 'found
|
||||
(not (function-equal (aref cnm-constants i)
|
||||
cl--generic-nnm-sample))))))
|
||||
(cl-assert (eq 'closure (car-safe cl--generic-cnm-sample)))
|
||||
(let ((cnm-env (cadr cnm)))
|
||||
(dolist (vb (cadr cl--generic-cnm-sample))
|
||||
(when (function-equal (cdr vb) cl--generic-nnm-sample)
|
||||
(throw 'found
|
||||
(not (function-equal (cdar cnm-env)
|
||||
cl--generic-nnm-sample))))
|
||||
(setq cnm-env (cdr cnm-env)))))
|
||||
(error "Haven't found no-next-method-sample in cnm-sample")))
|
||||
|
||||
(defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags)
|
||||
(let ((types (apply #'append (mapcar cl-generic-tag-types-function tags)))
|
||||
(methods '()))
|
||||
@ -452,12 +498,12 @@ for all those different tags in the method-cache.")
|
||||
|
||||
(cl-defgeneric cl-no-next-method (generic method &rest args)
|
||||
"Function called when `cl-call-next-method' finds no next method.")
|
||||
(cl-defmethod cl-no-next-method ((generic t) method &rest args)
|
||||
(cl-defmethod cl-no-next-method (generic method &rest args)
|
||||
(signal 'cl-no-next-method `(,generic ,method ,@args)))
|
||||
|
||||
(cl-defgeneric cl-no-applicable-method (generic &rest args)
|
||||
"Function called when a method call finds no applicable method.")
|
||||
(cl-defmethod cl-no-applicable-method ((generic t) &rest args)
|
||||
(cl-defmethod cl-no-applicable-method (generic &rest args)
|
||||
(signal 'cl-no-applicable-method `(,generic ,@args)))
|
||||
|
||||
(defun cl-call-next-method (&rest _args)
|
||||
@ -465,6 +511,12 @@ for all those different tags in the method-cache.")
|
||||
Can only be used from within the lexical body of a primary or around method."
|
||||
(error "cl-call-next-method only allowed inside primary and around methods"))
|
||||
|
||||
(defun cl-next-method-p ()
|
||||
"Return non-nil if there is a next method.
|
||||
Can only be used from within the lexical body of a primary or around method."
|
||||
(declare (obsolete "make sure there's always a next method, or catch `cl-no-next-method' instead" "25.1"))
|
||||
(error "cl-next-method-p only allowed inside primary and around methods"))
|
||||
|
||||
;;; Add support for describe-function
|
||||
|
||||
(defun cl--generic-search-method (met-name)
|
||||
|
||||
@ -36,12 +36,12 @@
|
||||
;; Retrieved from:
|
||||
;; http://192.220.96.201/dylan/linearization-oopsla96.html
|
||||
|
||||
;; There is funny stuff going on with typep and deftype. This
|
||||
;; is the only way I seem to be able to make this stuff load properly.
|
||||
|
||||
;; @TODO - fix :initform to be a form, not a quoted value
|
||||
;; @TODO - Prefix non-clos functions with `eieio-'.
|
||||
|
||||
;; TODO: better integrate CL's defstructs and classes. E.g. make it possible
|
||||
;; to create a new class that inherits from a struct.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar eieio-version "1.4"
|
||||
@ -924,7 +924,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
|
||||
|
||||
;;; Start of automatically extracted autoloads.
|
||||
|
||||
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "9a908efef1720439feb6323c1dd01770")
|
||||
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "6baa78cfc590cc0422e12b7eb55abf24")
|
||||
;;; Generated autoloads from eieio-custom.el
|
||||
|
||||
(autoload 'customize-object "eieio-custom" "\
|
||||
|
||||
Loading…
Reference in New Issue
Block a user