dotemacs

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

magit-apply.el (34077B)


      1 ;;; magit-apply.el --- apply Git diffs  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2010-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 ;; This library implements commands for applying Git diffs or parts
     29 ;; of such a diff.  The supported "apply variants" are apply, stage,
     30 ;; unstage, discard, and reverse - more than Git itself knows about,
     31 ;; at least at the porcelain level.
     32 
     33 ;;; Code:
     34 
     35 (require 'magit-core)
     36 (require 'magit-diff)
     37 (require 'magit-wip)
     38 
     39 (require 'transient) ; See #3732.
     40 
     41 ;; For `magit-apply'
     42 (declare-function magit-am "magit-sequence" ())
     43 (declare-function magit-patch-apply "magit-files" ())
     44 ;; For `magit-discard-files'
     45 (declare-function magit-checkout-stage "magit-merge" (file arg))
     46 (declare-function magit-checkout-read-stage "magit-merge" (file))
     47 (defvar auto-revert-verbose)
     48 ;; For `magit-stage-untracked'
     49 (declare-function magit-submodule-add-1 "magit-submodule"
     50                   (url &optional path name args))
     51 (declare-function magit-submodule-read-name-for-path "magit-submodule"
     52                   (path &optional prefer-short))
     53 (declare-function borg--maybe-absorb-gitdir "borg" (pkg))
     54 (declare-function borg--sort-submodule-sections "borg" (file))
     55 (declare-function borg-assimilate "borg" (package url &optional partially))
     56 (defvar borg-user-emacs-directory)
     57 
     58 ;;; Options
     59 
     60 (defcustom magit-delete-by-moving-to-trash t
     61   "Whether Magit uses the system's trash can.
     62 
     63 You should absolutely not disable this and also remove `discard'
     64 from `magit-no-confirm'.  You shouldn't do that even if you have
     65 all of the Magit-Wip modes enabled, because those modes do not
     66 track any files that are not tracked in the proper branch."
     67   :package-version '(magit . "2.1.0")
     68   :group 'magit-essentials
     69   :type 'boolean)
     70 
     71 (defcustom magit-unstage-committed t
     72   "Whether unstaging a committed change reverts it instead.
     73 
     74 A committed change cannot be unstaged, because staging and
     75 unstaging are actions that are concerned with the differences
     76 between the index and the working tree, not with committed
     77 changes.
     78 
     79 If this option is non-nil (the default), then typing \"u\"
     80 \(`magit-unstage') on a committed change, causes it to be
     81 reversed in the index but not the working tree.  For more
     82 information see command `magit-reverse-in-index'."
     83   :package-version '(magit . "2.4.1")
     84   :group 'magit-commands
     85   :type 'boolean)
     86 
     87 (defcustom magit-reverse-atomically nil
     88   "Whether to reverse changes atomically.
     89 
     90 If some changes can be reversed while others cannot, then nothing
     91 is reversed if the value of this option is non-nil.  But when it
     92 is nil, then the changes that can be reversed are reversed and
     93 for the other changes diff files are created that contain the
     94 rejected reversals."
     95   :package-version '(magit . "2.7.0")
     96   :group 'magit-commands
     97   :type 'boolean)
     98 
     99 (defcustom magit-post-stage-hook nil
    100   "Hook run after staging changes.
    101 This hook is run by `magit-refresh' if `this-command'
    102 is a member of `magit-post-stage-hook-commands'."
    103   :package-version '(magit . "2.90.0")
    104   :group 'magit-commands
    105   :type 'hook)
    106 
    107 (defvar magit-post-stage-hook-commands
    108   '(magit-stage magit-stage-file magit-stage-modified))
    109 
    110 (defcustom magit-post-unstage-hook nil
    111   "Hook run after unstaging changes.
    112 This hook is run by `magit-refresh' if `this-command'
    113 is a member of `magit-post-unstage-hook-commands'."
    114   :package-version '(magit . "2.90.0")
    115   :group 'magit-commands
    116   :type 'hook)
    117 
    118 (defvar magit-post-unstage-hook-commands
    119   '(magit-unstage magit-unstage-file magit-unstage-all))
    120 
    121 ;;; Commands
    122 ;;;; Apply
    123 
    124 (defun magit-apply (&rest args)
    125   "Apply the change at point to the working tree.
    126 With a prefix argument fallback to a 3-way merge.  Doing
    127 so causes the change to be applied to the index as well."
    128   (interactive (and current-prefix-arg (list "--3way")))
    129   (--when-let (magit-apply--get-selection)
    130     (pcase (list (magit-diff-type) (magit-diff-scope))
    131       (`(,(or `unstaged `staged) ,_)
    132        (user-error "Change is already in the working tree"))
    133       (`(untracked ,(or `file `files))
    134        (call-interactively 'magit-am))
    135       (`(,_ region) (magit-apply-region it args))
    136       (`(,_   hunk) (magit-apply-hunk   it args))
    137       (`(,_  hunks) (magit-apply-hunks  it args))
    138       (`(rebase-sequence file)
    139        (call-interactively 'magit-patch-apply))
    140       (`(,_   file) (magit-apply-diff   it args))
    141       (`(,_  files) (magit-apply-diffs  it args)))))
    142 
    143 (defun magit-apply--section-content (section)
    144   (buffer-substring-no-properties (if (magit-hunk-section-p section)
    145                                       (oref section start)
    146                                     (oref section content))
    147                                   (oref section end)))
    148 
    149 (defun magit-apply-diffs (sections &rest args)
    150   (setq sections (magit-apply--get-diffs sections))
    151   (magit-apply-patch sections args
    152                      (mapconcat
    153                       (lambda (s)
    154                         (concat (magit-diff-file-header s)
    155                                 (magit-apply--section-content s)))
    156                       sections "")))
    157 
    158 (defun magit-apply-diff (section &rest args)
    159   (setq section (car (magit-apply--get-diffs (list section))))
    160   (magit-apply-patch section args
    161                      (concat (magit-diff-file-header section)
    162                              (magit-apply--section-content section))))
    163 
    164 (defun magit-apply--adjust-hunk-new-starts (hunks)
    165   "Adjust new line numbers in headers of HUNKS for partial application.
    166 HUNKS should be a list of ordered, contiguous hunks to be applied
    167 from a file.  For example, if there is a sequence of hunks with
    168 the headers
    169 
    170   @@ -2,6 +2,7 @@
    171   @@ -10,6 +11,7 @@
    172   @@ -18,6 +20,7 @@
    173 
    174 and only the second and third are to be applied, they would be
    175 adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"."
    176   (let* ((first-hunk (car hunks))
    177          (offset (if (string-match diff-hunk-header-re-unified first-hunk)
    178                      (- (string-to-number (match-string 3 first-hunk))
    179                         (string-to-number (match-string 1 first-hunk)))
    180                    (error "Header hunks have to be applied individually"))))
    181     (if (= offset 0)
    182         hunks
    183       (mapcar (lambda (hunk)
    184                 (if (string-match diff-hunk-header-re-unified hunk)
    185                     (replace-match (number-to-string
    186                                     (- (string-to-number (match-string 3 hunk))
    187                                        offset))
    188                                    t t hunk 3)
    189                   (error "Hunk does not have expected header")))
    190               hunks))))
    191 
    192 (defun magit-apply--adjust-hunk-new-start (hunk)
    193   (car (magit-apply--adjust-hunk-new-starts (list hunk))))
    194 
    195 (defun magit-apply-hunks (sections &rest args)
    196   (let ((section (oref (car sections) parent)))
    197     (when (string-match "^diff --cc" (oref section value))
    198       (user-error "Cannot un-/stage resolution hunks.  Stage the whole file"))
    199     (magit-apply-patch
    200      section args
    201      (concat (oref section header)
    202              (mapconcat #'identity
    203                         (magit-apply--adjust-hunk-new-starts
    204                          (mapcar #'magit-apply--section-content sections))
    205                         "")))))
    206 
    207 (defun magit-apply-hunk (section &rest args)
    208   (when (string-match "^diff --cc" (magit-section-parent-value section))
    209     (user-error "Cannot un-/stage resolution hunks.  Stage the whole file"))
    210   (let* ((header (car (oref section value)))
    211          (header (and (symbolp header) header))
    212          (content (magit-apply--section-content section)))
    213     (magit-apply-patch
    214      (oref section parent) args
    215      (concat (magit-diff-file-header section (not (eq header 'rename)))
    216              (if header
    217                  content
    218                (magit-apply--adjust-hunk-new-start content))))))
    219 
    220 (defun magit-apply-region (section &rest args)
    221   (when (string-match "^diff --cc" (magit-section-parent-value section))
    222     (user-error "Cannot un-/stage resolution hunks.  Stage the whole file"))
    223   (magit-apply-patch (oref section parent) args
    224                      (concat (magit-diff-file-header section)
    225                              (magit-apply--adjust-hunk-new-start
    226                               (magit-diff-hunk-region-patch section args)))))
    227 
    228 (defun magit-apply-patch (section:s args patch)
    229   (let* ((files (if (atom section:s)
    230                     (list (oref section:s value))
    231                   (--map (oref it value) section:s)))
    232          (command (symbol-name this-command))
    233          (command (if (and command (string-match "^magit-\\([^-]+\\)" command))
    234                       (match-string 1 command)
    235                     "apply"))
    236          (ignore-context (magit-diff-ignore-any-space-p)))
    237     (unless (magit-diff-context-p)
    238       (user-error "Not enough context to apply patch.  Increase the context"))
    239     (when (and magit-wip-before-change-mode (not magit-inhibit-refresh))
    240       (magit-wip-commit-before-change files (concat " before " command)))
    241     (with-temp-buffer
    242       (insert patch)
    243       (magit-run-git-with-input
    244        "apply" args "-p0"
    245        (and ignore-context "-C0")
    246        "--ignore-space-change" "-"))
    247     (unless magit-inhibit-refresh
    248       (when magit-wip-after-apply-mode
    249         (magit-wip-commit-after-apply files (concat " after " command)))
    250       (magit-refresh))))
    251 
    252 (defun magit-apply--get-selection ()
    253   (or (magit-region-sections '(hunk file module) t)
    254       (let ((section (magit-current-section)))
    255         (pcase (oref section type)
    256           ((or `hunk `file `module) section)
    257           ((or `staged `unstaged `untracked
    258                `stashed-index `stashed-worktree `stashed-untracked)
    259            (oref section children))
    260           (_ (user-error "Cannot apply this, it's not a change"))))))
    261 
    262 (defun magit-apply--get-diffs (sections)
    263   (magit-section-case
    264     ([file diffstat]
    265      (--map (or (magit-get-section
    266                  (append `((file . ,(oref it value)))
    267                          (magit-section-ident magit-root-section)))
    268                 (error "Cannot get required diff headers"))
    269             sections))
    270     (t sections)))
    271 
    272 (defun magit-apply--diff-ignores-whitespace-p ()
    273   (and (cl-intersection magit-buffer-diff-args
    274                         '("--ignore-space-at-eol"
    275                           "--ignore-space-change"
    276                           "--ignore-all-space"
    277                           "--ignore-blank-lines")
    278                         :test #'equal)
    279        t))
    280 
    281 ;;;; Stage
    282 
    283 (defun magit-stage (&optional intent)
    284   "Add the change at point to the staging area.
    285 With a prefix argument, INTENT, and an untracked file (or files)
    286 at point, stage the file but not its content."
    287   (interactive "P")
    288   (--if-let (and (derived-mode-p 'magit-mode) (magit-apply--get-selection))
    289       (pcase (list (magit-diff-type)
    290                    (magit-diff-scope)
    291                    (magit-apply--diff-ignores-whitespace-p))
    292         (`(untracked     ,_  ,_) (magit-stage-untracked intent))
    293         (`(unstaged  region  ,_) (magit-apply-region it "--cached"))
    294         (`(unstaged    hunk  ,_) (magit-apply-hunk   it "--cached"))
    295         (`(unstaged   hunks  ,_) (magit-apply-hunks  it "--cached"))
    296         (`(unstaged    file   t) (magit-apply-diff   it "--cached"))
    297         (`(unstaged   files   t) (magit-apply-diffs  it "--cached"))
    298         (`(unstaged    list   t) (magit-apply-diffs  it "--cached"))
    299         (`(unstaged    file nil) (magit-stage-1 "-u" (list (oref it value))))
    300         (`(unstaged   files nil) (magit-stage-1 "-u" (magit-region-values nil t)))
    301         (`(unstaged    list nil) (magit-stage-modified))
    302         (`(staged        ,_  ,_) (user-error "Already staged"))
    303         (`(committed     ,_  ,_) (user-error "Cannot stage committed changes"))
    304         (`(undefined     ,_  ,_) (user-error "Cannot stage this change")))
    305     (call-interactively 'magit-stage-file)))
    306 
    307 ;;;###autoload
    308 (defun magit-stage-file (file)
    309   "Stage all changes to FILE.
    310 With a prefix argument or when there is no file at point ask for
    311 the file to be staged.  Otherwise stage the file at point without
    312 requiring confirmation."
    313   (interactive
    314    (let* ((atpoint (magit-section-value-if 'file))
    315           (current (magit-file-relative-name))
    316           (choices (nconc (magit-unstaged-files)
    317                           (magit-untracked-files)))
    318           (default (car (member (or atpoint current) choices))))
    319      (list (if (or current-prefix-arg (not default))
    320                (magit-completing-read "Stage file" choices
    321                                       nil t nil nil default)
    322              default))))
    323   (magit-with-toplevel
    324     (magit-stage-1 nil (list file))))
    325 
    326 ;;;###autoload
    327 (defun magit-stage-modified (&optional all)
    328   "Stage all changes to files modified in the worktree.
    329 Stage all new content of tracked files and remove tracked files
    330 that no longer exist in the working tree from the index also.
    331 With a prefix argument also stage previously untracked (but not
    332 ignored) files."
    333   (interactive "P")
    334   (when (magit-anything-staged-p)
    335     (magit-confirm 'stage-all-changes))
    336   (magit-with-toplevel
    337     (magit-stage-1 (if all "--all" "-u") magit-buffer-diff-files)))
    338 
    339 (defun magit-stage-1 (arg &optional files)
    340   (magit-wip-commit-before-change files " before stage")
    341   (magit-run-git "add" arg (if files (cons "--" files) "."))
    342   (when magit-auto-revert-mode
    343     (mapc #'magit-turn-on-auto-revert-mode-if-desired files))
    344   (magit-wip-commit-after-apply files " after stage"))
    345 
    346 (defun magit-stage-untracked (&optional intent)
    347   (let* ((section (magit-current-section))
    348          (files (pcase (magit-diff-scope)
    349                   (`file  (list (oref section value)))
    350                   (`files (magit-region-values nil t))
    351                   (`list  (magit-untracked-files))))
    352          plain repos)
    353     (dolist (file files)
    354       (if (and (not (file-symlink-p file))
    355                (magit-git-repo-p file t))
    356           (push file repos)
    357         (push file plain)))
    358     (magit-wip-commit-before-change files " before stage")
    359     (when plain
    360       (magit-run-git "add" (and intent "--intent-to-add")
    361                      "--" plain)
    362       (when magit-auto-revert-mode
    363         (mapc #'magit-turn-on-auto-revert-mode-if-desired plain)))
    364     (dolist (repo repos)
    365       (save-excursion
    366         (goto-char (oref (magit-get-section
    367                           `((file . ,repo) (untracked) (status)))
    368                          start))
    369         (let* ((topdir (magit-toplevel))
    370                (url (let ((default-directory
    371                             (file-name-as-directory (expand-file-name repo))))
    372                       (or (magit-get "remote" (magit-get-some-remote) "url")
    373                           (concat (file-name-as-directory ".") repo))))
    374                (package
    375                 (and (equal (bound-and-true-p borg-user-emacs-directory)
    376                             topdir)
    377                      (file-name-nondirectory (directory-file-name repo)))))
    378           (if (and package
    379                    (y-or-n-p (format "Also assimilate `%s' drone?" package)))
    380               (borg-assimilate package url)
    381             (magit-submodule-add-1
    382              url repo (magit-submodule-read-name-for-path repo package))
    383             (when package
    384               (borg--sort-submodule-sections
    385                (expand-file-name ".gitmodules" topdir))
    386               (let ((default-directory borg-user-emacs-directory))
    387                 (borg--maybe-absorb-gitdir package)))))))
    388     (magit-wip-commit-after-apply files " after stage")))
    389 
    390 ;;;; Unstage
    391 
    392 (defun magit-unstage ()
    393   "Remove the change at point from the staging area."
    394   (interactive)
    395   (--when-let (magit-apply--get-selection)
    396     (pcase (list (magit-diff-type)
    397                  (magit-diff-scope)
    398                  (magit-apply--diff-ignores-whitespace-p))
    399       (`(untracked     ,_  ,_) (user-error "Cannot unstage untracked changes"))
    400       (`(unstaged    file  ,_) (magit-unstage-intent (list (oref it value))))
    401       (`(unstaged   files  ,_) (magit-unstage-intent (magit-region-values nil t)))
    402       (`(unstaged      ,_  ,_) (user-error "Already unstaged"))
    403       (`(staged    region  ,_) (magit-apply-region it "--reverse" "--cached"))
    404       (`(staged      hunk  ,_) (magit-apply-hunk   it "--reverse" "--cached"))
    405       (`(staged     hunks  ,_) (magit-apply-hunks  it "--reverse" "--cached"))
    406       (`(staged      file   t) (magit-apply-diff   it "--reverse" "--cached"))
    407       (`(staged     files   t) (magit-apply-diffs  it "--reverse" "--cached"))
    408       (`(staged      list   t) (magit-apply-diffs  it "--reverse" "--cached"))
    409       (`(staged      file nil) (magit-unstage-1 (list (oref it value))))
    410       (`(staged     files nil) (magit-unstage-1 (magit-region-values nil t)))
    411       (`(staged      list nil) (magit-unstage-all))
    412       (`(committed     ,_  ,_) (if magit-unstage-committed
    413                                    (magit-reverse-in-index)
    414                                  (user-error "Cannot unstage committed changes")))
    415       (`(undefined     ,_  ,_) (user-error "Cannot unstage this change")))))
    416 
    417 ;;;###autoload
    418 (defun magit-unstage-file (file)
    419   "Unstage all changes to FILE.
    420 With a prefix argument or when there is no file at point ask for
    421 the file to be unstaged.  Otherwise unstage the file at point
    422 without requiring confirmation."
    423   (interactive
    424    (let* ((atpoint (magit-section-value-if 'file))
    425           (current (magit-file-relative-name))
    426           (choices (magit-staged-files))
    427           (default (car (member (or atpoint current) choices))))
    428      (list (if (or current-prefix-arg (not default))
    429                (magit-completing-read "Unstage file" choices
    430                                       nil t nil nil default)
    431              default))))
    432   (magit-with-toplevel
    433     (magit-unstage-1 (list file))))
    434 
    435 (defun magit-unstage-1 (files)
    436   (magit-wip-commit-before-change files " before unstage")
    437   (if (magit-no-commit-p)
    438       (magit-run-git "rm" "--cached" "--" files)
    439     (magit-run-git "reset" "HEAD" "--" files))
    440   (magit-wip-commit-after-apply files " after unstage"))
    441 
    442 (defun magit-unstage-intent (files)
    443   (if-let ((staged (magit-staged-files))
    444            (intent (--filter (member it staged) files)))
    445       (magit-unstage-1 intent)
    446     (user-error "Already unstaged")))
    447 
    448 ;;;###autoload
    449 (defun magit-unstage-all ()
    450   "Remove all changes from the staging area."
    451   (interactive)
    452   (unless (magit-anything-staged-p)
    453     (user-error "Nothing to unstage"))
    454   (when (or (magit-anything-unstaged-p)
    455             (magit-untracked-files))
    456     (magit-confirm 'unstage-all-changes))
    457   (magit-wip-commit-before-change nil " before unstage")
    458   (magit-run-git "reset" "HEAD" "--" magit-buffer-diff-files)
    459   (magit-wip-commit-after-apply nil " after unstage"))
    460 
    461 ;;;; Discard
    462 
    463 (defun magit-discard ()
    464   "Remove the change at point.
    465 
    466 On a hunk or file with unresolved conflicts prompt which side to
    467 keep (while discarding the other).  If point is within the text
    468 of a side, then keep that side without prompting."
    469   (interactive)
    470   (--when-let (magit-apply--get-selection)
    471     (pcase (list (magit-diff-type) (magit-diff-scope))
    472       (`(committed ,_) (user-error "Cannot discard committed changes"))
    473       (`(undefined ,_) (user-error "Cannot discard this change"))
    474       (`(,_    region) (magit-discard-region it))
    475       (`(,_      hunk) (magit-discard-hunk   it))
    476       (`(,_     hunks) (magit-discard-hunks  it))
    477       (`(,_      file) (magit-discard-file   it))
    478       (`(,_     files) (magit-discard-files  it))
    479       (`(,_      list) (magit-discard-files  it)))))
    480 
    481 (defun magit-discard-region (section)
    482   (magit-confirm 'discard "Discard region")
    483   (magit-discard-apply section 'magit-apply-region))
    484 
    485 (defun magit-discard-hunk (section)
    486   (magit-confirm 'discard "Discard hunk")
    487   (let ((file (magit-section-parent-value section)))
    488     (pcase (cddr (car (magit-file-status file)))
    489       (`(?U ?U) (magit-smerge-keep-current))
    490       (_ (magit-discard-apply section 'magit-apply-hunk)))))
    491 
    492 (defun magit-discard-apply (section apply)
    493   (if (eq (magit-diff-type section) 'unstaged)
    494       (funcall apply section "--reverse")
    495     (if (magit-anything-unstaged-p
    496          nil (if (magit-file-section-p section)
    497                  (oref section value)
    498                (magit-section-parent-value section)))
    499         (progn (let ((magit-inhibit-refresh t))
    500                  (funcall apply section "--reverse" "--cached")
    501                  (funcall apply section "--reverse" "--reject"))
    502                (magit-refresh))
    503       (funcall apply section "--reverse" "--index"))))
    504 
    505 (defun magit-discard-hunks (sections)
    506   (magit-confirm 'discard (format "Discard %s hunks from %s"
    507                                   (length sections)
    508                                   (magit-section-parent-value (car sections))))
    509   (magit-discard-apply-n sections 'magit-apply-hunks))
    510 
    511 (defun magit-discard-apply-n (sections apply)
    512   (let ((section (car sections)))
    513     (if (eq (magit-diff-type section) 'unstaged)
    514         (funcall apply sections "--reverse")
    515       (if (magit-anything-unstaged-p
    516            nil (if (magit-file-section-p section)
    517                    (oref section value)
    518                  (magit-section-parent-value section)))
    519           (progn (let ((magit-inhibit-refresh t))
    520                    (funcall apply sections "--reverse" "--cached")
    521                    (funcall apply sections "--reverse" "--reject"))
    522                  (magit-refresh))
    523         (funcall apply sections "--reverse" "--index")))))
    524 
    525 (defun magit-discard-file (section)
    526   (magit-discard-files (list section)))
    527 
    528 (defun magit-discard-files (sections)
    529   (let ((auto-revert-verbose nil)
    530         (type (magit-diff-type (car sections)))
    531         (status (magit-file-status))
    532         files delete resurrect rename discard discard-new resolve)
    533     (dolist (section sections)
    534       (let ((file (oref section value)))
    535         (push file files)
    536         (pcase (cons (pcase type
    537                        (`staged ?X)
    538                        (`unstaged ?Y)
    539                        (`untracked ?Z))
    540                      (cddr (assoc file status)))
    541           (`(?Z) (dolist (f (magit-untracked-files nil file))
    542                    (push f delete)))
    543           ((or `(?Z ?? ??) `(?Z ?! ?!)) (push file delete))
    544           ((or `(?Z ?D ? ) `(,_ ?D ?D)) (push file delete))
    545           ((or `(,_ ?U ,_) `(,_ ,_ ?U)) (push file resolve))
    546           (`(,_ ?A ?A)                  (push file resolve))
    547           (`(?X ?M ,(or ?  ?M ?D)) (push section discard))
    548           (`(?Y ,_         ?M    ) (push section discard))
    549           (`(?X ?A         ?M    ) (push file discard-new))
    550           (`(?X ?C         ?M    ) (push file discard-new))
    551           (`(?X ?A ,(or ?     ?D)) (push file delete))
    552           (`(?X ?C ,(or ?     ?D)) (push file delete))
    553           (`(?X ?D ,(or ?  ?M   )) (push file resurrect))
    554           (`(?Y ,_            ?D ) (push file resurrect))
    555           (`(?X ?R ,(or ?  ?M ?D)) (push file rename)))))
    556     (unwind-protect
    557         (let ((magit-inhibit-refresh t))
    558           (magit-wip-commit-before-change files " before discard")
    559           (when resolve
    560             (magit-discard-files--resolve (nreverse resolve)))
    561           (when resurrect
    562             (magit-discard-files--resurrect (nreverse resurrect)))
    563           (when delete
    564             (magit-discard-files--delete (nreverse delete) status))
    565           (when rename
    566             (magit-discard-files--rename (nreverse rename) status))
    567           (when (or discard discard-new)
    568             (magit-discard-files--discard (nreverse discard)
    569                                           (nreverse discard-new)))
    570           (magit-wip-commit-after-apply files " after discard"))
    571       (magit-refresh))))
    572 
    573 (defun magit-discard-files--resolve (files)
    574   (if-let ((arg (and (cdr files)
    575                      (magit-read-char-case
    576                          (format "For these %i files\n%s\ncheckout:\n"
    577                                  (length files)
    578                                  (mapconcat (lambda (file)
    579                                               (concat "  " file))
    580                                             files "\n"))
    581                          t
    582                        (?o "[o]ur stage"   "--ours")
    583                        (?t "[t]heir stage" "--theirs")
    584                        (?c "[c]onflict"    "--merge")
    585                        (?i "decide [i]ndividually" nil)))))
    586       (dolist (file files)
    587         (magit-checkout-stage file arg))
    588     (dolist (file files)
    589       (magit-checkout-stage file (magit-checkout-read-stage file)))))
    590 
    591 (defun magit-discard-files--resurrect (files)
    592   (magit-confirm-files 'resurrect files)
    593   (if (eq (magit-diff-type) 'staged)
    594       (magit-call-git "reset"  "--" files)
    595     (magit-call-git "checkout" "--" files)))
    596 
    597 (defun magit-discard-files--delete (files status)
    598   (magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete)
    599                        files)
    600   (let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash))
    601     (dolist (file files)
    602       (when (string-match-p "\\`\\\\?~" file)
    603         (error "Refusing to delete %S, too dangerous" file))
    604       (pcase (nth 3 (assoc file status))
    605         ((guard (memq (magit-diff-type) '(unstaged untracked)))
    606          (dired-delete-file file dired-recursive-deletes
    607                             magit-delete-by-moving-to-trash)
    608          (dired-clean-up-after-deletion file))
    609         (?\s (delete-file file t)
    610              (magit-call-git "rm" "--cached" "--" file))
    611         (?M  (let ((temp (magit-git-string "checkout-index" "--temp" file)))
    612                (string-match
    613                 (format "\\(.+?\\)\t%s" (regexp-quote file)) temp)
    614                (rename-file (match-string 1 temp)
    615                             (setq temp (concat file ".~{index}~")))
    616                (delete-file temp t))
    617              (magit-call-git "rm" "--cached" "--force" "--" file))
    618         (?D  (magit-call-git "checkout" "--" file)
    619              (delete-file file t)
    620              (magit-call-git "rm" "--cached" "--force" "--" file))))))
    621 
    622 (defun magit-discard-files--rename (files status)
    623   (magit-confirm 'rename "Undo rename %s" "Undo %i renames" nil
    624     (mapcar (lambda (file)
    625               (setq file (assoc file status))
    626               (format "%s -> %s" (cadr file) (car file)))
    627             files))
    628   (dolist (file files)
    629     (let ((orig (cadr (assoc file status))))
    630       (if (file-exists-p file)
    631           (progn
    632             (--when-let (file-name-directory orig)
    633               (make-directory it t))
    634             (magit-call-git "mv" file orig))
    635         (magit-call-git "rm" "--cached" "--" file)
    636         (magit-call-git "reset" "--" orig)))))
    637 
    638 (defun magit-discard-files--discard (sections new-files)
    639   (let ((files (--map (oref it value) sections)))
    640     (magit-confirm-files 'discard (append files new-files)
    641                          (format "Discard %s changes in" (magit-diff-type)))
    642     (if (eq (magit-diff-type (car sections)) 'unstaged)
    643         (magit-call-git "checkout" "--" files)
    644       (when new-files
    645         (magit-call-git "add"   "--" new-files)
    646         (magit-call-git "reset" "--" new-files))
    647       (let ((binaries (magit-binary-files "--cached")))
    648         (when binaries
    649           (setq sections
    650                 (--remove (member (oref it value) binaries)
    651                           sections)))
    652         (cond ((= (length sections) 1)
    653                (magit-discard-apply (car sections) 'magit-apply-diff))
    654               (sections
    655                (magit-discard-apply-n sections 'magit-apply-diffs)))
    656         (when binaries
    657           (let ((modified (magit-unstaged-files t)))
    658             (setq binaries (--separate (member it modified) binaries)))
    659           (when (cadr binaries)
    660             (magit-call-git "reset" "--" (cadr binaries)))
    661           (when (car binaries)
    662             (user-error
    663              (concat
    664               "Cannot discard staged changes to binary files, "
    665               "which also have unstaged changes.  Unstage instead."))))))))
    666 
    667 ;;;; Reverse
    668 
    669 (defun magit-reverse (&rest args)
    670   "Reverse the change at point in the working tree.
    671 With a prefix argument fallback to a 3-way merge.  Doing
    672 so causes the change to be applied to the index as well."
    673   (interactive (and current-prefix-arg (list "--3way")))
    674   (--when-let (magit-apply--get-selection)
    675     (pcase (list (magit-diff-type) (magit-diff-scope))
    676       (`(untracked ,_) (user-error "Cannot reverse untracked changes"))
    677       (`(unstaged  ,_) (user-error "Cannot reverse unstaged changes"))
    678       (`(,_    region) (magit-reverse-region it args))
    679       (`(,_      hunk) (magit-reverse-hunk   it args))
    680       (`(,_     hunks) (magit-reverse-hunks  it args))
    681       (`(,_      file) (magit-reverse-file   it args))
    682       (`(,_     files) (magit-reverse-files  it args))
    683       (`(,_      list) (magit-reverse-files  it args)))))
    684 
    685 (defun magit-reverse-region (section args)
    686   (magit-confirm 'reverse "Reverse region")
    687   (magit-reverse-apply section 'magit-apply-region args))
    688 
    689 (defun magit-reverse-hunk (section args)
    690   (magit-confirm 'reverse "Reverse hunk")
    691   (magit-reverse-apply section 'magit-apply-hunk args))
    692 
    693 (defun magit-reverse-hunks (sections args)
    694   (magit-confirm 'reverse
    695     (format "Reverse %s hunks from %s"
    696             (length sections)
    697             (magit-section-parent-value (car sections))))
    698   (magit-reverse-apply sections 'magit-apply-hunks args))
    699 
    700 (defun magit-reverse-file (section args)
    701   (magit-reverse-files (list section) args))
    702 
    703 (defun magit-reverse-files (sections args)
    704   (pcase-let ((`(,binaries ,sections)
    705                (let ((bs (magit-binary-files
    706                           (cond ((derived-mode-p 'magit-revision-mode)
    707                                  magit-buffer-range)
    708                                 ((derived-mode-p 'magit-diff-mode)
    709                                  magit-buffer-range)
    710                                 (t
    711                                  "--cached")))))
    712                  (--separate (member (oref it value) bs)
    713                              sections))))
    714     (magit-confirm-files 'reverse (--map (oref it value) sections))
    715     (cond ((= (length sections) 1)
    716            (magit-reverse-apply (car sections) 'magit-apply-diff args))
    717           (sections
    718            (magit-reverse-apply sections 'magit-apply-diffs args)))
    719     (when binaries
    720       (user-error "Cannot reverse binary files"))))
    721 
    722 (defun magit-reverse-apply (section:s apply args)
    723   (funcall apply section:s "--reverse" args
    724            (and (not magit-reverse-atomically)
    725                 (not (member "--3way" args))
    726                 "--reject")))
    727 
    728 (defun magit-reverse-in-index (&rest args)
    729   "Reverse the change at point in the index but not the working tree.
    730 
    731 Use this command to extract a change from `HEAD', while leaving
    732 it in the working tree, so that it can later be committed using
    733 a separate commit.  A typical workflow would be:
    734 
    735 0. Optionally make sure that there are no uncommitted changes.
    736 1. Visit the `HEAD' commit and navigate to the change that should
    737    not have been included in that commit.
    738 2. Type \"u\" (`magit-unstage') to reverse it in the index.
    739    This assumes that `magit-unstage-committed-changes' is non-nil.
    740 3. Type \"c e\" to extend `HEAD' with the staged changes,
    741    including those that were already staged before.
    742 4. Optionally stage the remaining changes using \"s\" or \"S\"
    743    and then type \"c c\" to create a new commit."
    744   (interactive)
    745   (magit-reverse (cons "--cached" args)))
    746 
    747 ;;; Smerge Support
    748 
    749 (defun magit-smerge-keep-current ()
    750   "Keep the current version of the conflict at point."
    751   (interactive)
    752   (magit-call-smerge #'smerge-keep-current))
    753 
    754 (defun magit-smerge-keep-upper ()
    755   "Keep the upper/our version of the conflict at point."
    756   (interactive)
    757   (magit-call-smerge #'smerge-keep-upper))
    758 
    759 (defun magit-smerge-keep-base ()
    760   "Keep the base version of the conflict at point."
    761   (interactive)
    762   (magit-call-smerge #'smerge-keep-base))
    763 
    764 (defun magit-smerge-keep-lower ()
    765   "Keep the lower/their version of the conflict at point."
    766   (interactive)
    767   (magit-call-smerge #'smerge-keep-lower))
    768 
    769 (defun magit-call-smerge (fn)
    770   (pcase-let* ((file (magit-file-at-point t t))
    771                (keep (get-file-buffer file))
    772                (`(,buf ,pos)
    773                 (let ((magit-diff-visit-jump-to-change nil))
    774                   (magit-diff-visit-file--noselect file))))
    775     (with-current-buffer buf
    776       (save-excursion
    777         (save-restriction
    778           (unless (<= (point-min) pos (point-max))
    779             (widen))
    780           (goto-char pos)
    781           (condition-case nil
    782               (smerge-match-conflict)
    783             (error
    784              (if (eq fn 'smerge-keep-current)
    785                  (when (eq this-command 'magit-discard)
    786                    (re-search-forward smerge-begin-re nil t)
    787                    (setq fn
    788                          (magit-read-char-case "Keep side: " t
    789                            (?o "[o]urs/upper"   #'smerge-keep-upper)
    790                            (?b "[b]ase"         #'smerge-keep-base)
    791                            (?t "[t]heirs/lower" #'smerge-keep-lower))))
    792                (re-search-forward smerge-begin-re nil t))))
    793           (funcall fn)))
    794       (when (and keep (magit-anything-unmerged-p file))
    795         (smerge-start-session))
    796       (save-buffer))
    797     (unless keep
    798       (kill-buffer buf))
    799     (magit-refresh)))
    800 
    801 ;;; _
    802 (provide 'magit-apply)
    803 ;;; magit-apply.el ends here