config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

magit-apply.el (36010B)


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