summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lisp/km-magit.el70
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)