[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/gnus-cloud 9af4ba0 08/28: Merge branch 'master' of
From: |
Teodor Zlatanov |
Subject: |
[Emacs-diffs] scratch/gnus-cloud 9af4ba0 08/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs |
Date: |
Mon, 18 Jul 2016 14:04:12 +0000 (UTC) |
branch: scratch/gnus-cloud
commit 9af4ba0a22b63c8f7ea19e3b2ece8782b4094a7a
Merge: 1d0011b 9c8c3a5
Author: Ted Zlatanov <address@hidden>
Commit: Ted Zlatanov <address@hidden>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
---
lisp/emacs-lisp/cl-generic.el | 60 ++++++++++++++++++++++++++++++-----------
lisp/emacs-lisp/cl-macs.el | 21 +++++++++++++++
lisp/emacs-lisp/eieio-core.el | 3 +++
3 files changed, 68 insertions(+), 16 deletions(-)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 0144daf..b7c8395 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -353,6 +353,26 @@ the specializer used will be the one returned by BODY."
,nbody))))))
(f (error "Unexpected macroexpansion result: %S" f))))))
+(put 'cl-defmethod 'function-documentation
+ '(cl--generic-make-defmethod-docstring))
+
+(defun cl--generic-make-defmethod-docstring ()
+ ;; FIXME: Copy&paste from pcase--make-docstring.
+ (let* ((main (documentation (symbol-function 'cl-defmethod) 'raw))
+ (ud (help-split-fundoc main 'cl-defmethod)))
+ ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works,
+ ;; where cl-lib is anything using pcase-defmacro.
+ (require 'help-fns)
+ (with-temp-buffer
+ (insert (or (cdr ud) main))
+ (insert "\n\n\tCurrently supported forms for TYPE:\n\n")
+ (dolist (method (reverse (cl--generic-method-table
+ (cl--generic 'cl-generic-generalizers))))
+ (let* ((info (cl--generic-method-info method)))
+ (when (nth 2 info)
+ (insert (nth 2 info) "\n\n"))))
+ (let ((combined-doc (buffer-string)))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
;;;###autoload
(defmacro cl-defmethod (name args &rest body)
@@ -370,15 +390,17 @@ modifies how the method is combined with other methods,
including:
:after - Method will be called after the primary
:around - Method will be called around everything else
The absence of QUALIFIER means this is a \"primary\" method.
+The set of acceptable qualifiers and their meaning is defined
+\(and can be extended) by the methods of `cl-generic-combine-methods'.
-TYPE can be one of the basic types (see the full list and their
-hierarchy in `cl--generic-typeof-types'), CL struct type, or an
-EIEIO class.
+ARGS can also include so-called context specializers, introduced by
+`&context' (which should appear right after the mandatory arguments,
+before any &optional or &rest). They have the form (EXPR TYPE) where
+EXPR is an Elisp expression whose value should match TYPE for the
+method to be applicable.
-Other than that, TYPE can also be of the form `(eql VAL)' in
-which case this method will be invoked when the argument is `eql'
-to VAL, or `(head VAL)', in which case the argument is required
-to be a cons with VAL as its head.
+The set of acceptable TYPEs (also called \"specializers\") is defined
+\(and can be extended) by the various methods of `cl-generic-generalizers'.
\(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)"
(declare (doc-string 3) (indent 2)
@@ -464,7 +486,8 @@ to be a cons with VAL as its head.
(cons method mt)
;; Keep the ordering; important for methods with :extra qualifiers.
(mapcar (lambda (x) (if (eq x (car me)) method x)) mt)))
- (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
+ (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic)
+ ,qualifiers . ,specializers))
current-load-list :test #'equal)
;; FIXME: Try to avoid re-constructing a new function if the old one
;; is still valid (e.g. still empty method cache)?
@@ -737,7 +760,7 @@ methods.")
(fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination))
(cl-defmethod cl-generic-generalizers (specializer)
- "Support for the catch-all t specializer."
+ "Support for the catch-all t specializer which always matches."
(if (eq specializer t) (list cl--generic-t-generalizer)
(error "Unknown specializer %S" specializer)))
@@ -909,8 +932,9 @@ MET-NAME is a cons (SYMBOL . SPECIALIZERS)."
(let* ((info (cl--generic-method-info method)))
;; FIXME: Add hyperlinks for the types as well.
(insert (format "%s%S" (nth 0 info) (nth 1 info)))
- (let* ((met-name (cons function
- (cl--generic-method-specializers method)))
+ (let* ((met-name `(,function
+ ,(cl--generic-method-qualifiers method)
+ . ,(cl--generic-method-specializers method)))
(file (find-lisp-object-file-name met-name 'cl-defmethod)))
(when file
(insert (substitute-command-keys " in `"))
@@ -994,7 +1018,8 @@ The value returned is a list of elements of the form
(lambda (tag &rest _) (if (eq (car-safe tag) 'head) (list tag))))
(cl-defmethod cl-generic-generalizers :extra "head" (specializer)
- "Support for the `(head VAL)' specializers."
+ "Support for (head VAL) specializers.
+These match if the argument is a cons cell whose car is `eql' to VAL."
;; We have to implement `head' here using the :extra qualifier,
;; since we can't use the `head' specializer to implement itself.
(if (not (eq (car-safe specializer) 'head))
@@ -1014,7 +1039,8 @@ The value returned is a list of elements of the form
(lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (list tag))))
(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
- "Support for the `(eql VAL)' specializers."
+ "Support for (eql VAL) specializers.
+These match if the argument is `eql' to VAL."
(puthash (cadr specializer) specializer cl--generic-eql-used)
(list cl--generic-eql-generalizer))
@@ -1069,7 +1095,7 @@ The value returned is a list of elements of the form
#'cl--generic-struct-specializers)
(cl-defmethod cl-generic-generalizers :extra "cl-struct" (type)
- "Support for dispatch on cl-struct types."
+ "Support for dispatch on types defined by `cl-defstruct'."
(or
(when (symbolp type)
;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
@@ -1113,7 +1139,8 @@ The value returned is a list of elements of the form
(and (symbolp tag) (assq tag cl--generic-typeof-types))))
(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
- "Support for dispatch on builtin types."
+ "Support for dispatch on builtin types.
+See the full list and their hierarchy in `cl--generic-typeof-types'."
;; FIXME: Add support for other types accepted by `cl-typep' such
;; as `character', `atom', `face', `function', ...
(or
@@ -1151,7 +1178,8 @@ The value returned is a list of elements of the form
#'cl--generic-derived-specializers)
(cl-defmethod cl-generic-generalizers ((_specializer (head derived-mode)))
- "Support for the `(derived-mode MODE)' specializers."
+ "Support for (derived-mode MODE) specializers.
+Used internally for the (major-mode MODE) context specializers."
(list cl--generic-derived-generalizer))
(cl-generic-define-context-rewriter major-mode (mode &rest modes)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d2c90c2..56170e6 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1808,6 +1808,27 @@ Labels have lexical scope and dynamic extent."
`(throw ',catch-tag ',label))))
,@macroexpand-all-environment)))))
+(defun cl--prog (binder bindings body)
+ (let (decls)
+ (while (eq 'declare (car-safe (car body)))
+ (push (pop body) decls))
+ `(cl-block nil
+ (,binder ,bindings
+ ,@(nreverse decls)
+ (cl-tagbody . ,body)))))
+
+;;;###autoload
+(defmacro cl-prog (bindings &rest body)
+ "Run BODY like a `cl-tagbody' after setting up the BINDINGS.
+Shorthand for (cl-block nil (let BINDINGS (cl-tagbody BODY)))"
+ (cl--prog 'let bindings body))
+
+;;;###autoload
+(defmacro cl-prog* (bindings &rest body)
+ "Run BODY like a `cl-tagbody' after setting up the BINDINGS.
+Shorthand for (cl-block nil (let* BINDINGS (cl-tagbody BODY)))"
+ (cl--prog 'let* bindings body))
+
;;;###autoload
(defmacro cl-do-symbols (spec &rest body)
"Loop over all symbols.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index fd8ae2a..0567c87 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1065,6 +1065,7 @@ method invocation orders of the involved classes."
(eieio--class-precedence-list (symbol-value tag))))))
(cl-defmethod cl-generic-generalizers :extra "class" (specializer)
+ "Support for dispatch on types defined by EIEIO's `defclass'."
;; CLHS says:
;; A class must be defined before it can be used as a parameter
;; specializer in a defmethod form.
@@ -1093,6 +1094,8 @@ method invocation orders of the involved classes."
#'eieio--generic-subclass-specializers)
(cl-defmethod cl-generic-generalizers ((_specializer (head subclass)))
+ "Support for (subclass CLASS) specializers.
+These match if the argument is the name of a subclass of CLASS."
(list eieio--generic-subclass-generalizer))
(provide 'eieio-core)
- [Emacs-diffs] scratch/gnus-cloud 1d0011b 07/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, (continued)
- [Emacs-diffs] scratch/gnus-cloud 1d0011b 07/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 9048d14 03/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 23262a8 11/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud fbda536 18/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 15fda1f 22/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 864e344 14/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 548f157 10/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 1aa29cc 19/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud fae4411 16/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud b996f42 27/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 9af4ba0 08/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs,
Teodor Zlatanov <=
- [Emacs-diffs] scratch/gnus-cloud e582450 24/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 82fe6fa 17/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 4bc13b7 25/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 0c9487a 12/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud e6381fa 13/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 8d67982 01/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud ae18a15 21/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 73e10a8 15/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud cbd54d0 28/28: Minor gnus-cloud UI improvements., Teodor Zlatanov, 2016/07/18
- [Emacs-diffs] scratch/gnus-cloud 4eae8f1 20/28: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs, Teodor Zlatanov, 2016/07/18