dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

magit-sequence.el (43811B)


      1 ;;; magit-sequence.el --- history manipulation in Magit  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2011-2021  The Magit Project Contributors
      4 ;;
      5 ;; You should have received a copy of the AUTHORS.md file which
      6 ;; lists all contributors.  If not, see http://magit.vc/authors.
      7 
      8 ;; Author: Jonas Bernoulli <jonas@bernoul.li>
      9 ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
     10 
     11 ;; SPDX-License-Identifier: GPL-3.0-or-later
     12 
     13 ;; Magit is free software; you can redistribute it and/or modify it
     14 ;; under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation; either version 3, or (at your option)
     16 ;; any later version.
     17 ;;
     18 ;; Magit is distributed in the hope that it will be useful, but WITHOUT
     19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
     20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
     21 ;; License for more details.
     22 ;;
     23 ;; You should have received a copy of the GNU General Public License
     24 ;; along with Magit.  If not, see http://www.gnu.org/licenses.
     25 
     26 ;;; Commentary:
     27 
     28 ;; Support for Git commands that replay commits and help the user make
     29 ;; changes along the way.  Supports `cherry-pick', `revert', `rebase',
     30 ;; `rebase--interactive' and `am'.
     31 
     32 ;;; Code:
     33 
     34 (require 'magit)
     35 
     36 ;; For `magit-rebase--todo'.
     37 (declare-function git-rebase-current-line "git-rebase" ())
     38 (eval-when-compile
     39   (cl-pushnew 'action-type eieio--known-slot-names)
     40   (cl-pushnew 'action eieio--known-slot-names)
     41   (cl-pushnew 'action-options eieio--known-slot-names)
     42   (cl-pushnew 'target eieio--known-slot-names))
     43 
     44 ;;; Options
     45 ;;;; Faces
     46 
     47 (defface magit-sequence-pick
     48   '((t :inherit default))
     49   "Face used in sequence sections."
     50   :group 'magit-faces)
     51 
     52 (defface magit-sequence-stop
     53   '((((class color) (background light)) :foreground "DarkOliveGreen4")
     54     (((class color) (background dark))  :foreground "DarkSeaGreen2"))
     55   "Face used in sequence sections."
     56   :group 'magit-faces)
     57 
     58 (defface magit-sequence-part
     59   '((((class color) (background light)) :foreground "Goldenrod4")
     60     (((class color) (background dark))  :foreground "LightGoldenrod2"))
     61   "Face used in sequence sections."
     62   :group 'magit-faces)
     63 
     64 (defface magit-sequence-head
     65   '((((class color) (background light)) :foreground "SkyBlue4")
     66     (((class color) (background dark))  :foreground "LightSkyBlue1"))
     67   "Face used in sequence sections."
     68   :group 'magit-faces)
     69 
     70 (defface magit-sequence-drop
     71   '((((class color) (background light)) :foreground "IndianRed")
     72     (((class color) (background dark))  :foreground "IndianRed"))
     73   "Face used in sequence sections."
     74   :group 'magit-faces)
     75 
     76 (defface magit-sequence-done
     77   '((t :inherit magit-hash))
     78   "Face used in sequence sections."
     79   :group 'magit-faces)
     80 
     81 (defface magit-sequence-onto
     82   '((t :inherit magit-sequence-done))
     83   "Face used in sequence sections."
     84   :group 'magit-faces)
     85 
     86 (defface magit-sequence-exec
     87   '((t :inherit magit-hash))
     88   "Face used in sequence sections."
     89   :group 'magit-faces)
     90 
     91 ;;; Common
     92 
     93 ;;;###autoload
     94 (defun magit-sequencer-continue ()
     95   "Resume the current cherry-pick or revert sequence."
     96   (interactive)
     97   (if (magit-sequencer-in-progress-p)
     98       (if (magit-anything-unstaged-p t)
     99           (user-error "Cannot continue due to unstaged changes")
    100         (magit-run-git-sequencer
    101          (if (magit-revert-in-progress-p) "revert" "cherry-pick") "--continue"))
    102     (user-error "No cherry-pick or revert in progress")))
    103 
    104 ;;;###autoload
    105 (defun magit-sequencer-skip ()
    106   "Skip the stopped at commit during a cherry-pick or revert sequence."
    107   (interactive)
    108   (if (magit-sequencer-in-progress-p)
    109       (progn (magit-call-git "reset" "--hard")
    110              (magit-sequencer-continue))
    111     (user-error "No cherry-pick or revert in progress")))
    112 
    113 ;;;###autoload
    114 (defun magit-sequencer-abort ()
    115   "Abort the current cherry-pick or revert sequence.
    116 This discards all changes made since the sequence started."
    117   (interactive)
    118   (if (magit-sequencer-in-progress-p)
    119       (magit-run-git-sequencer
    120        (if (magit-revert-in-progress-p) "revert" "cherry-pick") "--abort")
    121     (user-error "No cherry-pick or revert in progress")))
    122 
    123 (defun magit-sequencer-in-progress-p ()
    124   (or (magit-cherry-pick-in-progress-p)
    125       (magit-revert-in-progress-p)))
    126 
    127 ;;; Cherry-Pick
    128 
    129 (defvar magit-perl-executable "perl"
    130   "The Perl executable.")
    131 
    132 ;;;###autoload (autoload 'magit-cherry-pick "magit-sequence" nil t)
    133 (transient-define-prefix magit-cherry-pick ()
    134   "Apply or transplant commits."
    135   :man-page "git-cherry-pick"
    136   :value '("--ff")
    137   :incompatible '(("--ff" "-x"))
    138   ["Arguments"
    139    :if-not magit-sequencer-in-progress-p
    140    (magit-cherry-pick:--mainline)
    141    ("=s" magit-merge:--strategy)
    142    ("-F" "Attempt fast-forward"               "--ff")
    143    ("-x" "Reference cherry in commit message" "-x")
    144    ("-e" "Edit commit messages"               ("-e" "--edit"))
    145    ("-s" "Add Signed-off-by lines"            ("-s" "--signoff"))
    146    (5 magit:--gpg-sign)]
    147   [:if-not magit-sequencer-in-progress-p
    148    ["Apply here"
    149     ("A" "Pick"    magit-cherry-copy)
    150     ("a" "Apply"   magit-cherry-apply)
    151     ("h" "Harvest" magit-cherry-harvest)
    152     ("m" "Squash"  magit-merge-squash)]
    153    ["Apply elsewhere"
    154     ("d" "Donate"  magit-cherry-donate)
    155     ("n" "Spinout" magit-cherry-spinout)
    156     ("s" "Spinoff" magit-cherry-spinoff)]]
    157   ["Actions"
    158    :if magit-sequencer-in-progress-p
    159    ("A" "Continue" magit-sequencer-continue)
    160    ("s" "Skip"     magit-sequencer-skip)
    161    ("a" "Abort"    magit-sequencer-abort)])
    162 
    163 (transient-define-argument magit-cherry-pick:--mainline ()
    164   :description "Replay merge relative to parent"
    165   :class 'transient-option
    166   :shortarg "-m"
    167   :argument "--mainline="
    168   :reader 'transient-read-number-N+)
    169 
    170 (defun magit-cherry-pick-read-args (prompt)
    171   (list (or (nreverse (magit-region-values 'commit))
    172             (magit-read-other-branch-or-commit prompt))
    173         (transient-args 'magit-cherry-pick)))
    174 
    175 (defun magit--cherry-move-read-args (verb away fn)
    176   (declare (indent defun))
    177   (let ((commits (or (nreverse (magit-region-values 'commit))
    178                      (list (funcall (if away
    179                                         'magit-read-branch-or-commit
    180                                       'magit-read-other-branch-or-commit)
    181                                     (format "%s cherry" (capitalize verb))))))
    182         (current (magit-get-current-branch)))
    183     (unless current
    184       (user-error "Cannot %s cherries while HEAD is detached" verb))
    185     (let ((reachable (magit-rev-ancestor-p (car commits) current))
    186           (msg "Cannot %s cherries that %s reachable from HEAD"))
    187       (pcase (list away reachable)
    188         (`(nil t) (user-error msg verb "are"))
    189         (`(t nil) (user-error msg verb "are not"))))
    190     `(,commits
    191       ,@(funcall fn commits)
    192       ,(transient-args 'magit-cherry-pick))))
    193 
    194 (defun magit--cherry-spinoff-read-args (verb)
    195   (magit--cherry-move-read-args verb t
    196     (lambda (commits)
    197       (magit-branch-read-args
    198        (format "Create branch from %s cherries" (length commits))
    199        (magit-get-upstream-branch)))))
    200 
    201 ;;;###autoload
    202 (defun magit-cherry-copy (commits &optional args)
    203   "Copy COMMITS from another branch onto the current branch.
    204 Prompt for a commit, defaulting to the commit at point.  If
    205 the region selects multiple commits, then pick all of them,
    206 without prompting."
    207   (interactive (magit-cherry-pick-read-args "Cherry-pick"))
    208   (magit--cherry-pick commits args))
    209 
    210 ;;;###autoload
    211 (defun magit-cherry-apply (commits &optional args)
    212   "Apply the changes in COMMITS but do not commit them.
    213 Prompt for a commit, defaulting to the commit at point.  If
    214 the region selects multiple commits, then apply all of them,
    215 without prompting."
    216   (interactive (magit-cherry-pick-read-args "Apply changes from commit"))
    217   (magit--cherry-pick commits (cons "--no-commit" (remove "--ff" args))))
    218 
    219 ;;;###autoload
    220 (defun magit-cherry-harvest (commits branch &optional args)
    221   "Move COMMITS from another BRANCH onto the current branch.
    222 Remove the COMMITS from BRANCH and stay on the current branch.
    223 If a conflict occurs, then you have to fix that and finish the
    224 process manually."
    225   (interactive
    226    (magit--cherry-move-read-args "harvest" nil
    227      (lambda (commits)
    228        (list (let ((branches (magit-list-containing-branches (car commits))))
    229                (pcase (length branches)
    230                  (0 nil)
    231                  (1 (car branches))
    232                  (_ (magit-completing-read
    233                      (format "Remove %s cherries from branch" (length commits))
    234                      branches nil t))))))))
    235   (magit--cherry-move commits branch (magit-get-current-branch) args nil t))
    236 
    237 ;;;###autoload
    238 (defun magit-cherry-donate (commits branch &optional args)
    239   "Move COMMITS from the current branch onto another existing BRANCH.
    240 Remove COMMITS from the current branch and stay on that branch.
    241 If a conflict occurs, then you have to fix that and finish the
    242 process manually."
    243   (interactive
    244    (magit--cherry-move-read-args "donate" t
    245      (lambda (commits)
    246        (list (magit-read-other-branch (format "Move %s cherries to branch"
    247                                               (length commits)))))))
    248   (magit--cherry-move commits (magit-get-current-branch) branch args))
    249 
    250 ;;;###autoload
    251 (defun magit-cherry-spinout (commits branch start-point &optional args)
    252   "Move COMMITS from the current branch onto a new BRANCH.
    253 Remove COMMITS from the current branch and stay on that branch.
    254 If a conflict occurs, then you have to fix that and finish the
    255 process manually."
    256   (interactive (magit--cherry-spinoff-read-args "spinout"))
    257   (magit--cherry-move commits (magit-get-current-branch) branch args
    258                       start-point))
    259 
    260 ;;;###autoload
    261 (defun magit-cherry-spinoff (commits branch start-point &optional args)
    262   "Move COMMITS from the current branch onto a new BRANCH.
    263 Remove COMMITS from the current branch and checkout BRANCH.
    264 If a conflict occurs, then you have to fix that and finish
    265 the process manually."
    266   (interactive (magit--cherry-spinoff-read-args "spinoff"))
    267   (magit--cherry-move commits (magit-get-current-branch) branch args
    268                       start-point t))
    269 
    270 (defun magit--cherry-move (commits src dst args
    271                                    &optional start-point checkout-dst)
    272   (let ((current (magit-get-current-branch)))
    273     (unless (magit-branch-p dst)
    274       (let ((magit-process-raise-error t))
    275         (magit-call-git "branch" dst start-point))
    276       (--when-let (magit-get-indirect-upstream-branch start-point)
    277         (magit-call-git "branch" "--set-upstream-to" it dst)))
    278     (unless (equal dst current)
    279       (let ((magit-process-raise-error t))
    280         (magit-call-git "checkout" dst)))
    281     (if (not src) ; harvest only
    282         (magit--cherry-pick commits args)
    283       (let ((tip (car (last commits)))
    284             (keep (concat (car commits) "^")))
    285         (magit--cherry-pick commits args)
    286         (set-process-sentinel
    287          magit-this-process
    288          (lambda (process event)
    289            (when (memq (process-status process) '(exit signal))
    290              (if (> (process-exit-status process) 0)
    291                  (magit-process-sentinel process event)
    292                (process-put process 'inhibit-refresh t)
    293                (magit-process-sentinel process event)
    294                (cond
    295                 ((magit-rev-equal tip src)
    296                  (magit-call-git "update-ref"
    297                                  "-m" (format "reset: moving to %s" keep)
    298                                  (magit-ref-fullname src)
    299                                  keep tip)
    300                  (if (not checkout-dst)
    301                      (magit-run-git "checkout" src)
    302                    (magit-refresh)))
    303                 (t
    304                  (magit-git "checkout" src)
    305                  (let ((process-environment process-environment))
    306                    (push (format "%s=%s -i -ne '/^pick (%s)/ or print'"
    307                                  "GIT_SEQUENCE_EDITOR"
    308                                  magit-perl-executable
    309                                  (mapconcat #'magit-rev-abbrev commits "|"))
    310                          process-environment)
    311                    (magit-run-git-sequencer "rebase" "-i" keep))
    312                  (when checkout-dst
    313                    (set-process-sentinel
    314                     magit-this-process
    315                     (lambda (process event)
    316                       (when (memq (process-status process) '(exit signal))
    317                         (if (> (process-exit-status process) 0)
    318                             (magit-process-sentinel process event)
    319                           (process-put process 'inhibit-refresh t)
    320                           (magit-process-sentinel process event)
    321                           (magit-run-git "checkout" dst))))))))))))))))
    322 
    323 (defun magit--cherry-pick (commits args &optional revert)
    324   (let ((command (if revert "revert" "cherry-pick")))
    325     (when (stringp commits)
    326       (setq commits (if (string-match-p "\\.\\." commits)
    327                         (split-string commits "\\.\\.")
    328                       (list commits))))
    329     (magit-run-git-sequencer
    330      (if revert "revert" "cherry-pick")
    331      (pcase-let ((`(,merge ,non-merge)
    332                   (-separate 'magit-merge-commit-p commits)))
    333        (cond
    334         ((not merge)
    335          (--remove (string-prefix-p "--mainline=" it) args))
    336         (non-merge
    337          (user-error "Cannot %s merge and non-merge commits at once"
    338                      command))
    339         ((--first (string-prefix-p "--mainline=" it) args)
    340          args)
    341         (t
    342          (cons (format "--mainline=%s"
    343                        (read-number "Replay merges relative to parent: "))
    344                args))))
    345      commits)))
    346 
    347 (defun magit-cherry-pick-in-progress-p ()
    348   ;; .git/sequencer/todo does not exist when there is only one commit left.
    349   (file-exists-p (magit-git-dir "CHERRY_PICK_HEAD")))
    350 
    351 ;;; Revert
    352 
    353 ;;;###autoload (autoload 'magit-revert "magit-sequence" nil t)
    354 (transient-define-prefix magit-revert ()
    355   "Revert existing commits, with or without creating new commits."
    356   :man-page "git-revert"
    357   :value '("--edit")
    358   ["Arguments"
    359    :if-not magit-sequencer-in-progress-p
    360    (magit-cherry-pick:--mainline)
    361    ("-e" "Edit commit message"       ("-e" "--edit"))
    362    ("-E" "Don't edit commit message" "--no-edit")
    363    ("=s" magit-merge:--strategy)
    364    ("-s" "Add Signed-off-by lines"   ("-s" "--signoff"))
    365    (5 magit:--gpg-sign)]
    366   ["Actions"
    367    :if-not magit-sequencer-in-progress-p
    368    ("V" "Revert commit(s)" magit-revert-and-commit)
    369    ("v" "Revert changes"   magit-revert-no-commit)]
    370   ["Actions"
    371    :if magit-sequencer-in-progress-p
    372    ("V" "Continue" magit-sequencer-continue)
    373    ("s" "Skip"     magit-sequencer-skip)
    374    ("a" "Abort"    magit-sequencer-abort)])
    375 
    376 (defun magit-revert-read-args (prompt)
    377   (list (or (magit-region-values 'commit)
    378             (magit-read-branch-or-commit prompt))
    379         (transient-args 'magit-revert)))
    380 
    381 ;;;###autoload
    382 (defun magit-revert-and-commit (commit &optional args)
    383   "Revert COMMIT by creating a new commit.
    384 Prompt for a commit, defaulting to the commit at point.  If
    385 the region selects multiple commits, then revert all of them,
    386 without prompting."
    387   (interactive (magit-revert-read-args "Revert commit"))
    388   (magit--cherry-pick commit args t))
    389 
    390 ;;;###autoload
    391 (defun magit-revert-no-commit (commit &optional args)
    392   "Revert COMMIT by applying it in reverse to the worktree.
    393 Prompt for a commit, defaulting to the commit at point.  If
    394 the region selects multiple commits, then revert all of them,
    395 without prompting."
    396   (interactive (magit-revert-read-args "Revert changes"))
    397   (magit--cherry-pick commit (cons "--no-commit" args) t))
    398 
    399 (defun magit-revert-in-progress-p ()
    400   ;; .git/sequencer/todo does not exist when there is only one commit left.
    401   (file-exists-p (magit-git-dir "REVERT_HEAD")))
    402 
    403 ;;; Patch
    404 
    405 ;;;###autoload (autoload 'magit-am "magit-sequence" nil t)
    406 (transient-define-prefix magit-am ()
    407   "Apply patches received by email."
    408   :man-page "git-am"
    409   :value '("--3way")
    410   ["Arguments"
    411    :if-not magit-am-in-progress-p
    412    ("-3" "Fall back on 3way merge"           ("-3" "--3way"))
    413    (magit-apply:-p)
    414    ("-c" "Remove text before scissors line"  ("-c" "--scissors"))
    415    ("-k" "Inhibit removal of email cruft"    ("-k" "--keep"))
    416    ("-b" "Limit removal of email cruft"      "--keep-non-patch")
    417    ("-d" "Use author date as committer date" "--committer-date-is-author-date")
    418    ("-D" "Use committer date as author date" "--ignore-date")
    419    ("-s" "Add Signed-off-by lines"           ("-s" "--signoff"))
    420    (5 magit:--gpg-sign)]
    421   ["Apply"
    422    :if-not magit-am-in-progress-p
    423    ("m" "maildir"     magit-am-apply-maildir)
    424    ("w" "patches"     magit-am-apply-patches)
    425    ("a" "plain patch" magit-patch-apply)]
    426   ["Actions"
    427    :if magit-am-in-progress-p
    428    ("w" "Continue" magit-am-continue)
    429    ("s" "Skip"     magit-am-skip)
    430    ("a" "Abort"    magit-am-abort)])
    431 
    432 (defun magit-am-arguments ()
    433   (transient-args 'magit-am))
    434 
    435 (transient-define-argument magit-apply:-p ()
    436   :description "Remove leading slashes from paths"
    437   :class 'transient-option
    438   :argument "-p"
    439   :allow-empty t
    440   :reader 'transient-read-number-N+)
    441 
    442 ;;;###autoload
    443 (defun magit-am-apply-patches (&optional files args)
    444   "Apply the patches FILES."
    445   (interactive (list (or (magit-region-values 'file)
    446                          (list (let ((default (magit-file-at-point)))
    447                                  (read-file-name
    448                                   (if default
    449                                       (format "Apply patch (%s): " default)
    450                                     "Apply patch: ")
    451                                   nil default))))
    452                      (magit-am-arguments)))
    453   (magit-run-git-sequencer "am" args "--"
    454                            (--map (magit-convert-filename-for-git
    455                                    (expand-file-name it))
    456                                   files)))
    457 
    458 ;;;###autoload
    459 (defun magit-am-apply-maildir (&optional maildir args)
    460   "Apply the patches from MAILDIR."
    461   (interactive (list (read-file-name "Apply mbox or Maildir: ")
    462                      (magit-am-arguments)))
    463   (magit-run-git-sequencer "am" args (magit-convert-filename-for-git
    464                                       (expand-file-name maildir))))
    465 
    466 ;;;###autoload
    467 (defun magit-am-continue ()
    468   "Resume the current patch applying sequence."
    469   (interactive)
    470   (if (magit-am-in-progress-p)
    471       (if (magit-anything-unstaged-p t)
    472           (error "Cannot continue due to unstaged changes")
    473         (magit-run-git-sequencer "am" "--continue"))
    474     (user-error "Not applying any patches")))
    475 
    476 ;;;###autoload
    477 (defun magit-am-skip ()
    478   "Skip the stopped at patch during a patch applying sequence."
    479   (interactive)
    480   (if (magit-am-in-progress-p)
    481       (magit-run-git-sequencer "am" "--skip")
    482     (user-error "Not applying any patches")))
    483 
    484 ;;;###autoload
    485 (defun magit-am-abort ()
    486   "Abort the current patch applying sequence.
    487 This discards all changes made since the sequence started."
    488   (interactive)
    489   (if (magit-am-in-progress-p)
    490       (magit-run-git "am" "--abort")
    491     (user-error "Not applying any patches")))
    492 
    493 (defun magit-am-in-progress-p ()
    494   (file-exists-p (magit-git-dir "rebase-apply/applying")))
    495 
    496 ;;; Rebase
    497 
    498 ;;;###autoload (autoload 'magit-rebase "magit-sequence" nil t)
    499 (transient-define-prefix magit-rebase ()
    500   "Transplant commits and/or modify existing commits."
    501   :man-page "git-rebase"
    502   :value '("--autostash")
    503   ["Arguments"
    504    :if-not magit-rebase-in-progress-p
    505    ("-k" "Keep empty commits"       "--keep-empty")
    506    ("-p" "Preserve merges"          ("-p" "--preserve-merges"))
    507    (7 magit-merge:--strategy)
    508    (7 magit-merge:--strategy-option)
    509    (7 "=X" magit-diff:--diff-algorithm :argument "-Xdiff-algorithm=")
    510    ("-d" "Lie about committer date" "--committer-date-is-author-date")
    511    ("-a" "Autosquash"               "--autosquash")
    512    ("-A" "Autostash"                "--autostash")
    513    ("-i" "Interactive"              ("-i" "--interactive"))
    514    ("-h" "Disable hooks"            "--no-verify")
    515    (7 magit-rebase:--exec)
    516    (5 magit:--gpg-sign)
    517    (5 "-r" "Rebase merges" "--rebase-merges=" magit-rebase-merges-select-mode)]
    518   [:if-not magit-rebase-in-progress-p
    519    :description (lambda ()
    520                   (format (propertize "Rebase %s onto" 'face 'transient-heading)
    521                           (propertize (or (magit-get-current-branch) "HEAD")
    522                                       'face 'magit-branch-local)))
    523    ("p" magit-rebase-onto-pushremote)
    524    ("u" magit-rebase-onto-upstream)
    525    ("e" "elsewhere" magit-rebase-branch)]
    526   ["Rebase"
    527    :if-not magit-rebase-in-progress-p
    528    [("i" "interactively"      magit-rebase-interactive)
    529     ("s" "a subset"           magit-rebase-subset)]
    530    [("m" "to modify a commit" magit-rebase-edit-commit)
    531     ("w" "to reword a commit" magit-rebase-reword-commit)
    532     ("k" "to remove a commit" magit-rebase-remove-commit)
    533     ("f" "to autosquash"      magit-rebase-autosquash)
    534     (6 "t" "to change dates"  magit-reshelve-since)]]
    535   ["Actions"
    536    :if magit-rebase-in-progress-p
    537    ("r" "Continue" magit-rebase-continue)
    538    ("s" "Skip"     magit-rebase-skip)
    539    ("e" "Edit"     magit-rebase-edit)
    540    ("a" "Abort"    magit-rebase-abort)])
    541 
    542 (transient-define-argument magit-rebase:--exec ()
    543   :description "Run command after commits"
    544   :class 'transient-option
    545   :shortarg "-x"
    546   :argument "--exec="
    547   :reader #'read-shell-command)
    548 
    549 (defun magit-rebase-merges-select-mode (&rest _ignore)
    550   (magit-read-char-case nil t
    551     (?n "[n]o-rebase-cousins" "no-rebase-cousins")
    552     (?r "[r]ebase-cousins" "rebase-cousins")))
    553 
    554 (defun magit-rebase-arguments ()
    555   (transient-args 'magit-rebase))
    556 
    557 (defun magit-git-rebase (target args)
    558   (magit-run-git-sequencer "rebase" args target))
    559 
    560 ;;;###autoload (autoload 'magit-rebase-onto-pushremote "magit-sequence" nil t)
    561 (transient-define-suffix magit-rebase-onto-pushremote (args)
    562   "Rebase the current branch onto its push-remote branch.
    563 
    564 With a prefix argument or when the push-remote is either not
    565 configured or unusable, then let the user first configure the
    566 push-remote."
    567   :if 'magit-get-current-branch
    568   :description 'magit-pull--pushbranch-description
    569   (interactive (list (magit-rebase-arguments)))
    570   (pcase-let ((`(,branch ,remote)
    571                (magit--select-push-remote "rebase onto that")))
    572     (magit-git-rebase (concat remote "/" branch) args)))
    573 
    574 ;;;###autoload (autoload 'magit-rebase-onto-upstream "magit-sequence" nil t)
    575 (transient-define-suffix magit-rebase-onto-upstream (args)
    576   "Rebase the current branch onto its upstream branch.
    577 
    578 With a prefix argument or when the upstream is either not
    579 configured or unusable, then let the user first configure
    580 the upstream."
    581   :if 'magit-get-current-branch
    582   :description 'magit-rebase--upstream-description
    583   (interactive (list (magit-rebase-arguments)))
    584   (let* ((branch (or (magit-get-current-branch)
    585                      (user-error "No branch is checked out")))
    586          (upstream (magit-get-upstream-branch branch)))
    587     (when (or current-prefix-arg (not upstream))
    588       (setq upstream
    589             (magit-read-upstream-branch
    590              branch (format "Set upstream of %s and rebase onto that" branch)))
    591       (magit-set-upstream-branch branch upstream))
    592     (magit-git-rebase upstream args)))
    593 
    594 (defun magit-rebase--upstream-description ()
    595   (when-let ((branch (magit-get-current-branch)))
    596     (or (magit-get-upstream-branch branch)
    597         (let ((remote (magit-get "branch" branch "remote"))
    598               (merge  (magit-get "branch" branch "merge"))
    599               (u (magit--propertize-face "@{upstream}" 'bold)))
    600           (cond
    601            ((magit--unnamed-upstream-p remote merge)
    602             (concat u ", replacing unnamed"))
    603            ((magit--valid-upstream-p remote merge)
    604             (concat u ", replacing non-existent"))
    605            ((or remote merge)
    606             (concat u ", replacing invalid"))
    607            (t
    608             (concat u ", setting that")))))))
    609 
    610 ;;;###autoload
    611 (defun magit-rebase-branch (target args)
    612   "Rebase the current branch onto a branch read in the minibuffer.
    613 All commits that are reachable from `HEAD' but not from the
    614 selected branch TARGET are being rebased."
    615   (interactive (list (magit-read-other-branch-or-commit "Rebase onto")
    616                      (magit-rebase-arguments)))
    617   (message "Rebasing...")
    618   (magit-git-rebase target args)
    619   (message "Rebasing...done"))
    620 
    621 ;;;###autoload
    622 (defun magit-rebase-subset (newbase start args)
    623   "Rebase a subset of the current branch's history onto a new base.
    624 Rebase commits from START to `HEAD' onto NEWBASE.
    625 START has to be selected from a list of recent commits."
    626   (interactive (list (magit-read-other-branch-or-commit
    627                       "Rebase subset onto" nil
    628                       (magit-get-upstream-branch))
    629                      nil
    630                      (magit-rebase-arguments)))
    631   (if start
    632       (progn (message "Rebasing...")
    633              (magit-run-git-sequencer "rebase" "--onto" newbase start args)
    634              (message "Rebasing...done"))
    635     (magit-log-select
    636       `(lambda (commit)
    637          (magit-rebase-subset ,newbase (concat commit "^") (list ,@args)))
    638       (concat "Type %p on a commit to rebase it "
    639               "and commits above it onto " newbase ","))))
    640 
    641 (defvar magit-rebase-interactive-include-selected t)
    642 
    643 (defun magit-rebase-interactive-1
    644     (commit args message &optional editor delay-edit-confirm noassert confirm)
    645   (declare (indent 2))
    646   (when commit
    647     (if (eq commit :merge-base)
    648         (setq commit (--if-let (magit-get-upstream-branch)
    649                          (magit-git-string "merge-base" it "HEAD")
    650                        nil))
    651       (unless (magit-rev-ancestor-p commit "HEAD")
    652         (user-error "%s isn't an ancestor of HEAD" commit))
    653       (if (magit-commit-parents commit)
    654           (when (or (not (eq this-command 'magit-rebase-interactive))
    655                     magit-rebase-interactive-include-selected)
    656             (setq commit (concat commit "^")))
    657         (setq args (cons "--root" args)))))
    658   (when (and commit (not noassert))
    659     (setq commit (magit-rebase-interactive-assert
    660                   commit delay-edit-confirm
    661                   (--some (string-prefix-p "--rebase-merges" it) args))))
    662   (if (and commit (not confirm))
    663       (let ((process-environment process-environment))
    664         (when editor
    665           (push (concat "GIT_SEQUENCE_EDITOR="
    666                         (if (functionp editor)
    667                             (funcall editor commit)
    668                           editor))
    669                 process-environment))
    670         (magit-run-git-sequencer "rebase" "-i" args
    671                                  (unless (member "--root" args) commit)))
    672     (magit-log-select
    673       `(lambda (commit)
    674          ;; In some cases (currently just magit-rebase-remove-commit), "-c
    675          ;; commentChar=#" is added to the global arguments for git.  Ensure
    676          ;; that the same happens when we chose the commit via
    677          ;; magit-log-select, below.
    678          (let ((magit-git-global-arguments (list ,@magit-git-global-arguments)))
    679            (magit-rebase-interactive-1 commit (list ,@args)
    680              ,message ,editor ,delay-edit-confirm ,noassert)))
    681       message)))
    682 
    683 (defvar magit--rebase-published-symbol nil)
    684 (defvar magit--rebase-public-edit-confirmed nil)
    685 
    686 (defun magit-rebase-interactive-assert
    687     (since &optional delay-edit-confirm rebase-merges)
    688   (let* ((commit (magit-rebase--target-commit since))
    689          (branches (magit-list-publishing-branches commit)))
    690     (setq magit--rebase-public-edit-confirmed
    691           (delete (magit-toplevel) magit--rebase-public-edit-confirmed))
    692     (when (and branches
    693                (or (not delay-edit-confirm)
    694                    ;; The user might have stopped at a published commit
    695                    ;; merely to add new commits *after* it.  Try not to
    696                    ;; ask users whether they really want to edit public
    697                    ;; commits, when they don't actually intend to do so.
    698                    (not (--all-p (magit-rev-equal it commit) branches))))
    699       (let ((m1 "Some of these commits have already been published to ")
    700             (m2 ".\nDo you really want to modify them"))
    701         (magit-confirm (or magit--rebase-published-symbol 'rebase-published)
    702           (concat m1 "%s" m2)
    703           (concat m1 "%i public branches" m2)
    704           nil branches))
    705       (push (magit-toplevel) magit--rebase-public-edit-confirmed)))
    706   (if (and (magit-git-lines "rev-list" "--merges" (concat since "..HEAD"))
    707            (not rebase-merges))
    708       (magit-read-char-case "Proceed despite merge in rebase range?  " nil
    709         (?c "[c]ontinue" since)
    710         (?s "[s]elect other" nil)
    711         (?a "[a]bort" (user-error "Quit")))
    712     since))
    713 
    714 (defun magit-rebase--target-commit (since)
    715   (if (string-suffix-p "^" since)
    716       ;; If SINCE is "REV^", then the user selected
    717       ;; "REV", which is the first commit that will
    718       ;; be replaced.  (from^..to] <=> [from..to]
    719       (substring since 0 -1)
    720     ;; The "--root" argument is being used.
    721     since))
    722 
    723 ;;;###autoload
    724 (defun magit-rebase-interactive (commit args)
    725   "Start an interactive rebase sequence."
    726   (interactive (list (magit-commit-at-point)
    727                      (magit-rebase-arguments)))
    728   (magit-rebase-interactive-1 commit args
    729     "Type %p on a commit to rebase it and all commits above it,"
    730     nil t))
    731 
    732 ;;;###autoload
    733 (defun magit-rebase-autosquash (args)
    734   "Combine squash and fixup commits with their intended targets."
    735   (interactive (list (magit-rebase-arguments)))
    736   (magit-rebase-interactive-1 :merge-base
    737       (nconc (list "--autosquash" "--keep-empty") args)
    738     "Type %p on a commit to squash into it and then rebase as necessary,"
    739     "true" nil t))
    740 
    741 ;;;###autoload
    742 (defun magit-rebase-edit-commit (commit args)
    743   "Edit a single older commit using rebase."
    744   (interactive (list (magit-commit-at-point)
    745                      (magit-rebase-arguments)))
    746   (magit-rebase-interactive-1 commit args
    747     "Type %p on a commit to edit it,"
    748     (apply-partially #'magit-rebase--perl-editor 'edit)
    749     t))
    750 
    751 ;;;###autoload
    752 (defun magit-rebase-reword-commit (commit args)
    753   "Reword a single older commit using rebase."
    754   (interactive (list (magit-commit-at-point)
    755                      (magit-rebase-arguments)))
    756   (magit-rebase-interactive-1 commit args
    757     "Type %p on a commit to reword its message,"
    758     (apply-partially #'magit-rebase--perl-editor 'reword)))
    759 
    760 ;;;###autoload
    761 (defun magit-rebase-remove-commit (commit args)
    762   "Remove a single older commit using rebase."
    763   (interactive (list (magit-commit-at-point)
    764                      (magit-rebase-arguments)))
    765   ;; magit-rebase--perl-editor assumes that the comment character is "#".
    766   (let ((magit-git-global-arguments
    767          (nconc (list "-c" "core.commentChar=#")
    768                 magit-git-global-arguments)))
    769     (magit-rebase-interactive-1 commit args
    770       "Type %p on a commit to remove it,"
    771       (apply-partially #'magit-rebase--perl-editor 'remove)
    772       nil nil t)))
    773 
    774 (defun magit-rebase--perl-editor (action since)
    775   (let ((commit (magit-rev-abbrev (magit-rebase--target-commit since))))
    776     (format "%s -i -p -e '++$x if not $x and s/^pick %s/%s %s/'"
    777             magit-perl-executable
    778             commit
    779             (cl-case action
    780               (edit   "edit")
    781               (remove "noop\n# pick")
    782               (reword "reword")
    783               (t      (error "unknown action: %s" action)))
    784             commit)))
    785 
    786 ;;;###autoload
    787 (defun magit-rebase-continue (&optional noedit)
    788   "Restart the current rebasing operation.
    789 In some cases this pops up a commit message buffer for you do
    790 edit.  With a prefix argument the old message is reused as-is."
    791   (interactive "P")
    792   (if (magit-rebase-in-progress-p)
    793       (if (magit-anything-unstaged-p t)
    794           (user-error "Cannot continue rebase with unstaged changes")
    795         (when (and (magit-anything-staged-p)
    796                    (file-exists-p (magit-git-dir "rebase-merge"))
    797                    (not (member (magit-toplevel)
    798                                 magit--rebase-public-edit-confirmed)))
    799           (magit-commit-amend-assert
    800            (magit-file-line (magit-git-dir "rebase-merge/orig-head"))))
    801         (if noedit
    802             (let ((process-environment process-environment))
    803               (push "GIT_EDITOR=true" process-environment)
    804               (magit-run-git-async (magit--rebase-resume-command) "--continue")
    805               (set-process-sentinel magit-this-process
    806                                     #'magit-sequencer-process-sentinel)
    807               magit-this-process)
    808           (magit-run-git-sequencer (magit--rebase-resume-command) "--continue")))
    809     (user-error "No rebase in progress")))
    810 
    811 ;;;###autoload
    812 (defun magit-rebase-skip ()
    813   "Skip the current commit and restart the current rebase operation."
    814   (interactive)
    815   (unless (magit-rebase-in-progress-p)
    816     (user-error "No rebase in progress"))
    817   (magit-run-git-sequencer (magit--rebase-resume-command) "--skip"))
    818 
    819 ;;;###autoload
    820 (defun magit-rebase-edit ()
    821   "Edit the todo list of the current rebase operation."
    822   (interactive)
    823   (unless (magit-rebase-in-progress-p)
    824     (user-error "No rebase in progress"))
    825   (magit-run-git-sequencer "rebase" "--edit-todo"))
    826 
    827 ;;;###autoload
    828 (defun magit-rebase-abort ()
    829   "Abort the current rebase operation, restoring the original branch."
    830   (interactive)
    831   (unless (magit-rebase-in-progress-p)
    832     (user-error "No rebase in progress"))
    833   (magit-confirm 'abort-rebase "Abort this rebase")
    834   (magit-run-git (magit--rebase-resume-command) "--abort"))
    835 
    836 (defun magit-rebase-in-progress-p ()
    837   "Return t if a rebase is in progress."
    838   (or (file-exists-p (magit-git-dir "rebase-merge"))
    839       (file-exists-p (magit-git-dir "rebase-apply/onto"))))
    840 
    841 (defun magit--rebase-resume-command ()
    842   (if (file-exists-p (magit-git-dir "rebase-recursive")) "rbr" "rebase"))
    843 
    844 ;;; Sections
    845 
    846 (defun magit-insert-sequencer-sequence ()
    847   "Insert section for the on-going cherry-pick or revert sequence.
    848 If no such sequence is in progress, do nothing."
    849   (let ((picking (magit-cherry-pick-in-progress-p)))
    850     (when (or picking (magit-revert-in-progress-p))
    851       (magit-insert-section (sequence)
    852         (magit-insert-heading (if picking "Cherry Picking" "Reverting"))
    853         (when-let ((lines
    854                     (cdr (magit-file-lines (magit-git-dir "sequencer/todo")))))
    855           (dolist (line (nreverse lines))
    856             (when (string-match
    857                    "^\\(pick\\|revert\\) \\([^ ]+\\) \\(.*\\)$" line)
    858               (magit-bind-match-strings (cmd hash msg) line
    859                 (magit-insert-section (commit hash)
    860                   (insert (propertize cmd 'font-lock-face 'magit-sequence-pick)
    861                           " " (propertize hash 'font-lock-face 'magit-hash)
    862                           " " msg "\n"))))))
    863         (magit-sequence-insert-sequence
    864          (magit-file-line (magit-git-dir (if picking
    865                                              "CHERRY_PICK_HEAD"
    866                                            "REVERT_HEAD")))
    867          (magit-file-line (magit-git-dir "sequencer/head")))
    868         (insert "\n")))))
    869 
    870 (defun magit-insert-am-sequence ()
    871   "Insert section for the on-going patch applying sequence.
    872 If no such sequence is in progress, do nothing."
    873   (when (magit-am-in-progress-p)
    874     (magit-insert-section (rebase-sequence)
    875       (magit-insert-heading "Applying patches")
    876       (let ((patches (nreverse (magit-rebase-patches)))
    877             patch commit)
    878         (while patches
    879           (setq patch (pop patches))
    880           (setq commit (magit-commit-p
    881                         (cadr (split-string (magit-file-line patch)))))
    882           (cond ((and commit patches)
    883                  (magit-sequence-insert-commit
    884                   "pick" commit 'magit-sequence-pick))
    885                 (patches
    886                  (magit-sequence-insert-am-patch
    887                   "pick" patch 'magit-sequence-pick))
    888                 (commit
    889                  (magit-sequence-insert-sequence commit "ORIG_HEAD"))
    890                 (t
    891                  (magit-sequence-insert-am-patch
    892                   "stop" patch 'magit-sequence-stop)
    893                  (magit-sequence-insert-sequence nil "ORIG_HEAD")))))
    894       (insert ?\n))))
    895 
    896 (defun magit-sequence-insert-am-patch (type patch face)
    897   (magit-insert-section (file patch)
    898     (let ((title
    899            (with-temp-buffer
    900              (insert-file-contents patch nil nil 4096)
    901              (unless (re-search-forward "^Subject: " nil t)
    902                (goto-char (point-min)))
    903              (buffer-substring (point) (line-end-position)))))
    904       (insert (propertize type 'font-lock-face face)
    905               ?\s (propertize (file-name-nondirectory patch)
    906                               'font-lock-face 'magit-hash)
    907               ?\s title
    908               ?\n))))
    909 
    910 (defun magit-insert-rebase-sequence ()
    911   "Insert section for the on-going rebase sequence.
    912 If no such sequence is in progress, do nothing."
    913   (when (magit-rebase-in-progress-p)
    914     (let* ((interactive (file-directory-p (magit-git-dir "rebase-merge")))
    915            (dir  (if interactive "rebase-merge/" "rebase-apply/"))
    916            (name (thread-first (concat dir "head-name")
    917                    magit-git-dir
    918                    magit-file-line))
    919            (onto (thread-first (concat dir "onto")
    920                    magit-git-dir
    921                    magit-file-line))
    922            (onto (or (magit-rev-name onto name)
    923                      (magit-rev-name onto "refs/heads/*") onto))
    924            (name (or (magit-rev-name name "refs/heads/*") name)))
    925       (magit-insert-section (rebase-sequence)
    926         (magit-insert-heading (format "Rebasing %s onto %s" name onto))
    927         (if interactive
    928             (magit-rebase-insert-merge-sequence onto)
    929           (magit-rebase-insert-apply-sequence onto))
    930         (insert ?\n)))))
    931 
    932 (defun magit-rebase--todo ()
    933   "Return `git-rebase-action' instances for remaining rebase actions.
    934 These are ordered in that the same way they'll be sorted in the
    935 status buffer (i.e. the reverse of how they will be applied)."
    936   (let ((comment-start (or (magit-get "core.commentChar") "#"))
    937         lines)
    938     (with-temp-buffer
    939       (insert-file-contents (magit-git-dir "rebase-merge/git-rebase-todo"))
    940       (while (not (eobp))
    941         (let ((ln (git-rebase-current-line)))
    942           (when (oref ln action-type)
    943             (push ln lines)))
    944         (forward-line)))
    945     lines))
    946 
    947 (defun magit-rebase-insert-merge-sequence (onto)
    948   (dolist (line (magit-rebase--todo))
    949     (with-slots (action-type action action-options target) line
    950       (pcase action-type
    951         (`commit
    952          (magit-sequence-insert-commit action target 'magit-sequence-pick))
    953         ((or (or `exec `label)
    954              (and `merge (guard (not action-options))))
    955          (insert (propertize action 'font-lock-face 'magit-sequence-onto) "\s"
    956                  (propertize target 'font-lock-face 'git-rebase-label) "\n"))
    957         (`merge
    958          (if-let ((hash (and (string-match "-[cC] \\([^ ]+\\)" action-options)
    959                              (match-string 1 action-options))))
    960              (magit-insert-section (commit hash)
    961                (magit-insert-heading
    962                  (propertize "merge" 'font-lock-face 'magit-sequence-pick)
    963                  "\s"
    964                  (magit-format-rev-summary hash) "\n"))
    965            (error "failed to parse merge message hash"))))))
    966   (magit-sequence-insert-sequence
    967    (magit-file-line (magit-git-dir "rebase-merge/stopped-sha"))
    968    onto
    969    (--when-let (magit-file-lines (magit-git-dir "rebase-merge/done"))
    970      (cadr (split-string (car (last it)))))))
    971 
    972 (defun magit-rebase-insert-apply-sequence (onto)
    973   (let ((rewritten
    974          (--map (car (split-string it))
    975                 (magit-file-lines (magit-git-dir "rebase-apply/rewritten"))))
    976         (stop (magit-file-line (magit-git-dir "rebase-apply/original-commit"))))
    977     (dolist (patch (nreverse (cdr (magit-rebase-patches))))
    978       (let ((hash (cadr (split-string (magit-file-line patch)))))
    979         (unless (or (member hash rewritten)
    980                     (equal hash stop))
    981           (magit-sequence-insert-commit "pick" hash 'magit-sequence-pick)))))
    982   (magit-sequence-insert-sequence
    983    (magit-file-line (magit-git-dir "rebase-apply/original-commit"))
    984    onto))
    985 
    986 (defun magit-rebase-patches ()
    987   (directory-files (magit-git-dir "rebase-apply") t "^[0-9]\\{4\\}$"))
    988 
    989 (defun magit-sequence-insert-sequence (stop onto &optional orig)
    990   (let ((head (magit-rev-parse "HEAD")) done)
    991     (setq onto (if onto (magit-rev-parse onto) head))
    992     (setq done (magit-git-lines "log" "--format=%H" (concat onto "..HEAD")))
    993     (when (and stop (not (member (magit-rev-parse stop) done)))
    994       (let ((id (magit-patch-id stop)))
    995         (--if-let (--first (equal (magit-patch-id it) id) done)
    996             (setq stop it)
    997           (cond
    998            ((--first (magit-rev-equal it stop) done)
    999             ;; The commit's testament has been executed.
   1000             (magit-sequence-insert-commit "void" stop 'magit-sequence-drop))
   1001            ;; The faith of the commit is still undecided...
   1002            ((magit-anything-unmerged-p)
   1003             ;; ...and time travel isn't for the faint of heart.
   1004             (magit-sequence-insert-commit "join" stop 'magit-sequence-part))
   1005            ((magit-anything-modified-p t)
   1006             ;; ...and the dust hasn't settled yet...
   1007             (magit-sequence-insert-commit
   1008              (let* ((magit--refresh-cache nil)
   1009                     (staged   (magit-commit-tree "oO" nil "HEAD"))
   1010                     (unstaged (magit-commit-worktree "oO" "--reset")))
   1011                (cond
   1012                 ;; ...but we could end up at the same tree just by committing.
   1013                 ((or (magit-rev-equal staged   stop)
   1014                      (magit-rev-equal unstaged stop)) "goal")
   1015                 ;; ...but the changes are still there, untainted.
   1016                 ((or (equal (magit-patch-id staged)   id)
   1017                      (equal (magit-patch-id unstaged) id)) "same")
   1018                 ;; ...and some changes are gone and/or others were added.
   1019                 (t "work")))
   1020              stop 'magit-sequence-part))
   1021            ;; The commit is definitely gone...
   1022            ((--first (magit-rev-equal it stop) done)
   1023             ;; ...but all of its changes are still in effect.
   1024             (magit-sequence-insert-commit "poof" stop 'magit-sequence-drop))
   1025            (t
   1026             ;; ...and some changes are gone and/or other changes were added.
   1027             (magit-sequence-insert-commit "gone" stop 'magit-sequence-drop)))
   1028           (setq stop nil))))
   1029     (dolist (rev done)
   1030       (apply 'magit-sequence-insert-commit
   1031              (cond ((equal rev stop)
   1032                     ;; ...but its reincarnation lives on.
   1033                     ;; Or it didn't die in the first place.
   1034                     (list (if (and (equal rev head)
   1035                                    (equal (magit-patch-id rev)
   1036                                           (magit-patch-id orig)))
   1037                               "stop" ; We haven't done anything yet.
   1038                             "like")  ; There are new commits.
   1039                           rev (if (equal rev head)
   1040                                   'magit-sequence-head
   1041                                 'magit-sequence-stop)))
   1042                    ((equal rev head)
   1043                     (list "done" rev 'magit-sequence-head))
   1044                    (t
   1045                     (list "done" rev 'magit-sequence-done)))))
   1046     (magit-sequence-insert-commit "onto" onto
   1047                                   (if (equal onto head)
   1048                                       'magit-sequence-head
   1049                                     'magit-sequence-onto))))
   1050 
   1051 (defun magit-sequence-insert-commit (type hash face)
   1052   (magit-insert-section (commit hash)
   1053     (magit-insert-heading
   1054       (propertize type 'font-lock-face face)    "\s"
   1055       (magit-format-rev-summary hash) "\n")))
   1056 
   1057 ;;; _
   1058 (provide 'magit-sequence)
   1059 ;;; magit-sequence.el ends here