branch: elpa-admin
commit 2dc3592bae4bbb66b5a65e54cdfa2dec15abfa18
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Improve support for "subpackages"
Try and provide a bit more support for packages built from the same
branch, such as helm/helm-core. The idea is to try and keep a single
local `elpa/<FOO>` branch (and a single local worktree) for all the
packages coming from the same upstream branch.
* elpa-admin.el (elpaa--get-specs): Turn `:url <PKGNAME>` into
the usual `:url URL` format (and remember the parent in `:parent--package`).
(elpaa--local-branch-name): New function.
(elpaa--get-last-release, elpaa--check-sync-failures, elpaa--push)
(elpaa--publish-package-spec, elpaa--insert-repolinks, elpaa--ortb): Use it.
(elpaa--worktree-sync): Use it. Also, use a symlink for subpackages.
(elpaa--batch-fetch-and): Skip subpackages.
---
elpa-admin.el | 82 ++++++++++++++++++++++++++++++++++++++++-------------------
1 file changed, 56 insertions(+), 26 deletions(-)
diff --git a/elpa-admin.el b/elpa-admin.el
index 69c3a74592..1d4cd0c383 100644
--- a/elpa-admin.el
+++ b/elpa-admin.el
@@ -180,8 +180,20 @@ Delete backup files also."
(elpaa--message "new AC: %S" ac)
(elpaa--write-archive-contents ac dir)))
-(defun elpaa--get-specs ()
- (elpaa--form-from-file-contents elpaa--specs-file))
+(defun elpaa--get-specs (&optional no-follow-links)
+ (let ((specs (elpaa--form-from-file-contents elpaa--specs-file)))
+ (unless no-follow-links
+ (dolist (spec specs)
+ (when (eq :url (nth 1 spec))
+ (let ((url (nth 2 spec)))
+ (when (and url (symbolp url) url)
+ (let ((real-url (elpaa--spec-get (assq url specs) :url)))
+ (if (not (stringp real-url)) ;No subpackages for `:url nil'.
+ (user-error "Invalid :url redirection: %S" spec)
+ (setf (nth 2 spec) real-url)
+ (push url (nthcdr 3 spec))
+ (push :parent--package (nthcdr 3 spec)))))))))
+ specs))
(defun elpaa--spec-get (pkg-spec prop &optional default)
(or (plist-get (cdr pkg-spec) prop) default))
@@ -258,8 +270,8 @@ Assumes that the current worktree holds a snapshot version."
(elpaa--main-file pkg-spec)))
(search-start-rev
(or (if release-branch
- (format "refs/remotes/origin/%s%s"
- elpaa--release-branch-prefix (car pkg-spec)))
+ (format "refs/remotes/origin/%s"
+ (elpaa--local-branch-name pkg-spec t)))
(if (not (equal 0 ;Don't signal an error if call errors
out.
(elpaa--call
(current-buffer)
@@ -653,6 +665,20 @@ returns. Return the selected revision."
"\n\n## The current error output was the following:\n\n"
txt))))))))
+(defun elpaa--local-branch-name (pkg-spec &optional releasep)
+ "Return the name of the branch in which the package is kept.
+This is the name of the branch as used in the (Non)GNU ELPA repository
+as well as in the local clone, not upstream."
+ (format "%s%s"
+ (if (and releasep (elpaa--spec-get pkg-spec :release-branch))
+ elpaa--branch-prefix
+ elpaa--release-branch-prefix)
+ (or (elpaa--spec-get pkg-spec :parent--package)
+ (let ((url (elpaa--spec-get pkg-spec :url)))
+ (if (and url (symbolp url))
+ url
+ (car pkg-spec))))))
+
(defun elpaa--check-sync-failures (pkg-spec metadata)
(let* ((pkg (car pkg-spec))
(basename (format "%s-sync-failure.txt" pkg))
@@ -675,7 +701,7 @@ The archive will not be able to track your code until you
resolve this
problem by (re?)merging the code that's in %S. You can do that
with the following commands:
- git fetch https://git.sv.gnu.org/git/%s %s%s
+ git fetch https://git.sv.gnu.org/git/%s %s
git merge FETCH_HEAD
Of course, feel free to undo the changes it may introduce in the file
@@ -684,7 +710,7 @@ contents: we only need the metadata to indicate that this
commit was merged.
You can consult the latest error output in
[the sync-failure file](%s%s)."
elpaa--gitrepo elpaa--gitrepo
- elpaa--branch-prefix pkg
+ (elpaa--local-branch-name pkg-spec)
elpaa--url basename))))
(defun elpaa--report-build-failure (pkg-spec version destdir txt)
@@ -1041,12 +1067,10 @@ SPECS is the list of package specifications."
elpaa--gitrepo))
(setq rest
(plist-put rest :branch
- (format "%s%s" elpaa--branch-prefix name)))
+ (elpaa--local-branch-name spec)))
(when (plist-get :release-branch rest)
(setq rest (plist-put rest :release-branch
- (format "%s%s"
- elpaa--release-branch-prefix
- name)))))
+ (elpaa--local-branch-name spec t)))))
`(,name :url ,url ,@rest))
(`(,_ :core ,_ . ,_) nil)) ;Not supported in the published specs.
(error (message "Error: %S" err)
@@ -1837,10 +1861,9 @@ arbitrary code."
"gitweb/?p=emacs.git;a=blob;f="))))
(mapcar (lambda (s)
(format s elpaa--gitrepo
- elpaa--branch-prefix
- (car pkg-spec)))
- '("cgit/%s/?h=%s%s"
- "gitweb/?p=%s;a=shortlog;h=refs/heads/%s%s")))))
+ (elpaa--local-branch-name pkg-spec)))
+ '("cgit/%s/?h=%s"
+ "gitweb/?p=%s;a=shortlog;h=refs/heads/%s")))))
(insert (format
(concat (format "<dt>Browse %srepository</dt> <dd>"
(if url "ELPA's " ""))
@@ -2307,12 +2330,17 @@ If WITH-CORE is non-nil, it means we manage :core
packages as well."
"Sync worktree of PKG-SPEC."
(let* ((pkg (car pkg-spec))
(name (format "%s" pkg))
+ (url (nth 2 pkg-spec))
(default-directory (expand-file-name "packages/")))
(unless (file-directory-p default-directory)
(make-directory default-directory))
- (cond ((not (file-exists-p name))
+ (cond ((and url (symbolp url))
+ (unless (file-exists-p name)
+ (message "Symlinking %s to %S" name url)
+ (make-symbolic-link (symbol-name url) name)))
+ ((not (file-exists-p name))
(message "Cloning branch %s:" pkg)
- (let* ((branch (format "%s%s" elpaa--branch-prefix pkg))
+ (let* ((branch (elpaa--local-branch-name pkg-spec))
(add-branches
(lambda ()
(let ((pos (point)))
@@ -2326,9 +2354,7 @@ If WITH-CORE is non-nil, it means we manage :core
packages as well."
(when (elpaa--spec-get pkg-spec :release-branch)
(elpaa--call t "git" "remote" "set-branches"
"--add" "origin"
- (format "%s%s"
- elpaa--release-branch-prefix
- pkg)))
+ (elpaa--local-branch-name pkg-spec t)))
(elpaa--call t "git" "fetch" "origin")))))
(output
@@ -2460,7 +2486,7 @@ If WITH-CORE is non-nil, it means we manage :core
packages as well."
(elpaa-batch-archive-update-worktrees)))
(defun elpaa-batch-archive-update-worktrees (&rest _)
- (let ((specs (elpaa--get-specs))
+ (let ((specs (elpaa--get-specs 'no-follow))
(pkgs command-line-args-left)
(with-core (elpaa--sync-emacs-repo))
msg-done)
@@ -2871,7 +2897,8 @@ relative to elpa root."
"Return our origin remote tracking branch for PKG-SPEC."
;; We can't use the shorthand "origin/%s%s" when we pass it to
;; `git-show-ref'.
- (format "refs/remotes/origin/%s%s" elpaa--branch-prefix (car pkg-spec)))
+ (format "refs/remotes/origin/%s"
+ (elpaa--local-branch-name pkg-spec)))
(defun elpaa--git-branch-p (branch)
"Return non-nil iff BRANCH is an existing branch."
@@ -3019,12 +3046,12 @@ relative to elpa root."
((equal 0 (elpaa--call
t "git" "push" "--set-upstream"
"origin"
- (format "%s:refs/heads/%s%s"
- urtb elpaa--branch-prefix pkg)
+ (format "%s:refs/heads/%s"
+ urtb (elpaa--local-branch-name pkg-spec))
(when release-branch
- (format "%s:refs/heads/%s%s"
+ (format "%s:refs/heads/%s"
(elpaa--urtb pkg-spec "release")
- elpaa--release-branch-prefix pkg))))
+ (elpaa--local-branch-name pkg-spec t)))))
(message "Pushed %s successfully:\n%s" pkg (buffer-string))
(when (file-directory-p (elpaa--pkg-root pkg))
(elpaa--worktree-sync pkg-spec)))
@@ -3032,7 +3059,7 @@ relative to elpa root."
(message "Push error for %s:\n%s" pkg (buffer-string)))))))
(defun elpaa--batch-fetch-and (k)
- (let* ((specs (elpaa--get-specs))
+ (let* ((specs (elpaa--get-specs 'no-follow))
(pkgs (mapcar #'intern command-line-args-left))
(show-diverged (not (cdr pkgs)))
(condition ':)
@@ -3046,6 +3073,9 @@ relative to elpa root."
(dolist (pkg pkgs)
(let* ((pkg-spec (elpaa--get-package-spec pkg specs)))
(cond
+ ((let ((url (elpaa--spec-get pkg-spec :url)))
+ (and url (symbolp url)))
+ nil) ;; Skip "subpackages".
((and all (elpaa--manual-sync-p pkg-spec)) nil) ;Skip.
((or (eq condition ':)
(elpaa--spec-get pkg-spec condition))
