summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorAlan Mackenzie <acm@muc.de>2017-02-12 10:59:03 +0000
committerAlan Mackenzie <acm@muc.de>2017-02-12 10:59:03 +0000
commitf4d5b687150810129b7a1d5b006e31ccf82b691b (patch)
tree4229b13800349032697daae3904dc3773e6b7a80 /lisp/emacs-lisp
parentd5514332d4a6092673ce1f78fadcae0c57f7be64 (diff)
parent148100d98319499f0ac6f57b8be08cbd14884a5c (diff)
downloademacs-comment-cache.tar.gz
Merge branch 'master' into comment-cachecomment-cache
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/backquote.el10
-rw-r--r--lisp/emacs-lisp/cl-generic.el15
-rw-r--r--lisp/emacs-lisp/cl-lib.el143
-rw-r--r--lisp/emacs-lisp/cl.el24
-rw-r--r--lisp/emacs-lisp/edebug.el13
-rw-r--r--lisp/emacs-lisp/ert-x.el26
-rw-r--r--lisp/emacs-lisp/let-alist.el2
-rw-r--r--lisp/emacs-lisp/pcase.el3
-rw-r--r--lisp/emacs-lisp/subr-x.el41
-rw-r--r--lisp/emacs-lisp/tabulated-list.el9
10 files changed, 118 insertions, 168 deletions
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 94c561cba0a..bb877dd2c97 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -247,4 +247,14 @@ LEVEL is only used internally and indicates the nesting level:
tail))
(t (cons 'list heads)))))
+
+;; Give `,' and `,@' documentation strings which can be examined by C-h f.
+(put '\, 'function-documentation
+ "See `\\=`' (also `pcase') for the usage of `,'.")
+(put '\, 'reader-construct t)
+
+(put '\,@ 'function-documentation
+ "See `\\=`' for the usage of `,@'.")
+(put '\,@ 'reader-construct t)
+
;;; backquote.el ends here
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8d141d7a646..6cc70c4c2f5 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -226,7 +226,13 @@ DEFAULT-BODY, if present, is used as the body of a default method.
(when (eq 'setf (car-safe name))
(require 'gv)
(setq name (gv-setter (cadr name))))
- `(progn
+ `(prog1
+ (progn
+ (defalias ',name
+ (cl-generic-define ',name ',args ',(nreverse options))
+ ,(help-add-fundoc-usage doc args))
+ ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
+ (nreverse methods)))
,@(mapcar (lambda (declaration)
(let ((f (cdr (assq (car declaration)
defun-declarations-alist))))
@@ -235,12 +241,7 @@ DEFAULT-BODY, if present, is used as the body of a default method.
(t (message "Warning: Unknown defun property `%S' in %S"
(car declaration) name)
nil))))
- (cdr declarations))
- (defalias ',name
- (cl-generic-define ',name ',args ',(nreverse options))
- ,(help-add-fundoc-usage doc args))
- ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
- (nreverse methods)))))
+ (cdr declarations)))))
;;;###autoload
(defun cl-generic-define (name args options)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index b1db07fe165..5aa8f1bf652 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -413,125 +413,30 @@ Signal an error if X is not a list."
(declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
(nth 9 x))
-(defun cl-caaar (x)
- "Return the `car' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (car x))))
-
-(defun cl-caadr (x)
- "Return the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (cdr x))))
-
-(defun cl-cadar (x)
- "Return the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (car x))))
-
-(defun cl-caddr (x)
- "Return the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (cdr x))))
-
-(defun cl-cdaar (x)
- "Return the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (car x))))
-
-(defun cl-cdadr (x)
- "Return the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (cdr x))))
-
-(defun cl-cddar (x)
- "Return the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (car x))))
-
-(defun cl-cdddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (cdr x))))
-
-(defun cl-caaaar (x)
- "Return the `car' of the `car' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (car (car x)))))
-
-(defun cl-caaadr (x)
- "Return the `car' of the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (car (cdr x)))))
-
-(defun cl-caadar (x)
- "Return the `car' of the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (cdr (car x)))))
-
-(defun cl-caaddr (x)
- "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (car (cdr (cdr x)))))
-
-(defun cl-cadaar (x)
- "Return the `car' of the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (car (car x)))))
-
-(defun cl-cadadr (x)
- "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (car (cdr x)))))
-
-(defun cl-caddar (x)
- "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (cdr (car x)))))
-
-(defun cl-cadddr (x)
- "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (car (cdr (cdr (cdr x)))))
-
-(defun cl-cdaaar (x)
- "Return the `cdr' of the `car' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (car (car x)))))
-
-(defun cl-cdaadr (x)
- "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (car (cdr x)))))
-
-(defun cl-cdadar (x)
- "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (cdr (car x)))))
-
-(defun cl-cdaddr (x)
- "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (car (cdr (cdr x)))))
-
-(defun cl-cddaar (x)
- "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (car (car x)))))
-
-(defun cl-cddadr (x)
- "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (car (cdr x)))))
-
-(defun cl-cdddar (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (cdr (car x)))))
-
-(defun cl-cddddr (x)
- "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro internal--compiler-macro-cXXr))
- (cdr (cdr (cdr (cdr x)))))
+(defalias 'cl-caaar 'caaar)
+(defalias 'cl-caadr 'caadr)
+(defalias 'cl-cadar 'cadar)
+(defalias 'cl-caddr 'caddr)
+(defalias 'cl-cdaar 'cdaar)
+(defalias 'cl-cdadr 'cdadr)
+(defalias 'cl-cddar 'cddar)
+(defalias 'cl-cdddr 'cdddr)
+(defalias 'cl-caaaar 'caaaar)
+(defalias 'cl-caaadr 'caaadr)
+(defalias 'cl-caadar 'caadar)
+(defalias 'cl-caaddr 'caaddr)
+(defalias 'cl-cadaar 'cadaar)
+(defalias 'cl-cadadr 'cadadr)
+(defalias 'cl-caddar 'caddar)
+(defalias 'cl-cadddr 'cadddr)
+(defalias 'cl-cdaaar 'cdaaar)
+(defalias 'cl-cdaadr 'cdaadr)
+(defalias 'cl-cdadar 'cdadar)
+(defalias 'cl-cdaddr 'cdaddr)
+(defalias 'cl-cddaar 'cddaar)
+(defalias 'cl-cddadr 'cddadr)
+(defalias 'cl-cdddar 'cdddar)
+(defalias 'cl-cddddr 'cddddr)
;;(defun last* (x &optional n)
;; "Returns the last link in the list LIST.
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index e33a603d1b0..73eb9a4e866 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -258,30 +258,6 @@
copy-list
ldiff
list*
- cddddr
- cdddar
- cddadr
- cddaar
- cdaddr
- cdadar
- cdaadr
- cdaaar
- cadddr
- caddar
- cadadr
- cadaar
- caaddr
- caadar
- caaadr
- caaaar
- cdddr
- cddar
- cdadr
- cdaar
- caddr
- cadar
- caadr
- caaar
tenth
ninth
eighth
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index db54d1eeb20..ec0f08de356 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -112,6 +112,18 @@ and some not, use `def-edebug-spec' to specify an `edebug-form-spec'."
:type 'boolean
:group 'edebug)
+(defcustom edebug-max-depth 150
+ "Maximum recursion depth when instrumenting code.
+This limit is intended to stop recursion if an Edebug specification
+contains an infinite loop. When Edebug is instrumenting code
+containing very large quoted lists, it may reach this limit and give
+the error message \"Too deep - perhaps infinite loop in spec?\".
+Make this limit larger to countermand that, but you may also need to
+increase `max-lisp-eval-depth' and `max-specpdl-size'."
+ :type 'integer
+ :group 'edebug
+ :version "26.1")
+
(defcustom edebug-save-windows t
"If non-nil, Edebug saves and restores the window configuration.
That takes some time, so if your program does not care what happens to
@@ -1452,7 +1464,6 @@ expressions; a `progn' form will be returned enclosing these forms."
(defvar edebug-after-dotted-spec nil)
(defvar edebug-matching-depth 0) ;; initial value
-(defconst edebug-max-depth 150) ;; maximum number of matching recursions.
;;; Failure to match
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 7d99cb30274..4cf9d9609e9 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -97,7 +97,7 @@ To be used in ERT tests. If BODY finishes successfully, the test
buffer is killed; if there is an error, the test buffer is kept
around on error for further inspection. Its name is derived from
the name of the test and the result of NAME-FORM."
- (declare (debug ((form) body))
+ (declare (debug ((":name" form) body))
(indent 1))
`(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
@@ -285,6 +285,30 @@ BUFFER defaults to current buffer. Does not modify BUFFER."
(kill-buffer clone)))))))
+(defmacro ert-with-message-capture (var &rest body)
+ "Execute BODY while collecting anything written with `message' in VAR.
+
+Capture all messages produced by `message' when it is called from
+Lisp, and concatenate them separated by newlines into one string.
+
+This is useful for separating the issuance of messages by the
+code under test from the behavior of the *Messages* buffer."
+ (declare (debug (symbolp body))
+ (indent 1))
+ (let ((g-advice (cl-gensym)))
+ `(let* ((,var "")
+ (,g-advice (lambda (func &rest args)
+ (if (or (null args) (equal (car args) ""))
+ (apply func args)
+ (let ((msg (apply #'format-message args)))
+ (setq ,var (concat ,var msg "\n"))
+ (funcall func "%s" msg))))))
+ (advice-add 'message :around ,g-advice)
+ (unwind-protect
+ (progn ,@body)
+ (advice-remove 'message ,g-advice)))))
+
+
(provide 'ert-x)
;;; ert-x.el ends here
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index a45fc0a05c3..cf82fe3ec63 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -4,7 +4,7 @@
;; Author: Artur Malabarba <emacs@endlessparentheses.com>
;; Package-Requires: ((emacs "24.1"))
-;; Version: 1.0.4
+;; Version: 1.0.5
;; Keywords: extensions lisp
;; Prefix: let-alist
;; Separator: -
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 54678c5f324..46a5eedd150 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -89,7 +89,8 @@
(functionp &rest form)
sexp))
-(def-edebug-spec pcase-MACRO pcase--edebug-match-macro)
+;; See bug#24717
+(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro)
;; Only called from edebug.
(declare-function get-edebug-spec "edebug" (symbol))
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 7736225b5fa..f7a846927c0 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -115,12 +115,16 @@ threading."
binding))
bindings)))
-(defmacro if-let (bindings then &rest else)
- "Process BINDINGS and if all values are non-nil eval THEN, else ELSE.
-Argument BINDINGS is a list of tuples whose car is a symbol to be
-bound and (optionally) used in THEN, and its cadr is a sexp to be
-evalled to set symbol's value. In the special case you only want
-to bind a single value, BINDINGS can just be a plain tuple."
+(defmacro if-let* (bindings then &rest else)
+ "Bind variables according to VARLIST and eval THEN or ELSE.
+Each binding is evaluated in turn with `let*', and evaluation
+stops if a binding value is nil. If all are non-nil, the value
+of THEN is returned, or the last form in ELSE is returned.
+Each element of VARLIST is a symbol (which is bound to nil)
+or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
+In the special case you only want to bind a single value,
+VARLIST can just be a plain tuple.
+\n(fn VARLIST THEN ELSE...)"
(declare (indent 2)
(debug ([&or (&rest (symbolp form)) (symbolp form)] form body)))
(when (and (<= (length bindings) 2)
@@ -132,15 +136,23 @@ to bind a single value, BINDINGS can just be a plain tuple."
,then
,@else)))
-(defmacro when-let (bindings &rest body)
- "Process BINDINGS and if all values are non-nil eval BODY.
-Argument BINDINGS is a list of tuples whose car is a symbol to be
-bound and (optionally) used in BODY, and its cadr is a sexp to be
-evalled to set symbol's value. In the special case you only want
-to bind a single value, BINDINGS can just be a plain tuple."
+(defmacro when-let* (bindings &rest body)
+ "Bind variables according to VARLIST and conditionally eval BODY.
+Each binding is evaluated in turn with `let*', and evaluation
+stops if a binding value is nil. If all are non-nil, the value
+of the last form in BODY is returned.
+Each element of VARLIST is a symbol (which is bound to nil)
+or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
+In the special case you only want to bind a single value,
+VARLIST can just be a plain tuple.
+\n(fn VARLIST BODY...)"
(declare (indent 1) (debug if-let))
(list 'if-let bindings (macroexp-progn body)))
+(defalias 'if-let 'if-let*)
+(defalias 'when-let 'when-let*)
+(defalias 'and-let* 'when-let*)
+
(defsubst hash-table-empty-p (hash-table)
"Check whether HASH-TABLE is empty (has 0 elements)."
(zerop (hash-table-count hash-table)))
@@ -214,6 +226,11 @@ user enters `recenter', `scroll-up', or `scroll-down' responses,
perform the requested window recentering or scrolling and ask
again.
+When `use-dialog-box' is t (the default), this function can pop
+up a dialog window to collect the user input. That functionality
+requires `display-popup-menus-p' to return t. Otherwise, a text
+dialog will be used.
+
The return value is the matching entry from the CHOICES list.
Usage example:
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index eadf79ffd4f..b6b49b1bfa2 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -412,8 +412,13 @@ of column descriptors."
(inhibit-read-only t))
(if (> tabulated-list-padding 0)
(insert (make-string x ?\s)))
- (dotimes (n ncols)
- (setq x (tabulated-list-print-col n (aref cols n) x)))
+ (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
+ (or (bound-and-true-p tabulated-list--near-rows)
+ (list (or (tabulated-list-get-entry (point-at-bol 0))
+ cols)
+ cols))))
+ (dotimes (n ncols)
+ (setq x (tabulated-list-print-col n (aref cols n) x))))
(insert ?\n)
;; Ever so slightly faster than calling `put-text-property' twice.
(add-text-properties