diff options
| -rw-r--r-- | lisp/km-magit.el | 70 |
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) |