summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/advice.el5
-rw-r--r--lisp/emacs-lisp/autoload.el915
-rw-r--r--lisp/emacs-lisp/byte-opt.el17
-rw-r--r--lisp/emacs-lisp/byte-run.el17
-rw-r--r--lisp/emacs-lisp/bytecomp.el34
-rw-r--r--lisp/emacs-lisp/checkdoc.el25
-rw-r--r--lisp/emacs-lisp/cl-lib.el4
-rw-r--r--lisp/emacs-lisp/cl-macs.el30
-rw-r--r--lisp/emacs-lisp/comp.el5
-rw-r--r--lisp/emacs-lisp/edebug.el2
-rw-r--r--lisp/emacs-lisp/eldoc.el1
-rw-r--r--lisp/emacs-lisp/ert.el2
-rw-r--r--lisp/emacs-lisp/helper.el1
-rw-r--r--lisp/emacs-lisp/lisp-mode.el68
-rw-r--r--lisp/emacs-lisp/lisp.el9
-rw-r--r--lisp/emacs-lisp/loaddefs-gen.el124
-rw-r--r--lisp/emacs-lisp/package.el11
-rw-r--r--lisp/emacs-lisp/seq.el27
-rw-r--r--lisp/emacs-lisp/shortdoc.el2
-rw-r--r--lisp/emacs-lisp/subr-x.el11
-rw-r--r--lisp/emacs-lisp/timer.el70
-rw-r--r--lisp/emacs-lisp/warnings.el2
22 files changed, 271 insertions, 1111 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 2a2bcca7007..391743d7156 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1580,8 +1580,6 @@
:link '(custom-manual "(elisp)Advising Functions")
:group 'lisp)
-(defconst ad-version "2.14")
-
;;;###autoload
(defcustom ad-redefinition-action 'warn
"Defines what to do with redefinitions during Advice de/activation.
@@ -3250,6 +3248,9 @@ Use only in REAL emergencies."
(message "Oops! Left over advised function %S" function)
(ad-pop-advised-function function)))
+(defconst ad-version "2.14")
+(make-obsolete-variable 'ad-version 'emacs-version "29.1")
+
(provide 'advice)
;;; advice.el ends here
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
deleted file mode 100644
index eed88b6faf4..00000000000
--- a/lisp/emacs-lisp/autoload.el
+++ /dev/null
@@ -1,915 +0,0 @@
-;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 1991-1997, 2001-2022 Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@gnu.org>
-;; Keywords: maint
-;; Package: emacs
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
-;; date. It interprets magic cookies of the form ";;;###autoload" in
-;; Lisp source files in various useful ways. To learn more, read the
-;; source; if you're going to use this, you'd better be able to.
-
-;; The functions in this file have been largely superseded by
-;; loaddefs-gen.el.
-
-;;; Code:
-
-(require 'lisp-mode) ;for `doc-string-elt' properties.
-(require 'lisp-mnt)
-(require 'cl-lib)
-(require 'loaddefs-gen)
-
-;; This feels like it should be a defconst, but MH-E sets it to
-;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el.
-(defvar generate-autoload-cookie ";;;###autoload"
- "Magic comment indicating the following form should be autoloaded.
-Used by \\[update-file-autoloads]. This string should be
-meaningless to Lisp (e.g., a comment).
-
-This string is used:
-
-\;;;###autoload
-\(defun function-to-be-autoloaded () ...)
-
-If this string appears alone on a line, the following form will be
-read and an autoload made for it. If there is further text on the line,
-that text will be copied verbatim to `generated-autoload-file'.")
-
-(defvar autoload-excludes nil
- "If non-nil, list of absolute file names not to scan for autoloads.")
-
-(defconst generate-autoload-section-header "\f\n;;;### "
- "String that marks the form at the start of a new file's autoload section.")
-
-(defconst generate-autoload-section-trailer "\n;;;***\n"
- "String which indicates the end of the section of autoloads for a file.")
-
-(defconst generate-autoload-section-continuation ";;;;;; "
- "String to add on each continuation of the section header form.")
-
-;; In some ways it would be nicer to use a value that is recognizably
-;; not a time-value, eg t, but that can cause issues if an older Emacs
-;; that does not expect non-time-values loads the file.
-(defconst autoload--non-timestamp '(0 0 0 0)
- "Value to insert when `autoload-timestamps' is nil.")
-
-(defvar autoload-timestamps nil ; experimental, see bug#22213
- "Non-nil means insert a timestamp for each input file into the output.
-We use these in incremental updates of the output file to decide
-if we need to rescan an input file. If you set this to nil,
-then we use the timestamp of the output file instead. As a result:
- - for fixed inputs, the output will be the same every time
- - incremental updates of the output file might not be correct if:
- i) the timestamp of the output file cannot be trusted (at least
- relative to that of the input files)
- ii) any of the input files can be modified during the time it takes
- to create the output
- iii) only a subset of the input files are scanned
- These issues are unlikely to happen in practice, and would arguably
- represent bugs in the build system. Item iii) will happen if you
- use a command like `update-file-autoloads', though, since it only
- checks a single input file.")
-
-(defvar autoload-modified-buffers) ;Dynamically scoped var.
-
-(defalias 'make-autoload #'loaddefs-generate--make-autoload)
-
-;; Forms which have doc-strings which should be printed specially.
-;; A doc-string-elt property of ELT says that (nth ELT FORM) is
-;; the doc-string in FORM.
-;; Those properties are now set in lisp-mode.el.
-
-(defun autoload-find-generated-file (file)
- "Visit the autoload file for the current buffer, and return its buffer."
- (let ((enable-local-variables :safe)
- (enable-local-eval nil)
- (find-file-hook nil)
- (delay-mode-hooks t))
- ;; We used to use `raw-text' to read this file, but this causes
- ;; problems when the file contains non-ASCII characters.
- (with-current-buffer (find-file-noselect
- (autoload-ensure-file-writeable file))
- (if (zerop (buffer-size)) (insert (autoload-rubric file nil t)))
- (current-buffer))))
-
-(defun autoload-generated-file (outfile)
- "Return OUTFILE as an absolute name.
-If `generated-autoload-file' is bound locally in the current
-buffer, that is used instead, and it is expanded using the
-default directory; otherwise, `source-directory'/lisp is used."
- (expand-file-name (if (local-variable-p 'generated-autoload-file)
- generated-autoload-file
- outfile)
- ;; File-local settings of generated-autoload-file should
- ;; be interpreted relative to the file's location,
- ;; of course.
- (if (not (local-variable-p 'generated-autoload-file))
- (expand-file-name "lisp" source-directory))))
-
-(defun autoload-read-section-header ()
- "Read a section header form.
-Since continuation lines have been marked as comments,
-we must copy the text of the form and remove those comment
-markers before we call `read'."
- (save-match-data
- (let ((beginning (point))
- string)
- (forward-line 1)
- (while (looking-at generate-autoload-section-continuation)
- (forward-line 1))
- (setq string (buffer-substring beginning (point)))
- (with-current-buffer (get-buffer-create " *autoload*")
- (erase-buffer)
- (insert string)
- (goto-char (point-min))
- (while (search-forward generate-autoload-section-continuation nil t)
- (replace-match " "))
- (goto-char (point-min))
- (read (current-buffer))))))
-
-(defvar autoload-print-form-outbuf nil
- "Buffer which gets the output of `autoload-print-form'.")
-
-(defun autoload-print-form (form)
- "Print FORM such that `make-docfile' will find the docstrings.
-The variable `autoload-print-form-outbuf' specifies the buffer to
-put the output in."
- (cond
- ;; If the form is a sequence, recurse.
- ((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form)))
- ;; Symbols at the toplevel are meaningless.
- ((symbolp form) nil)
- (t
- (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
- (outbuf autoload-print-form-outbuf))
- (if (and (numberp doc-string-elt) (stringp (nth doc-string-elt form)))
- ;; We need to hack the printing because the
- ;; doc-string must be printed specially for
- ;; make-docfile (sigh).
- (let* ((p (nthcdr (1- doc-string-elt) form))
- (elt (cdr p)))
- (setcdr p nil)
- (princ "\n(" outbuf)
- (let ((print-escape-newlines t)
- (print-escape-control-characters t)
- (print-quoted t)
- (print-escape-nonascii t))
- (dolist (elt form)
- (prin1 elt outbuf)
- (princ " " outbuf)))
- (princ "\"\\\n" outbuf)
- (let ((begin (with-current-buffer outbuf (point))))
- (princ (substring (prin1-to-string (car elt)) 1)
- outbuf)
- ;; Insert a backslash before each ( that
- ;; appears at the beginning of a line in
- ;; the doc string.
- (with-current-buffer outbuf
- (save-excursion
- (while (re-search-backward "\n[[(]" begin t)
- (forward-char 1)
- (insert "\\"))))
- (if (null (cdr elt))
- (princ ")" outbuf)
- (princ " " outbuf)
- (princ (substring (prin1-to-string (cdr elt)) 1)
- outbuf))
- (terpri outbuf)))
- (let ((print-escape-newlines t)
- (print-escape-control-characters t)
- (print-quoted t)
- (print-escape-nonascii t))
- (print form outbuf)))))))
-
-(defalias 'autoload-rubric #'loaddefs-generate--rubric)
-
-(defvar autoload-ensure-writable nil
- "Non-nil means `autoload-find-generated-file' makes existing file writable.")
-;; Just in case someone tries to get you to overwrite a file that you
-;; don't want to.
-;;;###autoload
-(put 'autoload-ensure-writable 'risky-local-variable t)
-
-(defun autoload-ensure-file-writeable (file)
- ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
- ;; which was designed to handle CVSREAD=1 and equivalent.
- (and autoload-ensure-writable
- (let ((modes (file-modes file)))
- (if (and modes (zerop (logand modes #o0200)))
- ;; Ignore any errors here, and let subsequent attempts
- ;; to write the file raise any real error.
- (ignore-errors (set-file-modes file (logior modes #o0200))))))
- file)
-
-(defun autoload-insert-section-header (outbuf autoloads load-name file time)
- "Insert into buffer OUTBUF the section-header line for FILE.
-The header line lists the file name, its \"load name\", its autoloads,
-and the time the FILE was last updated (the time is inserted only
-if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
- ;; (cl-assert ;Make sure we don't insert it in the middle of another section.
- ;; (save-excursion
- ;; (or (not (re-search-backward
- ;; (concat "\\("
- ;; (regexp-quote generate-autoload-section-header)
- ;; "\\)\\|\\("
- ;; (regexp-quote generate-autoload-section-trailer)
- ;; "\\)")
- ;; nil t))
- ;; (match-end 2))))
- (insert generate-autoload-section-header)
- (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
- outbuf)
- (terpri outbuf)
- ;; Break that line at spaces, to avoid very long lines.
- ;; Make each sub-line into a comment.
- (with-current-buffer outbuf
- (save-excursion
- (forward-line -1)
- (while (not (eolp))
- (move-to-column 64)
- (skip-chars-forward "^ \n")
- (or (eolp)
- (insert "\n" generate-autoload-section-continuation))))))
-
-(defun autoload-find-file (file)
- "Fetch FILE and put it in a temp buffer. Return the buffer."
- ;; It is faster to avoid visiting the file.
- (setq file (expand-file-name file))
- (with-current-buffer (get-buffer-create " *autoload-file*")
- (kill-all-local-variables)
- (erase-buffer)
- (setq buffer-undo-list t
- buffer-read-only nil)
- (delay-mode-hooks (emacs-lisp-mode))
- (setq default-directory (file-name-directory file))
- (insert-file-contents file nil)
- (let ((enable-local-variables :safe)
- (enable-local-eval nil))
- (hack-local-variables))
- (current-buffer)))
-
-(defalias 'autoload-insert-section-header
- #'loaddefs-generate--insert-section-header)
-
-(defvar no-update-autoloads nil
- "File local variable to prevent scanning this file for autoload cookies.")
-
-(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name)
-
-(defun generate-file-autoloads (file)
- "Insert at point a loaddefs autoload section for FILE.
-Autoloads are generated for defuns and defmacros in FILE
-marked by `generate-autoload-cookie' (which see).
-If FILE is being visited in a buffer, the contents of the buffer
-are used.
-Return non-nil in the case where no autoloads were added at point."
- (interactive "fGenerate autoloads for file: ")
- (let ((autoload-modified-buffers nil))
- (autoload-generate-file-autoloads file (current-buffer) buffer-file-name)
- autoload-modified-buffers))
-
-(defconst autoload-def-prefixes-max-entries 5
- "Target length of the list of definition prefixes per file.
-If set too small, the prefixes will be too generic (i.e. they'll use little
-memory, we'll end up looking in too many files when we need a particular
-prefix), and if set too large, they will be too specific (i.e. they will
-cost more memory use).")
-
-(defconst autoload-def-prefixes-max-length 12
- "Target size of definition prefixes.
-Don't try to split prefixes that are already longer than that.")
-
-(defalias 'autoload--make-defs-autoload #'loaddefs-generate--make-prefixes)
-
-(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file)
- (let ((outbuf
- (or (if otherbuf
- ;; A file-local setting of
- ;; autoload-generated-file says we
- ;; should ignore OUTBUF.
- nil
- outbuf)
- (autoload-find-destination absfile load-name output-file)
- ;; The file has autoload cookies, but they're
- ;; already up-to-date. If OUTFILE is nil, the
- ;; entries are in the expected OUTBUF,
- ;; otherwise they're elsewhere.
- (throw 'done otherbuf))))
- (with-current-buffer outbuf
- (point-marker))))
-
-(defun autoload--print-cookie-text (output-start load-name file)
- (let ((standard-output (marker-buffer output-start)))
- (search-forward generate-autoload-cookie)
- (skip-chars-forward " \t")
- (if (eolp)
- (condition-case-unless-debug err
- ;; Read the next form and make an autoload.
- (let* ((form (prog1 (read (current-buffer))
- (or (bolp) (forward-line 1))))
- (autoload (make-autoload form load-name)))
- (if autoload
- nil
- (setq autoload form))
- (let ((autoload-print-form-outbuf
- standard-output))
- (autoload-print-form autoload)))
- (error
- (message "Autoload cookie error in %s:%s %S"
- file (count-lines (point-min) (point)) err)))
-
- ;; Copy the rest of the line to the output.
- (princ (buffer-substring
- (progn
- ;; Back up over whitespace, to preserve it.
- (skip-chars-backward " \f\t")
- (if (= (char-after (1+ (point))) ? )
- ;; Eat one space.
- (forward-char 1))
- (point))
- (progn (forward-line 1) (point)))))))
-
-(defvar autoload-builtin-package-versions nil)
-
-(defun autoload-generate-file-autoloads (file &optional outbuf outfile)
- "Insert an autoload section for FILE in the appropriate buffer.
-Autoloads are generated for defuns and defmacros in FILE
-marked by `generate-autoload-cookie' (which see).
-
-If FILE is being visited in a buffer, the contents of the buffer are used.
-OUTBUF is the buffer in which the autoload statements should be inserted.
-
-If OUTBUF is nil, the output will go to OUTFILE, unless there's a
-buffer-local setting of `generated-autoload-file' in FILE.
-
-Return non-nil if and only if FILE adds no autoloads to OUTFILE
-\(or OUTBUF if OUTFILE is nil). The actual return value is
-FILE's modification time."
- ;; Include the file name in any error messages
- (condition-case err
- (let (load-name
- (print-length nil)
- (print-level nil)
- (float-output-format nil)
- (visited (get-file-buffer file))
- (otherbuf nil)
- (absfile (expand-file-name file))
- (defs '())
- ;; nil until we found a cookie.
- output-start)
- (when
- (catch 'done
- (with-current-buffer (or visited
- ;; It is faster to avoid visiting the file.
- (autoload-find-file file))
- ;; Obey the no-update-autoloads file local variable.
- (unless no-update-autoloads
- (or noninteractive (message "Generating autoloads for %s..." file))
- (setq load-name
- (if (stringp generated-autoload-load-name)
- generated-autoload-load-name
- (autoload-file-load-name absfile outfile)))
- ;; FIXME? Comparing file-names for equality with just equal
- ;; is fragile, eg if one has an automounter prefix and one
- ;; does not, but both refer to the same physical file.
- (when (and outfile
- (not outbuf)
- (not
- (if (memq system-type '(ms-dos windows-nt))
- (equal (downcase outfile)
- (downcase (autoload-generated-file
- outfile)))
- (equal outfile (autoload-generated-file
- outfile)))))
- (setq otherbuf t))
- (save-excursion
- (save-restriction
- (widen)
- (when autoload-builtin-package-versions
- (let ((version (lm-header "version"))
- package)
- (and version
- (setq version (ignore-errors (version-to-list version)))
- (setq package (or (lm-header "package")
- (file-name-sans-extension
- (file-name-nondirectory file))))
- (setq output-start (autoload--setup-output
- otherbuf outbuf absfile
- load-name outfile))
- (let ((standard-output (marker-buffer output-start))
- (print-quoted t))
- (princ `(push (purecopy
- ',(cons (intern package) version))
- package--builtin-versions))
- (princ "\n")))))
-
- ;; Do not insert autoload entries for excluded files.
- (unless (member absfile autoload-excludes)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n\f")
- (cond
- ((looking-at (regexp-quote generate-autoload-cookie))
- ;; If not done yet, figure out where to insert this text.
- (unless output-start
- (setq output-start (autoload--setup-output
- otherbuf outbuf absfile
- load-name outfile)))
- (autoload--print-cookie-text output-start load-name file))
- ((= (following-char) ?\;)
- ;; Don't read the comment.
- (forward-line 1))
- (t
- ;; Avoid (defvar <foo>) by requiring a trailing space.
- ;; Also, ignore this prefix business
- ;; for ;;;###tramp-autoload and friends.
- (when (and (equal generate-autoload-cookie ";;;###autoload")
- (looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]")
- (not (member
- (match-string 1)
- autoload-ignored-definitions)))
- (push (match-string-no-properties 2) defs))
- (forward-sexp 1)
- (forward-line 1)))))))
-
- (when (and autoload-compute-prefixes defs)
- ;; This output needs to always go in the main loaddefs.el,
- ;; regardless of generated-autoload-file.
- ;; FIXME: the files that don't have autoload cookies but
- ;; do have definitions end up listed twice in loaddefs.el:
- ;; once for their register-definition-prefixes and once in
- ;; the list of "files without any autoloads".
- (let ((form (autoload--make-defs-autoload defs load-name)))
- (cond
- ((null form)) ;All defs obey the default rule, yay!
- ((not otherbuf)
- (unless output-start
- (setq output-start (autoload--setup-output
- nil outbuf absfile load-name outfile)))
- (let ((autoload-print-form-outbuf
- (marker-buffer output-start)))
- (autoload-print-form form)))
- (t
- (let* ((other-output-start
- ;; To force the output to go to the main loaddefs.el
- ;; rather than to generated-autoload-file,
- ;; there are two cases: if outbuf is non-nil,
- ;; then passing otherbuf=nil is enough, but if
- ;; outbuf is nil, that won't cut it, so we
- ;; locally bind generated-autoload-file.
- (autoload--setup-output nil outbuf absfile load-name
- outfile))
- (autoload-print-form-outbuf
- (marker-buffer other-output-start)))
- (autoload-print-form form)
- (with-current-buffer (marker-buffer other-output-start)
- (save-excursion
- ;; Insert the section-header line which lists
- ;; the file name and which functions are in it, etc.
- (goto-char other-output-start)
- (let ((relfile (file-relative-name absfile)))
- (autoload-insert-section-header
- (marker-buffer other-output-start)
- "actual autoloads are elsewhere" load-name relfile
- (if autoload-timestamps
- (file-attribute-modification-time
- (file-attributes absfile))
- autoload--non-timestamp))
- (insert ";;; Generated autoloads from " relfile "\n")))
- (insert generate-autoload-section-trailer)))))))
-
- (when output-start
- (let ((secondary-autoloads-file-buf
- (if otherbuf (current-buffer))))
- (with-current-buffer (marker-buffer output-start)
- (cl-assert (> (point) output-start))
- (save-excursion
- ;; Insert the section-header line which lists the file name
- ;; and which functions are in it, etc.
- (goto-char output-start)
- (let ((relfile (file-relative-name absfile)))
- (autoload-insert-section-header
- (marker-buffer output-start)
- () load-name relfile
- (if secondary-autoloads-file-buf
- ;; MD5 checksums are much better because they do not
- ;; change unless the file changes (so they'll be
- ;; equal on two different systems and will change
- ;; less often than time-stamps, thus leading to fewer
- ;; unneeded changes causing spurious conflicts), but
- ;; using time-stamps is a very useful optimization,
- ;; so we use time-stamps for the main autoloads file
- ;; (loaddefs.el) where we have special ways to
- ;; circumvent the "random change problem", and MD5
- ;; checksum in secondary autoload files where we do
- ;; not need the time-stamp optimization because it is
- ;; already provided by the primary autoloads file.
- (md5 secondary-autoloads-file-buf
- ;; We'd really want to just use
- ;; `emacs-internal' instead.
- nil nil 'emacs-mule-unix)
- (if autoload-timestamps
- (file-attribute-modification-time
- (file-attributes relfile))
- autoload--non-timestamp)))
- (insert ";;; Generated autoloads from " relfile "\n")))
- (insert generate-autoload-section-trailer))))
- (or noninteractive
- (message "Generating autoloads for %s...done" file)))
- (or visited
- ;; We created this buffer, so we should kill it.
- (kill-buffer (current-buffer))))
- (or (not output-start)
- ;; If the entries were added to some other buffer, then the file
- ;; doesn't add entries to OUTFILE.
- otherbuf))
- (file-attribute-modification-time (file-attributes absfile))))
- (error
- ;; Probably unbalanced parens in forward-sexp. In that case, the
- ;; condition is scan-error, and the signal data includes point
- ;; where the error was found; we'd like to convert that to
- ;; line:col, but line-number-at-pos gets the wrong line in batch
- ;; mode for some reason.
- ;;
- ;; At least this gets the file name in the error message; the
- ;; developer can use goto-char to get to the error position.
- (error "%s:0:0: error: %s: %s" file (car err) (cdr err)))
- ))
-
-;; For parallel builds, to stop another process reading a half-written file.
-(defun autoload--save-buffer ()
- "Save current buffer to its file, atomically."
- ;; Similar to byte-compile-file.
- (let* ((version-control 'never)
- (tempfile (make-temp-file buffer-file-name))
- (default-modes (default-file-modes))
- (temp-modes (logand default-modes #o600))
- (desired-modes (logand default-modes
- (or (file-modes buffer-file-name) #o666)))
- (kill-emacs-hook
- (cons (lambda () (ignore-errors (delete-file tempfile)))
- kill-emacs-hook)))
- (unless (= temp-modes desired-modes)
- (set-file-modes tempfile desired-modes 'nofollow))
- (write-region (point-min) (point-max) tempfile nil 1)
- (backup-buffer)
- (rename-file tempfile buffer-file-name t))
- (set-buffer-modified-p nil)
- (set-visited-file-modtime)
- (or noninteractive (message "Wrote %s" buffer-file-name)))
-
-(defun autoload-save-buffers ()
- (while autoload-modified-buffers
- (with-current-buffer (pop autoload-modified-buffers)
- (autoload--save-buffer))))
-
-;; FIXME This command should be deprecated.
-;; See https://debbugs.gnu.org/22213#41
-;;;###autoload
-(defun update-file-autoloads (file &optional save-after outfile)
- "Update the autoloads for FILE.
-If prefix arg SAVE-AFTER is non-nil, save the buffer too.
-
-If FILE binds `generated-autoload-file' as a file-local variable,
-autoloads are written into that file. Otherwise, the autoloads
-file is determined by OUTFILE. If called interactively, prompt
-for OUTFILE; if called from Lisp with OUTFILE nil, use the
-existing value of `generated-autoload-file'.
-
-Return FILE if there was no autoload cookie in it, else nil."
- (interactive (list (read-file-name "Update autoloads for file: ")
- current-prefix-arg
- (read-file-name "Write autoload definitions to file: ")))
- (setq outfile (or outfile generated-autoload-file))
- (let* ((autoload-modified-buffers nil)
- ;; We need this only if the output file handles more than one input.
- ;; See https://debbugs.gnu.org/22213#38 and subsequent.
- (autoload-timestamps t)
- (no-autoloads (autoload-generate-file-autoloads
- file nil
- (if (local-variable-p 'generated-autoload-file)
- generated-autoload-file
- outfile))))
- (if autoload-modified-buffers
- (if save-after (autoload-save-buffers))
- (if (called-interactively-p 'interactive)
- (message "Autoload section for %s is up to date." file)))
- (if no-autoloads file)))
-
-(defun autoload-find-destination (file load-name output-file)
- "Find the destination point of the current buffer's autoloads.
-FILE is the file name of the current buffer.
-LOAD-NAME is the name as it appears in the output.
-Returns a buffer whose point is placed at the requested location.
-Returns nil if the file's autoloads are up-to-date, otherwise
-removes any prior now out-of-date autoload entries."
- (catch 'up-to-date
- (let* ((buf (current-buffer))
- (existing-buffer (if buffer-file-name buf))
- (output-file (autoload-generated-file output-file))
- (output-time (if (file-exists-p output-file)
- (file-attribute-modification-time
- (file-attributes output-file))))
- (found nil))
- (with-current-buffer (autoload-find-generated-file output-file)
- ;; This is to make generated-autoload-file have Unix EOLs, so
- ;; that it is portable to all platforms.
- (or (eq 0 (coding-system-eol-type buffer-file-coding-system))
- (set-buffer-file-coding-system 'unix))
- (or (> (buffer-size) 0)
- (error "Autoloads file %s lacks boilerplate" buffer-file-name))
- (or (file-writable-p buffer-file-name)
- (error "Autoloads file %s is not writable" buffer-file-name))
- (widen)
- (goto-char (point-min))
- ;; Look for the section for LOAD-NAME.
- (while (and (not found)
- (search-forward generate-autoload-section-header nil t))
- (let ((form (autoload-read-section-header)))
- (cond ((string= (nth 2 form) load-name)
- ;; We found the section for this file.
- ;; Check if it is up to date.
- (let ((begin (match-beginning 0))
- (last-time (nth 4 form))
- (file-time (file-attribute-modification-time
- (file-attributes file))))
- (if (and (or (null existing-buffer)
- (not (buffer-modified-p existing-buffer)))
- (cond
- ;; FIXME? Arguably we should throw a
- ;; user error, or some kind of warning,
- ;; if we were called from update-file-autoloads,
- ;; which can update only a single input file.
- ;; It's not appropriate to use the output
- ;; file modtime in such a case,
- ;; if there are multiple input files
- ;; contributing to the output.
- ((and output-time
- (member last-time
- (list t autoload--non-timestamp)))
- (not (time-less-p output-time file-time)))
- ;; last-time is the time-stamp (specifying
- ;; the last time we looked at the file) and
- ;; the file hasn't been changed since.
- ((listp last-time)
- (not (time-less-p last-time file-time)))
- ;; last-time is an MD5 checksum instead.
- ((stringp last-time)
- (equal last-time
- (md5 buf nil nil 'emacs-mule)))))
- (throw 'up-to-date nil)
- (autoload-remove-section begin)
- (setq found t))))
- ((string< load-name (nth 2 form))
- ;; We've come to a section alphabetically later than
- ;; LOAD-NAME. We assume the file is in order and so
- ;; there must be no section for LOAD-NAME. We will
- ;; insert one before the section here.
- (goto-char (match-beginning 0))
- (setq found t)))))
- (or found
- (progn
- ;; No later sections in the file. Put before the last page.
- (goto-char (point-max))
- (search-backward "\f" nil t)))
- (unless (memq (current-buffer) autoload-modified-buffers)
- (push (current-buffer) autoload-modified-buffers))
- (current-buffer)))))
-
-(defun autoload-remove-section (begin)
- (goto-char begin)
- (search-forward generate-autoload-section-trailer)
- (delete-region begin (point)))
-
-;;;###autoload
-(defun update-directory-autoloads (&rest dirs)
- "Update autoload definitions for Lisp files in the directories DIRS.
-In an interactive call, you must give one argument, the name of a
-single directory. In a call from Lisp, you can supply multiple
-directories as separate arguments, but this usage is discouraged.
-
-The function does NOT recursively descend into subdirectories of the
-directory or directories specified.
-
-In an interactive call, prompt for a default output file for the
-autoload definitions. When called from Lisp, use the existing
-value of `generated-autoload-file'. If any Lisp file binds
-`generated-autoload-file' as a file-local variable, write its
-autoloads into the specified file instead."
- (declare (obsolete make-directory-autoloads "28.1"))
- (interactive "DUpdate autoloads from directory: ")
- (make-directory-autoloads
- dirs
- (if (called-interactively-p 'interactive)
- (read-file-name "Write autoload definitions to file: ")
- generated-autoload-file)))
-
-;;;###autoload
-(defun make-directory-autoloads (dir output-file)
- "Update autoload definitions for Lisp files in the directories DIRS.
-DIR can be either a single directory or a list of
-directories. (The latter usage is discouraged.)
-
-The autoloads will be written to OUTPUT-FILE. If any Lisp file
-binds `generated-autoload-file' as a file-local variable, write
-its autoloads into the specified file instead.
-
-The function does NOT recursively descend into subdirectories of the
-directory or directories specified."
- (interactive "DUpdate autoloads from directory: \nFWrite to file: ")
- (let* ((files-re (let ((tmp nil))
- (dolist (suf (get-load-suffixes))
- ;; We don't use module-file-suffix below because
- ;; we don't want to depend on whether Emacs was
- ;; built with or without modules support, nor
- ;; what is the suffix for the underlying OS.
- (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf)
- (push suf tmp)))
- (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'")))
- (files (apply #'nconc
- (mapcar (lambda (d)
- (directory-files (expand-file-name d)
- t files-re))
- (if (consp dir) dir (list dir)))))
- (done ()) ;Files processed; to remove duplicates.
- (changed nil) ;Non-nil if some change occurred.
- (last-time)
- ;; Files with no autoload cookies or whose autoloads go to other
- ;; files because of file-local autoload-generated-file settings.
- (no-autoloads nil)
- ;; Ensure that we don't do odd things when putting the doc
- ;; strings into the autoloads file.
- (left-margin 0)
- (autoload-modified-buffers nil)
- (output-time
- (and (file-exists-p output-file)
- (file-attribute-modification-time
- (file-attributes output-file)))))
-
- (with-current-buffer (autoload-find-generated-file output-file)
- (save-excursion
- ;; Canonicalize file names and remove the autoload file itself.
- (setq files (delete (file-relative-name buffer-file-name)
- (mapcar #'file-relative-name files)))
-
- (goto-char (point-min))
- (while (search-forward generate-autoload-section-header nil t)
- (let* ((form (autoload-read-section-header))
- (file (nth 3 form)))
- (cond ((and (consp file) (stringp (car file)))
- ;; This is a list of files that have no autoload cookies.
- ;; There shouldn't be more than one such entry.
- ;; Remove the obsolete section.
- (autoload-remove-section (match-beginning 0))
- (setq last-time (nth 4 form))
- (if (member last-time (list t autoload--non-timestamp))
- (setq last-time output-time))
- (dolist (file file)
- (let ((file-time (file-attribute-modification-time
- (file-attributes file))))
- (when (and file-time
- (not (time-less-p last-time file-time)))
- ;; file unchanged
- (push file no-autoloads)
- (setq files (delete file files))))))
- ((not (stringp file)))
- ((or (not (file-exists-p file))
- ;; Remove duplicates as well, just in case.
- (member file done))
- ;; Remove the obsolete section.
- (setq changed t)
- (autoload-remove-section (match-beginning 0)))
- ((not (time-less-p (let ((oldtime (nth 4 form)))
- (if (member oldtime
- (list
- t autoload--non-timestamp))
- output-time
- oldtime))
- (file-attribute-modification-time
- (file-attributes file))))
- ;; File hasn't changed.
- nil)
- (t
- (setq changed t)
- (autoload-remove-section (match-beginning 0))
- (if (autoload-generate-file-autoloads
- ;; Passing `current-buffer' makes it insert at point.
- file (current-buffer) buffer-file-name)
- (push file no-autoloads))))
- (push file done)
- (setq files (delete file files)))))
- ;; Elements remaining in FILES have no existing autoload sections yet.
- (let ((no-autoloads-time (or last-time '(0 0 0 0)))
- (progress (make-progress-reporter
- (byte-compile-info
- (concat "Scraping files for "
- (file-relative-name output-file)))
- 0 (length files) nil 10))
- (file-count 0)
- file-time)
- (dolist (file files)
- (progress-reporter-update progress (setq file-count (1+ file-count)))
- (cond
- ;; Passing nil as second argument forces
- ;; autoload-generate-file-autoloads to look for the right
- ;; spot where to insert each autoloads section.
- ((setq file-time
- (autoload-generate-file-autoloads file nil buffer-file-name))
- (push file no-autoloads)
- (if (time-less-p no-autoloads-time file-time)
- (setq no-autoloads-time file-time)))
- (t (setq changed t))))
- (progress-reporter-done progress)
-
- (when no-autoloads
- ;; Sort them for better readability.
- (setq no-autoloads (sort no-autoloads 'string<))
- ;; Add the `no-autoloads' section.
- (goto-char (point-max))
- (search-backward "\f" nil t)
- (autoload-insert-section-header
- (current-buffer) nil nil
- ;; Filter out the other loaddefs files, because it makes
- ;; the list unstable (and leads to spurious changes in
- ;; ldefs-boot.el) since the loaddef files can be created in
- ;; any order.
- (seq-filter (lambda (file)
- (not (string-match-p "[/-]loaddefs.el" file)))
- no-autoloads)
- (if autoload-timestamps
- no-autoloads-time
- autoload--non-timestamp))
- (insert generate-autoload-section-trailer)))
-
- ;; Don't modify the file if its content has not been changed, so `make'
- ;; dependencies don't trigger unnecessarily.
- (if (not changed)
- (set-buffer-modified-p nil)
- (autoload--save-buffer))
-
- ;; In case autoload entries were added to other files because of
- ;; file-local autoload-generated-file settings.
- (autoload-save-buffers))))
-
-(defun batch-update-autoloads--summary (strings)
- (let ((message ""))
- (while strings
- (when (> (length (concat message " " (car strings))) 64)
- (byte-compile-info (concat message " ...") t "SCRAPE")
- (setq message ""))
- (setq message (if (zerop (length message))
- (car strings)
- (concat message " " (car strings))))
- (setq strings (cdr strings)))
- (when (> (length message) 0)
- (byte-compile-info message t "SCRAPE"))))
-
-;;;###autoload
-(defun batch-update-autoloads ()
- "Update loaddefs.el autoloads in batch mode.
-Calls `update-directory-autoloads' on the command line arguments.
-Definitions are written to `generated-autoload-file' (which
-should be non-nil)."
- ;; For use during the Emacs build process only.
- ;; Exclude those files that are preloaded on ALL platforms.
- ;; These are the ones in loadup.el where "(load" is at the start
- ;; of the line (crude, but it works).
- (unless autoload-excludes
- (let ((default-directory (file-name-directory generated-autoload-file))
- file)
- (when (file-readable-p "loadup.el")
- (with-temp-buffer
- (insert-file-contents "loadup.el")
- (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t)
- (setq file (match-string 1))
- (or (string-match "\\.el\\'" file)
- (setq file (format "%s.el" file)))
- (or (string-match "\\`site-" file)
- (push (expand-file-name file) autoload-excludes)))))))
- (let ((args command-line-args-left))
- (batch-update-autoloads--summary args)
- (setq command-line-args-left nil)
- (make-directory-autoloads args generated-autoload-file)))
-
-(provide 'autoload)
-
-;;; autoload.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 7a4bbf2e8af..a7edecfac73 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1747,10 +1747,10 @@ See Info node `(elisp) Integer Basics'."
byte-goto-if-not-nil-else-pop))
(defconst byte-after-unbind-ops
- '(byte-constant byte-dup
+ '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard
byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
byte-eq byte-not
- byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4
+ byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-listN
byte-interactive-p)
;; How about other side-effect-free-ops? Is it safe to move an
;; error invocation (such as from nth) out of an unwind-protect?
@@ -1762,7 +1762,8 @@ See Info node `(elisp) Integer Basics'."
(defconst byte-compile-side-effect-and-error-free-ops
'(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp
byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
- byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
+ byte-cdr-safe byte-cons byte-list1 byte-list2 byte-list3 byte-list4
+ byte-listN byte-point byte-point-max
byte-point-min byte-following-char byte-preceding-char
byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
byte-current-buffer byte-stack-ref))
@@ -2113,13 +2114,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
(setcar (cdr rest) lap0)
(setq keep-going t))
;;
- ;; varbind-X unbind-N --> discard unbind-(N-1)
- ;; save-excursion unbind-N --> unbind-(N-1)
- ;; save-restriction unbind-N --> unbind-(N-1)
+ ;; varbind-X unbind-N --> discard unbind-(N-1)
+ ;; save-excursion unbind-N --> unbind-(N-1)
+ ;; save-restriction unbind-N --> unbind-(N-1)
+ ;; save-current-buffer unbind-N --> unbind-(N-1)
;;
((and (eq 'byte-unbind (car lap1))
(memq (car lap0) '(byte-varbind byte-save-excursion
- byte-save-restriction))
+ byte-save-restriction
+ byte-save-current-buffer))
(< 0 (cdr lap1)))
(if (zerop (setcdr lap1 (1- (cdr lap1))))
(delq lap1 rest))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9370bd3a097..4a2860cd43d 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -236,6 +236,20 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''command-modes (list 'quote val))))
+(defalias 'byte-run--set-interactive-args
+ #'(lambda (f args &rest val)
+ (setq args (remove '&optional (remove '&rest args)))
+ (list 'function-put (list 'quote f)
+ ''interactive-args
+ (list
+ 'quote
+ (mapcar
+ (lambda (elem)
+ (cons
+ (seq-position args (car elem))
+ (cadr elem)))
+ val)))))
+
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
@@ -255,7 +269,8 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
(list 'indent #'byte-run--set-indent)
(list 'speed #'byte-run--set-speed)
(list 'completion #'byte-run--set-completion)
- (list 'modes #'byte-run--set-modes))
+ (list 'modes #'byte-run--set-modes)
+ (list 'interactive-args #'byte-run--set-interactive-args))
"List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b0ace9dae6a..5b9f92a4cc2 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -767,7 +767,7 @@ Each element is (INDEX . VALUE)")
(byte-defop 122 0 byte-char-syntax)
(byte-defop 123 -1 byte-buffer-substring)
(byte-defop 124 -1 byte-delete-region)
-(byte-defop 125 -2 byte-narrow-to-region)
+(byte-defop 125 -1 byte-narrow-to-region)
(byte-defop 126 1 byte-widen)
(byte-defop 127 0 byte-end-of-line)
@@ -1760,7 +1760,7 @@ It is too wide if it has any lines longer than the largest of
kind name col))
;; There's a "naked" ' character before a symbol/list, so it
;; should probably be quoted with \=.
- (when (string-match-p "\\( \"\\|[ \t]\\|^\\)'[a-z(]" docs)
+ (when (string-match-p "\\( [\"#]\\|[ \t]\\|^\\)'[a-z(]" docs)
(byte-compile-warn-x
name "%s%sdocstring has wrong usage of unescaped single quotes (use \\= or different quoting)"
kind name))
@@ -2416,8 +2416,8 @@ Call from the source buffer."
(defun byte-compile-output-file-form (form)
;; Write the given form to the output buffer, being careful of docstrings
- ;; in defvar, defvaralias, defconst, autoload and
- ;; custom-declare-variable because make-docfile is so amazingly stupid.
+ ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias,
+ ;; defconst, autoload, and custom-declare-variable.
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
@@ -2463,21 +2463,9 @@ list that represents a doc string reference.
(let (position
(print-symbols-bare t)) ; Possibly redundant binding.
;; Insert the doc string, and make it a comment with #@LENGTH.
- (and (>= (nth 1 info) 0)
- dynamic-docstrings
- (progn
- ;; Make the doc string start at beginning of line
- ;; for make-docfile's sake.
- (insert "\n")
- (setq position
- (byte-compile-output-as-comment
- (nth (nth 1 info) form) nil))
- ;; If the doc string starts with * (a user variable),
- ;; negate POSITION.
- (if (and (stringp (nth (nth 1 info) form))
- (> (length (nth (nth 1 info) form)) 0)
- (eq (aref (nth (nth 1 info) form) 0) ?*))
- (setq position (- position)))))
+ (when (and (>= (nth 1 info) 0) dynamic-docstrings)
+ (setq position (byte-compile-output-as-comment
+ (nth (nth 1 info) form) nil)))
(let ((print-continuous-numbering t)
print-number-table
@@ -2604,8 +2592,8 @@ list that represents a doc string reference.
(t
(byte-compile-keep-pending form)))))
-;; Functions and variables with doc strings must be output separately,
-;; so make-docfile can recognize them. Most other things can be output
+;; Functions and variables with doc strings must be output specially,
+;; for `byte-compile-dynamic-docstrings'. Most other things can be output
;; as byte-code.
(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
@@ -3845,7 +3833,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(byte-defop-compiler setcdr 2)
(byte-defop-compiler buffer-substring 2)
(byte-defop-compiler delete-region 2)
-(byte-defop-compiler narrow-to-region 2-3)
+(byte-defop-compiler narrow-to-region 2)
(byte-defop-compiler (% byte-rem) 2)
(byte-defop-compiler aset 3)
@@ -5004,7 +4992,7 @@ binding slots have been popped."
;;
;; FIXME: we also use this hunk-handler to implement the function's
;; dynamic docstring feature (via byte-compile-file-form-defmumble).
- ;; We should actually implement it (more elegantly) in
+ ;; We should probably actually implement it (more elegantly) in
;; byte-compile-lambda so it applies to all lambdas. We did it here
;; so the resulting .elc format was recognizable by make-docfile,
;; but since then we stopped using DOC for the docstrings of
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 611f32e23c6..04ead562f2f 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1,6 +1,6 @@
;;; checkdoc.el --- check documentation strings for style requirements -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Old-Version: 0.6.2
@@ -248,7 +248,7 @@ with these words enabled."
;;;###autoload(put 'checkdoc-spellcheck-documentation-flag 'safe-local-variable #'booleanp)
(defvar checkdoc-ispell-lisp-words
- '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs")
+ '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp")
"List of words that are correct when spell-checking Lisp documentation.")
;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable #'checkdoc-list-of-strings-p)
@@ -1357,23 +1357,6 @@ checking of documentation strings.
checkdoc-common-verbs-wrong-voice "\\|")
"\\)\\>"))))
-;; Profiler says this is not yet faster than just calling assoc
-;;(defun checkdoc-word-in-alist-vector (word vector)
-;; "Check to see if WORD is in the car of an element of VECTOR.
-;;VECTOR must be sorted. The CDR should be a replacement. Since the
-;;word list is getting bigger, it is time for a quick bisecting search."
-;; (let ((max (length vector)) (min 0) i
-;; (found nil) (fw nil))
-;; (setq i (/ max 2))
-;; (while (and (not found) (/= min max))
-;; (setq fw (car (aref vector i)))
-;; (cond ((string= word fw) (setq found (cdr (aref vector i))))
-;; ((string< word fw) (setq max i))
-;; (t (setq min i)))
-;; (setq i (/ (+ max min) 2))
-;; )
-;; found))
-
;;; Checking engines
;;
(defun checkdoc-this-string-valid (&optional take-notes)
@@ -2360,8 +2343,6 @@ News agents may remove it"
;;; Comment checking engine
;;
-(defvar generate-autoload-cookie)
-
(defun checkdoc-file-comments-engine ()
"Return a message list if this file does not match the Emacs standard.
This checks for style only, such as the first line, Commentary:,
@@ -2862,8 +2843,6 @@ function called to create the messages."
(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
-;; Obsolete
-
(define-obsolete-function-alias 'checkdoc-run-hooks
#'run-hook-with-args-until-success "28.1")
(defvar checkdoc-version "0.6.2"
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 3f40ab07605..a54fa21fa96 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -372,8 +372,8 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
(cl--defalias 'cl-second 'cadr)
(cl--defalias 'cl-rest 'cdr)
-(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.")
-(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.")
+(cl--defalias 'cl-third #'caddr "Return the third element of the list X.")
+(cl--defalias 'cl-fourth #'cadddr "Return the fourth element of the list X.")
(defsubst cl-fifth (x)
"Return the fifth element of the list X."
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 727b3098e34..eefaa36b911 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -527,7 +527,7 @@ its argument list allows full Common Lisp conventions."
(while (and (eq (car args) '&aux) (pop args))
(while (and args (not (memq (car args) cl--lambda-list-keywords)))
(if (consp (car args))
- (if (and cl--bind-enquote (cl-cadar args))
+ (if (and cl--bind-enquote (cadar args))
(cl--do-arglist (caar args)
`',(cadr (pop args)))
(cl--do-arglist (caar args) (cadr (pop args))))
@@ -612,7 +612,7 @@ its argument list allows full Common Lisp conventions."
(if (eq ?_ (aref name 0))
(setq name (substring name 1)))
(intern (format ":%s" name)))))
- (varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
+ (varg (if (consp (car arg)) (cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
;; The ordering between those two or clauses is
;; irrelevant, since in practice only one of the two
@@ -1339,7 +1339,7 @@ For more details, see Info node `(cl)Loop Facility'.
(temp-idx
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
- (eq (cl-caadr cl--loop-args) 'index))
+ (eq (caadr cl--loop-args) 'index))
(cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-idx--"))))
@@ -1370,8 +1370,8 @@ For more details, see Info node `(cl)Loop Facility'.
(other
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
- (memq (cl-caadr cl--loop-args) hash-types)
- (not (eq (cl-caadr cl--loop-args) word)))
+ (memq (caadr cl--loop-args) hash-types)
+ (not (eq (caadr cl--loop-args) word)))
(cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-var--"))))
@@ -1433,8 +1433,8 @@ For more details, see Info node `(cl)Loop Facility'.
(other
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
- (memq (cl-caadr cl--loop-args) key-types)
- (not (eq (cl-caadr cl--loop-args) word)))
+ (memq (caadr cl--loop-args) key-types)
+ (not (eq (caadr cl--loop-args) word)))
(cadr (cl--pop2 cl--loop-args))
(error "Bad `using' clause"))
(make-symbol "--cl-var--"))))
@@ -1656,7 +1656,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings."
(let ((temps nil) (new nil))
(when par
(let ((p specs))
- (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
+ (while (and p (or (symbolp (car-safe (car p))) (null (cadar p))))
(setq p (cdr p)))
(when p
(setq par nil)
@@ -1731,7 +1731,7 @@ such that COMBO is equivalent to (and . CLAUSES)."
(setq clauses (cons (nconc (butlast (car clauses))
(if (eq (car-safe (cadr clauses))
'progn)
- (cl-cdadr clauses)
+ (cdadr clauses)
(list (cadr clauses))))
(cddr clauses)))
;; A final (progn ,@A t) is moved outside of the `and'.
@@ -2563,9 +2563,9 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
(defun cl--optimize (f _args &rest qualities)
"Serve `cl-optimize' in function declarations.
Example:
-(defun foo (x)
- (declare (cl-optimize (speed 3) (safety 0)))
- x)"
+ (defun foo (x)
+ (declare (cl-optimize (speed 3) (safety 0)))
+ x)"
;; FIXME this should make use of `cl--declare-stack' but I suspect
;; this mechanism should be reviewed first.
(cl-loop for (qly val) in qualities
@@ -2613,7 +2613,7 @@ Example:
((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
(while (setq spec (cdr spec))
(if (consp (car spec))
- (if (eq (cl-cadar spec) 0)
+ (if (eq (cadar spec) 0)
(byte-compile-disable-warning (caar spec))
(byte-compile-enable-warning (caar spec)))))))
nil)
@@ -3093,9 +3093,9 @@ To see the documentation for a defined struct type, use
(t `(and (consp cl-x)
(memq (nth ,pos cl-x) ,tag-symbol))))))
pred-check (and pred-form (> safety 0)
- (if (and (eq (cl-caadr pred-form) 'vectorp)
+ (if (and (eq (caadr pred-form) 'vectorp)
(= safety 1))
- (cons 'and (cl-cdddr pred-form))
+ (cons 'and (cdddr pred-form))
`(,predicate cl-x))))
(when pred-form
(push `(,defsym ,predicate (cl-x)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 4354ea03a4e..5ee10fcbca2 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1915,7 +1915,10 @@ and the annotation emission."
(byte-char-syntax auto)
(byte-buffer-substring auto)
(byte-delete-region auto)
- (byte-narrow-to-region auto)
+ (byte-narrow-to-region
+ (comp-emit-set-call (comp-call 'narrow-to-region
+ (comp-slot)
+ (comp-slot+1))))
(byte-widen
(comp-emit-set-call (comp-call 'widen)))
(byte-end-of-line auto)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1a1d58d6e36..dff16df0029 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -864,7 +864,7 @@ marker. The needed data will then come from property
(defun edebug-read-special (stream)
"Read from STREAM a Lisp object beginning with #.
-Turn #'thing into (function thing) and handle the read syntax for
+Turn #\\='thing into (function thing) and handle the read syntax for
circular objects. Let `read' read everything else."
(catch 'return
(forward-char 1)
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 8d7f182e0cd..6fd89a690dc 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -381,7 +381,6 @@ Also store it in `eldoc-last-message' and return that value."
(defun eldoc-display-message-no-interference-p ()
"Return nil if displaying a message would cause interference."
(not (or executing-kbd-macro
- (bound-and-true-p edebug-active)
;; The following configuration shows "Matches..." in the
;; echo area when point is after a closing bracket, which
;; conflicts with eldoc.
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 49b54c2d00f..c8ff6b68144 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1692,7 +1692,7 @@ test packages depend on each other, it might be helpful.")
(string-match-p "^Running 0 tests" logfile-contents))
(insert (format " <testsuite id=\"%s\" name=\"%s\" tests=\"1\" errors=\"1\" failures=\"0\" skipped=\"0\" time=\"0\" timestamp=\"%s\">\n"
id test-report
- (ert--format-time-iso8601 (current-time))))
+ (ert--format-time-iso8601 nil)))
(insert (format " <testcase name=\"Test report missing %s\" status=\"error\" time=\"0\">\n"
(file-name-nondirectory test-report)))
(insert (format " <error message=\"Test report missing %s\" type=\"error\">\n"
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 654dbbc5fef..10bb2973253 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -131,7 +131,6 @@
(defun Helper-describe-bindings ()
"Describe local key bindings of current mode."
(interactive)
- (message "Making binding list...")
(save-window-excursion (describe-bindings))
(Helper-help-scroller))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index c906ee6e31d..c31fbec640c 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -728,30 +728,62 @@ font-lock keywords will not be case sensitive."
len))))
(defun lisp-current-defun-name ()
- "Return the name of the defun at point, or nil."
+ "Return the name of the defun at point.
+If there is no defun at point, return the first symbol from the
+top-level form. If there is no top-level form, return nil.
+
+(\"defun\" here means \"form that defines something\", and is
+decided heuristically.)"
(save-excursion
- (let ((location (point)))
+ (let ((location (point))
+ name)
;; If we are now precisely at the beginning of a defun, make sure
;; beginning-of-defun finds that one rather than the previous one.
- (or (eobp) (forward-char 1))
+ (unless (eobp)
+ (forward-char 1))
(beginning-of-defun)
;; Make sure we are really inside the defun found, not after it.
- (when (and (looking-at "\\s(")
- (progn (end-of-defun)
- (< location (point)))
- (progn (forward-sexp -1)
- (>= location (point))))
- (if (looking-at "\\s(")
- (forward-char 1))
- ;; Skip the defining construct name, typically "defun" or
+ (when (and (looking-at "(")
+ (progn
+ (end-of-defun)
+ (< location (point)))
+ (progn
+ (forward-sexp -1)
+ (>= location (point))))
+ (when (looking-at "(")
+ (forward-char 1))
+ ;; Read the defining construct name, typically "defun" or
;; "defvar".
- (forward-sexp 1)
- ;; The second element is usually a symbol being defined. If it
- ;; is not, use the first symbol in it.
- (skip-chars-forward " \t\n'(")
- (buffer-substring-no-properties (point)
- (progn (forward-sexp 1)
- (point)))))))
+ (let ((symbol (ignore-errors (read (current-buffer)))))
+ (when (and symbol (not (symbolp symbol)))
+ (setq symbol nil))
+ ;; If there's an edebug spec, use that to determine what the
+ ;; name is.
+ (when symbol
+ (let ((spec (get symbol 'edebug-form-spec)))
+ (save-excursion
+ (when (and (eq (car-safe spec) '&define)
+ (memq 'name spec))
+ (pop spec)
+ (while (and spec (not name))
+ (let ((candidate (ignore-errors (read (current-buffer)))))
+ (when (eq (pop spec) 'name)
+ (setq name candidate
+ spec nil))))))))
+ ;; We didn't have an edebug spec (or couldn't find the
+ ;; name). If the symbol starts with \"def\", then it's
+ ;; likely that the next symbol is the name.
+ (when (and (not name)
+ (string-match-p "\\(\\`\\|-\\)def" (symbol-name symbol)))
+ (when-let ((candidate (ignore-errors (read (current-buffer)))))
+ (cond
+ ((symbolp candidate)
+ (setq name candidate))
+ ((and (consp candidate)
+ (symbolp (car (delete 'quote candidate))))
+ (setq name (car (delete 'quote candidate)))))))
+ (when-let ((result (or name symbol)))
+ (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/lisp.el b/lisp/emacs-lisp/lisp.el
index 4b85414943a..acae1a0b0a9 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -507,6 +507,11 @@ It is called with no argument, right after calling `beginning-of-defun-raw'.
So the function can assume that point is at the beginning of the defun body.
It should move point to the first position after the defun.")
+(defvar end-of-defun-moves-to-eol t
+ "Whether `end-of-defun' moves to eol before doing anything else.
+Set this to nil if this movement adversely affects the buffer's
+major mode's decisions about context.")
+
(defun buffer-end (arg)
"Return the \"far end\" position of the buffer, in direction ARG.
If ARG is positive, that's the end of the buffer.
@@ -538,7 +543,9 @@ report errors as appropriate for this kind of usage."
(push-mark))
(if (or (null arg) (= arg 0)) (setq arg 1))
(let ((pos (point))
- (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point)))
+ (beg (progn (when end-of-defun-moves-to-eol
+ (end-of-line 1))
+ (beginning-of-defun-raw 1) (point)))
(skip (lambda ()
;; When comparing point against pos, we want to consider that
;; if point was right after the end of the function, it's
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 261e44aeced..0c9bc4832b4 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -50,17 +50,27 @@ prefix, that will not be registered. But all other prefixes will
be included.")
(put 'autoload-compute-prefixes 'safe-local-variable #'booleanp)
+(defvar no-update-autoloads nil
+ "File local variable to prevent scanning this file for autoload cookies.")
+
(defvar autoload-ignored-definitions
'("define-obsolete-function-alias"
"define-obsolete-variable-alias"
- "define-category" "define-key"
+ "define-category"
+ "define-key" "define-key-after" "define-keymap"
"defgroup" "defface" "defadvice"
"def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
"define-erc-module"
"define-erc-response-handler"
- "defun-rcirc-command")
+ "defun-rcirc-command"
+ "define-short-documentation-group"
+ "def-edebug-elem-spec"
+ "defvar-mode-local"
+ "defcustom-mode-local-semantic-dependency-system-include-path"
+ "define-ibuffer-column"
+ "define-ibuffer-sorter")
"List of strings naming definitions to ignore for prefixes.
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")
@@ -117,6 +127,15 @@ scanning for autoloads and will be in the `load-path'."
(substring name 0 (match-beginning 0))
name)))
+(defun loaddefs-generate--shorten-autoload (form)
+ "Remove optional nil elements from an `autoload' form."
+ (take (max (- (length form)
+ (seq-position (reverse form) nil
+ (lambda (e1 e2)
+ (not (eq e1 e2)))))
+ 3)
+ form))
+
(defun loaddefs-generate--make-autoload (form file &optional expansion)
"Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
@@ -155,8 +174,8 @@ expression, in which case we want to handle forms differently."
;; Add the usage form at the end where describe-function-1
;; can recover it.
(when (consp args) (setq doc (help-add-fundoc-usage doc args)))
- ;; (message "autoload of %S" (nth 1 form))
- `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
+ (loaddefs-generate--shorten-autoload
+ `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))))
((and expansion (memq car '(progn prog1)))
(let ((end (memq :autoload-end form)))
@@ -210,22 +229,23 @@ expression, in which case we want to handle forms differently."
;; can recover it.
(when (listp args) (setq doc (help-add-fundoc-usage doc args)))
;; `define-generic-mode' quotes the name, so take care of that
- `(autoload ,(if (listp name) name (list 'quote name))
- ,file ,doc
- ,(or (and (memq car '(define-skeleton define-derived-mode
- define-generic-mode
- easy-mmode-define-global-mode
- define-global-minor-mode
- define-globalized-minor-mode
- easy-mmode-define-minor-mode
- define-minor-mode))
- t)
- (and (eq (car-safe (car body)) 'interactive)
- ;; List of modes or just t.
- (or (if (nthcdr 1 (car body))
- (list 'quote (nthcdr 1 (car body)))
- t))))
- ,(if macrop ''macro nil))))
+ (loaddefs-generate--shorten-autoload
+ `(autoload ,(if (listp name) name (list 'quote name))
+ ,file ,doc
+ ,(or (and (memq car '(define-skeleton define-derived-mode
+ define-generic-mode
+ easy-mmode-define-global-mode
+ define-global-minor-mode
+ define-globalized-minor-mode
+ easy-mmode-define-minor-mode
+ define-minor-mode))
+ t)
+ (and (eq (car-safe (car body)) 'interactive)
+ ;; List of modes or just t.
+ (or (if (nthcdr 1 (car body))
+ (list 'quote (nthcdr 1 (car body)))
+ t))))
+ ,(if macrop ''macro nil)))))
;; For defclass forms, use `eieio-defclass-autoload'.
((eq car 'defclass)
@@ -447,7 +467,7 @@ don't include."
(let ((prefs nil))
;; Avoid (defvar <foo>) by requiring a trailing space.
(while (re-search-forward
- "^(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
+ "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
(unless (member (match-string 1) autoload-ignored-definitions)
(let ((name (match-string-no-properties 2)))
(when (save-excursion
@@ -459,7 +479,7 @@ don't include."
(push name prefs)))))
(loaddefs-generate--make-prefixes prefs load-name)))
-(defun loaddefs-generate--rubric (file &optional type feature)
+(defun loaddefs-generate--rubric (file &optional type feature compile)
"Return a string giving the appropriate autoload rubric for FILE.
TYPE (default \"autoloads\") is a string stating the type of
information contained in FILE. TYPE \"package\" acts like the default,
@@ -467,7 +487,9 @@ but adds an extra line to the output to modify `load-path'.
If FEATURE is non-nil, FILE will provide a feature. FEATURE may
be a string naming the feature, otherwise it will be based on
-FILE's name."
+FILE's name.
+
+If COMPILE, don't include a \"don't compile\" cookie."
(let ((lp (and (equal type "package") (setq type "autoloads"))))
(with-temp-buffer
(generate-lisp-file-heading
@@ -481,30 +503,10 @@ FILE's name."
(insert " \n;;; End of scraped data\n\n")
(generate-lisp-file-trailer
file :provide (and (stringp feature) feature)
+ :compile compile
:inhibit-provide (not feature))
(buffer-string))))
-(defun loaddefs-generate--insert-section-header (outbuf autoloads
- load-name file time)
- "Insert into buffer OUTBUF the section-header line for FILE.
-The header line lists the file name, its \"load name\", its autoloads,
-and the time the FILE was last updated (the time is inserted only
-if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
- (insert "\f\n;;;### ")
- (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
- outbuf)
- (terpri outbuf)
- ;; Break that line at spaces, to avoid very long lines.
- ;; Make each sub-line into a comment.
- (with-current-buffer outbuf
- (save-excursion
- (forward-line -1)
- (while (not (eolp))
- (move-to-column 64)
- (skip-chars-forward "^ \n")
- (or (eolp)
- (insert "\n" ";;;;;; "))))))
-
;;;###autoload
(defun loaddefs-generate (dir output-file &optional excluded-files
extra-data include-package-version
@@ -517,15 +519,21 @@ binds `generated-autoload-file' as a file-local variable, write
its autoloads into the specified file instead.
The function does NOT recursively descend into subdirectories of the
-directory or directories specified.
+directory or directories specified by DIRS.
+
+Optional argument EXCLUDED-FILES, if non-nil, should be a list of
+files, such as preloaded files, whose autoloads should not be written
+to OUTPUT-FILE.
-If EXTRA-DATA, include this string at the start of the generated
-file. This will also force generation of OUTPUT-FILE even if
-there are no autoloads to put into the file.
+If EXTRA-DATA is non-nil, it should be a string; include that string
+at the beginning of the generated file. This will also force the
+generation of OUTPUT-FILE even if there are no autoloads to put into
+that file.
-If INCLUDE-PACKAGE-VERSION, include package version data.
+If INCLUDE-PACKAGE-VERSION is non-nil, include package version data.
-If GENERATE-FULL, don't update, but regenerate all the loaddefs files."
+If GENERATE-FULL is non-nil, regenerate all the loaddefs files anew,
+instead of just updating them with the new/changed autoloads."
(let* ((files-re (let ((tmp nil))
(dolist (suf (get-load-suffixes))
;; We don't use module-file-suffix below because
@@ -585,7 +593,8 @@ If GENERATE-FULL, don't update, but regenerate all the loaddefs files."
(with-temp-buffer
(if (and updating (file-exists-p loaddefs-file))
(insert-file-contents loaddefs-file)
- (insert (loaddefs-generate--rubric loaddefs-file nil t))
+ (insert (loaddefs-generate--rubric
+ loaddefs-file nil t include-package-version))
(search-backward "\f")
(when extra-data
(insert extra-data)
@@ -631,18 +640,19 @@ If GENERATE-FULL, don't update, but regenerate all the loaddefs files."
t "GEN")))))))
(defun loaddefs-generate--print-form (def)
- "Print DEF in the way make-docfile.c expects it."
+ "Print DEF in a format that makes sense for version control."
(if (or (not (consp def))
(not (symbolp (car def)))
(memq (car def) '( make-obsolete
define-obsolete-function-alias))
(not (stringp (nth 3 def))))
(prin1 def (current-buffer) t)
- ;; The salient point here is that we have to have the doc string
- ;; that starts with a backslash and a newline, and there mustn't
- ;; be any newlines before that. So -- typically
- ;; (defvar foo 'value "\
- ;; Doc string" ...).
+ ;; We want to print, for instance, `defvar' values while escaping
+ ;; control characters (so that we don't end up with lines with
+ ;; trailing tab characters and the like), but we don't want to do
+ ;; this for doc strings, because then the doc strings would be on
+ ;; one single line, which would lead to more VC churn. So --
+ ;; typically (defvar foo 'value "\ Doc string" ...).
(insert "(")
(dotimes (_ 3)
(prin1 (pop def) (current-buffer)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ab1a652188f..2de5056475d 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1064,7 +1064,9 @@ untar into a directory named DIR; otherwise, signal an error."
(unless (file-exists-p file)
(require 'autoload)
(let ((coding-system-for-write 'utf-8-emacs-unix))
- (write-region (autoload-rubric file "package" nil) nil file nil 'silent)))
+ (with-suppressed-warnings ((obsolete autoload-rubric))
+ (write-region (autoload-rubric file "package" nil)
+ nil file nil 'silent))))
file)
(defvar autoload-timestamps)
@@ -2127,7 +2129,10 @@ If PACKAGE is a `package-desc' object, MIN-VERSION is ignored."
package-activated-list)
;; We used the quickstart: make it possible to use package-installed-p
;; even before package is fully initialized.
- (memq package package-activated-list))
+ (or
+ (memq package package-activated-list)
+ ;; Also check built-in packages.
+ (package-built-in-p package min-version)))
(t
(or
(let ((pkg-descs (cdr (assq package (package--alist)))))
@@ -3597,7 +3602,7 @@ If optional arg BUTTON is non-nil, describe its associated package."
(let ((place (cdr desc))
(out (copy-sequence (car desc))))
(add-text-properties place (1+ place)
- '(face (bold font-lock-warning-face))
+ '(face help-key-binding)
out)
out))
(package--prettify-quick-help-key (cons desc 0))))
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 1b8d86563a1..b6f0f66e5b1 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -455,6 +455,33 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil."
(setq result (cons elt result))))
(nreverse result)))
+(cl-defmethod seq-uniq ((sequence list) &optional testfn)
+ (let ((result nil))
+ (if (not testfn)
+ ;; Fast path. If the list is long, use a hash table to speed
+ ;; things up even more.
+ (let ((l (length sequence)))
+ (if (> l 100)
+ (let ((hash (make-hash-table :test #'equal :size l)))
+ (while sequence
+ (unless (gethash (car sequence) hash)
+ (setf (gethash (car sequence) hash) t)
+ (push (car sequence) result))
+ (setq sequence (cdr sequence))))
+ ;; Short list.
+ (while sequence
+ (unless (member (car sequence) result)
+ (push (car sequence) result))
+ (pop sequence))))
+ ;; Slower path.
+ (while sequence
+ (unless (seq-find (lambda (elem)
+ (funcall testfn elem (car sequence)))
+ result)
+ (push (car sequence) result))
+ (pop sequence)))
+ (nreverse result)))
+
(cl-defgeneric seq-mapcat (function sequence &optional type)
"Concatenate the result of applying FUNCTION to each element of SEQUENCE.
The result is a sequence of type TYPE, or a list if TYPE is nil."
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 315afd4312b..d187af9ac83 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -503,7 +503,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
(set-file-modes
:no-value "(set-file-modes \"/tmp/foo\" #o644)")
(set-file-times
- :no-value (set-file-times "/tmp/foo" (current-time)))
+ :no-value (set-file-times "/tmp/foo"))
"File Modes"
(set-default-file-modes
:no-value "(set-default-file-modes #o755)")
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index d5d7bfeb6f5..1cce97cdb10 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -118,6 +118,7 @@ the resulting string may be longer than the original if LENGTH is
(concat "..." (substring string (min (1- strlen)
(max 0 (- strlen length))))))))
+;;;###autoload
(defsubst string-blank-p (string)
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
@@ -253,13 +254,9 @@ the string."
(unless (natnump length)
(signal 'wrong-type-argument (list 'natnump length)))
(let ((pad-length (- length (length string))))
- (if (< pad-length 0)
- string
- (concat (and start
- (make-string pad-length (or padding ?\s)))
- string
- (and (not start)
- (make-string pad-length (or padding ?\s)))))))
+ (cond ((<= pad-length 0) string)
+ (start (concat (make-string pad-length (or padding ?\s)) string))
+ (t (concat string (make-string pad-length (or padding ?\s)))))))
(defun string-chop-newline (string)
"Remove the final newline (if any) from STRING."
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index fd29abf40a3..b25a040a96c 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -122,7 +122,7 @@ of SECS seconds since the epoch. SECS may be a fraction."
(setq ticks (ash ticks 1))
(setq hz (ash hz 1)))
(let ((more-ticks (+ ticks trunc-s-ticks)))
- (time-convert (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz)))))
+ (time-convert (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz) t))))
(defun timer-relative-time (time secs &optional usecs psecs)
"Advance TIME by SECS seconds.
@@ -159,32 +159,42 @@ SECS may be a fraction."
timer)
(defun timer--activate (timer &optional triggered-p reuse-cell idle)
- (if (and (timerp timer)
- (integerp (timer--high-seconds timer))
- (integerp (timer--low-seconds timer))
- (integerp (timer--usecs timer))
- (integerp (timer--psecs timer))
- (timer--function timer))
- (let ((timers (if idle timer-idle-list timer-list))
- last)
- ;; Skip all timers to trigger before the new one.
- (while (and timers (timer--time-less-p (car timers) timer))
- (setq last timers
- timers (cdr timers)))
- (if reuse-cell
- (progn
- (setcar reuse-cell timer)
- (setcdr reuse-cell timers))
- (setq reuse-cell (cons timer timers)))
- ;; Insert new timer after last which possibly means in front of queue.
- (setf (cond (last (cdr last))
- (idle timer-idle-list)
- (t timer-list))
- reuse-cell)
- (setf (timer--triggered timer) triggered-p)
- (setf (timer--idle-delay timer) idle)
- nil)
- (error "Invalid or uninitialized timer")))
+ (let ((timers (if idle timer-idle-list timer-list))
+ last)
+ (cond
+ ((not (and (timerp timer)
+ (integerp (timer--high-seconds timer))
+ (integerp (timer--low-seconds timer))
+ (integerp (timer--usecs timer))
+ (integerp (timer--psecs timer))
+ (timer--function timer)))
+ (error "Invalid or uninitialized timer"))
+ ;; FIXME: This is not reliable because `idle-delay' is only set late,
+ ;; by `timer-activate-when-idle' :-(
+ ;;((not (eq (not idle)
+ ;; (not (timer--idle-delay timer))))
+ ;; (error "idle arg %S out of sync with idle-delay field of timer: %S"
+ ;; idle timer))
+ ((memq timer timers)
+ (error "Timer already activated"))
+ (t
+ ;; Skip all timers to trigger before the new one.
+ (while (and timers (timer--time-less-p (car timers) timer))
+ (setq last timers
+ timers (cdr timers)))
+ (if reuse-cell
+ (progn
+ (setcar reuse-cell timer)
+ (setcdr reuse-cell timers))
+ (setq reuse-cell (cons timer timers)))
+ ;; Insert new timer after last which possibly means in front of queue.
+ (setf (cond (last (cdr last))
+ (idle timer-idle-list)
+ (t timer-list))
+ reuse-cell)
+ (setf (timer--triggered timer) triggered-p)
+ (setf (timer--idle-delay timer) idle)
+ nil))))
(defun timer-activate (timer &optional triggered-p reuse-cell)
"Insert TIMER into `timer-list'.
@@ -216,7 +226,7 @@ the time of the current timer. That's because the activated
timer will fire right away."
(timer--activate timer (not dont-wait) reuse-cell 'idle))
-(defalias 'disable-timeout 'cancel-timer)
+(defalias 'disable-timeout #'cancel-timer)
(defun cancel-timer (timer)
"Remove TIMER from the list of active timers."
@@ -430,7 +440,7 @@ The action is to call FUNCTION with arguments ARGS.
This function returns a timer object which you can use in `cancel-timer'."
(interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
- (apply 'run-at-time secs repeat function args))
+ (apply #'run-at-time secs repeat function args))
(defun add-timeout (secs function object &optional repeat)
"Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT.
@@ -457,7 +467,7 @@ This function returns a timer object which you can use in `cancel-timer'."
(interactive
(list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
(y-or-n-p "Repeat each time Emacs is idle? ")
- (intern (completing-read "Function: " obarray 'fboundp t))))
+ (intern (completing-read "Function: " obarray #'fboundp t))))
(let ((timer (timer-create)))
(timer-set-function timer function args)
(timer-set-idle-time timer secs repeat)
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 516fdeb10ea..d60eedbc9cd 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -209,7 +209,7 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress."
(text " stop "))
"Suppress warnings."
:version "29.1"
- :help-echo "Click to supress this warning type")
+ :help-echo "Click to suppress this warning type")
(defun warnings-suppress (type)
(pcase (car
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-25 15:23:23 +0000