mirror of
https://github.com/masscollaborationlabs/emacs.git
synced 2025-07-17 17:29:30 +00:00
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:
parent
a52cec7b6b
commit
30f1e7c1e9
3 changed files with 94 additions and 29 deletions
|
@ -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))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue