summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/advice.el14
-rw-r--r--lisp/emacs-lisp/byte-opt.el343
-rw-r--r--lisp/emacs-lisp/bytecomp.el26
-rw-r--r--lisp/emacs-lisp/cl-macs.el2
-rw-r--r--lisp/emacs-lisp/ert.el3
-rw-r--r--lisp/emacs-lisp/lisp-mode.el9
-rw-r--r--lisp/emacs-lisp/loaddefs-gen.el40
-rw-r--r--lisp/emacs-lisp/macroexp.el2
-rw-r--r--lisp/emacs-lisp/nadvice.el24
-rw-r--r--lisp/emacs-lisp/pcase.el13
-rw-r--r--lisp/emacs-lisp/ring.el4
-rw-r--r--lisp/emacs-lisp/subr-x.el12
-rw-r--r--lisp/emacs-lisp/warnings.el4
13 files changed, 332 insertions, 164 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 391743d7156..d383650f4e5 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1054,9 +1054,9 @@
;; (print "Let's clean up now!"))
;; foo
;;
-;; Now `foo's advice is byte-compiled:
+;; Now `foo's advice is compiled:
;;
-;; (byte-code-function-p 'ad-Advice-foo)
+;; (compiled-function-p 'ad-Advice-foo)
;; t
;;
;; (foo 3)
@@ -1298,7 +1298,7 @@
;; constructed during preactivation was used, even though we did not specify
;; the `compile' flag:
;;
-;; (byte-code-function-p 'ad-Advice-fum)
+;; (compiled-function-p 'ad-Advice-fum)
;; t
;;
;; (fum 2)
@@ -1329,7 +1329,7 @@
;;
;; A new uncompiled advised definition got constructed:
;;
-;; (byte-code-function-p 'ad-Advice-fum)
+;; (compiled-function-p 'ad-Advice-fum)
;; nil
;;
;; (fum 2)
@@ -2116,9 +2116,9 @@ the cache-id will clear the cache."
(defsubst ad-compiled-p (definition)
"Return non-nil if DEFINITION is a compiled byte-code object."
- (or (byte-code-function-p definition)
- (and (macrop definition)
- (byte-code-function-p (ad-lambdafy definition)))))
+ (or (compiled-function-p definition)
+ (and (macrop definition)
+ (compiled-function-p (ad-lambdafy definition)))))
(defsubst ad-compiled-code (compiled-definition)
"Return the byte-code object of a COMPILED-DEFINITION."
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index a7edecfac73..bbe8135f04a 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -722,35 +722,83 @@ for speeding up processing.")
;; something not EQ to its argument if and ONLY if it has made a change.
;; This implies that you cannot simply destructively modify the list;
;; you must return something not EQ to it if you make an optimization.
-;;
-;; It is now safe to optimize code such that it introduces new bindings.
-(defsubst byte-compile-trueconstp (form)
+(defsubst byte-opt--bool-value-form (form)
+ "The form in FORM that yields its boolean value, possibly FORM itself."
+ (while (let ((head (car-safe form)))
+ (cond ((memq head '( progn inline save-excursion save-restriction
+ save-current-buffer))
+ (setq form (car (last form)))
+ t)
+ ((memq head '(let let* setq setcar setcdr))
+ (setq form (car (last (cddr form))))
+ t)
+ ((memq head '( prog1 unwind-protect copy-sequence identity
+ reverse nreverse sort))
+ (setq form (nth 1 form))
+ t)
+ ((eq head 'mapc)
+ (setq form (nth 2 form))
+ t))))
+ form)
+
+(defun byte-compile-trueconstp (form)
"Return non-nil if FORM always evaluates to a non-nil value."
- (while (eq (car-safe form) 'progn)
- (setq form (car (last (cdr form)))))
+ (setq form (byte-opt--bool-value-form form))
(cond ((consp form)
- (pcase (car form)
- ('quote (cadr form))
- ;; Can't use recursion in a defsubst.
- ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))
- ))
+ (let ((head (car form)))
+ ;; FIXME: Lots of other expressions are statically non-nil.
+ (cond ((memq head '(quote function)) (cadr form))
+ ((eq head 'list) (cdr form))
+ ((memq head
+ ;; FIXME: Replace this list with a function property?
+ '( length safe-length cons lambda
+ string make-string format concat
+ substring substring-no-properties string-replace
+ replace-regexp-in-string symbol-name make-symbol
+ mapconcat
+ vector make-vector vconcat make-record record
+ regexp-quote regexp-opt
+ buffer-string buffer-substring
+ buffer-substring-no-properties
+ current-buffer buffer-size
+ point point-min point-max
+ following-char preceding-char max-char
+ + - * / % 1+ 1- min max abs
+ logand logior lorxor lognot ash
+ number-to-string string-to-number
+ int-to-string char-to-string prin1-to-string
+ byte-to-string string-to-vector string-to-char
+ always))
+ t)
+ ((eq head 'if)
+ (and (byte-compile-trueconstp (nth 2 form))
+ (byte-compile-trueconstp (car (last (cdddr form))))))
+ ((memq head '(not null))
+ (byte-compile-nilconstp (cadr form)))
+ ((eq head 'or)
+ (and (cdr form)
+ (byte-compile-trueconstp (car (last (cdr form)))))))))
((not (symbolp form)))
((eq form t))
((keywordp form))))
-(defsubst byte-compile-nilconstp (form)
+(defun byte-compile-nilconstp (form)
"Return non-nil if FORM always evaluates to a nil value."
- (while (eq (car-safe form) 'progn)
- (setq form (car (last (cdr form)))))
- (cond ((consp form)
- (pcase (car form)
- ('quote (null (cadr form)))
- ;; Can't use recursion in a defsubst.
- ;; (`progn (byte-compile-nilconstp (car (last (cdr form)))))
- ))
- ((not (symbolp form)) nil)
- ((null form))))
+ (setq form (byte-opt--bool-value-form form))
+ (or (not form) ; assume (quote nil) always being normalised to nil
+ (and (consp form)
+ (let ((head (car form)))
+ ;; FIXME: There are many other expressions that are statically nil.
+ (cond ((memq head '(while ignore)) t)
+ ((eq head 'if)
+ (and (byte-compile-nilconstp (nth 2 form))
+ (byte-compile-nilconstp (car (last (cdddr form))))))
+ ((memq head '(not null))
+ (byte-compile-trueconstp (cadr form)))
+ ((eq head 'and)
+ (and (cdr form)
+ (byte-compile-nilconstp (car (last (cdr form)))))))))))
;; If the function is being called with constant integer args,
;; evaluate as much as possible at compile-time. This optimizer
@@ -1077,35 +1125,91 @@ See Info node `(elisp) Integer Basics'."
(nth 1 form)))
(defun byte-optimize-and (form)
- ;; Simplify if less than 2 args.
- ;; if there is a literal nil in the args to `and', throw it and following
- ;; forms away, and surround the `and' with (progn ... nil).
- (cond ((null (cdr form)))
- ((memq nil form)
- (list 'progn
- (byte-optimize-and
- (prog1 (setq form (copy-sequence form))
- (while (nth 1 form)
- (setq form (cdr form)))
- (setcdr form nil)))
- nil))
- ((null (cdr (cdr form)))
- (nth 1 form))
- ((byte-optimize-constant-args form))))
+ (let ((seq nil)
+ (new-args nil)
+ (nil-result nil)
+ (args (cdr form)))
+ (while
+ (and args
+ (let ((arg (car args)))
+ (cond
+ (seq ; previous arg was always-true
+ (push arg seq)
+ (unless (and (cdr args) (byte-compile-trueconstp arg))
+ (push `(progn . ,(nreverse seq)) new-args)
+ (setq seq nil))
+ t)
+ ((and (cdr args) (byte-compile-trueconstp arg))
+ ;; Always-true arg: evaluate unconditionally.
+ (push arg seq)
+ t)
+ ((and arg (not (byte-compile-nilconstp arg)))
+ (push arg new-args)
+ t)
+ (t
+ ;; Throw away the remaining args; this one is always false.
+ (setq nil-result t)
+ (when arg
+ (push arg new-args)) ; keep possible side-effects
+ nil))))
+ (setq args (cdr args)))
+
+ (setq new-args (nreverse new-args))
+ (if (equal new-args (cdr form))
+ ;; Input is unchanged: keep original form, and don't represent
+ ;; a nil result explicitly because that would lead to infinite
+ ;; growth when the optimiser is iterated.
+ (setq nil-result nil)
+ (setq form (cons (car form) new-args)))
+
+ (let ((new-form
+ (pcase form
+ ;; (and (progn ... X) ...) -> (progn ... (and X ...))
+ (`(,head (progn . ,forms) . ,rest)
+ `(progn ,@(butlast forms) (,head ,(car (last forms)) . ,rest)))
+ (`(,_) t) ; (and) -> t
+ (`(,_ ,arg) arg) ; (and X) -> X
+ (_ (byte-optimize-constant-args form)))))
+ (if nil-result
+ `(progn ,new-form nil)
+ new-form))))
(defun byte-optimize-or (form)
- ;; Throw away nil's, and simplify if less than 2 args.
- ;; If there is a literal non-nil constant in the args to `or', throw away all
- ;; following forms.
- (setq form (remq nil form))
- (let ((rest form))
- (while (cdr (setq rest (cdr rest)))
- (if (byte-compile-trueconstp (car rest))
- (setq form (copy-sequence form)
- rest (setcdr (memq (car rest) form) nil))))
- (if (cdr (cdr form))
- (byte-optimize-constant-args form)
- (nth 1 form))))
+ (let ((seq nil)
+ (new-args nil)
+ (args (remq nil (cdr form)))) ; Discard nil arguments.
+ (while
+ (and args
+ (let ((arg (car args)))
+ (cond
+ (seq ; previous arg was always-false
+ (push arg seq)
+ (unless (and (cdr args) (byte-compile-nilconstp arg))
+ (push `(progn . ,(nreverse seq)) new-args)
+ (setq seq nil))
+ t)
+ ((and (cdr args) (byte-compile-nilconstp arg))
+ ;; Always-false arg: evaluate unconditionally.
+ (push arg seq)
+ t)
+ (t
+ (push arg new-args)
+ ;; If this arg is always true, throw away the remaining args.
+ (not (byte-compile-trueconstp arg))))))
+ (setq args (cdr args)))
+
+ (setq new-args (nreverse new-args))
+ ;; Keep original form unless the arguments changed.
+ (unless (equal new-args (cdr form))
+ (setq form (cons (car form) new-args)))
+
+ (pcase form
+ ;; (or (progn ... X) ...) -> (progn ... (or X ...))
+ (`(,head (progn . ,forms) . ,rest)
+ `(progn ,@(butlast forms) (,head ,(car (last forms)) . ,rest)))
+ (`(,_) nil) ; (or) -> nil
+ (`(,_ ,arg) arg) ; (or X) -> X
+ (_ (byte-optimize-constant-args form)))))
(defun byte-optimize-cond (form)
;; if any clauses have a literal nil as their test, throw them away.
@@ -1142,55 +1246,82 @@ See Info node `(elisp) Integer Basics'."
(and clauses form)))
form))
+(defsubst byte-opt--negate (form)
+ "Negate FORM, avoiding double negation if already negated."
+ (if (and (consp form) (memq (car form) '(not null)))
+ (cadr form)
+ `(not ,form)))
+
(defun byte-optimize-if (form)
- ;; (if (progn <insts> <test>) <rest>) ==> (progn <insts> (if <test> <rest>))
- ;; (if <true-constant> <then> <else...>) ==> <then>
- ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
- ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
- ;; (if <test> <then> nil) ==> (if <test> <then>)
- (let ((clause (nth 1 form)))
- (cond ((and (eq (car-safe clause) 'progn)
- (proper-list-p clause))
- (if (null (cddr clause))
- ;; A trivial `progn'.
- (byte-optimize-if `(,(car form) ,(cadr clause) ,@(nthcdr 2 form)))
- (nconc (butlast clause)
- (list
- (byte-optimize-if
- `(,(car form) ,(car (last clause)) ,@(nthcdr 2 form)))))))
- ((byte-compile-trueconstp clause)
- `(progn ,clause ,(nth 2 form)))
- ((byte-compile-nilconstp clause)
- `(progn ,clause ,@(nthcdr 3 form)))
- ((nth 2 form)
- (if (equal '(nil) (nthcdr 3 form))
- (list (car form) clause (nth 2 form))
- form))
- ((or (nth 3 form) (nthcdr 4 form))
- (list (car form)
- ;; Don't make a double negative;
- ;; instead, take away the one that is there.
- (if (and (consp clause) (memq (car clause) '(not null))
- (= (length clause) 2)) ; (not xxxx) or (not (xxxx))
- (nth 1 clause)
- (list 'not clause))
- (if (nthcdr 4 form)
- (cons 'progn (nthcdr 3 form))
- (nth 3 form))))
- (t
- (list 'progn clause nil)))))
+ (let ((condition (nth 1 form))
+ (then (nth 2 form))
+ (else (nthcdr 3 form)))
+ (cond
+ ;; (if (progn ... X) ...) -> (progn ... (if X ...))
+ ((eq (car-safe condition) 'progn)
+ (nconc (butlast condition)
+ (list
+ (byte-optimize-if
+ `(,(car form) ,(car (last condition)) ,@(nthcdr 2 form))))))
+ ;; (if TRUE THEN ...) -> (progn TRUE THEN)
+ ((byte-compile-trueconstp condition)
+ `(progn ,condition ,then))
+ ;; (if FALSE THEN ELSE...) -> (progn FALSE ELSE...)
+ ((byte-compile-nilconstp condition)
+ (if else
+ `(progn ,condition ,@else)
+ condition))
+ ;; (if X nil t) -> (not X)
+ ((and (eq then nil) (eq else '(t)))
+ `(not ,condition))
+ ;; (if X t [nil]) -> (not (not X))
+ ((and (eq then t) (or (null else) (eq else '(nil))))
+ `(not ,(byte-opt--negate condition)))
+ ;; (if VAR VAR X...) -> (or VAR (progn X...))
+ ((and (symbolp condition) (eq condition then))
+ `(or ,then ,(if (cdr else)
+ `(progn . ,else)
+ (car else))))
+ ;; (if X THEN nil) -> (if X THEN)
+ (then
+ (if (equal else '(nil))
+ (list (car form) condition then)
+ form))
+ ;; (if X nil ELSE...) -> (if (not X) (progn ELSE...))
+ ((or (car else) (cdr else))
+ (list (car form) (byte-opt--negate condition)
+ (if (cdr else)
+ `(progn . ,else)
+ (car else))))
+ ;; (if X nil nil) -> (progn X nil)
+ (t
+ (list 'progn condition nil)))))
(defun byte-optimize-while (form)
+ ;; FIXME: This check does not belong here, move!
(when (< (length form) 2)
(byte-compile-warn-x form "too few arguments for `while'"))
- (if (nth 1 form)
- form))
+ (let ((condition (nth 1 form)))
+ (if (byte-compile-nilconstp condition)
+ condition
+ form)))
+
+(defun byte-optimize-not (form)
+ (and (= (length form) 2)
+ (let ((arg (nth 1 form)))
+ (cond ((null arg) t)
+ ((macroexp-const-p arg) nil)
+ ((byte-compile-nilconstp arg) `(progn ,arg t))
+ ((byte-compile-trueconstp arg) `(progn ,arg nil))
+ (t form)))))
(put 'and 'byte-optimizer #'byte-optimize-and)
(put 'or 'byte-optimizer #'byte-optimize-or)
(put 'cond 'byte-optimizer #'byte-optimize-cond)
(put 'if 'byte-optimizer #'byte-optimize-if)
(put 'while 'byte-optimizer #'byte-optimize-while)
+(put 'not 'byte-optimizer #'byte-optimize-not)
+(put 'null 'byte-optimizer #'byte-optimize-not)
;; byte-compile-negation-optimizer lives in bytecomp.el
(put '/= 'byte-optimizer #'byte-compile-negation-optimizer)
@@ -1207,25 +1338,26 @@ See Info node `(elisp) Integer Basics'."
form)))
(defun byte-optimize-apply (form)
- ;; If the last arg is a literal constant, turn this into a funcall.
- ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
- (if (= (length form) 2)
- ;; single-argument `apply' is not worth optimizing (bug#40968)
- form
- (let ((fn (nth 1 form))
- (last (nth (1- (length form)) form))) ; I think this really is fastest
- (or (if (or (null last)
- (eq (car-safe last) 'quote))
- (if (listp (nth 1 last))
- (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
- (nconc (list 'funcall fn) butlast
- (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
+ (let ((len (length form)))
+ (if (>= len 2)
+ (let ((fn (nth 1 form))
+ (last (nth (1- len) form)))
+ (cond
+ ;; (apply F ... '(X Y ...)) -> (funcall F ... 'X 'Y ...)
+ ((or (null last)
+ (eq (car-safe last) 'quote))
+ (let ((last-value (nth 1 last)))
+ (if (listp last-value)
+ `(funcall ,fn ,@(butlast (cddr form))
+ ,@(mapcar (lambda (x) (list 'quote x)) last-value))
(byte-compile-warn-x
- last
- "last arg to apply can't be a literal atom: `%s'"
- last)
- nil))
- form))))
+ last "last arg to apply can't be a literal atom: `%s'" last)
+ nil)))
+ ;; (apply F ... (list X Y ...)) -> (funcall F ... X Y ...)
+ ((eq (car-safe last) 'list)
+ `(funcall ,fn ,@(butlast (cddr form)) ,@(cdr last)))
+ (t form)))
+ form)))
(put 'funcall 'byte-optimizer #'byte-optimize-funcall)
(put 'apply 'byte-optimizer #'byte-optimize-apply)
@@ -2478,8 +2610,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;; itself, compile some of its most used recursive functions (at load time).
;;
(eval-when-compile
- (or (byte-code-function-p (symbol-function 'byte-optimize-form))
- (subr-native-elisp-p (symbol-function 'byte-optimize-form))
+ (or (compiled-function-p (symbol-function 'byte-optimize-form))
(assq 'byte-code (symbol-function 'byte-optimize-form))
(let ((byte-optimize nil)
(byte-compile-warnings nil))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 5b9f92a4cc2..a5bd2bca8a2 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1161,7 +1161,7 @@ message buffer `default-directory'."
;; Log something that isn't a warning.
(defun byte-compile-log-1 (string)
- (with-current-buffer byte-compile-log-buffer
+ (with-current-buffer (get-buffer-create byte-compile-log-buffer)
(let ((inhibit-read-only t))
(goto-char (point-max))
(byte-compile-warning-prefix nil nil)
@@ -1395,7 +1395,7 @@ when printing the error message."
(or (symbolp (symbol-function fn))
(consp (symbol-function fn))
(and (not macro-p)
- (byte-code-function-p (symbol-function fn)))))
+ (compiled-function-p (symbol-function fn)))))
(setq fn (symbol-function fn)))
(let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
;; Could be a subr.
@@ -1407,7 +1407,7 @@ when printing the error message."
(if macro-p
`(macro lambda ,advertised)
`(lambda ,advertised)))
- ((and (not macro-p) (byte-code-function-p fn)) fn)
+ ((and (not macro-p) (compiled-function-p fn)) fn)
((not (consp fn)) nil)
((eq 'macro (car fn)) (cdr fn))
(macro-p nil)
@@ -2958,11 +2958,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(setq fun (cdr fun)))
(prog1
(cond
- ;; Up until Emacs-24.1, byte-compile silently did nothing when asked to
- ;; compile something invalid. So let's tune down the complaint from an
- ;; error to a simple message for the known case where signaling an error
- ;; causes problems.
- ((byte-code-function-p fun)
+ ;; Up until Emacs-24.1, byte-compile silently did nothing
+ ;; when asked to compile something invalid. So let's tone
+ ;; down the complaint from an error to a simple message for
+ ;; the known case where signaling an error causes problems.
+ ((compiled-function-p fun)
(message "Function %s is already compiled"
(if (symbolp form) form "provided"))
fun)
@@ -3539,7 +3539,7 @@ lambda-expression."
(byte-compile-out-tag endtag)))
(defun byte-compile-unfold-bcf (form)
- "Inline call to byte-code-functions."
+ "Inline call to byte-code function."
(let* ((byte-compile-bound-variables byte-compile-bound-variables)
(fun (car form))
(fargs (aref fun 0))
@@ -5266,11 +5266,13 @@ invoked interactively."
((not (consp f))
"<malformed function>")
((eq 'macro (car f))
- (if (or (byte-code-function-p (cdr f))
+ (if (or (compiled-function-p (cdr f))
+ ;; FIXME: Can this still happen?
(assq 'byte-code (cdr (cdr (cdr f)))))
" <compiled macro>"
" <macro>"))
((assq 'byte-code (cdr (cdr f)))
+ ;; FIXME: Can this still happen?
"<compiled lambda>")
((eq 'lambda (car f))
"<function>")
@@ -5519,9 +5521,7 @@ and corresponding effects."
;; itself, compile some of its most used recursive functions (at load time).
;;
(eval-when-compile
- (or (byte-code-function-p (symbol-function 'byte-compile-form))
- (subr-native-elisp-p (symbol-function 'byte-compile-form))
- (assq 'byte-code (symbol-function 'byte-compile-form))
+ (or (compiled-function-p (symbol-function 'byte-compile-form))
(let ((byte-optimize nil) ; do it fast
(byte-compile-warnings nil))
(mapc (lambda (x)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index eefaa36b911..80ca43c902a 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3411,7 +3411,7 @@ Of course, we really can't know that for sure, so it's just a heuristic."
(character . natnump)
(char-table . char-table-p)
(command . commandp)
- (compiled-function . byte-code-function-p)
+ (compiled-function . compiled-function-p)
(hash-table . hash-table-p)
(cons . consp)
(fixnum . fixnump)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index c8ff6b68144..047b0069bb9 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1813,8 +1813,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
(unless (or (null tests) (zerop high))
(message "\nLONG-RUNNING TESTS")
(message "------------------")
- (setq tests (sort tests (lambda (x y) (> (car x) (car y)))))
- (when (< high (length tests)) (setcdr (nthcdr (1- high) tests) nil))
+ (setq tests (ntake high (sort tests (lambda (x y) (> (car x) (car y))))))
(message "%s" (mapconcat #'cdr tests "\n")))
;; More details on hydra and emba, where the logs are harder to get to.
(when (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index c31fbec640c..c56a9660e7c 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -760,7 +760,9 @@ decided heuristically.)"
;; If there's an edebug spec, use that to determine what the
;; name is.
(when symbol
- (let ((spec (get symbol 'edebug-form-spec)))
+ (let ((spec (or (get symbol 'edebug-form-spec)
+ (and (eq (get symbol 'lisp-indent-function) 'defun)
+ (get 'defun 'edebug-form-spec)))))
(save-excursion
(when (and (eq (car-safe spec) '&define)
(memq 'name spec))
@@ -768,6 +770,9 @@ decided heuristically.)"
(while (and spec (not name))
(let ((candidate (ignore-errors (read (current-buffer)))))
(when (eq (pop spec) 'name)
+ (when (and (consp candidate)
+ (symbolp (car (delete 'quote candidate))))
+ (setq candidate (car (delete 'quote candidate))))
(setq name candidate
spec nil))))))))
;; We didn't have an edebug spec (or couldn't find the
@@ -783,7 +788,7 @@ decided heuristically.)"
(symbolp (car (delete 'quote candidate))))
(setq name (car (delete 'quote candidate)))))))
(when-let ((result (or name symbol)))
- (symbol-name result)))))))
+ (and (symbolp result) (symbol-name result))))))))
(defvar-keymap lisp-mode-shared-map
:doc "Keymap for commands shared by all sorts of Lisp modes."
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 0c9bc4832b4..8413373e5d4 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -551,6 +551,11 @@ instead of just updating them with the new/changed autoloads."
(updating (and (file-exists-p output-file) (not generate-full)))
(defs nil))
+ ;; Allow the excluded files to be relative.
+ (setq excluded-files
+ (mapcar (lambda (file) (expand-file-name file dir))
+ excluded-files))
+
;; Collect all the autoload data.
(let ((progress (make-progress-reporter
(byte-compile-info
@@ -565,16 +570,15 @@ instead of just updating them with the new/changed autoloads."
(time-less-p output-time
(file-attribute-modification-time
(file-attributes file))))
- (setq defs (nconc
- (loaddefs-generate--parse-file
- file output-file
- ;; We only want the package name from the
- ;; excluded files.
- (and include-package-version
- (if (member (expand-file-name file) excluded-files)
- 'only
- t)))
- defs))))
+ ;; If we're scanning for package versions, we want to look
+ ;; at the file even if it's excluded.
+ (let* ((excluded (member (expand-file-name file dir) excluded-files))
+ (package-data
+ (and include-package-version (if excluded 'only t))))
+ (when (or package-data (not excluded))
+ (setq defs (nconc (loaddefs-generate--parse-file
+ file output-file package-data)
+ defs))))))
(progress-reporter-done progress))
;; If we have no autoloads data, but we have EXTRA-DATA, then
@@ -589,7 +593,8 @@ instead of just updating them with the new/changed autoloads."
;; We have some data, so generate the loaddef files. First
;; group per output file.
(dolist (fdefs (seq-group-by #'car defs))
- (let ((loaddefs-file (car fdefs)))
+ (let ((loaddefs-file (car fdefs))
+ hash)
(with-temp-buffer
(if (and updating (file-exists-p loaddefs-file))
(insert-file-contents loaddefs-file)
@@ -599,6 +604,7 @@ instead of just updating them with the new/changed autoloads."
(when extra-data
(insert extra-data)
(ensure-empty-lines 1)))
+ (setq hash (buffer-hash))
;; Then group by source file (and sort alphabetically).
(dolist (section (sort (seq-group-by #'cadr (cdr fdefs))
(lambda (e1 e2)
@@ -635,9 +641,11 @@ instead of just updating them with the new/changed autoloads."
(loaddefs-generate--print-form def))
(unless (bolp)
(insert "\n")))))
- (write-region (point-min) (point-max) loaddefs-file nil 'silent)
- (byte-compile-info (file-relative-name loaddefs-file lisp-directory)
- t "GEN")))))))
+ ;; Only write the file if we actually made a change.
+ (unless (equal (buffer-hash) hash)
+ (write-region (point-min) (point-max) loaddefs-file nil 'silent)
+ (byte-compile-info
+ (file-relative-name loaddefs-file lisp-directory) t "GEN"))))))))
(defun loaddefs-generate--print-form (def)
"Print DEF in a format that makes sense for version control."
@@ -666,7 +674,9 @@ instead of just updating them with the new/changed autoloads."
(insert "\\\n")))
(while def
(insert " ")
- (prin1 (pop def) (current-buffer) t))
+ (prin1 (pop def) (current-buffer)
+ '(t (escape-newlines . t)
+ (escape-control-characters . t))))
(insert ")")))
(defun loaddefs-generate--excluded-files ()
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 6a193a56d2d..5ae9d8368f0 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -823,7 +823,7 @@ test of free variables in the following ways:
(eval-when-compile
(add-hook 'emacs-startup-hook
(lambda ()
- (and (not (byte-code-function-p
+ (and (not (compiled-function-p
(symbol-function 'macroexpand-all)))
(locate-library "macroexp.elc")
(load "macroexp.elc")))))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 2d5a1b5e77b..a9a20ab5abf 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -167,31 +167,31 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.")
(defun advice--interactive-form (function)
"Like `interactive-form' but tries to avoid autoloading functions."
- (when (commandp function)
- (if (not (and (symbolp function) (autoloadp (indirect-function function))))
- (interactive-form function)
+ (if (not (and (symbolp function) (autoloadp (indirect-function function))))
+ (interactive-form function)
+ (when (commandp function)
`(interactive (advice-eval-interactive-spec
(cadr (interactive-form ',function)))))))
-(defun advice--make-interactive-form (function main)
+(defun advice--make-interactive-form (iff ifm)
;; TODO: make it so that interactive spec can be a constant which
;; dynamically checks the advice--car/cdr to do its job.
;; For that, advice-eval-interactive-spec needs to be more faithful.
- (let* ((iff (advice--interactive-form function))
- (ifm (advice--interactive-form main))
- (fspec (cadr iff)))
+ (let* ((fspec (cadr iff)))
(when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
- (setq fspec (nth 1 fspec)))
+ (setq fspec (eval fspec t)))
(if (functionp fspec)
`(funcall ',fspec ',(cadr ifm))
(cadr (or iff ifm)))))
(cl-defmethod oclosure-interactive-form ((ad advice) &optional _)
- (let ((car (advice--car ad))
- (cdr (advice--cdr ad)))
- (when (or (commandp car) (commandp cdr))
- `(interactive ,(advice--make-interactive-form car cdr)))))
+ (let* ((car (advice--car ad))
+ (cdr (advice--cdr ad))
+ (ifa (advice--interactive-form car))
+ (ifd (advice--interactive-form cdr)))
+ (when (or ifa ifd)
+ `(interactive ,(advice--make-interactive-form ifa ifd)))))
(cl-defmethod cl-print-object ((object advice) stream)
(cl-assert (advice--p object))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 07443dabfef..10bd4bc6886 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -607,31 +607,38 @@ recording whether the var has been referenced by earlier parts of the match."
(symbolp . vectorp)
(symbolp . stringp)
(symbolp . byte-code-function-p)
+ (symbolp . compiled-function-p)
(symbolp . recordp)
(integerp . consp)
(integerp . arrayp)
(integerp . vectorp)
(integerp . stringp)
(integerp . byte-code-function-p)
+ (integerp . compiled-function-p)
(integerp . recordp)
(numberp . consp)
(numberp . arrayp)
(numberp . vectorp)
(numberp . stringp)
(numberp . byte-code-function-p)
+ (numberp . compiled-function-p)
(numberp . recordp)
(consp . arrayp)
(consp . atom)
(consp . vectorp)
(consp . stringp)
(consp . byte-code-function-p)
+ (consp . compiled-function-p)
(consp . recordp)
(arrayp . byte-code-function-p)
+ (arrayp . compiled-function-p)
(vectorp . byte-code-function-p)
+ (vectorp . compiled-function-p)
(vectorp . recordp)
(stringp . vectorp)
(stringp . recordp)
- (stringp . byte-code-function-p)))
+ (stringp . byte-code-function-p)
+ (stringp . compiled-function-p)))
(defun pcase--mutually-exclusive-p (pred1 pred2)
(or (member (cons pred1 pred2)
@@ -771,8 +778,8 @@ A and B can be one of:
((consp (cadr pat)) #'consp)
((stringp (cadr pat)) #'stringp)
((vectorp (cadr pat)) #'vectorp)
- ((byte-code-function-p (cadr pat))
- #'byte-code-function-p))))
+ ((compiled-function-p (cadr pat))
+ #'compiled-function-p))))
(pcase--mutually-exclusive-p (cadr upat) otherpred))
'(:pcase--fail . nil))
;; Since we turn (or 'a 'b 'c) into (pred (pcase--flip (memq '(a b c))))
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 2b2039f9d15..e8b92a532fa 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -42,6 +42,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
;;; User Functions:
;;;###autoload
@@ -51,6 +53,8 @@
(consp (cdr x)) (integerp (cadr x))
(vectorp (cddr x))))
+(cl-deftype ring () '(satisfies ring-p))
+
;;;###autoload
(defun make-ring (size)
"Make a ring that can contain SIZE elements."
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 1cce97cdb10..bd7c3c82f97 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -467,6 +467,18 @@ be marked unmodified, effectively ignoring those changes."
(equal ,hash (buffer-hash)))
(restore-buffer-modified-p nil))))))))
+(defun emacs-etc--hide-local-variables ()
+ "Hide local variables.
+Used by `emacs-authors-mode' and `emacs-news-mode'."
+ (narrow-to-region (point-min)
+ (save-excursion
+ (goto-char (point-max))
+ ;; Obfuscate to avoid this being interpreted
+ ;; as a local variable section itself.
+ (if (re-search-backward "^Local\sVariables:$" nil t)
+ (progn (forward-line -1) (point))
+ (point-max)))))
+
(provide 'subr-x)
;;; subr-x.el ends here
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index d60eedbc9cd..3a966957ec5 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -220,10 +220,10 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress."
(?q "quit and do nothing"))))
(?y
(customize-save-variable 'warning-suppress-log-types
- (cons type warning-suppress-log-types)))
+ (cons (list type) warning-suppress-log-types)))
(?n
(customize-save-variable 'warning-suppress-types
- (cons type warning-suppress-types)))
+ (cons (list type) warning-suppress-types)))
(_ (message "Exiting"))))
;;;###autoload
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-25 10:08:38 +0000