aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
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:
247 tail)) 247 tail))
248 (t (cons 'list heads))))) 248 (t (cons 'list heads)))))
249 249
250
251;; Give `,' and `,@' documentation strings which can be examined by C-h f.
252(put '\, 'function-documentation
253 "See `\\=`' (also `pcase') for the usage of `,'.")
254(put '\, 'reader-construct t)
255
256(put '\,@ 'function-documentation
257 "See `\\=`' for the usage of `,@'.")
258(put '\,@ 'reader-construct t)
259
250;;; backquote.el ends here 260;;; 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.
226 (when (eq 'setf (car-safe name)) 226 (when (eq 'setf (car-safe name))
227 (require 'gv) 227 (require 'gv)
228 (setq name (gv-setter (cadr name)))) 228 (setq name (gv-setter (cadr name))))
229 `(progn 229 `(prog1
230 (progn
231 (defalias ',name
232 (cl-generic-define ',name ',args ',(nreverse options))
233 ,(help-add-fundoc-usage doc args))
234 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
235 (nreverse methods)))
230 ,@(mapcar (lambda (declaration) 236 ,@(mapcar (lambda (declaration)
231 (let ((f (cdr (assq (car declaration) 237 (let ((f (cdr (assq (car declaration)
232 defun-declarations-alist)))) 238 defun-declarations-alist))))
@@ -235,12 +241,7 @@ DEFAULT-BODY, if present, is used as the body of a default method.
235 (t (message "Warning: Unknown defun property `%S' in %S" 241 (t (message "Warning: Unknown defun property `%S' in %S"
236 (car declaration) name) 242 (car declaration) name)
237 nil)))) 243 nil))))
238 (cdr declarations)) 244 (cdr declarations)))))
239 (defalias ',name
240 (cl-generic-define ',name ',args ',(nreverse options))
241 ,(help-add-fundoc-usage doc args))
242 ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
243 (nreverse methods)))))
244 245
245;;;###autoload 246;;;###autoload
246(defun cl-generic-define (name args options) 247(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."
413 (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) 413 (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
414 (nth 9 x)) 414 (nth 9 x))
415 415
416(defun cl-caaar (x) 416(defalias 'cl-caaar 'caaar)
417 "Return the `car' of the `car' of the `car' of X." 417(defalias 'cl-caadr 'caadr)
418 (declare (compiler-macro internal--compiler-macro-cXXr)) 418(defalias 'cl-cadar 'cadar)
419 (car (car (car x)))) 419(defalias 'cl-caddr 'caddr)
420 420(defalias 'cl-cdaar 'cdaar)
421(defun cl-caadr (x) 421(defalias 'cl-cdadr 'cdadr)
422 "Return the `car' of the `car' of the `cdr' of X." 422(defalias 'cl-cddar 'cddar)
423 (declare (compiler-macro internal--compiler-macro-cXXr)) 423(defalias 'cl-cdddr 'cdddr)
424 (car (car (cdr x)))) 424(defalias 'cl-caaaar 'caaaar)
425 425(defalias 'cl-caaadr 'caaadr)
426(defun cl-cadar (x) 426(defalias 'cl-caadar 'caadar)
427 "Return the `car' of the `cdr' of the `car' of X." 427(defalias 'cl-caaddr 'caaddr)
428 (declare (compiler-macro internal--compiler-macro-cXXr)) 428(defalias 'cl-cadaar 'cadaar)
429 (car (cdr (car x)))) 429(defalias 'cl-cadadr 'cadadr)
430 430(defalias 'cl-caddar 'caddar)
431(defun cl-caddr (x) 431(defalias 'cl-cadddr 'cadddr)
432 "Return the `car' of the `cdr' of the `cdr' of X." 432(defalias 'cl-cdaaar 'cdaaar)
433 (declare (compiler-macro internal--compiler-macro-cXXr)) 433(defalias 'cl-cdaadr 'cdaadr)
434 (car (cdr (cdr x)))) 434(defalias 'cl-cdadar 'cdadar)
435 435(defalias 'cl-cdaddr 'cdaddr)
436(defun cl-cdaar (x) 436(defalias 'cl-cddaar 'cddaar)
437 "Return the `cdr' of the `car' of the `car' of X." 437(defalias 'cl-cddadr 'cddadr)
438 (declare (compiler-macro internal--compiler-macro-cXXr)) 438(defalias 'cl-cdddar 'cdddar)
439 (cdr (car (car x)))) 439(defalias 'cl-cddddr 'cddddr)
440
441(defun cl-cdadr (x)
442 "Return the `cdr' of the `car' of the `cdr' of X."
443 (declare (compiler-macro internal--compiler-macro-cXXr))
444 (cdr (car (cdr x))))
445
446(defun cl-cddar (x)
447 "Return the `cdr' of the `cdr' of the `car' of X."
448 (declare (compiler-macro internal--compiler-macro-cXXr))
449 (cdr (cdr (car x))))
450
451(defun cl-cdddr (x)
452 "Return the `cdr' of the `cdr' of the `cdr' of X."
453 (declare (compiler-macro internal--compiler-macro-cXXr))
454 (cdr (cdr (cdr x))))
455
456(defun cl-caaaar (x)
457 "Return the `car' of the `car' of the `car' of the `car' of X."
458 (declare (compiler-macro internal--compiler-macro-cXXr))
459 (car (car (car (car x)))))
460
461(defun cl-caaadr (x)
462 "Return the `car' of the `car' of the `car' of the `cdr' of X."
463 (declare (compiler-macro internal--compiler-macro-cXXr))
464 (car (car (car (cdr x)))))
465
466(defun cl-caadar (x)
467 "Return the `car' of the `car' of the `cdr' of the `car' of X."
468 (declare (compiler-macro internal--compiler-macro-cXXr))
469 (car (car (cdr (car x)))))
470
471(defun cl-caaddr (x)
472 "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
473 (declare (compiler-macro internal--compiler-macro-cXXr))
474 (car (car (cdr (cdr x)))))
475
476(defun cl-cadaar (x)
477 "Return the `car' of the `cdr' of the `car' of the `car' of X."
478 (declare (compiler-macro internal--compiler-macro-cXXr))
479 (car (cdr (car (car x)))))
480
481(defun cl-cadadr (x)
482 "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
483 (declare (compiler-macro internal--compiler-macro-cXXr))
484 (car (cdr (car (cdr x)))))
485
486(defun cl-caddar (x)
487 "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
488 (declare (compiler-macro internal--compiler-macro-cXXr))
489 (car (cdr (cdr (car x)))))
490
491(defun cl-cadddr (x)
492 "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
493 (declare (compiler-macro internal--compiler-macro-cXXr))
494 (car (cdr (cdr (cdr x)))))
495
496(defun cl-cdaaar (x)
497 "Return the `cdr' of the `car' of the `car' of the `car' of X."
498 (declare (compiler-macro internal--compiler-macro-cXXr))
499 (cdr (car (car (car x)))))
500
501(defun cl-cdaadr (x)
502 "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
503 (declare (compiler-macro internal--compiler-macro-cXXr))
504 (cdr (car (car (cdr x)))))
505
506(defun cl-cdadar (x)
507 "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
508 (declare (compiler-macro internal--compiler-macro-cXXr))
509 (cdr (car (cdr (car x)))))
510
511(defun cl-cdaddr (x)
512 "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
513 (declare (compiler-macro internal--compiler-macro-cXXr))
514 (cdr (car (cdr (cdr x)))))
515
516(defun cl-cddaar (x)
517 "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
518 (declare (compiler-macro internal--compiler-macro-cXXr))
519 (cdr (cdr (car (car x)))))
520
521(defun cl-cddadr (x)
522 "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
523 (declare (compiler-macro internal--compiler-macro-cXXr))
524 (cdr (cdr (car (cdr x)))))
525
526(defun cl-cdddar (x)
527 "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
528 (declare (compiler-macro internal--compiler-macro-cXXr))
529 (cdr (cdr (cdr (car x)))))
530
531(defun cl-cddddr (x)
532 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
533 (declare (compiler-macro internal--compiler-macro-cXXr))
534 (cdr (cdr (cdr (cdr x)))))
535 440
536;;(defun last* (x &optional n) 441;;(defun last* (x &optional n)
537;; "Returns the last link in the list LIST. 442;; "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 @@
258 copy-list 258 copy-list
259 ldiff 259 ldiff
260 list* 260 list*
261 cddddr
262 cdddar
263 cddadr
264 cddaar
265 cdaddr
266 cdadar
267 cdaadr
268 cdaaar
269 cadddr
270 caddar
271 cadadr
272 cadaar
273 caaddr
274 caadar
275 caaadr
276 caaaar
277 cdddr
278 cddar
279 cdadr
280 cdaar
281 caddr
282 cadar
283 caadr
284 caaar
285 tenth 261 tenth
286 ninth 262 ninth
287 eighth 263 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'."
112 :type 'boolean 112 :type 'boolean
113 :group 'edebug) 113 :group 'edebug)
114 114
115(defcustom edebug-max-depth 150
116 "Maximum recursion depth when instrumenting code.
117This limit is intended to stop recursion if an Edebug specification
118contains an infinite loop. When Edebug is instrumenting code
119containing very large quoted lists, it may reach this limit and give
120the error message \"Too deep - perhaps infinite loop in spec?\".
121Make this limit larger to countermand that, but you may also need to
122increase `max-lisp-eval-depth' and `max-specpdl-size'."
123 :type 'integer
124 :group 'edebug
125 :version "26.1")
126
115(defcustom edebug-save-windows t 127(defcustom edebug-save-windows t
116 "If non-nil, Edebug saves and restores the window configuration. 128 "If non-nil, Edebug saves and restores the window configuration.
117That takes some time, so if your program does not care what happens to 129That 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."
1452(defvar edebug-after-dotted-spec nil) 1464(defvar edebug-after-dotted-spec nil)
1453 1465
1454(defvar edebug-matching-depth 0) ;; initial value 1466(defvar edebug-matching-depth 0) ;; initial value
1455(defconst edebug-max-depth 150) ;; maximum number of matching recursions.
1456 1467
1457 1468
1458;;; Failure to match 1469;;; 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
97buffer is killed; if there is an error, the test buffer is kept 97buffer is killed; if there is an error, the test buffer is kept
98around on error for further inspection. Its name is derived from 98around on error for further inspection. Its name is derived from
99the name of the test and the result of NAME-FORM." 99the name of the test and the result of NAME-FORM."
100 (declare (debug ((form) body)) 100 (declare (debug ((":name" form) body))
101 (indent 1)) 101 (indent 1))
102 `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) 102 `(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
103 103
@@ -285,6 +285,30 @@ BUFFER defaults to current buffer. Does not modify BUFFER."
285 (kill-buffer clone))))))) 285 (kill-buffer clone)))))))
286 286
287 287
288(defmacro ert-with-message-capture (var &rest body)
289 "Execute BODY while collecting anything written with `message' in VAR.
290
291Capture all messages produced by `message' when it is called from
292Lisp, and concatenate them separated by newlines into one string.
293
294This is useful for separating the issuance of messages by the
295code under test from the behavior of the *Messages* buffer."
296 (declare (debug (symbolp body))
297 (indent 1))
298 (let ((g-advice (cl-gensym)))
299 `(let* ((,var "")
300 (,g-advice (lambda (func &rest args)
301 (if (or (null args) (equal (car args) ""))
302 (apply func args)
303 (let ((msg (apply #'format-message args)))
304 (setq ,var (concat ,var msg "\n"))
305 (funcall func "%s" msg))))))
306 (advice-add 'message :around ,g-advice)
307 (unwind-protect
308 (progn ,@body)
309 (advice-remove 'message ,g-advice)))))
310
311
288(provide 'ert-x) 312(provide 'ert-x)
289 313
290;;; ert-x.el ends here 314;;; 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 @@
4 4
5;; Author: Artur Malabarba <emacs@endlessparentheses.com> 5;; Author: Artur Malabarba <emacs@endlessparentheses.com>
6;; Package-Requires: ((emacs "24.1")) 6;; Package-Requires: ((emacs "24.1"))
7;; Version: 1.0.4 7;; Version: 1.0.5
8;; Keywords: extensions lisp 8;; Keywords: extensions lisp
9;; Prefix: let-alist 9;; Prefix: let-alist
10;; Separator: - 10;; 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 @@
89 (functionp &rest form) 89 (functionp &rest form)
90 sexp)) 90 sexp))
91 91
92(def-edebug-spec pcase-MACRO pcase--edebug-match-macro) 92;; See bug#24717
93(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro)
93 94
94;; Only called from edebug. 95;; Only called from edebug.
95(declare-function get-edebug-spec "edebug" (symbol)) 96(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."
115 binding)) 115 binding))
116 bindings))) 116 bindings)))
117 117
118(defmacro if-let (bindings then &rest else) 118(defmacro if-let* (bindings then &rest else)
119 "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. 119 "Bind variables according to VARLIST and eval THEN or ELSE.
120Argument BINDINGS is a list of tuples whose car is a symbol to be 120Each binding is evaluated in turn with `let*', and evaluation
121bound and (optionally) used in THEN, and its cadr is a sexp to be 121stops if a binding value is nil. If all are non-nil, the value
122evalled to set symbol's value. In the special case you only want 122of THEN is returned, or the last form in ELSE is returned.
123to bind a single value, BINDINGS can just be a plain tuple." 123Each element of VARLIST is a symbol (which is bound to nil)
124or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
125In the special case you only want to bind a single value,
126VARLIST can just be a plain tuple.
127\n(fn VARLIST THEN ELSE...)"
124 (declare (indent 2) 128 (declare (indent 2)
125 (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) 129 (debug ([&or (&rest (symbolp form)) (symbolp form)] form body)))
126 (when (and (<= (length bindings) 2) 130 (when (and (<= (length bindings) 2)
@@ -132,15 +136,23 @@ to bind a single value, BINDINGS can just be a plain tuple."
132 ,then 136 ,then
133 ,@else))) 137 ,@else)))
134 138
135(defmacro when-let (bindings &rest body) 139(defmacro when-let* (bindings &rest body)
136 "Process BINDINGS and if all values are non-nil eval BODY. 140 "Bind variables according to VARLIST and conditionally eval BODY.
137Argument BINDINGS is a list of tuples whose car is a symbol to be 141Each binding is evaluated in turn with `let*', and evaluation
138bound and (optionally) used in BODY, and its cadr is a sexp to be 142stops if a binding value is nil. If all are non-nil, the value
139evalled to set symbol's value. In the special case you only want 143of the last form in BODY is returned.
140to bind a single value, BINDINGS can just be a plain tuple." 144Each element of VARLIST is a symbol (which is bound to nil)
145or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
146In the special case you only want to bind a single value,
147VARLIST can just be a plain tuple.
148\n(fn VARLIST BODY...)"
141 (declare (indent 1) (debug if-let)) 149 (declare (indent 1) (debug if-let))
142 (list 'if-let bindings (macroexp-progn body))) 150 (list 'if-let bindings (macroexp-progn body)))
143 151
152(defalias 'if-let 'if-let*)
153(defalias 'when-let 'when-let*)
154(defalias 'and-let* 'when-let*)
155
144(defsubst hash-table-empty-p (hash-table) 156(defsubst hash-table-empty-p (hash-table)
145 "Check whether HASH-TABLE is empty (has 0 elements)." 157 "Check whether HASH-TABLE is empty (has 0 elements)."
146 (zerop (hash-table-count hash-table))) 158 (zerop (hash-table-count hash-table)))
@@ -214,6 +226,11 @@ user enters `recenter', `scroll-up', or `scroll-down' responses,
214perform the requested window recentering or scrolling and ask 226perform the requested window recentering or scrolling and ask
215again. 227again.
216 228
229When `use-dialog-box' is t (the default), this function can pop
230up a dialog window to collect the user input. That functionality
231requires `display-popup-menus-p' to return t. Otherwise, a text
232dialog will be used.
233
217The return value is the matching entry from the CHOICES list. 234The return value is the matching entry from the CHOICES list.
218 235
219Usage example: 236Usage 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."
412 (inhibit-read-only t)) 412 (inhibit-read-only t))
413 (if (> tabulated-list-padding 0) 413 (if (> tabulated-list-padding 0)
414 (insert (make-string x ?\s))) 414 (insert (make-string x ?\s)))
415 (dotimes (n ncols) 415 (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
416 (setq x (tabulated-list-print-col n (aref cols n) x))) 416 (or (bound-and-true-p tabulated-list--near-rows)
417 (list (or (tabulated-list-get-entry (point-at-bol 0))
418 cols)
419 cols))))
420 (dotimes (n ncols)
421 (setq x (tabulated-list-print-col n (aref cols n) x))))
417 (insert ?\n) 422 (insert ?\n)
418 ;; Ever so slightly faster than calling `put-text-property' twice. 423 ;; Ever so slightly faster than calling `put-text-property' twice.
419 (add-text-properties 424 (add-text-properties