magit-apply.el (35950B)
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 552 (list "Discard %d hunks from %s" 553 (length sections) 554 (magit-section-parent-value (car sections)))) 555 (magit-discard-apply-n sections #'magit-apply-hunks)) 556 557 (defun magit-discard-apply-n (sections apply) 558 (let ((section (car sections))) 559 (if (eq (magit-diff-type section) 'unstaged) 560 (funcall apply sections "--reverse") 561 (if (magit-anything-unstaged-p 562 nil (if (magit-file-section-p section) 563 (oref section value) 564 (magit-section-parent-value section))) 565 (progn (let ((magit-inhibit-refresh t)) 566 (funcall apply sections "--reverse" "--cached") 567 (funcall apply sections "--reverse" "--reject")) 568 (magit-refresh)) 569 (funcall apply sections "--reverse" "--index"))))) 570 571 (defun magit-discard-file (section) 572 (magit-discard-files (list section))) 573 574 (defun magit-discard-files (sections) 575 (let ((auto-revert-verbose nil) 576 (type (magit-diff-type (car sections))) 577 (status (magit-file-status)) 578 files delete resurrect rename discard discard-new resolve) 579 (dolist (section sections) 580 (let ((file (oref section value))) 581 (push file files) 582 (pcase (cons (pcase type 583 (`staged ?X) 584 (`unstaged ?Y) 585 (`untracked ?Z)) 586 (cddr (assoc file status))) 587 ('(?Z) (dolist (f (magit-untracked-files nil file)) 588 (push f delete))) 589 ((or '(?Z ?? ??) '(?Z ?! ?!)) (push file delete)) 590 ('(?Z ?D ? ) (push file delete)) 591 (`(,_ ?D ?D) (push file resolve)) 592 ((or `(,_ ?U ,_) `(,_ ,_ ?U)) (push file resolve)) 593 (`(,_ ?A ?A) (push file resolve)) 594 (`(?X ?M ,(or ? ?M ?D)) (push section discard)) 595 (`(?Y ,_ ?M ) (push section discard)) 596 ('(?X ?A ?M ) (push file discard-new)) 597 ('(?X ?C ?M ) (push file discard-new)) 598 (`(?X ?A ,(or ? ?D)) (push file delete)) 599 (`(?X ?C ,(or ? ?D)) (push file delete)) 600 (`(?X ?D ,(or ? ?M )) (push file resurrect)) 601 (`(?Y ,_ ?D ) (push file resurrect)) 602 (`(?X ?R ,(or ? ?M ?D)) (push file rename))))) 603 (unwind-protect 604 (let ((magit-inhibit-refresh t)) 605 (magit-wip-commit-before-change files " before discard") 606 (when resolve 607 (magit-discard-files--resolve (nreverse resolve))) 608 (when resurrect 609 (magit-discard-files--resurrect (nreverse resurrect))) 610 (when delete 611 (magit-discard-files--delete (nreverse delete) status)) 612 (when rename 613 (magit-discard-files--rename (nreverse rename) status)) 614 (when (or discard discard-new) 615 (magit-discard-files--discard (nreverse discard) 616 (nreverse discard-new))) 617 (magit-wip-commit-after-apply files " after discard")) 618 (magit-refresh)))) 619 620 (defun magit-discard-files--resolve (files) 621 (if-let ((arg (and (cdr files) 622 (magit-read-char-case 623 (format "For these %d files\n%s\ncheckout:\n" 624 (length files) 625 (mapconcat (lambda (file) 626 (concat " " file)) 627 files "\n")) 628 t 629 (?o "[o]ur stage" "--ours") 630 (?t "[t]heir stage" "--theirs") 631 (?c "[c]onflict" "--merge") 632 (?i "decide [i]ndividually" nil))))) 633 (dolist (file files) 634 (magit-checkout-stage file arg)) 635 (dolist (file files) 636 (magit-checkout-stage file (magit-checkout-read-stage file))))) 637 638 (defun magit-discard-files--resurrect (files) 639 (magit-confirm-files 'resurrect files) 640 (if (eq (magit-diff-type) 'staged) 641 (magit-call-git "reset" "--" files) 642 (magit-call-git "checkout" "--" files))) 643 644 (defun magit-discard-files--delete (files status) 645 (magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete) 646 files) 647 (let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash)) 648 (dolist (file files) 649 (when (string-match-p "\\`\\\\?~" file) 650 (error "Refusing to delete %S, too dangerous" file)) 651 (pcase (nth 3 (assoc file status)) 652 ((guard (memq (magit-diff-type) '(unstaged untracked))) 653 (dired-delete-file file dired-recursive-deletes 654 magit-delete-by-moving-to-trash) 655 (dired-clean-up-after-deletion file)) 656 (?\s (delete-file file t) 657 (magit-call-git "rm" "--cached" "--" file)) 658 (?M (let ((temp (magit-git-string "checkout-index" "--temp" file))) 659 (string-match 660 (format "\\(.+?\\)\t%s" (regexp-quote file)) temp) 661 (rename-file (match-string 1 temp) 662 (setq temp (concat file ".~{index}~"))) 663 (delete-file temp t)) 664 (magit-call-git "rm" "--cached" "--force" "--" file)) 665 (?D (magit-call-git "checkout" "--" file) 666 (delete-file file t) 667 (magit-call-git "rm" "--cached" "--force" "--" file)))))) 668 669 (defun magit-discard-files--rename (files status) 670 (magit-confirm 'rename "Undo rename %s" "Undo %d renames" nil 671 (mapcar (lambda (file) 672 (setq file (assoc file status)) 673 (format "%s -> %s" (cadr file) (car file))) 674 files)) 675 (dolist (file files) 676 (let ((orig (cadr (assoc file status)))) 677 (if (file-exists-p file) 678 (progn 679 (when-let ((path (file-name-directory orig))) 680 (make-directory path t)) 681 (magit-call-git "mv" file orig)) 682 (magit-call-git "rm" "--cached" "--" file) 683 (magit-call-git "reset" "--" orig))))) 684 685 (defun magit-discard-files--discard (sections new-files) 686 (let ((files (--map (oref it value) sections))) 687 (magit-confirm-files 'discard (append files new-files) 688 (format "Discard %s changes in" (magit-diff-type))) 689 (if (eq (magit-diff-type (car sections)) 'unstaged) 690 (magit-call-git "checkout" "--" files) 691 (when new-files 692 (magit-call-git "add" "--" new-files) 693 (magit-call-git "reset" "--" new-files)) 694 (let ((binaries (magit-binary-files "--cached"))) 695 (when binaries 696 (setq sections 697 (--remove (member (oref it value) binaries) 698 sections))) 699 (cond ((length= sections 1) 700 (magit-discard-apply (car sections) 'magit-apply-diff)) 701 (sections 702 (magit-discard-apply-n sections #'magit-apply-diffs))) 703 (when binaries 704 (let ((modified (magit-unstaged-files t))) 705 (setq binaries (--separate (member it modified) binaries))) 706 (when (cadr binaries) 707 (magit-call-git "reset" "--" (cadr binaries))) 708 (when (car binaries) 709 (user-error 710 (concat 711 "Cannot discard staged changes to binary files, " 712 "which also have unstaged changes. Unstage instead.")))))))) 713 714 ;;;; Reverse 715 716 (defun magit-reverse (&rest args) 717 "Reverse the change at point in the working tree. 718 With a prefix argument fallback to a 3-way merge. Doing 719 so causes the change to be applied to the index as well." 720 (interactive (and current-prefix-arg (list "--3way"))) 721 (when-let ((s (magit-apply--get-selection))) 722 (pcase (list (magit-diff-type) (magit-diff-scope)) 723 (`(untracked ,_) (user-error "Cannot reverse untracked changes")) 724 (`(unstaged ,_) (user-error "Cannot reverse unstaged changes")) 725 (`(,_ region) (magit-reverse-region s args)) 726 (`(,_ hunk) (magit-reverse-hunk s args)) 727 (`(,_ hunks) (magit-reverse-hunks s args)) 728 (`(,_ file) (magit-reverse-file s args)) 729 (`(,_ files) (magit-reverse-files s args)) 730 (`(,_ list) (magit-reverse-files s args))))) 731 732 (defun magit-reverse-region (section args) 733 (magit-confirm 'reverse "Reverse region") 734 (magit-reverse-apply section #'magit-apply-region args)) 735 736 (defun magit-reverse-hunk (section args) 737 (magit-confirm 'reverse "Reverse hunk") 738 (magit-reverse-apply section #'magit-apply-hunk args)) 739 740 (defun magit-reverse-hunks (sections args) 741 (magit-confirm 'reverse 742 (list "Reverse %d hunks from %s" 743 (length sections) 744 (magit-section-parent-value (car sections)))) 745 (magit-reverse-apply sections #'magit-apply-hunks args)) 746 747 (defun magit-reverse-file (section args) 748 (magit-reverse-files (list section) args)) 749 750 (defun magit-reverse-files (sections args) 751 (pcase-let ((`(,binaries ,sections) 752 (let ((bs (magit-binary-files 753 (cond ((derived-mode-p 'magit-revision-mode) 754 magit-buffer-range) 755 ((derived-mode-p 'magit-diff-mode) 756 magit-buffer-range) 757 (t 758 "--cached"))))) 759 (--separate (member (oref it value) bs) 760 sections)))) 761 (magit-confirm-files 'reverse (--map (oref it value) sections)) 762 (cond ((length= sections 1) 763 (magit-reverse-apply (car sections) #'magit-apply-diff args)) 764 (sections 765 (magit-reverse-apply sections #'magit-apply-diffs args))) 766 (when binaries 767 (user-error "Cannot reverse binary files")))) 768 769 (defun magit-reverse-apply (section:s apply args) 770 (funcall apply section:s "--reverse" args 771 (and (not magit-reverse-atomically) 772 (not (member "--3way" args)) 773 "--reject"))) 774 775 (defun magit-reverse-in-index (&rest args) 776 "Reverse the change at point in the index but not the working tree. 777 778 Use this command to extract a change from `HEAD', while leaving 779 it in the working tree, so that it can later be committed using 780 a separate commit. A typical workflow would be: 781 782 0. Optionally make sure that there are no uncommitted changes. 783 1. Visit the `HEAD' commit and navigate to the change that should 784 not have been included in that commit. 785 2. Type \"u\" (`magit-unstage') to reverse it in the index. 786 This assumes that `magit-unstage-committed' is non-nil. 787 3. Type \"c e\" to extend `HEAD' with the staged changes, 788 including those that were already staged before. 789 4. Optionally stage the remaining changes using \"s\" or \"S\" 790 and then type \"c c\" to create a new commit." 791 (interactive) 792 (magit-reverse (cons "--cached" args))) 793 794 ;;; Smerge Support 795 796 (defun magit-smerge-keep-current () 797 "Keep the current version of the conflict at point." 798 (interactive) 799 (magit-call-smerge #'smerge-keep-current)) 800 801 (defun magit-smerge-keep-upper () 802 "Keep the upper/our version of the conflict at point." 803 (interactive) 804 (magit-call-smerge #'smerge-keep-upper)) 805 806 (defun magit-smerge-keep-base () 807 "Keep the base version of the conflict at point." 808 (interactive) 809 (magit-call-smerge #'smerge-keep-base)) 810 811 (defun magit-smerge-keep-lower () 812 "Keep the lower/their version of the conflict at point." 813 (interactive) 814 (magit-call-smerge #'smerge-keep-lower)) 815 816 (defun magit-smerge-keep-all () 817 "Keep all versions of the conflict at point." 818 (interactive) 819 (magit-call-smerge #'smerge-keep-all)) 820 821 (defun magit-call-smerge (fn) 822 (pcase-let* ((file (magit-file-at-point t t)) 823 (keep (get-file-buffer file)) 824 (`(,buf ,pos) 825 (let ((magit-diff-visit-jump-to-change nil)) 826 (magit-diff-visit-file--noselect file)))) 827 (with-current-buffer buf 828 (save-excursion 829 (save-restriction 830 (unless (<= (point-min) pos (point-max)) 831 (widen)) 832 (goto-char pos) 833 (condition-case nil 834 (smerge-match-conflict) 835 (error 836 (if (eq fn #'smerge-keep-current) 837 (when (eq this-command #'magit-discard) 838 (re-search-forward smerge-begin-re nil t) 839 (setq fn 840 (magit-read-char-case "Keep side: " t 841 (?o "[o]urs/upper" #'smerge-keep-upper) 842 (?b "[b]ase" #'smerge-keep-base) 843 (?t "[t]heirs/lower" #'smerge-keep-lower)))) 844 (re-search-forward smerge-begin-re nil t)))) 845 (funcall fn))) 846 (when (and keep (magit-anything-unmerged-p file)) 847 (smerge-start-session)) 848 (save-buffer)) 849 (unless keep 850 (kill-buffer buf)) 851 (magit-refresh))) 852 853 ;;; _ 854 (provide 'magit-apply) 855 ;;; magit-apply.el ends here