b4: Ask caller about branch and base for am

The function for generating the default branch name may need to be
tweaked to give useful suggestions in practice.  Let's see.

1 files changed, 135 insertions, 23 deletions

diff --git a/piem-b4.el b/piem-b4.el
index bbd7cb2..6698348 100644
--- a/piem-b4.el
+++ b/piem-b4.el
@@ -27,6 +27,8 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'mail-extr)
+(require 'message)
 (require 'piem)
 (require 'subr-x)
 (require 'transient)
@@ -53,6 +55,22 @@
   "Whether to use Magit where possible."
   :type 'boolean)
 
+(defcustom piem-b4-default-branch-function
+  #'piem-b4-name-branch-who-what-v
+  "Function that generates the default branch on completion.
+
+The function is called with one argument, a plist that contains
+the following information about the patch series:
+
+  :date
+  :from
+  :subject
+      The date, sender, and subject of the cover letter, if any, or of
+      the first patch otherwise.
+  :base-commit
+      The reported base commit of the patch, if any."
+  :type 'boolean)
+
 
 ;;; Internals
 
@@ -78,11 +96,92 @@
 (defun piem-b4--call-git (infile &rest args)
   (apply #'piem-b4--call piem-b4-git-executable infile args))
 
+(defun piem-b4--series-info (cover patches)
+  "Collect information for a patch series.
+COVER is an mbox with the cover letter, and PATCHES is an
+am-ready mbox.  If the series does not have a cover letter (e.g.,
+a one-patch series), COVER may be nil."
+  (with-temp-buffer
+    (insert-file-contents (or cover patches))
+    (let ((info (save-restriction
+                  (message-narrow-to-headers)
+                  (list :date (message-fetch-field "date")
+                        :from (message-fetch-field "from")
+                        :subject (message-fetch-field "subject")))))
+      (when (re-search-forward (rx line-start "base-commit: "
+                                   (group (>= 40 hex-digit))
+                                   line-end)
+                               nil t)
+        (plist-put info :base-commit (match-string 1)))
+      info)))
+
+(defun piem-b4--shorten-subject (subject)
+  (let ((words
+         (mapcar #'downcase
+                 (split-string
+                  (thread-last subject
+                    (replace-regexp-in-string
+                     (rx (any "'\""))
+                     "")
+                    (replace-regexp-in-string
+                     (rx string-start (zero-or-more space) "["
+                         (zero-or-more (not (any "]" "\n")))
+                         "PATCH"
+                         (zero-or-more (not (any "]" "\n")))
+                         "]" (one-or-more space))
+                     ""))
+                  "\\W+" t)))
+        (ignore-these (list "a" "an" "the"))
+        (num-words 0)
+        (num-chars 0)
+        kept)
+    (catch 'stop
+      (dolist (word words)
+        (when (not (member word ignore-these))
+          (cl-incf num-words)
+          (cl-incf num-chars (length word))
+          (push word kept)
+          (when (or (> num-words 5)
+                    (> num-chars 20))
+            (throw 'stop nil)))))
+    (mapconcat #'identity (reverse kept) "-")))
+
+(defun piem-b4-name-branch-who-what-v (info)
+  "Construct a branch name like \"km/b4-short-subj__v3\".
+
+In the above example, \"k\" and \"m\" are the first letters of
+the first and second \"words\" in the \"From:\" field.
+\"b4-short-subj\" is a stripped down, truncated variant of
+\"Subject:\".  And \"v3\" is the version of the patch series, as
+indicated in the subject.
+
+INFO is a plist with properties documented
+in `piem-b4-default-branch-function'."
+  (when-let ((sender (car (mail-extract-address-components
+                           (plist-get info :from))))
+             (subject (plist-get info :subject)))
+    (let* ((subnames (split-string sender))
+           (initials (mapconcat
+                      (lambda (subname)
+                        (and subname
+                             (downcase (substring subname nil 1))))
+                      (list (car subnames) (cadr subnames))
+                      ""))
+           (version (and (string-match
+                          (rx "[" (zero-or-more (not (any "[" "\n")))
+                              "PATCH "
+                              (zero-or-one (group "v" (one-or-more digit))))
+                          subject)
+                         (match-string 1 subject))))
+      (concat initials "/"
+              (piem-b4--shorten-subject subject)
+              (and version (concat "__" version))))))
+
 ;; In many cases, we don't really need b4 to download the mbox for us,
 ;; as we already have our own mbox to URL mapping.  Perhaps we should
 ;; default to using that, but it should still be an option to use b4
 ;; so that we honor its customization/URL resolution.
-(defun piem-b4--get-mbox-file (mid coderepo args)
+(defun piem-b4--get-am-files (mid coderepo args)
   (let* ((outdir (file-name-as-directory
                   (make-temp-file "piem-b4-" t)))
          (root (concat outdir "m"))
@@ -103,10 +202,13 @@
              (concat "--outdir=" outdir)
              (concat "--mbox-name=m")
              (append args (list mid))))
-    (let ((mbox-am (concat root ".mbx")))
-      (if (file-exists-p mbox-am)
-          mbox-am
-        (error "Expected mbox file does not exist: %s" mbox-am)))))
+    (let ((mbox-cover (concat root ".cover"))
+          (mbox-am (concat root ".mbx")))
+      (list (and (file-exists-p mbox-cover)
+                 mbox-cover)
+            (if (file-exists-p mbox-am)
+                mbox-am
+              (error "Expected mbox file does not exist: %s" mbox-am))))))
 
 
 ;;; Commands
@@ -140,25 +242,35 @@
                              (match-string 1 arg)))
                       args)))
     (user-error "%s is incompatible with this command" badopt))
-  (let* ((coderepo (or (piem-inbox-coderepo)
-                       (and (fboundp 'projectile-relevant-known-projects)
-                            (completing-read
-                             "Project: "
-                             (projectile-relevant-known-projects)))
-                       (and piem-b4-use-magit
-                            (fboundp 'magit-read-repository)
-                            (magit-read-repository))
-                       (read-directory-name "Git repository: ")))
-         (mbox-file (piem-b4--get-mbox-file mid coderepo args))
-         (default-directory coderepo))
-    ;; TODO: From the mbox file (1) search for base commit and (2)
-    ;; gather information to suggest default branch name.
-
-    ;; TODO: Add branch call.  Without base, will need to ask branch
-    ;; name and starting point.  Detached head could be signaled with
-    ;; empty string.
-
+  (pcase-let* ((coderepo (or (piem-inbox-coderepo)
+                             (and (fboundp 'projectile-relevant-known-projects)
+                                  (completing-read
+                                   "Project: "
+                                   (projectile-relevant-known-projects)))
+                             (and piem-b4-use-magit
+                                  (fboundp 'magit-read-repository)
+                                  (magit-read-repository))
+                             (read-directory-name "Git repository: ")))
+               (`(,cover ,mbox-file)
+                (piem-b4--get-am-files mid coderepo args))
+               (info (piem-b4--series-info cover mbox-file))
+               (default-directory coderepo))
     ;; TODO: Optionally do more through Magit.
+    (let ((new-branch (read-string
+                       "New branch (empty for detached): "
+                       (funcall piem-b4-default-branch-function info)))
+          (base (completing-read
+                 "Base commit: "
+                 (let ((cands (and piem-b4-use-magit
+                                   (fboundp 'magit-list-local-branch-names)
+                                   (magit-list-local-branch-names)))
+                       (base (plist-get info :base-commit)))
+                   (if base (cons base cands) cands)))))
+      (apply #'piem-b4--call-git nil "checkout"
+             (append (if (string-empty-p new-branch)
+                         (list "--detach")
+                       (list "-b" new-branch))
+                     (list base))))
     (piem-b4--call-git mbox-file "am" "--scissors")
     (if (and piem-b4-use-magit
              (fboundp 'magit-status-setup-buffer))