config

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

magit-apply.el (36240B)


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