km-magit: Rework rebase commands for git-rebase.el changes

1 files changed, 48 insertions, 22 deletions

diff --git a/lisp/km-magit.el b/lisp/km-magit.el
index fcb3809..952f785 100644
--- a/lisp/km-magit.el
+++ b/lisp/km-magit.el
@@ -21,6 +21,7 @@
 ;;; Code:
 
 (require 'avy)
+(require 'cl-lib)
 (require 'git-rebase)
 (require 'km-util)
 (require 'magit)
@@ -876,6 +877,21 @@ simple solution that works for me."
   (replace-regexp-in-string
    (concat "\\`" (regexp-opt '("fixup! " "squash! "))) "" s))
 
+(defmacro km/git-rebase-on-each (end &rest body)
+  "Run BODY on each commit action line from point to END.
+The current line will be bound to `rebase-line'.  BODY should
+restore point to the current line."
+  (declare (indent 1) (debug (form body)))
+  (let ((bound (cl-gensym)))
+    `(let ((,bound ,end)
+           rebase-line)
+       (while (and (setq rebase-line (git-rebase-current-line))
+                   (not (or (and ,bound (> (point) ,bound))
+                            (eobp))))
+         (when (oref rebase-line action-type)
+           ,@body)
+         (forward-line)))))
+
 (defun km/git-rebase-fixup-duplicates (beg end &optional squash)
   "Mark sequential lines with same subject as fixup commits.
 With an active region, limit to lines that the region touches.
@@ -888,20 +904,27 @@ of fixing up."
   (save-excursion
     (goto-char beg)
     (let ((prefix (if squash "squash" "fixup"))
-          prev-subj subj)
-      (while (re-search-forward git-rebase-line end t)
-        (setq subj (km/git-rebase--clean-subject
-                    (match-string-no-properties 3)))
-        (when (equal subj prev-subj)
-          (let ((inhibit-read-only t))
-            (replace-match prefix 'fixedcase nil nil 1)))
-        (setq prev-subj subj)))))
+          line prev-subj subj)
+      (km/git-rebase-on-each end
+        (with-slots (action-type target trailer) rebase-line
+          (if (eq action-type 'commit)
+              (progn
+                (setq subj (km/git-rebase--clean-subject trailer))
+                (when (equal subj prev-subj)
+                  (let ((inhibit-read-only t))
+                    (delete-region (point-at-bol) (point-at-eol))
+                    (insert prefix " " target " " subj)))
+                (setq prev-subj subj))
+            (setq prev-subj nil)
+            (setq subj nil)))))))
 
 (defun km/git-rebase-join-repeats (beg end &optional arg)
   "Move repeated subject lines after line of first occurrence.
 
 If region is active, limit to lines that the region touches.
 
+Warning: This will happily cross --rebase-merges branch points.
+
 By default, repeated lines are marked for fixing up.
 With a \\[universal-argument], mark them for squashing instead.
 With a \\[universal-argument] \\[universal-argument], do not mark them at all."
@@ -910,15 +933,17 @@ With a \\[universal-argument] \\[universal-argument], do not mark them at all."
   (save-excursion
     (goto-char beg)
     (let (roots dups)
-      (while (re-search-forward git-rebase-line end t)
-        (let ((subj (km/git-rebase--clean-subject
-                     (match-string-no-properties 3))))
-          (push (list subj (match-string-no-properties 0) (point-marker))
-                (if (assoc subj roots) dups roots))))
+      (km/git-rebase-on-each end
+        (when (eq (oref rebase-line action-type) 'commit)
+          (let ((subj (km/git-rebase--clean-subject
+                       (oref rebase-line trailer))))
+            (push (list subj rebase-line (copy-marker (point-at-eol)))
+                  (if (assoc subj roots) dups roots)))))
       (pcase-dolist (`(,subj ,line ,marker) dups)
         (goto-char (1+ (nth 2 (assoc subj roots))))
         (let ((inhibit-read-only t))
-          (insert (concat line "\n"))
+          (with-slots (action target trailer) line
+            (insert action " " target " " trailer "\n"))
           (goto-char marker)
           (delete-region (point-at-bol) (1+ (point-at-eol)))))
       (unless (equal arg (list 16))
@@ -939,22 +964,23 @@ With a \\[universal-argument] \\[universal-argument], do not mark them at all."
       (save-restriction
         (narrow-to-region (window-start) (window-end))
         (goto-char (point-min))
-        (while (re-search-forward git-rebase-line nil t)
-          (setq pt (point-at-bol))
-          (unless (= pt current-ln)
-            (push pt candidates)))
+        (km/git-rebase-on-each nil
+          (when (eq (oref rebase-line action-type) 'commit)
+            (setq pt (point-at-bol))
+            (unless (= pt current-ln)
+              (push pt candidates))))
         ;; Offer first empty line after last commit as candidate so
         ;; the current commit can be moved to the end.
         (unless (> current-ln (car candidates))
-          (forward-line 1)
-          (push (point-at-bol) candidates))
+          (goto-char (car candidates))
+          (push (1+ (point-at-eol)) candidates))
         (nreverse candidates)))))
 
 (defun km/git-rebase-move-commit ()
   "Move the commit on current line above selected line."
   (interactive)
-  (unless (save-excursion (beginning-of-line)
-                          (looking-at-p git-rebase-line))
+  (unless (eq (oref (git-rebase-current-line) action-type)
+              'commit)
     (user-error "Not on commit line"))
   (avy-with km/git-rebase-move-commit
     (setq avy-action #'km/git-rebase--move-line)