git-rebase: Add two fixup commands

2 files changed, 65 insertions, 0 deletions

diff --git a/lisp/km-magit.el b/lisp/km-magit.el
index 9544e1d..9fead0f 100644
--- a/lisp/km-magit.el
+++ b/lisp/km-magit.el
@@ -22,6 +22,7 @@
 
 (require 'avy)
 (require 'git-rebase)
+(require 'km-util)
 (require 'magit)
 (require 'projectile)
 
@@ -588,5 +589,58 @@ argument.  Interactively, this can be accessed using the command
   (interactive "P")
   (km/magit-diff-visit-file prev-rev t))
 
+
+;;; Git Rebase mode
+
+(defun km/git-rebase--clean-subject (s)
+  (replace-regexp-in-string
+   (concat "\\`" (regexp-opt '("fixup! " "squash! "))) "" s))
+
+(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.
+If prefix argument SQUASH is non-nil, mark for squashing instead
+of fixing up."
+  (interactive (nconc (km/region-or-buffer-line-bounds)
+                      (list current-prefix-arg)))
+  (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)))))
+
+(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.
+
+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."
+  (interactive (nconc (km/region-or-buffer-line-bounds)
+                      (list current-prefix-arg)))
+  (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))))
+      (pcase-dolist (`(,subj ,line ,marker) dups)
+        (goto-char (1+ (nth 2 (assoc subj roots))))
+        (let ((inhibit-read-only t))
+          (insert (concat line "\n"))
+          (goto-char marker)
+          (delete-region (point-at-bol) (1+ (point-at-eol)))))
+      (unless (equal arg (list 16))
+        (km/git-rebase-fixup-duplicates beg end (equal arg (list 4)))))))
+
 (provide 'km-magit)
 ;;; km-magit.el ends here
diff --git a/lisp/km-util.el b/lisp/km-util.el
index 8957862..40672d7 100644
--- a/lisp/km-util.el
+++ b/lisp/km-util.el
@@ -34,5 +34,16 @@
   (--filter (with-current-buffer it (derived-mode-p mode))
             (buffer-list)))
 
+(defun km/region-or-buffer-line-bounds ()
+  "Return line bounds for region.
+If region is active, return postions that mark the beginning of
+the first line and end of the last line that the region touches.
+If there is no active region, return a the minimum and maximum
+point in the buffer."
+  (if (use-region-p)
+      (list (progn (goto-char (region-beginning)) (point-at-bol))
+            (progn (goto-char (region-end)) (1+ (point-at-eol))))
+    (list (point-min) (point-max))))
+
 (provide 'km-util)
 ;;; km-util.el ends here