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/bytecomp.el170
-rw-r--r--lisp/emacs-lisp/cl-generic.el4
-rw-r--r--lisp/emacs-lisp/eldoc.el6
-rw-r--r--lisp/emacs-lisp/elint.el2
-rw-r--r--lisp/emacs-lisp/find-func.el2
-rw-r--r--lisp/emacs-lisp/gv.el5
-rw-r--r--lisp/emacs-lisp/memory-report.el8
-rw-r--r--lisp/emacs-lisp/package.el49
-rw-r--r--lisp/emacs-lisp/seq.el7
-rw-r--r--lisp/emacs-lisp/warnings.el7
11 files changed, 152 insertions, 113 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 4c9d709697c..573212ac00d 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2410,8 +2410,9 @@ as if they had been supplied to a function with TARGET-ARGLIST directly.
Excess source arguments will be neglected, missing source arguments will be
supplied as nil. Returns a `funcall' or `apply' form with the second element
being `function' which has to be replaced by an actual function argument.
-Example: (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return
- (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))."
+Example:
+ (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return
+ (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))."
(let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
(source-reqopt-args (append (nth 0 parsed-source-arglist)
(nth 1 parsed-source-arglist)))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 02605f3d9f6..620f15c619d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -144,7 +144,7 @@ is hard-coded in various places in Emacs.)"
;; Eg is_elc in Fload.
:type 'regexp)
-(defcustom byte-compile-dest-file-function nil
+(defcustom byte-compile-dest-file-function #'byte-compile--default-dest-file
"Function for the function `byte-compile-dest-file' to call.
It should take one argument, the name of an Emacs Lisp source
file name, and return the name of the compiled file.
@@ -177,14 +177,16 @@ function to do the work. Otherwise, if FILENAME matches
`emacs-lisp-file-regexp' (by default, files with the extension \".el\"),
replaces the matching part (and anything after it) with \".elc\";
otherwise adds \".elc\"."
- (if byte-compile-dest-file-function
- (funcall byte-compile-dest-file-function filename)
- (setq filename (file-name-sans-versions
- (byte-compiler-base-file-name filename)))
- (cond ((string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc"))
- (t (concat filename ".elc")))))
-)
+ (funcall (or byte-compile-dest-file-function
+ #'byte-compile--default-dest-file)
+ filename)))
+
+(defun byte-compile--default-dest-file (filename)
+ (setq filename (file-name-sans-versions
+ (byte-compiler-base-file-name filename)))
+ (cond ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc"))))
;; This can be the 'byte-compile property of any symbol.
(autoload 'byte-compile-inline-expand "byte-opt")
@@ -749,7 +751,8 @@ Each element is (INDEX . VALUE)")
;; These store their argument in the next two bytes
(byte-defop 129 1 byte-constant2
- "for reference to a constant with vector index >= byte-constant-limit")
+ "for reference to a constant with vector
+index >= byte-constant-limit")
(byte-defop 130 0 byte-goto "for unconditional jump")
(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
(byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
@@ -769,11 +772,14 @@ otherwise pop it")
(byte-defop 139 0 byte-save-window-excursion-OBSOLETE
"to make a binding to record entire window configuration")
(byte-defop 140 0 byte-save-restriction
- "to make a binding to record the current buffer clipping restrictions")
+ "to make a binding to record the current buffer clipping
+restrictions")
(byte-defop 141 -1 byte-catch-OBSOLETE ; Not generated since Emacs 25.
- "for catch. Takes, on stack, the tag and an expression for the body")
+ "for catch. Takes, on stack, the tag and an expression for
+the body")
(byte-defop 142 -1 byte-unwind-protect
- "for unwind-protect. Takes, on stack, an expression for the unwind-action")
+ "for unwind-protect. Takes, on stack, an expression for
+the unwind-action")
;; For condition-case. Takes, on stack, the variable to bind,
;; an expression for the body, and a list of clauses.
@@ -833,8 +839,8 @@ otherwise pop it")
(defconst byte-discardN-preserve-tos byte-discardN)
(byte-defop 183 -2 byte-switch
- "to take a hash table and a value from the stack, and jump to the address
-the value maps to, if any.")
+ "to take a hash table and a value from the stack, and jump to
+the address the value maps to, if any.")
;; unused: 182-191
@@ -1862,24 +1868,23 @@ If compilation is needed, this functions returns the result of
(let ((dest (byte-compile-dest-file filename))
;; Expand now so we get the current buffer's defaults
(filename (expand-file-name filename)))
- (if (if (file-exists-p dest)
- ;; File was already compiled
- ;; Compile if forced to, or filename newer
- (or force
- (file-newer-than-file-p filename dest))
- (and arg
- (or (eq 0 arg)
- (y-or-n-p (concat "Compile "
- filename "? ")))))
- (progn
- (if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." filename))
- (byte-compile-file filename)
- (when load
- (load (if (file-exists-p dest) dest filename))))
+ (prog1
+ (if (if (and dest (file-exists-p dest))
+ ;; File was already compiled
+ ;; Compile if forced to, or filename newer
+ (or force
+ (file-newer-than-file-p filename dest))
+ (and arg
+ (or (eq 0 arg)
+ (y-or-n-p (concat "Compile "
+ filename "? ")))))
+ (progn
+ (if (and noninteractive (not byte-compile-verbose))
+ (message "Compiling %s..." filename))
+ (byte-compile-file filename))
+ 'no-byte-compile)
(when load
- (load (if (file-exists-p dest) dest filename)))
- 'no-byte-compile)))
+ (load (if (and dest (file-exists-p dest)) dest filename))))))
(defun byte-compile--load-dynvars (file)
(and file (not (equal file ""))
@@ -1989,7 +1994,7 @@ See also `emacs-lisp-byte-compile-and-load'."
;; (message "%s not compiled because of `no-byte-compile: %s'"
;; (byte-compile-abbreviate-file filename)
;; (with-current-buffer input-buffer no-byte-compile))
- (when (file-exists-p target-file)
+ (when (and target-file (file-exists-p target-file))
(message "%s deleted because of `no-byte-compile: %s'"
(byte-compile-abbreviate-file target-file)
(buffer-local-value 'no-byte-compile input-buffer))
@@ -2013,46 +2018,63 @@ See also `emacs-lisp-byte-compile-and-load'."
(with-current-buffer output-buffer
(goto-char (point-max))
(insert "\n") ; aaah, unix.
- (if (or (file-writable-p target-file)
- byte-native-compiling)
- ;; We must disable any code conversion here.
- (progn
- (let* ((coding-system-for-write 'no-conversion)
- ;; Write to a tempfile so that if another Emacs
- ;; process is trying to load target-file (eg in a
- ;; parallel bootstrap), it does not risk getting a
- ;; half-finished file. (Bug#4196)
- (tempfile
- (make-temp-file (when (file-writable-p target-file)
- (expand-file-name target-file))))
- (default-modes (default-file-modes))
- (temp-modes (logand default-modes #o600))
- (desired-modes (logand default-modes #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)
- ;; This has the intentional side effect that any
- ;; hard-links to target-file continue to
- ;; point to the old file (this makes it possible
- ;; for installed files to share disk space with
- ;; the build tree, without causing problems when
- ;; emacs-lisp files in the build tree are
- ;; recompiled). Previously this was accomplished by
- ;; deleting target-file before writing it.
- (if byte-native-compiling
- (if byte-native-for-bootstrap
- ;; Defer elc final renaming.
- (setf byte-to-native-output-file
- (cons tempfile target-file))
- (delete-file tempfile))
- (rename-file tempfile target-file t)))
- (or noninteractive
- byte-native-compiling
- (message "Wrote %s" target-file)))
+ (cond
+ ((null target-file) nil) ;We only wanted the warnings!
+ ((and (or (file-writable-p target-file)
+ byte-native-compiling)
+ ;; We attempt to create a temporary file in the
+ ;; target directory, so the target directory must be
+ ;; writable.
+ (file-writable-p
+ (file-name-directory
+ ;; Need to expand in case TARGET-FILE doesn't
+ ;; include a directory (Bug#45287).
+ (expand-file-name target-file))))
+ ;; We must disable any code conversion here.
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile
+ (make-temp-file (expand-file-name target-file)))
+ (default-modes (default-file-modes))
+ (temp-modes (logand default-modes #o600))
+ (desired-modes (logand default-modes #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)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (if byte-native-compiling
+ (if byte-native-for-bootstrap
+ ;; Defer elc final renaming.
+ (setf byte-to-native-output-file
+ (cons tempfile target-file))
+ (delete-file tempfile))
+ (rename-file tempfile target-file t)))
+ (or noninteractive
+ byte-native-compiling
+ (message "Wrote %s" target-file)))
+ ((file-writable-p target-file)
+ ;; In case the target directory isn't writable (see e.g. Bug#44631),
+ ;; try writing to the output file directly. We must disable any
+ ;; code conversion here.
+ (let ((coding-system-for-write 'no-conversion))
+ (with-file-modes (logand (default-file-modes) #o666)
+ (write-region (point-min) (point-max) target-file nil 1)))
+ (or noninteractive (message "Wrote %s" target-file)))
+ (t
;; This is just to give a better error message than write-region
(let ((exists (file-exists-p target-file)))
(signal (if exists 'file-error 'file-missing)
@@ -2060,7 +2082,7 @@ See also `emacs-lisp-byte-compile-and-load'."
(if exists
"Cannot overwrite file"
"Directory not writable or nonexistent")
- target-file))))
+ target-file)))))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b37b05b9a3a..9ddf9e7333b 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -811,8 +811,8 @@ It should return a function that expects the same arguments as the methods, and
GENERIC is the generic function (mostly used for its name).
METHODS is the list of the selected methods.
The METHODS list is sorted from most specific first to most generic last.
-The function can use `cl-generic-call-method' to create functions that call those
-methods.")
+The function can use `cl-generic-call-method' to create functions that call
+those methods.")
(unless (ignore-errors (cl-generic-generalizers t))
;; Temporary definition to let the next defmethod succeed.
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 6a976841038..c9d5521e502 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -867,11 +867,7 @@ the docstrings eventually produced, using
eldoc--last-request-state))
(let ((non-essential t))
(setq eldoc--last-request-state token)
- ;; Only keep looking for the info as long as the user hasn't
- ;; requested our attention. This also locally disables
- ;; inhibit-quit.
- (while-no-input
- (eldoc--invoke-strategy nil)))))))
+ (eldoc--invoke-strategy nil))))))
;; This section only affects ElDoc output to the echo area, as in
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index 79b72ff969f..d0a0389b3b7 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -521,7 +521,7 @@ Return nil if there are no more forms, t otherwise."
"The currently linted top form, or nil.")
(defvar elint-top-form-logged nil
- "The value t if the currently linted top form has been mentioned in the log buffer.")
+ "Non-nil if the currently linted top form has been mentioned in the log buffer.")
(defun elint-top-form (form)
"Lint a top FORM."
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 4417082971f..cf927729b6c 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -103,7 +103,7 @@ Please send improvements and fixes to the maintainer."
(defcustom find-feature-regexp
(concat ";;; Code:")
- "The regexp used by `xref-find-definitions' when searching for a feature definition.
+ "Regexp used by `xref-find-definitions' when searching for a feature definition.
Note it may contain up to one `%s' at the place where `format'
should insert the feature name."
;; We search for ";;; Code" rather than (feature '%s) because the
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 5470b8532fc..7ee5c47d116 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -504,6 +504,11 @@ The return value is the last VAL in the list.
(funcall do `(funcall (car ,gv))
(lambda (v) `(funcall (cdr ,gv) ,v))))))))
+(put 'error 'gv-expander
+ (lambda (do &rest args)
+ (funcall do `(error . ,args)
+ (lambda (v) `(progn ,v (error . ,args))))))
+
(defmacro gv-synthetic-place (getter setter)
"Special place described by its setter and getter.
GETTER and SETTER (typically obtained via `gv-letplace') get and
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index c88d9f2768a..b532ddc56c5 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -232,11 +232,11 @@ by counted more than once."
(defun memory-report--format (bytes)
(setq bytes (/ bytes 1024.0))
- (let ((units '("kB" "MB" "GB" "TB")))
+ (let ((units '("KiB" "MiB" "GiB" "TiB")))
(while (>= bytes 1024)
(setq bytes (/ bytes 1024.0))
(setq units (cdr units)))
- (format "%6.1f%s" bytes (car units))))
+ (format "%6.1f %s" bytes (car units))))
(defun memory-report--gc-elem (elems type)
(* (nth 1 (assq type elems))
@@ -294,7 +294,9 @@ by counted more than once."
(overlay-lists)))))
(defun memory-report--image-cache ()
- (list (cons "Total Image Cache Size" (image-cache-size))))
+ (list (cons "Total Image Cache Size" (if (fboundp 'image-cache-size)
+ (image-cache-size)
+ 0))))
(provide 'memory-report)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index e980f8841e0..7e5e6fc4a32 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1132,14 +1132,15 @@ boundaries."
;; Use some headers we've invented to drive the process.
(let* (;; Prefer Package-Version; if defined, the package author
;; probably wants us to use it. Otherwise try Version.
- (pkg-version
- (or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version"))))
+ (version-info
+ (or (lm-header "package-version") (lm-header "version")))
+ (pkg-version (package-strip-rcs-id version-info))
(keywords (lm-keywords-list))
(homepage (lm-homepage)))
(unless pkg-version
- (error
- "Package lacks a \"Version\" or \"Package-Version\" header"))
+ (if version-info
+ (error "Unrecognized package version: %s" version-info)
+ (error "Package lacks a \"Version\" or \"Package-Version\" header")))
(package-desc-from-define
file-name pkg-version desc
(and-let* ((require-lines (lm-header-multiline "package-requires")))
@@ -1631,18 +1632,22 @@ that code in the early init-file."
"Activate all installed packages.
The variable `package-load-list' controls which packages to load."
(setq package--activated t)
- (if (file-readable-p package-quickstart-file)
- ;; Skip load-source-file-function which would slow us down by a factor
- ;; 2 (this assumes we were careful to save this file so it doesn't need
- ;; any decoding).
- (let ((load-source-file-function nil))
- (load package-quickstart-file nil 'nomessage))
- (dolist (elt (package--alist))
- (condition-case err
- (package-activate (car elt))
- ;; Don't let failure of activation of a package arbitrarily stop
- ;; activation of further packages.
- (error (message "%s" (error-message-string err)))))))
+ (let* ((elc (concat package-quickstart-file "c"))
+ (qs (if (file-readable-p elc) elc
+ (if (file-readable-p package-quickstart-file)
+ package-quickstart-file))))
+ (if qs
+ ;; Skip load-source-file-function which would slow us down by a factor
+ ;; 2 when loading the .el file (this assumes we were careful to
+ ;; save this file so it doesn't need any decoding).
+ (let ((load-source-file-function nil))
+ (load qs nil 'nomessage))
+ (dolist (elt (package--alist))
+ (condition-case err
+ (package-activate (car elt))
+ ;; Don't let failure of activation of a package arbitrarily stop
+ ;; activation of further packages.
+ (error (message "%s" (error-message-string err))))))))
;;;; Populating `package-archive-contents' from archives
;; This subsection populates the variables listed above from the
@@ -2129,7 +2134,10 @@ Otherwise return nil."
(when str
(when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
(setq str (substring str (match-end 0))))
- (if (version-to-list str) str)))
+ (let ((l (version-to-list str)))
+ ;; Don't return `str' but (package-version-join (version-to-list str))
+ ;; to make sure we use a "canonical name"!
+ (if l (package-version-join l)))))
(declare-function lm-homepage "lisp-mnt" (&optional file))
@@ -4065,6 +4073,7 @@ activations need to be changed, such as when `package-load-list' is modified."
;; FIXME: Delay refresh in case we're installing/deleting
;; several packages!
(package-quickstart-refresh)
+ (delete-file (concat package-quickstart-file "c"))
(delete-file package-quickstart-file)))
(defun package-quickstart-refresh ()
@@ -4120,10 +4129,10 @@ activations need to be changed, such as when `package-load-list' is modified."
(insert "
;; Local\sVariables:
;; version-control: never
-;;\sno-byte-compile: t
;; no-update-autoloads: t
;; End:
-"))))
+"))
+ (byte-compile-file package-quickstart-file)))
(defun package--imenu-prev-index-position-function ()
"Move point to previous line in package-menu buffer.
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 4656277ea16..d91a33c1403 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -317,7 +317,7 @@ list."
;;;###autoload
(cl-defgeneric seq-filter (pred sequence)
- "Return a list of all the elements for which (PRED element) is non-nil in SEQUENCE."
+ "Return a list of all elements for which (PRED element) is non-nil in SEQUENCE."
(let ((exclude (make-symbol "exclude")))
(delq exclude (seq-map (lambda (elt)
(if (funcall pred elt)
@@ -411,7 +411,8 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
nil))
(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
- "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order.
+ "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements.
+This does not depend on the order of the elements.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn)) sequence1)
(seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn)) sequence2)))
@@ -444,7 +445,7 @@ The result is a sequence of type TYPE, or a list if TYPE is nil."
(seq-map function sequence)))
(cl-defgeneric seq-partition (sequence n)
- "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
+ "Return list of elements of SEQUENCE grouped into sub-sequences of length N.
The last sequence may contain less than N elements. If N is a
negative integer or 0, nil is returned."
(unless (< n 1)
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index f525ea433ad..28458847cc2 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -67,6 +67,7 @@ Level :debug is ignored by default (see `warning-minimum-level').")
Each element looks like (ALIAS . LEVEL) and defines ALIAS as
equivalent to LEVEL. LEVEL must be defined in `warning-levels';
it may not itself be an alias.")
+(make-obsolete-variable 'warning-level-aliases 'warning-levels "28.1")
(define-obsolete-variable-alias 'display-warning-minimum-level
'warning-minimum-level "28.1")
@@ -256,8 +257,10 @@ entirely by setting `warning-suppress-types' or
(setq level :warning))
(unless buffer-name
(setq buffer-name "*Warnings*"))
- (if (assq level warning-level-aliases)
- (setq level (cdr (assq level warning-level-aliases))))
+ (with-suppressed-warnings ((obsolete warning-level-aliases))
+ (when-let ((new (cdr (assq level warning-level-aliases))))
+ (warn "Warning level `%s' is obsolete; use `%s' instead" level new)
+ (setq level new)))
(or (< (warning-numeric-level level)
(warning-numeric-level warning-minimum-log-level))
(warning-suppress-p type warning-suppress-log-types)
generated by cgit v1.2.3 (git 2.39.1) at 2025-06-01 17:45:38 +0000