config

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

magit-apply.el (36068B)


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