diff options
Diffstat (limited to 'lisp/vc/diff-mode.el')
| -rw-r--r-- | lisp/vc/diff-mode.el | 246 |
1 files changed, 195 insertions, 51 deletions
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 4f150dc7f36..66043059d14 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -153,6 +153,17 @@ and hunk-based syntax highlighting otherwise as a fallback." :type (get 'whitespace-style 'custom-type) :version "29.1") +(defcustom diff-ignore-whitespace-switches "-b" + "Switch or list of diff switches to use when ignoring whitespace. +The default \"-b\" means to ignore whitespace-only changes, +\"-w\" means ignore all whitespace changes." + :type '(choice + (string :tag "Ignore whitespace-only changes" :value "-b") + (string :tag "Ignore all whitespace changes" :value "-w") + (string :tag "Single switch") + (repeat :tag "Multiple switches" (string :tag "Switch"))) + :version "30.1") + (defvar diff-vc-backend nil "The VC backend that created the current Diff buffer, if any.") @@ -205,6 +216,7 @@ and hunk-based syntax highlighting otherwise as a fallback." "C-x 4 A" #'diff-add-change-log-entries-other-window ;; Misc operations. "C-c C-a" #'diff-apply-hunk + "C-c C-m a" #'diff-apply-buffer "C-c C-e" #'diff-ediff-patch "C-c C-n" #'diff-restrict-view "C-c C-s" #'diff-split-hunk @@ -228,6 +240,8 @@ and hunk-based syntax highlighting otherwise as a fallback." :help "Apply the current hunk to the source file and go to the next"] ["Test applying hunk" diff-test-hunk :help "See whether it's possible to apply the current hunk"] + ["Apply all hunks" diff-apply-buffer + :help "Apply all hunks in the current diff buffer"] ["Apply diff with Ediff" diff-ediff-patch :help "Call `ediff-patch-file' on the current buffer"] ["Create Change Log entries" diff-add-change-log-entries-other-window @@ -505,8 +519,8 @@ use the face `diff-removed' for removed lines, and the face ("^Only in .*\n" . 'diff-nonexistent) ("^Binary files .* differ\n" . 'diff-file-header) ("^\\(#\\)\\(.*\\)" - (1 font-lock-comment-delimiter-face) - (2 font-lock-comment-face)) + (1 'font-lock-comment-delimiter-face) + (2 'font-lock-comment-face)) ("^diff: .*" (0 'diff-error)) ("^[^-=+*!<>#].*\n" (0 'diff-context)) (,#'diff--font-lock-syntax) @@ -932,7 +946,8 @@ like \(diff-merge-strings \"b/foo\" \"b/bar\" \"/a/c/foo\")." (when (and (string-match (concat "\\`\\(.*?\\)\\(.*\\)\\(.*\\)\n" "\\1\\(.*\\)\\3\n" - "\\(.*\\(\\2\\).*\\)\\'") str) + "\\(.*\\(\\2\\).*\\)\\'") + str) (equal to (match-string 5 str))) (concat (substring str (match-beginning 5) (match-beginning 6)) (match-string 4 str) @@ -1604,7 +1619,7 @@ modified lines of the diff." nil))) (when (eq diff-buffer-type 'git) (setq diff-outline-regexp - (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)"))) + (concat "\\(^diff --git.*\\|" diff-hunk-header-re "\\)"))) (setq-local outline-level #'diff--outline-level) (setq-local outline-regexp diff-outline-regexp)) @@ -1987,7 +2002,7 @@ With a prefix argument, REVERSE the hunk." (diff-find-source-location nil reverse))) (cond ((null line-offset) - (error "Can't find the text to patch")) + (user-error "Can't find the text to patch")) ((with-current-buffer buf (and buffer-file-name (backup-file-name-p buffer-file-name) @@ -1996,7 +2011,7 @@ With a prefix argument, REVERSE the hunk." (yes-or-no-p (format "Really apply this hunk to %s? " (file-name-nondirectory buffer-file-name))))))) - (error "%s" + (user-error "%s" (substitute-command-keys (format "Use %s\\[diff-apply-hunk] to apply it to the other file" (if (not reverse) "\\[universal-argument] "))))) @@ -2043,6 +2058,40 @@ With a prefix argument, try to REVERSE the hunk." (diff-hunk-kill) (diff-hunk-next))))) +(defun diff-apply-buffer () + "Apply the diff in the entire diff buffer. +When applying all hunks was successful, then save the changed buffers." + (interactive) + (let ((buffer-edits nil) + (failures 0) + (diff-refine nil)) + (save-excursion + (goto-char (point-min)) + (diff-beginning-of-hunk t) + (while (pcase-let ((`(,buf ,line-offset ,pos ,_src ,dst ,switched) + (diff-find-source-location nil nil))) + (cond ((and line-offset (not switched)) + (push (cons pos dst) + (alist-get buf buffer-edits))) + (t (setq failures (1+ failures)))) + (and (not (eq (prog1 (point) (ignore-errors (diff-hunk-next))) + (point))) + (looking-at-p diff-hunk-header-re))))) + (cond ((zerop failures) + (dolist (buf-edits (reverse buffer-edits)) + (with-current-buffer (car buf-edits) + (dolist (edit (cdr buf-edits)) + (let ((pos (car edit)) + (dst (cdr edit)) + (inhibit-read-only t)) + (goto-char (car pos)) + (delete-region (car pos) (cdr pos)) + (insert (car dst)))) + (save-buffer))) + (message "Saved %d buffers" (length buffer-edits))) + (t + (message "%d hunks failed; no buffers changed" failures))))) + (defalias 'diff-mouse-goto-source #'diff-goto-source) (defun diff-goto-source (&optional other-file event) @@ -2103,10 +2152,13 @@ For use in `add-log-current-defun-function'." (goto-char (+ (car pos) (cdr src))) (add-log-current-defun))))))) -(defun diff-ignore-whitespace-hunk () - "Re-diff the current hunk, ignoring whitespace differences." - (interactive) - (diff-refresh-hunk t)) +(defun diff-ignore-whitespace-hunk (&optional whole-buffer) + "Re-diff the current hunk, ignoring whitespace differences. +With non-nil prefix arg, re-diff all the hunks." + (interactive "P") + (if whole-buffer + (diff--ignore-whitespace-all-hunks) + (diff-refresh-hunk t))) (defun diff-refresh-hunk (&optional ignore-whitespace) "Re-diff the current hunk." @@ -2127,7 +2179,7 @@ For use in `add-log-current-defun-function'." (coding-system-for-read buffer-file-coding-system) opts old new) (when ignore-whitespace - (setq opts '("-b"))) + (setq opts (ensure-list diff-ignore-whitespace-switches))) (when opt-type (setq opts (cons opt-type opts))) @@ -2226,6 +2278,24 @@ Return new point, if it was moved." (end (progn (diff-end-of-hunk) (point)))) (diff--refine-hunk beg end))))) +(defun diff--refine-propertize (beg end face) + (let ((ol (make-overlay beg end))) + (overlay-put ol 'diff-mode 'fine) + (overlay-put ol 'evaporate t) + (overlay-put ol 'face face))) + +(defcustom diff-refine-nonmodified nil + "If non-nil, also highlight the added/removed lines as \"refined\". +The lines highlighted when this is non-nil are those that were +added or removed in their entirety, as opposed to lines some +parts of which were modified. The added lines are highlighted +using the `diff-refine-added' face, while the removed lines are +highlighted using the `diff-refine-removed' face. +This is currently implemented only for diff formats supported +by `diff-refine-hunk'." + :version "30.1" + :type 'boolean) + (defun diff--refine-hunk (start end) (require 'smerge-mode) (goto-char start) @@ -2240,41 +2310,68 @@ Return new point, if it was moved." (goto-char beg) (pcase style ('unified - (while (re-search-forward "^-" end t) + (while (re-search-forward "^[-+]" end t) (let ((beg-del (progn (beginning-of-line) (point))) beg-add end-add) - (when (and (diff--forward-while-leading-char ?- end) - ;; Allow for "\ No newline at end of file". - (progn (diff--forward-while-leading-char ?\\ end) - (setq beg-add (point))) - (diff--forward-while-leading-char ?+ end) - (progn (diff--forward-while-leading-char ?\\ end) - (setq end-add (point)))) + (cond + ((eq (char-after) ?+) + (diff--forward-while-leading-char ?+ end) + (when diff-refine-nonmodified + (diff--refine-propertize beg-del (point) 'diff-refine-added))) + ((and (diff--forward-while-leading-char ?- end) + ;; Allow for "\ No newline at end of file". + (progn (diff--forward-while-leading-char ?\\ end) + (setq beg-add (point))) + (diff--forward-while-leading-char ?+ end) + (progn (diff--forward-while-leading-char ?\\ end) + (setq end-add (point)))) (smerge-refine-regions beg-del beg-add beg-add end-add - nil #'diff-refine-preproc props-r props-a))))) + nil #'diff-refine-preproc props-r props-a)) + (t ;; If we're here, it's because + ;; (diff--forward-while-leading-char ?+ end) failed. + (when diff-refine-nonmodified + (diff--refine-propertize beg-del (point) + 'diff-refine-removed))))))) ('context (let* ((middle (save-excursion (re-search-forward "^---" end t))) (other middle)) - (while (and middle - (re-search-forward "^\\(?:!.*\n\\)+" middle t)) - (smerge-refine-regions (match-beginning 0) (match-end 0) - (save-excursion - (goto-char other) - (re-search-forward "^\\(?:!.*\n\\)+" end) - (setq other (match-end 0)) - (match-beginning 0)) - other - (if diff-use-changed-face props-c) - #'diff-refine-preproc - (unless diff-use-changed-face props-r) - (unless diff-use-changed-face props-a))))) + (when middle + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-regions (match-beginning 0) (match-end 0) + (save-excursion + (goto-char other) + (re-search-forward "^\\(?:!.*\n\\)+" end) + (setq other (match-end 0)) + (match-beginning 0)) + other + (if diff-use-changed-face props-c) + #'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))) + (when diff-refine-nonmodified + (goto-char beg) + (while (re-search-forward "^\\(?:-.*\n\\)+" middle t) + (diff--refine-propertize (match-beginning 0) + (match-end 0) + 'diff-refine-removed)) + (goto-char middle) + (while (re-search-forward "^\\(?:\\+.*\n\\)+" end t) + (diff--refine-propertize (match-beginning 0) + (match-end 0) + 'diff-refine-added)))))) (_ ;; Normal diffs. (let ((beg1 (1+ (point)))) - (when (re-search-forward "^---.*\n" end t) + (cond + ((re-search-forward "^---.*\n" end t) ;; It's a combined add&remove, so there's something to do. (smerge-refine-regions beg1 (match-beginning 0) (match-end 0) end - nil #'diff-refine-preproc props-r props-a))))))) + nil #'diff-refine-preproc props-r props-a)) + (diff-refine-nonmodified + (diff--refine-propertize + beg1 end + (if (eq (char-after beg1) ?<) + 'diff-refine-removed 'diff-refine-added))))))))) (defun diff--iterate-hunks (max fun) "Iterate over all hunks between point and MAX. @@ -2299,6 +2396,16 @@ Call FUN with two args (BEG and END) for each hunk." (or (ignore-errors (diff-hunk-next) (point)) max))))))))) +;; This doesn't use `diff--iterate-hunks', since that assumes that +;; hunks don't change size. +(defun diff--ignore-whitespace-all-hunks () + "Re-diff all the hunks, ignoring whitespace-differences." + (save-excursion + (goto-char (point-min)) + (diff-hunk-next) + (while (looking-at diff-hunk-header-re) + (diff-refresh-hunk t)))) + (defun diff--font-lock-refined (max) "Apply hunk refinement from font-lock." (when (eq diff-refine 'font-lock) @@ -2758,6 +2865,57 @@ and the position in MAX." (defvar-local diff--syntax-file-attributes nil) (put 'diff--syntax-file-attributes 'permanent-local t) +(defvar diff--cached-revision-buffers nil + "List of ((FILE . REVISION) . BUFFER) in MRU order.") + +(defvar diff--cache-clean-timer nil) +(defconst diff--cache-clean-interval 3600) ; seconds + +(defun diff--cache-clean () + "Discard the least recently used half of the cache." + (let ((n (/ (length diff--cached-revision-buffers) 2))) + (mapc #'kill-buffer (mapcar #'cdr (nthcdr n diff--cached-revision-buffers))) + (setq diff--cached-revision-buffers + (ntake n diff--cached-revision-buffers))) + (diff--cache-schedule-clean)) + +(defun diff--cache-schedule-clean () + (setq diff--cache-clean-timer + (and diff--cached-revision-buffers + (run-with-timer diff--cache-clean-interval nil + #'diff--cache-clean)))) + +(defun diff--get-revision-properties (file revision text line-nb) + "Get font-lock properties from FILE at REVISION for TEXT at LINE-NB." + (let* ((file-rev (cons file revision)) + (entry (assoc file-rev diff--cached-revision-buffers)) + (buffer (cdr entry))) + (if (buffer-live-p buffer) + (progn + ;; Don't re-initialize the buffer (which would throw + ;; away the previous fontification work). + (setq file nil) + (setq diff--cached-revision-buffers + (cons entry + (delq entry diff--cached-revision-buffers)))) + ;; Cache miss: create a new entry. + (setq buffer (get-buffer-create (format " *diff-syntax:%s.~%s~*" + file revision))) + (condition-case nil + (vc-find-revision-no-save file revision diff-vc-backend buffer) + (error + (kill-buffer buffer) + (setq buffer nil)) + (:success + (push (cons file-rev buffer) + diff--cached-revision-buffers)))) + (when diff--cache-clean-timer + (cancel-timer diff--cache-clean-timer)) + (diff--cache-schedule-clean) + (and buffer + (with-current-buffer buffer + (diff-syntax-fontify-props file text line-nb))))) + (defun diff-syntax-fontify-hunk (beg end old) "Highlight source language syntax in diff hunk between BEG and END. When OLD is non-nil, highlight the hunk from the old source." @@ -2808,22 +2966,8 @@ When OLD is non-nil, highlight the hunk from the old source." (insert-file-contents file) (setq diff--syntax-file-attributes attrs))) (diff-syntax-fontify-props file text line-nb))))) - ;; Get properties from a cached revision - (let* ((buffer-name (format " *diff-syntax:%s.~%s~*" - file revision)) - (buffer (get-buffer buffer-name))) - (if buffer - ;; Don't re-initialize the buffer (which would throw - ;; away the previous fontification work). - (setq file nil) - (setq buffer (ignore-errors - (vc-find-revision-no-save - file revision - diff-vc-backend - (get-buffer-create buffer-name))))) - (when buffer - (with-current-buffer buffer - (diff-syntax-fontify-props file text line-nb)))))))) + (diff--get-revision-properties file revision + text line-nb))))) (let ((file (car (diff-hunk-file-names old)))) (cond ((and file diff-default-directory |