[elpa] elpa-admin 771de7d250: elpa-admin.el: Add support for non-fast-forward syncs

[Stefan Monnier]

branch: elpa-admin
commit 771de7d2500d197055703582c945348957c515dd
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    elpa-admin.el: Add support for non-fast-forward syncs
    
    * elpa-admin.el (elpaa--fetch): Don't stop at diversion when `:merge`
    is specified.  Signal an error in branch suspected of being redundant.
    (elpaa--merge): New function.
    (elpaa--push): Obey `:merge`.
---
 README        |  6 +++++
 elpa-admin.el | 77 +++++++++++++++++++++++++++++++++++++++++++----------------
 2 files changed, 62 insertions(+), 21 deletions(-)

diff --git a/README b/README
index 4ff305047a..a61c4f2b59 100644
--- a/README
+++ b/README
@@ -168,6 +168,12 @@ this ORIG-VERSION (or REMAPPED-VERSION if non-nil) to 
override
 the default heuristic which uses the last revision that modified the
 "Version:" header.
 
+** =:merge BOOL=
+If non-nil, this setting indicates that syncs from upstream should use 
automatic
+merges instead of fast-forwards.
+This only works for the main branch, not for the release branch.
+An unnecessary =:merge= setting is considered as an error.
+
 * Configuration (elpa-config)
 
 The configuration file is a `lisp-data-mode` file containing
diff --git a/elpa-admin.el b/elpa-admin.el
index dfe3d6bc19..ab6587dbca 100644
--- a/elpa-admin.el
+++ b/elpa-admin.el
@@ -1061,7 +1061,7 @@ Signal an error if the command did not finish with exit 
code 0."
 ;; Some packages use version numbers which `version-to-list' doesn't
 ;; recognize out of the box.  So here we help.
 
-;; (defvar version-regexp-alist version-regexp-alist) ;; Make it writable!
+(defvar version-regexp-alist version-regexp-alist) ;; Make it writable!
 (add-to-list 'version-regexp-alist '("^[-.+ ]*beta-?$" . -2)) ;"1.0.0-beta-3"
 (add-to-list 'version-regexp-alist '("^[-.+ ]*dev$" . -4))    ;2.5-dev
 
@@ -2327,8 +2327,9 @@ relative to elpa root."
          ((zerop (elpaa--call t "git" "merge-base" "--is-ancestor"
                               urtb ortb))
           (message "Nothing new upstream for %s" pkg))
-         ((not (zerop (elpaa--call t "git" "merge-base" "--is-ancestor"
-                                   ortb urtb)))
+         ((not (or (zerop (elpaa--call t "git" "merge-base" "--is-ancestor"
+                                       ortb urtb))
+                   (elpaa--spec-get pkg-spec :merge)))
           (message "Upstream of %s has DIVERGED!\n" pkg)
           (when show-diverged
             (elpaa--call t "git" "log"
@@ -2345,16 +2346,42 @@ relative to elpa root."
                                    (format "%s..%s" ortb urtb))))
           (message "Log error for %s:\n%s" pkg (buffer-string)))
          ((eq (point-min) (point-max))
-          (message "No pending upstream changes for %s" pkg))
+          (message "No pending upstream changes for %s" pkg)
+          (error "Empty log but there is something upstream!?\n%S\n%S"
+                 pkg-spec (buffer-string)))
          (t (message "%s" (buffer-string))
             (when k (funcall k pkg-spec))))))))
 
+(defun elpaa--merge (pkg-spec urtb ortb)
+  "Return the merge branch, or nil upon failure."
+  (if (not (file-directory-p "packages"))
+      (progn
+        (message "Can't find the 'packages' directory in: %S"
+                 default-directory)
+        nil)
+    (let* ((pkg (car pkg-spec))
+           (wt (expand-file-name pkg "packages"))
+           (merge-branch (concat "elpa--merge/" pkg)))
+      (if (file-directory-p wt)
+          (progn (message "Worktree exists already for merge of %S" pkg)
+                 nil)
+        (when (elpaa--git-branch-p (concat "refs/heads/" merge-branch))
+          (elpaa--call t "git" "branch" "-D" merge-branch))
+        (unwind-protect
+            (progn
+              (elpaa--call t "git" "worktree" "add" "-b" merge-branch wt ortb)
+              (let ((default-directory (file-name-as-directory wt)))
+                (when (zerop (elpaa--call t "git" "merge" urtb))
+                  merge-branch)))
+          (elpaa--call t "git" "worktree" "remove" "--force" wt))))))
+
 (defun elpaa--push (pkg-spec)
   (let* ((pkg (car pkg-spec))
          (release-branch (elpaa--spec-get pkg-spec :release-branch))
          (ortb (elpaa--ortb pkg-spec))
          (ortb-p (elpaa--git-branch-p ortb))
-         (urtb (elpaa--urtb pkg-spec)))
+         (urtb (elpaa--urtb pkg-spec))
+         (merge (elpaa--spec-get pkg-spec :merge)))
     ;; FIXME: Arrange to merge if it's not a fast-forward.
     (with-temp-buffer
       (cond
@@ -2362,23 +2389,31 @@ relative to elpa root."
              (zerop (elpaa--call t "git" "merge-base"
                                  "--is-ancestor" urtb ortb)))
         (message "Nothing to push for %s" pkg))
-       ((and ortb-p
-             (not (zerop (elpaa--call t "git" "merge-base" "--is-ancestor"
-                                      ortb urtb)))
-             (elpaa--git-branch-p ortb))
-        (message "Can't push %s: not a fast-forward" pkg))
-       ((equal 0 (apply #'elpaa--call
-                        t "git" "push" "--set-upstream"
-                        "origin"
-                        (format "%s:refs/heads/%s%s"
-                                urtb elpaa--branch-prefix pkg)
-                        (when release-branch
-                          (list
-                           (format "%s:refs/heads/%s%s"
-                                   (elpaa--urtb pkg-spec "release")
-                                   elpaa--release-branch-prefix pkg)))))
+       ((xor (and ortb-p
+                  (not (zerop (elpaa--call t "git" "merge-base" "--is-ancestor"
+                                           ortb urtb))))
+             merge)
+        (if merge
+            (message "Error: ':merge' used when not needed: %S\n%S"
+                     pkg (buffer-substring))
+          (message "Can't push %s: not a fast-forward" pkg)))
+       ((when merge
+          ;; FIXME: This only handles merges on the devel branch.
+          (not (setq urtb (elpaa--merge pkg-spec urtb ortb))))
+        (message "Merge failure for %S:\n%S" pkg
+                 (buffer-string)))
+       ((zerop (apply #'elpaa--call
+                      t "git" "push" "--set-upstream"
+                      "origin"
+                      (format "%s:refs/heads/%s%s"
+                              urtb elpaa--branch-prefix pkg)
+                      (when release-branch
+                        (list
+                         (format "%s:refs/heads/%s%s"
+                                 (elpaa--urtb pkg-spec "release")
+                                 elpaa--release-branch-prefix pkg)))))
         (message "Pushed %s successfully:\n%s" pkg (buffer-string))
-        (when (file-directory-p (expand-file-name (car pkg-spec) "packages"))
+        (when (file-directory-p (expand-file-name pkg "packages"))
           (elpaa--worktree-sync pkg-spec)))
        (t
         (message "Push error for %s:\n%s" pkg (buffer-string)))))))