1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-07 15:21:46 +00:00

Introduce new function lm-package-requires

* lisp/emacs-lisp/package.el (package--prepare-dependencies): Move
from here...
* lisp/emacs-lisp/lisp-mnt.el (lm--prepare-package-dependencies):
...to here.
(lm-package-requires): New function.
(package-buffer-info): Use above new function.
* test/lisp/emacs-lisp/lisp-mnt-tests.el
(lm--tests-lm-package-requires): New test.
This commit is contained in:
Stefan Kangas 2023-12-22 23:41:36 +01:00
parent 9cb85e950d
commit bb5399e3cd
3 changed files with 54 additions and 23 deletions

View File

@ -434,6 +434,38 @@ This can be found in an RCS or SCCS header."
header-max t)
(match-string-no-properties 1)))))))
(defun lm--prepare-package-dependencies (deps)
"Turn DEPS into an acceptable list of dependencies.
Any parts missing a version string get a default version string
of \"0\" (meaning any version) and an appropriate level of lists
is wrapped around any parts requiring it."
(cond
((not (listp deps))
(error "Invalid requirement specifier: %S" deps))
(t (mapcar (lambda (dep)
(cond
((symbolp dep) `(,dep "0"))
((stringp dep)
(error "Invalid requirement specifier: %S" dep))
((and (listp dep) (null (cdr dep)))
(list (car dep) "0"))
(t dep)))
deps))))
(declare-function package-read-from-string "package" (str))
(defun lm-package-requires (&optional file)
"Return dependencies listed in file FILE, or current buffer if FILE is nil.
The return value is a list of elements of the form (PACKAGE VERSION)
where PACKAGE is the package name (a symbol) and VERSION is the
package version (a string)."
(require 'package)
(lm-with-file file
(and-let* ((require-lines (lm-header-multiline "package-requires")))
(lm--prepare-package-dependencies
(package-read-from-string (mapconcat #'identity require-lines " "))))))
(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

View File

@ -1149,27 +1149,8 @@ Signal an error if the entire string was not used."
(error "Can't read whole string"))
(end-of-file expr))))
(defun package--prepare-dependencies (deps)
"Turn DEPS into an acceptable list of dependencies.
Any parts missing a version string get a default version string
of \"0\" (meaning any version) and an appropriate level of lists
is wrapped around any parts requiring it."
(cond
((not (listp deps))
(error "Invalid requirement specifier: %S" deps))
(t (mapcar (lambda (dep)
(cond
((symbolp dep) `(,dep "0"))
((stringp dep)
(error "Invalid requirement specifier: %S" dep))
((and (listp dep) (null (cdr dep)))
(list (car dep) "0"))
(t dep)))
deps))))
(declare-function lm-header "lisp-mnt" (header))
(declare-function lm-header-multiline "lisp-mnt" (header))
(declare-function lm-package-requires "lisp-mnt" (header))
(declare-function lm-website "lisp-mnt" (&optional file))
(declare-function lm-keywords-list "lisp-mnt" (&optional file))
(declare-function lm-maintainers "lisp-mnt" (&optional file))
@ -1212,9 +1193,7 @@ boundaries."
(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")))
(package--prepare-dependencies
(package-read-from-string (mapconcat #'identity require-lines " "))))
(lm-package-requires)
:kind 'single
:url website
:keywords keywords

View File

@ -30,6 +30,26 @@
'(("Bob Weiner" . "rsw@gnu.org")
("Mats Lidell" . "matsl@gnu.org")))))
(ert-deftest lm--tests-lm-package-requires ()
(with-temp-buffer
(insert ";; Package-Requires: ((emacs 29.1))")
(should (equal (lm-package-requires) '((emacs 29.1)))))
(with-temp-buffer
(insert ";; Package-Requires: ((emacs \"26.3\") (jsonrpc \"1.0.16\") (flymake \"1.2.1\") (project \"0.9.8\") (xref \"1.6.2\") (eldoc \"1.14.0\") (seq \"2.23\") (external-completion \"0.1\"))")
(should (equal (lm-package-requires)
'((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1")
(project "0.9.8") (xref "1.6.2") (eldoc "1.14.0")
(seq "2.23") (external-completion "0.1")))))
(with-temp-buffer
(insert ";; Package-Requires: ((emacs \"26.3\") (jsonrpc \"1.0.16\") (flymake \"1.2.1\")\n"
";; (project \"0.9.8\") (xref \"1.6.2\") (eldoc \"1.14.0\")\n"
";; (seq \"2.23\") (external-completion \"0.1\"))")
(should (equal (lm-package-requires)
'((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1")
(project "0.9.8") (xref "1.6.2") (eldoc "1.14.0")
(seq "2.23") (external-completion "0.1"))))))
(ert-deftest lm--tests-lm-website ()
(with-temp-buffer
(insert ";; URL: https://example.org/foo")