Extract last source package release from local VCS data

* lisp/emacs-lisp/package-vc.el (package-vc-archive-spec-alist):
Unmention :release-rev
(package-vc-desc->spec): Fall back on other archives if a
specification is missing.
(package-vc-main-file): Add new function, copying the behaviour of
elpa-admin.el.
(package-vc-generate-description-file): Use 'package-vc-main-file'.
(package-vc-unpack): Handle special value ':last-release'.
(package-vc-release-rev): Add new function using 'last-change'.
(package-vc-install): Pass ':last-release' as REV instead of a
release.
* lisp/vc/vc-git.el (vc-git-last-change): Add Git 'last-change'
implementation.
* lisp/vc/vc.el (vc-default-last-change): Add default 'last-change'
implementation.

This attempts to replicate the behaviour of elpa-admin.el's
"elpaa--get-last-release-commit".
This commit is contained in:
Philip Kaludercic 2022-10-30 11:43:11 +01:00
parent a52cec7b6b
commit 30f1e7c1e9
3 changed files with 94 additions and 29 deletions

View file

@ -139,12 +139,6 @@ The main file of the project, relevant to gather package
metadata. If not given, the assumed default is the package named
with \".el\" concatenated to the end.
`:release-rev' (string)
A revision string indicating the revision used for the current
release in the package archive. If missing or nil, no release
was made.
`:vc-backend' (symbol)
A symbol indicating what the VC backend to use for cloning a
@ -179,8 +173,10 @@ The optional argument NAME can be used to override the default
name for PKG-DESC."
(alist-get
(or name (package-desc-name pkg-desc))
(alist-get (intern (package-desc-archive pkg-desc))
package-vc-archive-spec-alist)
(if (package-desc-archive pkg-desc)
(alist-get (intern (package-desc-archive pkg-desc))
package-vc-archive-spec-alist)
(mapcan #'append (mapcar #'cdr package-vc-archive-spec-alist)))
nil nil #'string=))
(define-inline package-vc-query-spec (pkg-desc prop)
@ -258,6 +254,20 @@ asynchronously."
return it
finally return "0"))
(defun package-vc-main-file (pkg-desc)
"Return the main file for PKG-DESC."
(cl-assert (package-vc-p pkg-desc))
(let ((pkg-spec (package-vc-desc->spec pkg-desc)))
(or (plist-get pkg-spec :main-file)
(expand-file-name
(format "%s.el" (package-desc-name pkg-desc))
(file-name-concat
(or (package-desc-dir pkg-desc)
(expand-file-name
(package-desc-name pkg-desc)
package-user-dir))
(plist-get pkg-spec :lisp-dir))))))
(defun package-vc-generate-description-file (pkg-desc pkg-file)
"Generate a package description file for PKG-DESC.
The output is written out into PKG-FILE."
@ -265,18 +275,13 @@ The output is written out into PKG-FILE."
;; Infer the subject if missing.
(unless (package-desc-summary pkg-desc)
(setf (package-desc-summary pkg-desc)
(or (package-desc-summary pkg-desc)
(and-let* ((pkg (cadr (assq name package-archive-contents))))
(package-desc-summary pkg))
(and-let* ((pkg-spec (package-vc-desc->spec pkg-desc))
(main-file (plist-get pkg-spec :main-file)))
(lm-summary main-file))
(and-let* ((main-file (expand-file-name
(format "%s.el" name)
(package-desc-dir pkg-desc)))
((file-exists-p main-file)))
(lm-summary main-file))
package--default-summary)))
(let ((main-file (package-vc-main-file pkg-desc)))
(or (package-desc-summary pkg-desc)
(and-let* ((pkg (cadr (assq name package-archive-contents))))
(package-desc-summary pkg))
(and main-file (file-exists-p main-file)
(lm-summary main-file))
package--default-summary))))
(let ((print-level nil)
(print-quoted t)
(print-length nil))
@ -424,9 +429,16 @@ the `:brach' attribute in PKG-SPEC."
nil nil #'string=)
:vc-backend)
package-vc-default-backend)))
(unless (vc-clone url backend repo-dir (or rev branch))
(unless (vc-clone url backend repo-dir
(or (and (not (eq rev :last-release)) rev) branch))
(error "Failed to clone %s from %s" name url))))
;; Check out the latest release if requested
(when (eq rev :last-release)
(if-let ((release-rev (package-vc-release-rev pkg-desc)))
(vc-retrieve-tag pkg-dir release-rev)
(message "No release revision was found, continuing...")))
(unless (eq pkg-dir repo-dir)
;; Link from the right position in `repo-dir' to the package
;; directory in the ELPA store.
@ -466,6 +478,22 @@ the `:brach' attribute in PKG-SPEC."
(unless package-vc-archive-data-alist
(package-vc--download-and-read-archives)))
(defun package-vc-release-rev (pkg-desc)
"Find the latest revision that bumps the \"Version\" tag for PKG-DESC.
If no such revision can be found, return nil."
(with-current-buffer (find-file-noselect (package-vc-main-file pkg-desc))
(vc-buffer-sync)
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t))
(when (re-search-forward (concat (lm-get-header-re "version") ".*$")
(lm-code-start) t)
(ignore-error vc-not-supported
(vc-call-backend (vc-backend (buffer-file-name))
'last-change
(match-beginning 0)
(match-end 0))))))))
;;;###autoload
(defun package-vc-install (name-or-url &optional name rev backend)
"Fetch the source of NAME-OR-URL.
@ -477,9 +505,11 @@ NAME-OR-URL is taken to be a package name, and the package
metadata will be consulted for the URL. An explicit revision can
be requested using REV. If the command is invoked with a prefix
argument, the revision used for the last release in the package
archive is used. If a NAME-OR-URL is a URL, that is to say a
string, the VC backend used to clone the repository can be set by
BACKEND. If missing, `package-vc-guess-backend' will be used."
archive is used. This can also be reproduced by passing the
special value `:last-release' as REV. If a NAME-OR-URL is a URL,
that is to say a string, the VC backend used to clone the
repository can be set by BACKEND. If missing,
`package-vc-guess-backend' will be used."
(interactive
(progn
;; Initialize the package system to get the list of package
@ -490,11 +520,7 @@ BACKEND. If missing, `package-vc-guess-backend' will be used."
"Fetch package source (name or URL): " packages))
(name (file-name-base input)))
(list input (intern (string-remove-prefix "emacs-" name))
(and current-prefix-arg
(or (package-vc-query-spec
(cadr (assoc input package-archive-contents #'string=))
:release-rev)
(user-error "No release revision was found")))))))
(and current-prefix-arg :last-release)))))
(package-vc--archives-initialize)
(cond
((and-let* ((stringp name-or-url)
@ -511,6 +537,10 @@ BACKEND. If missing, `package-vc-guess-backend' will be used."
(setf (package-desc-kind copy) 'vc)
copy)
(or (package-vc-desc->spec (cadr desc))
(and-let* ((extras (package-desc-extras (cadr desc)))
(url (alist-get :url extras))
(backend (package-vc-guess-backend url)))
(list :vc-backend backend :url url))
(user-error "Package has no VC data"))
rev)))
((user-error "Unknown package to fetch: %s" name-or-url))))