summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/checkdoc.el141
-rw-r--r--lisp/emacs-lisp/comp-cstr.el13
-rw-r--r--lisp/emacs-lisp/comp.el149
-rw-r--r--lisp/emacs-lisp/find-func.el16
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el47
-rw-r--r--lisp/emacs-lisp/package.el12
6 files changed, 250 insertions, 128 deletions
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index fd25b0f981f..d81eba7e85c 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -290,6 +290,7 @@ made in the style guide relating to order."
Currently, all recognized keywords must be on `finder-known-keywords'."
:version "25.1"
:type 'boolean)
+;;;###autoload(put 'checkdoc-package-keywords-flag 'safe-local-variable #'booleanp)
(defvar checkdoc-style-functions nil
"Hook run after the standard style check is completed.
@@ -308,11 +309,12 @@ problem discovered. This is useful for adding additional checks.")
(defvar checkdoc-diagnostic-buffer "*Style Warnings*"
"Name of warning message buffer.")
-(defcustom checkdoc-verb-check-experimental-flag t
+(defcustom checkdoc-verb-check-experimental-flag nil
"Non-nil means to attempt to check the voice of the doc string.
This check keys off some words which are commonly misused. See the
variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own."
- :type 'boolean)
+ :type 'boolean
+ :version "31.1")
;;;###autoload(put 'checkdoc-verb-check-experimental-flag 'safe-local-variable #'booleanp)
(defvar checkdoc-generate-compile-warnings-flag nil
@@ -346,6 +348,7 @@ See Info node `(elisp) Documentation Tips' for background."
;; (setq checkdoc--argument-missing-flag nil) ; optional
;; (setq checkdoc--disambiguate-symbol-flag nil) ; optional
;; (setq checkdoc--interactive-docstring-flag nil) ; optional
+;; (setq checkdoc-permit-comma-termination-flag t) ; optional
;; (setq checkdoc-verb-check-experimental-flag nil)
;; Then use `M-x find-dired' ("-name '*.el'") and `M-x checkdoc-dired'
@@ -1085,7 +1088,7 @@ Optional argument TAKE-NOTES causes all errors to be logged."
Evaluation is done first so the form will be read before the
documentation is checked. If there is a documentation error, then the display
of what was evaluated will be overwritten by the diagnostic message."
- (interactive)
+ (interactive nil emacs-lisp-mode)
(call-interactively #'eval-defun)
(checkdoc-defun))
@@ -1096,7 +1099,7 @@ Call `error' if the doc string has problems. If NO-ERROR is
non-nil, then do not call error, but call `message' instead.
If the doc string passes the test, then check the function for rogue white
space at the end of each line."
- (interactive)
+ (interactive nil emacs-lisp-mode)
(save-excursion
(beginning-of-defun)
(when (checkdoc--next-docstring)
@@ -2134,7 +2137,7 @@ Examples of recognized abbreviations: \"e.g.\", \"i.e.\", \"cf.\"."
(seq (any "cC") "f") ; cf.
(seq (any "eE") ".g") ; e.g.
(seq (any "iI") "." (any "eE")) ; i.e.
- "a.k.a" "etc" "vs" "N.B"
+ "a.k.a" "etc" "vs" "N.B" "U.S"
;; Some non-standard or less common ones that we
;; might as well accept.
"Inc" "Univ" "misc" "resp")
@@ -2473,25 +2476,33 @@ Code:, and others referenced in the style guide."
(setq
err
(or
- ;; * A footer. Not compartmentalized from lm-verify: too bad.
- ;; The following is partially clipped from lm-verify
+ ;; * Library footer
(save-excursion
(goto-char (point-max))
- (if (not (re-search-backward
- ;; This should match the requirement in
- ;; `package-buffer-info'.
- (concat "^;;; " (regexp-quote (concat fn fe)) " ends here")
- nil t))
- (if (checkdoc-y-or-n-p "No identifiable footer! Add one?")
- (progn
- (goto-char (point-max))
- (insert "\n(provide '" fn ")\n\n;;; " fn fe " ends here\n"))
- (checkdoc-create-error
- (format "The footer should be: (provide '%s)\\n;;; %s%s ends here"
- fn fn fe)
- ;; The buffer may be empty.
- (max (point-min) (1- (point-max)))
- (point-max)))))
+ (let* ((footer-line (lm-package-needs-footer-line)))
+ (if (not (re-search-backward
+ ;; This should match the requirement in
+ ;; `package-buffer-info'.
+ (if footer-line
+ (concat "^;;; " (regexp-quote (concat fn fe)) " ends here")
+ (concat "\n(provide '" fn ")\n"))
+ nil t))
+ (if (checkdoc-y-or-n-p (if footer-line
+ "No identifiable footer! Add one?"
+ "No `provide' statement! Add one?"))
+ (progn
+ (goto-char (point-max))
+ (insert (if footer-line
+ (concat "\n(provide '" fn ")\n\n;;; " fn fe " ends here\n")
+ (concat "\n(provide '" fn ")\n"))))
+ (checkdoc-create-error
+ (if footer-line
+ (format "The footer should be: (provide '%s)\\n;;; %s%s ends here"
+ fn fn fe)
+ (format "The footer should be: (provide '%s)\\n" fn))
+ ;; The buffer may be empty.
+ (max (point-min) (1- (point-max)))
+ (point-max))))))
err))
;; The below checks will not return errors if the user says NO
@@ -2532,14 +2543,18 @@ Code:, and others referenced in the style guide."
"Search between BEG and END for a style error with message text.
Optional arguments BEG and END represent the boundary of the check.
The default boundary is the entire buffer."
- (let ((e nil)
- (type nil))
+ (let ((e nil))
(if (not (or beg end)) (setq beg (point-min) end (point-max)))
(goto-char beg)
- (while (setq type (checkdoc-message-text-next-string end))
+ (while-let ((type (checkdoc-message-text-next-string end)))
(setq e (checkdoc-message-text-engine type)))
e))
+(defvar checkdoc--warning-function-re
+ (rx (or "display-warning" "org-display-warning"
+ "warn" "lwarn"
+ "message-box")))
+
(defun checkdoc-message-text-next-string (end)
"Move cursor to the next checkable message string after point.
Return the message classification.
@@ -2552,6 +2567,7 @@ Argument END is the maximum bounds to search in."
(group
(or (seq (* (or wordchar (syntax symbol)))
"error")
+ (regexp checkdoc--warning-function-re)
(seq (* (or wordchar (syntax symbol)))
(or "y-or-n-p" "yes-or-no-p")
(? "-with-timeout"))
@@ -2559,8 +2575,13 @@ Argument END is the maximum bounds to search in."
(+ (any "\n\t ")))
end t))
(let* ((fn (match-string 1))
- (type (cond ((string-match "error" fn)
- 'error)
+ (type (cond ((string-match "error" fn)
+ 'error)
+ ((string-match (rx bos
+ (regexp checkdoc--warning-function-re)
+ eos)
+ fn)
+ 'warning)
(t 'y-or-n-p))))
(if (string-match "checkdoc-autofix-ask-replace" fn)
(progn (forward-sexp 2)
@@ -2630,30 +2651,33 @@ should not end with a period, and should start with a capital letter.
The function `y-or-n-p' has similar constraints.
Argument TYPE specifies the type of question, such as `error' or `y-or-n-p'."
;; If type is nil, then attempt to derive it.
- (if (not type)
- (save-excursion
- (up-list -1)
- (if (looking-at "(format")
- (up-list -1))
- (setq type
- (cond ((looking-at "(error")
- 'error)
- (t 'y-or-n-p)))))
+ (unless type
+ (save-excursion
+ (up-list -1)
+ (when (looking-at "(format")
+ (up-list -1))
+ (setq type
+ (cond ((looking-at "(error")
+ 'error)
+ ((looking-at
+ (rx "(" (regexp checkdoc--warning-function-re)
+ (syntax whitespace)))
+ 'warning)
+ (t 'y-or-n-p)))))
(let ((case-fold-search nil))
(or
;; From the documentation of the symbol `error':
;; In Emacs, the convention is that error messages start with a capital
;; letter but *do not* end with a period. Please follow this convention
;; for the sake of consistency.
- (if (and (checkdoc--error-bad-format-p)
- (not (checkdoc-autofix-ask-replace
- (match-beginning 1) (match-end 1)
- "Capitalize your message text?"
- (capitalize (match-string 1))
- t)))
- (checkdoc-create-error "Messages should start with a capital letter"
- (match-beginning 1) (match-end 1))
- nil)
+ (when (and (checkdoc--error-bad-format-p)
+ (not (checkdoc-autofix-ask-replace
+ (match-beginning 1) (match-end 1)
+ "Capitalize your message text?"
+ (capitalize (match-string 1))
+ t)))
+ (checkdoc-create-error "Messages should start with a capital letter"
+ (match-beginning 1) (match-end 1)))
;; In general, sentences should have two spaces after the period.
(checkdoc-sentencespace-region-engine (point)
(save-excursion (forward-sexp 1)
@@ -2663,19 +2687,18 @@ Argument TYPE specifies the type of question, such as `error' or `y-or-n-p'."
(save-excursion (forward-sexp 1)
(point)))
;; Here are message type specific questions.
- (if (and (eq type 'error)
- (save-excursion (forward-sexp 1)
- (forward-char -2)
- (looking-at "\\."))
- (not (checkdoc-autofix-ask-replace (match-beginning 0)
- (match-end 0)
- "Remove period from error?"
- ""
- t)))
- (checkdoc-create-error
- "Error messages should *not* end with a period"
- (match-beginning 0) (match-end 0))
- nil)
+ (when (and (eq type 'error)
+ (save-excursion (forward-sexp 1)
+ (forward-char -2)
+ (looking-at "\\."))
+ (not (checkdoc-autofix-ask-replace (match-beginning 0)
+ (match-end 0)
+ "Remove period from error?"
+ ""
+ t)))
+ (checkdoc-create-error
+ "Error messages should *not* end with a period"
+ (match-beginning 0) (match-end 0)))
;; From `(elisp) Programming Tips': "A question asked in the
;; minibuffer with `yes-or-no-p' or `y-or-n-p' should start with
;; a capital letter and end with '?'."
@@ -2828,7 +2851,7 @@ function called to create the messages."
;;;###autoload
(defun checkdoc-package-keywords ()
"Find package keywords that aren't in `finder-known-keywords'."
- (interactive)
+ (interactive nil emacs-lisp-mode)
(require 'finder)
(let ((unrecognized-keys
(cl-remove-if
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 058fc522858..66c44f16835 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -926,15 +926,6 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(> high most-positive-fixnum))
t))))))
-(defun comp-cstr-symbol-p (cstr)
- "Return t if CSTR is certainly a symbol."
- (with-comp-cstr-accessors
- (and (null (range cstr))
- (null (neg cstr))
- (and (or (null (typeset cstr))
- (equal (typeset cstr) '(symbol)))
- (cl-every #'symbolp (valset cstr))))))
-
(defsubst comp-cstr-cons-p (cstr)
"Return t if CSTR is certainly a cons."
(with-comp-cstr-accessors
@@ -965,6 +956,10 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(error "Unknown predicate for type %s" type)))))
t))
+(defun comp-cstr-symbol-p (cstr)
+ "Return t if CSTR is certainly a symbol."
+ (comp-cstr-type-p cstr 'symbol))
+
;; Move to comp.el?
(defsubst comp-cstr-cl-tag-p (cstr)
"Return non-nil if CSTR is a CL tag."
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 947fb06e602..9447f68c362 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -164,6 +164,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
comp--ipa-pure
comp--add-cstrs
comp--fwprop
+ comp--type-check-optim
comp--tco
comp--fwprop
comp--remove-type-hints
@@ -792,21 +793,29 @@ clashes."
:byte-func byte-code)))
(maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)))
-(cl-defmethod comp--spill-lap-function ((form list))
- "Byte-compile FORM, spilling data from the byte compiler."
- (unless (memq (car-safe form) '(lambda closure))
- (signal 'native-compiler-error
- '("Cannot native-compile, form is not a lambda or closure")))
+(defun comp--spill-lap-single-function (function)
+ "Byte-compile FUNCTION, spilling data from the byte compiler."
(unless (comp-ctxt-output comp-ctxt)
(setf (comp-ctxt-output comp-ctxt)
(make-temp-file "comp-lambda-" nil ".eln")))
- (let* ((byte-code (byte-compile form))
+ (let* ((byte-code (byte-compile function))
(c-name (comp-c-func-name "anonymous-lambda" "F")))
- (setf (comp-ctxt-top-level-forms comp-ctxt)
- (list (make-byte-to-native-func-def :name '--anonymous-lambda
- :c-name c-name
- :byte-func byte-code)))
- (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)))
+ (setf (comp-ctxt-top-level-forms comp-ctxt)
+ (list (make-byte-to-native-func-def :name '--anonymous-lambda
+ :c-name c-name
+ :byte-func byte-code)))
+ (maphash #'comp--intern-func-in-ctxt byte-to-native-lambdas-h)))
+
+(cl-defmethod comp--spill-lap-function ((form list))
+ "Byte-compile FORM, spilling data from the byte compiler."
+ (unless (eq (car-safe form) 'lambda)
+ (signal 'native-compiler-error
+ '("Cannot native-compile, form is not a lambda")))
+ (comp--spill-lap-single-function form))
+
+(cl-defmethod comp--spill-lap-function ((fun interpreted-function))
+ "Spill data from the byte compiler for the interpreted-function FUN."
+ (comp--spill-lap-single-function fun))
(defun comp--intern-func-in-ctxt (_ obj)
"Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'."
@@ -2540,26 +2549,29 @@ Return t when one or more block was removed, nil otherwise."
ret t)
finally return ret))
+(defun comp--ssa-function (function)
+ "Port into minimal SSA FUNCTION."
+ (let* ((comp-func function)
+ (ssa-status (comp-func-ssa-status function)))
+ (unless (eq ssa-status t)
+ (cl-loop
+ when (eq ssa-status 'dirty)
+ do (comp--clean-ssa function)
+ do (comp--compute-edges)
+ (comp--compute-dominator-tree)
+ until (null (comp--remove-unreachable-blocks)))
+ (comp--compute-dominator-frontiers)
+ (comp--log-block-info)
+ (comp--place-phis)
+ (comp--ssa-rename)
+ (comp--finalize-phis)
+ (comp--log-func comp-func 3)
+ (setf (comp-func-ssa-status function) t))))
+
(defun comp--ssa ()
- "Port all functions into minimal SSA form."
- (maphash (lambda (_ f)
- (let* ((comp-func f)
- (ssa-status (comp-func-ssa-status f)))
- (unless (eq ssa-status t)
- (cl-loop
- when (eq ssa-status 'dirty)
- do (comp--clean-ssa f)
- do (comp--compute-edges)
- (comp--compute-dominator-tree)
- until (null (comp--remove-unreachable-blocks)))
- (comp--compute-dominator-frontiers)
- (comp--log-block-info)
- (comp--place-phis)
- (comp--ssa-rename)
- (comp--finalize-phis)
- (comp--log-func comp-func 3)
- (setf (comp-func-ssa-status f) t))))
- (comp-ctxt-funcs-h comp-ctxt)))
+ "Port all functions into minimal SSA all functions."
+ (cl-loop for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt)
+ do (comp--ssa-function f)))
;;; propagate pass specific code.
@@ -2802,6 +2814,68 @@ Return t if something was changed."
(comp-ctxt-funcs-h comp-ctxt)))
+;;; Type check optimizer pass specific code.
+
+;; This pass optimize-out unnecessary type checks, that is calls to
+;; `type-of' and corresponding conditional branches.
+;;
+;; This is often advantageous in cases where a function manipulates an
+;; object with several slot accesses like:
+;;
+;; (cl-defstruct foo a b c)
+;; (defun bar (x)
+;; (setf (foo-a x) 3)
+;; (+ (foo-b x) (foo-c x)))
+;;
+;; After x is accessed and type checked once, it's proved to be of type
+;; foo, and no other type checks are required.
+
+;; At present running this pass over the whole Emacs codebase triggers
+;; the optimization of 1972 type checks.
+
+(defun comp--type-check-optim-block (block)
+ "Optimize conditional branches in BLOCK when possible."
+ (cl-loop
+ named in-the-basic-block
+ for insns-seq on (comp-block-insns block)
+ do (pcase insns-seq
+ (`((set ,(and (pred comp-mvar-p) mvar-tested-copy)
+ ,(and (pred comp-mvar-p) mvar-tested))
+ (set ,(and (pred comp-mvar-p) mvar-1)
+ (call type-of ,(and (pred comp-mvar-p) mvar-tested-copy)))
+ (set ,(and (pred comp-mvar-p) mvar-2)
+ (call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag)))
+ (set ,(and (pred comp-mvar-p) mvar-3)
+ (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2)))
+ (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,_bb1 ,bb2))
+ (cl-assert (comp-cstr-imm-vld-p mvar-tag))
+ (when (comp-cstr-type-p mvar-tested (comp-cstr-cl-tag mvar-tag))
+ (comp-log (format "Optimizing conditional branch in function: %s"
+ (comp-func-name comp-func))
+ 3)
+ (setf (car insns-seq) '(comment "optimized by comp--type-check-optim")
+ (cdr insns-seq) `((jump ,bb2))
+ ;; Set the SSA status as dirty so
+ ;; `comp--ssa-function' will remove the unreachable
+ ;; branches later.
+ (comp-func-ssa-status comp-func) 'dirty))))))
+
+(defun comp--type-check-optim (_)
+ "Optimize conditional branches when possible."
+ (cl-loop
+ for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt)
+ for comp-func = f
+ when (>= (comp-func-speed f) 2)
+ do (cl-loop
+ for b being each hash-value of (comp-func-blocks f)
+ do (comp--type-check-optim-block b)
+ finally
+ (progn
+ (when (eq (comp-func-ssa-status f) 'dirty)
+ (comp--ssa-function f))
+ (comp--log-func comp-func 3)))))
+
+
;;; Call optimizer pass specific code.
;; This pass is responsible for the following optimizations:
;; - Call to subrs that are in defined in the C source and are passing through
@@ -3577,14 +3651,13 @@ Search happens in `native-comp-eln-load-path'."
;;;###autoload
(defun native-compile (function-or-file &optional output)
"Compile FUNCTION-OR-FILE into native code.
-This is the synchronous entry-point for the Emacs Lisp native
-compiler. FUNCTION-OR-FILE is a function symbol, a form, or the
-filename of an Emacs Lisp source file. If OUTPUT is non-nil, use
-it as the filename for the compiled object. If FUNCTION-OR-FILE
-is a filename, if the compilation was successful return the
-filename of the compiled object. If FUNCTION-OR-FILE is a
-function symbol or a form, if the compilation was successful
-return the compiled function."
+This is the synchronous entry-point for the Emacs Lisp native compiler.
+FUNCTION-OR-FILE is a function symbol, a form, an interpreted-function,
+or the filename of an Emacs Lisp source file. If OUTPUT is non-nil, use
+it as the filename for the compiled object. If FUNCTION-OR-FILE is a
+filename, if the compilation was successful return the filename of the
+compiled object. If FUNCTION-OR-FILE is a function symbol or a form, if
+the compilation was successful return the compiled function."
(declare (ftype (function ((or string symbol) &optional string)
(or native-comp-function string))))
(comp--native-compile function-or-file nil output))
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index ce783983b77..a320a00608d 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -323,6 +323,8 @@ customizing the candidate completions."
(switch-to-buffer (find-file-noselect (find-library-name library)))
(run-hooks 'find-function-after-hook)))
+(defvar find-function--read-history-library nil)
+
;;;###autoload
(defun read-library-name ()
"Read and return a library name, defaulting to the one near point.
@@ -351,12 +353,14 @@ if non-nil)."
(when (and def (not (test-completion def table)))
(setq def nil))
(completing-read (format-prompt "Library name" def)
- table nil nil nil nil def))
+ table nil nil nil
+ find-function--read-history-library def))
(let ((files (read-library-name--find-files dirs suffixes)))
(when (and def (not (member def files)))
(setq def nil))
(completing-read (format-prompt "Library name" def)
- files nil t nil nil def)))))
+ files nil t nil
+ find-function--read-history-library def)))))
(defun read-library-name--find-files (dirs suffixes)
"Return a list of all files in DIRS that match SUFFIXES."
@@ -575,6 +579,10 @@ is non-nil, signal an error instead."
(let ((func-lib (find-function-library function lisp-only t)))
(find-function-search-for-symbol (car func-lib) nil (cdr func-lib))))
+(defvar find-function--read-history-function nil)
+(defvar find-function--read-history-variable nil)
+(defvar find-function--read-history-face nil)
+
(defun find-function-read (&optional type)
"Read and return an interned symbol, defaulting to the one near point.
@@ -597,7 +605,9 @@ otherwise uses `variable-at-point'."
(list (intern (completing-read
(format-prompt "Find %s" symb prompt-type)
obarray predicate
- 'lambda nil nil (and symb (symbol-name symb)))))))
+ 'lambda nil
+ (intern (format "find-function--read-history-%s" prompt-type))
+ (and symb (symbol-name symb)))))))
(defun find-function-do-it (symbol type switch-fn)
"Find Emacs Lisp SYMBOL in a buffer and display it.
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 8b0494dc5cb..3c7f047d203 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -1,7 +1,6 @@
;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1994, 1997, 2000-2024 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2024 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@thyrsus.com>
;; Maintainer: emacs-devel@gnu.org
@@ -106,8 +105,10 @@
;; * Code line --- exists so Lisp can know where commentary and/or
;; change-log sections end.
;;
-;; * Footer line --- marks end-of-file so it can be distinguished from
-;; an expanded formfeed or the results of truncation.
+;; * Footer line --- marks end-of-file so it can be distinguished
+;; from an expanded formfeed or the results of truncation. This is
+;; required for a package to be installable by package.el in Emacs 29.1
+;; or earlier, but is optional in later versions.
;;; Code:
@@ -467,6 +468,29 @@ package version (a string)."
(lm--prepare-package-dependencies
(package-read-from-string (mapconcat #'identity require-lines " "))))))
+(defun lm-package-needs-footer-line (&optional file)
+ "Return non-nil if package in current buffer needs a footer line.
+
+Footer lines (sometimes referred to as \"terminating comments\") look
+like this:
+
+ ;;; some-cool-package.el ends here
+
+Such lines are required for a package to be installable by package.el in
+Emacs 29.1 or earlier, but are optional in later versions. If the
+package depends on a version of Emacs where package.el requires such
+comments, or if no version requirement is specified, return non-nil.
+
+If optional argument FILE is non-nil, use that file instead of the
+current buffer."
+ (lm-with-file file
+ ;; Starting in Emacs 30.1, avoid warning if the minimum Emacs
+ ;; version is specified as 30.1 or later.
+ (let ((min-emacs (cadar (seq-filter (lambda (x) (eq (car x) 'emacs))
+ (lm-package-requires)))))
+ (or (null min-emacs)
+ (version< min-emacs "30.1")))))
+
(defun lm-keywords (&optional file)
"Return the keywords given in file FILE, or current buffer if FILE is nil.
The return is a `downcase'-ed string, or nil if no keywords
@@ -533,7 +557,6 @@ absent, return nil."
(if (and page (string-match (rx bol "<" (+ nonl) ">" eol) page))
(substring page 1 -1)
page)))
-(defalias 'lm-homepage #'lm-website) ; for backwards-compatibility
;;; Verification and synopses
@@ -552,7 +575,7 @@ says display \"OK\" in temp buffer for files that have no problems.
Optional argument VERBOSE specifies verbosity level.
Optional argument NON-FSF-OK if non-nil means a non-FSF
copyright notice is allowed."
- ;; FIXME: Make obsolete in favor of checkdoc?
+ (declare (obsolete checkdoc "31.1"))
(interactive (list nil nil t))
(let* ((ret (and verbose "Ok"))
name)
@@ -593,11 +616,12 @@ copyright notice is allowed."
((not (lm-code-start))
"Can't find a `Code' section marker")
((progn
- (goto-char (point-max))
- (not
- (re-search-backward
- (rx bol ";;; " (regexp name) " ends here")
- nil t)))
+ (when (lm-package-needs-footer-line)
+ (goto-char (point-max))
+ (not
+ (re-search-backward
+ (rx bol ";;; " (regexp name) " ends here")
+ nil t))))
"Can't find the footer line")
((not (and (lm-copyright-mark) (lm-crack-copyright)))
"Can't find a valid copyright notice")
@@ -663,6 +687,7 @@ Prompts for bug subject TOPIC. Leaves you in a mail buffer."
(define-obsolete-function-alias 'lm-code-mark #'lm-code-start "30.1")
(define-obsolete-function-alias 'lm-commentary-mark #'lm-commentary-start "30.1")
(define-obsolete-function-alias 'lm-history-mark #'lm-history-start "30.1")
+(define-obsolete-function-alias 'lm-homepage #'lm-website "31.1")
(provide 'lisp-mnt)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 53d04b0d5ec..7cae8d68bc0 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1161,6 +1161,7 @@ Signal an error if the entire string was not used."
(declare-function lm-keywords-list "lisp-mnt" (&optional file))
(declare-function lm-maintainers "lisp-mnt" (&optional file))
(declare-function lm-authors "lisp-mnt" (&optional file))
+(declare-function lm-package-needs-footer-line "lisp-mnt" (&optional file))
(defun package-buffer-info ()
"Return a `package-desc' describing the package in the current buffer.
@@ -1180,14 +1181,9 @@ boundaries."
;; requirement for a "footer line" without unduly impacting users
;; on earlier Emacs versions. See Bug#26490 for more details.
(unless (search-forward (concat ";;; " file-name ".el ends here") nil 'move)
- ;; Starting in Emacs 30.1, avoid warning if the minimum Emacs
- ;; version is specified as 30.1 or later.
- (let ((min-emacs (cadar (seq-filter (lambda (x) (eq (car x) 'emacs))
- (lm-package-requires)))))
- (when (or (null min-emacs)
- (version< min-emacs "30.1"))
- (lwarn '(package package-format) :warning
- "Package lacks a terminating comment"))))
+ (when (lm-package-needs-footer-line)
+ (lwarn '(package package-format) :warning
+ "Package lacks a terminating comment")))
;; Try to include a trailing newline.
(forward-line)
(narrow-to-region start (point))