X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/acaf905b1130aae80fa59d2c861ffd4c8eb75486..c7fe9adcd4c114443f3706d7150ff5ce632f8717:/lisp/vc/diff-mode.el diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 7de9d17e3f..d3d9878c5a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1,6 +1,6 @@ ;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*- -;; Copyright (C) 1998-2012 Free Software Foundation, Inc. +;; Copyright (C) 1998-2012 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: convenience patch diff vc @@ -27,7 +27,7 @@ ;; to the corresponding source file. ;; Inspired by Pavel Machek's patch-mode.el () -;; Some efforts were spent to have it somewhat compatible with XEmacs' +;; Some efforts were spent to have it somewhat compatible with XEmacs's ;; diff-mode as well as with compilation-minor-mode ;; Bugs: @@ -53,7 +53,7 @@ ;; - Handle `diff -b' output in context->unified. ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defvar add-log-buffer-file-name-function) @@ -107,8 +107,7 @@ when editing big diffs)." ;;;; (easy-mmode-defmap diff-mode-shared-map - '(;; From Pavel Machek's patch-mode. - ("n" . diff-hunk-next) + '(("n" . diff-hunk-next) ("N" . diff-file-next) ("p" . diff-hunk-prev) ("P" . diff-file-prev) @@ -116,27 +115,17 @@ when editing big diffs)." ([backtab] . diff-hunk-prev) ("k" . diff-hunk-kill) ("K" . diff-file-kill) - ;; From compilation-minor-mode. - ("}" . diff-file-next) + ("}" . diff-file-next) ; From compilation-minor-mode. ("{" . diff-file-prev) ("\C-m" . diff-goto-source) ([mouse-2] . diff-goto-source) - ;; From XEmacs' diff-mode. ("W" . widen) - ;;("." . diff-goto-source) ;display-buffer - ;;("f" . diff-goto-source) ;find-file - ("o" . diff-goto-source) ;other-window - ;;("w" . diff-goto-source) ;other-frame - ;;("N" . diff-narrow) - ;;("h" . diff-show-header) - ;;("j" . diff-show-difference) ;jump to Nth diff - ;;("q" . diff-quit) - ;; Not useful if you have to metafy them. - ;;(" " . scroll-up) - ;;("\177" . scroll-down) + ("o" . diff-goto-source) ; other-window ("A" . diff-ediff-patch) ("r" . diff-restrict-view) - ("R" . diff-reverse-direction)) + ("R" . diff-reverse-direction) + ("/" . diff-undo) + ([remap undo] . diff-undo)) "Basic keymap for `diff-mode', bound to various prefix keys." :inherit special-mode-map) @@ -237,7 +226,7 @@ from disabled to enabled, it tries to refine the current hunk, as well." :group 'diff-mode :init-value t :lighter nil ;; " Auto-Refine" (when diff-auto-refine-mode - (condition-case-no-debug nil (diff-refine-hunk) (error nil)))) + (condition-case-unless-debug nil (diff-refine-hunk) (error nil)))) ;;;; ;;;; font-lock support @@ -248,10 +237,8 @@ well." :background "grey80") (((class color) (min-colors 88) (background dark)) :background "grey45") - (((class color) (background light)) + (((class color)) :foreground "blue1" :weight bold) - (((class color) (background dark)) - :foreground "green" :weight bold) (t :weight bold)) "`diff-mode' face inherited by hunk and index header faces." :group 'diff-mode) @@ -263,9 +250,7 @@ well." :background "grey70" :weight bold) (((class color) (min-colors 88) (background dark)) :background "grey60" :weight bold) - (((class color) (background light)) - :foreground "green" :weight bold) - (((class color) (background dark)) + (((class color)) :foreground "cyan" :weight bold) (t :weight bold)) ; :height 1.3 "`diff-mode' face used to highlight file header lines." @@ -288,14 +273,28 @@ well." (defvar diff-hunk-header-face 'diff-hunk-header) (defface diff-removed - '((t :inherit diff-changed)) + '((default + :inherit diff-changed) + (((class color) (min-colors 88) (background light)) + :background "#ffdddd") + (((class color) (min-colors 88) (background dark)) + :background "#553333") + (((class color)) + :foreground "red")) "`diff-mode' face used to highlight removed lines." :group 'diff-mode) (define-obsolete-face-alias 'diff-removed-face 'diff-removed "22.1") (defvar diff-removed-face 'diff-removed) (defface diff-added - '((t :inherit diff-changed)) + '((default + :inherit diff-changed) + (((class color) (min-colors 88) (background light)) + :background "#ddffdd") + (((class color) (min-colors 88) (background dark)) + :background "#335533") + (((class color)) + :foreground "green")) "`diff-mode' face used to highlight added lines." :group 'diff-mode) (define-obsolete-face-alias 'diff-added-face 'diff-added "22.1") @@ -307,10 +306,8 @@ well." '((((class color grayscale) (min-colors 88))) ;; If the terminal lacks sufficient colors for shadowing, ;; highlight changed lines explicitly. - (((class color) (background light)) - :foreground "magenta" :weight bold :slant italic) - (((class color) (background dark)) - :foreground "yellow" :weight bold :slant italic)) + (((class color)) + :foreground "yellow")) "`diff-mode' face used to highlight changed lines." :group 'diff-mode) (define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1") @@ -385,6 +382,13 @@ well." (defconst diff-context-mid-hunk-header-re "--- \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? ----$") +(defvar diff-use-changed-face (and (face-differs-from-default-p diff-changed-face) + (not (face-equal diff-changed-face diff-added-face)) + (not (face-equal diff-changed-face diff-removed-face))) + "If non-nil, use the face `diff-changed' for changed lines in context diffs. +Otherwise, use the face `diff-removed' for removed lines, +and the face `diff-added' for added lines.") + (defvar diff-font-lock-keywords `((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$") (1 diff-hunk-header-face) (6 diff-function-face)) @@ -404,8 +408,25 @@ well." ("^\\([+>]\\)\\(.*\n\\)" (1 diff-indicator-added-face) (2 diff-added-face)) ("^\\(!\\)\\(.*\n\\)" - (1 diff-indicator-changed-face) (2 diff-changed-face)) - ("^Index: \\(.+\\).*\n" + (1 (if diff-use-changed-face + diff-indicator-changed-face + ;; Otherwise, search for `diff-context-mid-hunk-header-re' and + ;; if the line of context diff is above, use `diff-removed-face'; + ;; if below, use `diff-added-face'. + (save-match-data + (let ((limit (save-excursion (diff-beginning-of-hunk)))) + (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t)) + diff-indicator-added-face + diff-indicator-removed-face))))) + (2 (if diff-use-changed-face + diff-changed-face + ;; Otherwise, use the same method as above. + (save-match-data + (let ((limit (save-excursion (diff-beginning-of-hunk)))) + (if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t)) + diff-added-face + diff-removed-face)))))) + ("^\\(?:Index\\|revno\\): \\(.+\\).*\n" (0 diff-header-face) (1 diff-index-face prepend)) ("^Only in .*\n" . diff-nonexistent-face) ("^\\(#\\)\\(.*\\)" @@ -445,6 +466,7 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") style) (defun diff-end-of-hunk (&optional style donttrustheader) + "Advance to the end of the current hunk, and return its position." (let (end) (when (looking-at diff-hunk-header-re) ;; Especially important for unified (because headers are ambiguous). @@ -471,14 +493,15 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") ;; We may have a first evaluation of `end' thanks to the hunk header. (unless end (setq end (and (re-search-forward - (case style - (unified (concat (if diff-valid-unified-empty-line - "^[^-+# \\\n]\\|" "^[^-+# \\]\\|") - ;; A `unified' header is ambiguous. - diff-file-header-re)) - (context "^[^-+#! \\]") - (normal "^[^<>#\\]") - (t "^[^-+#!<> \\]")) + (pcase style + (`unified + (concat (if diff-valid-unified-empty-line + "^[^-+# \\\n]\\|" "^[^-+# \\]\\|") + ;; A `unified' header is ambiguous. + diff-file-header-re)) + (`context "^[^-+#! \\]") + (`normal "^[^<>#\\]") + (_ "^[^-+#!<> \\]")) nil t) (match-beginning 0))) (when diff-valid-unified-empty-line @@ -492,19 +515,21 @@ See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html") (goto-char (or end (point-max))))) (defun diff-beginning-of-hunk (&optional try-harder) - "Move back to beginning of hunk. -If TRY-HARDER is non-nil, try to cater to the case where we're not in a hunk -but in the file header instead, in which case move forward to the first hunk." + "Move back to the previous hunk beginning, and return its position. +If point is in a file header rather than a hunk, advance to the +next hunk if TRY-HARDER is non-nil; otherwise signal an error." (beginning-of-line) - (unless (looking-at diff-hunk-header-re) + (if (looking-at diff-hunk-header-re) + (point) (forward-line 1) (condition-case () (re-search-backward diff-hunk-header-re) (error - (if (not try-harder) - (error "Can't find the beginning of the hunk") - (diff-beginning-of-file-and-junk) - (diff-hunk-next)))))) + (unless try-harder + (error "Can't find the beginning of the hunk")) + (diff-beginning-of-file-and-junk) + (diff-hunk-next) + (point))))) (defun diff-unified-hunk-p () (save-excursion @@ -542,49 +567,77 @@ but in the file header instead, in which case move forward to the first hunk." (easy-mmode-define-navigation diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view (if diff-auto-refine-mode - (condition-case-no-debug nil (diff-refine-hunk) (error nil)))) + (condition-case-unless-debug nil (diff-refine-hunk) (error nil)))) (easy-mmode-define-navigation - diff-file diff-file-header-re "file" diff-end-of-hunk) + diff-file diff-file-header-re "file" diff-end-of-file) + +(defun diff-bounds-of-hunk () + "Return the bounds of the diff hunk at point. +The return value is a list (BEG END), which are the hunk's start +and end positions. Signal an error if no hunk is found. If +point is in a file header, return the bounds of the next hunk." + (save-excursion + (let ((pos (point)) + (beg (diff-beginning-of-hunk t)) + (end (diff-end-of-hunk))) + (cond ((>= end pos) + (list beg end)) + ;; If this hunk ends above POS, consider the next hunk. + ((re-search-forward diff-hunk-header-re nil t) + (list (match-beginning 0) (diff-end-of-hunk))) + (t (error "No hunk found")))))) + +(defun diff-bounds-of-file () + "Return the bounds of the file segment at point. +The return value is a list (BEG END), which are the segment's +start and end positions." + (save-excursion + (let ((pos (point)) + (beg (progn (diff-beginning-of-file-and-junk) + (point)))) + (diff-end-of-file) + ;; bzr puts a newline after the last hunk. + (while (looking-at "^\n") + (forward-char 1)) + (if (> pos (point)) + (error "Not inside a file diff")) + (list beg (point))))) (defun diff-restrict-view (&optional arg) "Restrict the view to the current hunk. If the prefix ARG is given, restrict the view to the current file instead." (interactive "P") - (save-excursion - (if arg (diff-beginning-of-file) (diff-beginning-of-hunk 'try-harder)) - (narrow-to-region (point) - (progn (if arg (diff-end-of-file) (diff-end-of-hunk)) - (point))) - (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk)))) - + (apply 'narrow-to-region + (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) + (set (make-local-variable 'diff-narrowed-to) (if arg 'file 'hunk))) (defun diff-hunk-kill () - "Kill current hunk." + "Kill the hunk at point." (interactive) - (diff-beginning-of-hunk) - (let* ((start (point)) - ;; Search the second match, since we're looking at the first. - (nexthunk (when (re-search-forward diff-hunk-header-re nil t 2) - (match-beginning 0))) - (firsthunk (ignore-errors - (goto-char start) - (diff-beginning-of-file) (diff-hunk-next) (point))) - (nextfile (ignore-errors (diff-file-next) (point))) + (let* ((hunk-bounds (diff-bounds-of-hunk)) + (file-bounds (ignore-errors (diff-bounds-of-file))) + ;; If the current hunk is the only one for its file, kill the + ;; file header too. + (bounds (if (and file-bounds + (progn (goto-char (car file-bounds)) + (= (progn (diff-hunk-next) (point)) + (car hunk-bounds))) + (progn (goto-char (cadr hunk-bounds)) + ;; bzr puts a newline after the last hunk. + (while (looking-at "^\n") + (forward-char 1)) + (= (point) (cadr file-bounds)))) + file-bounds + hunk-bounds)) (inhibit-read-only t)) - (goto-char start) - (if (and firsthunk (= firsthunk start) - (or (null nexthunk) - (and nextfile (> nexthunk nextfile)))) - ;; It's the only hunk for this file, so kill the file. - (diff-file-kill) - (diff-end-of-hunk) - (kill-region start (point))))) + (apply 'kill-region bounds) + (goto-char (car bounds)))) ;; "index ", "old mode", "new mode", "new file mode" and ;; "deleted file mode" are output by git-diff. (defconst diff-file-junk-re - "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode") + "diff \\|index \\|\\(?:deleted file\\|new\\(?: file\\)?\\|old\\) mode\\|=== modified file") (defun diff-beginning-of-file-and-junk () "Go to the beginning of file-related diff-info. @@ -636,13 +689,8 @@ data such as \"Index: ...\" and such." (defun diff-file-kill () "Kill current file's hunks." (interactive) - (let ((orig (point)) - (start (progn (diff-beginning-of-file-and-junk) (point))) - (inhibit-read-only t)) - (diff-end-of-file) - (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs. - (if (> orig (point)) (error "Not inside a file diff")) - (kill-region start (point)))) + (let ((inhibit-read-only t)) + (apply 'kill-region (diff-bounds-of-file)))) (defun diff-kill-junk () "Kill spurious empty diffs." @@ -663,7 +711,7 @@ data such as \"Index: ...\" and such." (save-excursion (let ((n 0)) (goto-char start) - (while (re-search-forward re end t) (incf n)) + (while (re-search-forward re end t) (cl-incf n)) n))) (defun diff-splittable-p () @@ -678,7 +726,7 @@ data such as \"Index: ...\" and such." (interactive) (beginning-of-line) (let ((pos (point)) - (start (progn (diff-beginning-of-hunk) (point)))) + (start (diff-beginning-of-hunk))) (unless (looking-at diff-hunk-header-re-unified) (error "diff-split-hunk only works on unified context diffs")) (forward-line 1) @@ -787,16 +835,16 @@ PREFIX is only used internally: don't use it." ;; use any previously used preference (cdr (assoc fs diff-remembered-files-alist)) ;; try to be clever and use previous choices as an inspiration - (dolist (rf diff-remembered-files-alist) + (cl-dolist (rf diff-remembered-files-alist) (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf)))) - (if (and newfile (file-exists-p newfile)) (return newfile)))) + (if (and newfile (file-exists-p newfile)) (cl-return newfile)))) ;; look for each file in turn. If none found, try again but ;; ignoring the first level of directory, ... - (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files))) - (file nil nil)) + (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files))) + (file nil nil)) ((or (null files) - (setq file (do* ((files files (cdr files)) - (file (car files) (car files))) + (setq file (cl-do* ((files files (cdr files)) + (file (car files) (car files))) ;; Use file-regular-p to avoid ;; /dev/null, directories, etc. ((or (null file) (file-regular-p file)) @@ -815,7 +863,7 @@ PREFIX is only used internally: don't use it." (diff-find-file-name old noprompt (match-string 1))) ;; if all else fails, ask the user (unless noprompt - (let ((file (expand-file-name (or (first fs) "")))) + (let ((file (expand-file-name (or (car fs) "")))) (setq file (read-file-name (format "Use file %s: " file) (file-name-directory file) file t @@ -893,21 +941,23 @@ else cover the whole buffer." (let ((modif nil) last-pt) (while (progn (setq last-pt (point)) (= (forward-line -1) 0)) - (case (char-after) + (pcase (char-after) (?\s (insert " ") (setq modif nil) (backward-char 1)) (?+ (delete-region (point) last-pt) (setq modif t)) (?- (if (not modif) - (progn (forward-char 1) - (insert " ")) - (delete-char 1) - (insert "! ")) - (backward-char 2)) + (progn (forward-char 1) + (insert " ")) + (delete-char 1) + (insert "! ")) + (backward-char 2)) (?\\ (when (save-excursion (forward-line -1) - (= (char-after) ?+)) - (delete-region (point) last-pt) (setq modif t))) + (= (char-after) ?+)) + (delete-region (point) last-pt) + (setq modif t))) ;; diff-valid-unified-empty-line. - (?\n (insert " ") (setq modif nil) (backward-char 2)) - (t (setq modif nil)))))) + (?\n (insert " ") (setq modif nil) + (backward-char 2)) + (_ (setq modif nil)))))) (goto-char (point-max)) (save-excursion (insert "--- " line2 "," @@ -920,7 +970,8 @@ else cover the whole buffer." (if (not (save-excursion (re-search-forward "^+" nil t))) (delete-region (point) (point-max)) (let ((modif nil) (delete nil)) - (if (save-excursion (re-search-forward "^\\+.*\n-" nil t)) + (if (save-excursion (re-search-forward "^\\+.*\n-" + nil t)) ;; Normally, lines in a substitution come with ;; first the removals and then the additions, and ;; the context->unified function follows this @@ -929,22 +980,22 @@ else cover the whole buffer." ;; context->unified as an undo command. (setq reversible nil)) (while (not (eobp)) - (case (char-after) + (pcase (char-after) (?\s (insert " ") (setq modif nil) (backward-char 1)) (?- (setq delete t) (setq modif t)) (?+ (if (not modif) - (progn (forward-char 1) - (insert " ")) - (delete-char 1) - (insert "! ")) - (backward-char 2)) + (progn (forward-char 1) + (insert " ")) + (delete-char 1) + (insert "! ")) + (backward-char 2)) (?\\ (when (save-excursion (forward-line 1) - (not (eobp))) - (setq delete t) (setq modif t))) + (not (eobp))) + (setq delete t) (setq modif t))) ;; diff-valid-unified-empty-line. (?\n (insert " ") (setq modif nil) (backward-char 2) (setq reversible nil)) - (t (setq modif nil))) + (_ (setq modif nil))) (let ((last-pt (point))) (forward-line 1) (when delete @@ -1004,17 +1055,18 @@ With a prefix argument, convert unified format to context format." (goto-char pt1) (forward-line 1) (while (< (point) pt2) - (case (char-after) + (pcase (char-after) (?! (delete-char 2) (insert "-") (forward-line 1)) (?- (forward-char 1) (delete-char 1) (forward-line 1)) - (?\s ;merge with the other half of the chunk + (?\s ;merge with the other half of the chunk (let* ((endline2 (save-excursion (goto-char pt2) (forward-line 1) (point)))) - (case (char-after pt2) - ((?! ?+) + (pcase (char-after pt2) + ((or ?! ?+) (insert "+" - (prog1 (buffer-substring (+ pt2 2) endline2) + (prog1 + (buffer-substring (+ pt2 2) endline2) (delete-region pt2 endline2)))) (?\s (unless (= (- endline2 pt2) @@ -1028,9 +1080,9 @@ With a prefix argument, convert unified format to context format." (delete-char 1) (forward-line 1)) (?\\ (forward-line 1)) - (t (setq reversible nil) + (_ (setq reversible nil) (delete-char 1) (forward-line 1))))) - (t (setq reversible nil) (forward-line 1)))) + (_ (setq reversible nil) (forward-line 1)))) (while (looking-at "[+! ] ") (if (/= (char-after) ?!) (forward-char 1) (delete-char 1) (insert "+")) @@ -1108,13 +1160,13 @@ else cover the whole buffer." (replace-match "@@ -\\8 +\\7 @@" nil) (forward-line 1) (let ((c (char-after)) first last) - (while (case (setq c (char-after)) + (while (pcase (setq c (char-after)) (?- (setq first (or first (point))) - (delete-char 1) (insert "+") t) + (delete-char 1) (insert "+") t) (?+ (setq last (or last (point))) - (delete-char 1) (insert "-") t) - ((?\\ ?#) t) - (t (when (and first last (< first last)) + (delete-char 1) (insert "-") t) + ((or ?\\ ?#) t) + (_ (when (and first last (< first last)) (insert (delete-and-extract-region first last))) (setq first nil last nil) (memq c (if diff-valid-unified-empty-line @@ -1137,13 +1189,13 @@ else cover the whole buffer." (concat diff-hunk-header-re-unified "\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$" "\\|--- .+\n\\+\\+\\+ "))) - (case (char-after) - (?\s (incf space)) - (?+ (incf plus)) - (?- (incf minus)) - (?! (incf bang)) - ((?\\ ?#) nil) - (t (setq space 0 plus 0 minus 0 bang 0))) + (pcase (char-after) + (?\s (cl-incf space)) + (?+ (cl-incf plus)) + (?- (cl-incf minus)) + (?! (cl-incf bang)) + ((or ?\\ ?#) nil) + (_ (setq space 0 plus 0 minus 0 bang 0))) (cond ((looking-at diff-hunk-header-re-unified) (let* ((old1 (match-string 2)) @@ -1283,11 +1335,7 @@ a diff with \\[diff-reverse-direction]. (set (make-local-variable 'end-of-defun-function) 'diff-end-of-file) - ;; Set up `whitespace-mode' so that turning it on will show trailing - ;; whitespace problems on the modified lines of the diff. - (set (make-local-variable 'whitespace-style) '(face trailing)) - (set (make-local-variable 'whitespace-trailing-regexp) - "^[-\+!<>].*?\\([\t ]+\\)$") + (diff-setup-whitespace) (setq buffer-read-only diff-default-read-only) ;; setup change hooks @@ -1332,6 +1380,22 @@ the mode if ARG is omitted or nil. ;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun diff-setup-whitespace () + "Set up Whitespace mode variables for the current Diff mode buffer. +This sets `whitespace-style' and `whitespace-trailing-regexp' so +that Whitespace mode shows trailing whitespace problems on the +modified lines of the diff." + (set (make-local-variable 'whitespace-style) '(face trailing)) + (let ((style (save-excursion + (goto-char (point-min)) + (when (re-search-forward diff-hunk-header-re nil t) + (goto-char (match-beginning 0)) + (diff-hunk-style))))) + (set (make-local-variable 'whitespace-trailing-regexp) + (if (eq style 'context) + "^[-\+!] .*?\\([\t ]+\\)$" + "^[-\+!<>].*?\\([\t ]+\\)$")))) + (defun diff-delete-if-empty () ;; An empty diff file means there's no more diffs to integrate, so we ;; can just remove the file altogether. Very handy for .rej files if we @@ -1373,7 +1437,7 @@ Only works for unified diffs." (cond ((and (memq (char-after) '(?\s ?! ?+ ?-)) (memq (char-after (1+ (point))) '(?\s ?\t))) - (decf count) t) + (cl-decf count) t) ((or (zerop count) (= count lines)) nil) ((memq (char-after) '(?! ?+ ?-)) (if (not (and (eq (char-after (1+ (point))) ?\n) @@ -1424,8 +1488,8 @@ Only works for unified diffs." (after (string-to-number (or (match-string 4) "1")))) (forward-line) (while - (case (char-after) - (?\s (decf before) (decf after) t) + (pcase (char-after) + (?\s (cl-decf before) (cl-decf after) t) (?- (if (and (looking-at diff-file-header-re) (zerop before) (zerop after)) @@ -1435,15 +1499,15 @@ Only works for unified diffs." ;; line so that our code which doesn't count lines ;; will not get confused. (progn (save-excursion (insert "\n")) nil) - (decf before) t)) - (?+ (decf after) t) - (t + (cl-decf before) t)) + (?+ (cl-decf after) t) + (_ (cond ((and diff-valid-unified-empty-line ;; Not just (eolp) so we don't infloop at eob. (eq (char-after) ?\n) (> before 0) (> after 0)) - (decf before) (decf after) t) + (cl-decf before) (cl-decf after) t) ((and (zerop before) (zerop after)) nil) ((or (< before 0) (< after 0)) (error (if (or (zerop before) (zerop after)) @@ -1588,8 +1652,7 @@ SWITCHED is non-nil if the patch is already applied. NOPROMPT, if non-nil, means not to prompt the user." (save-excursion (let* ((other (diff-xor other-file diff-jump-to-old-file)) - (char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder) - (point)))) + (char-offset (- (point) (diff-beginning-of-hunk t))) ;; Check that the hunk is well-formed. Otherwise diff-mode and ;; the user may disagree on what constitutes the hunk ;; (e.g. because an empty line truncates the hunk mid-course), @@ -1661,16 +1724,17 @@ the value of this variable when given an appropriate prefix argument). With a prefix argument, REVERSE the hunk." (interactive "P") - (destructuring-bind (buf line-offset pos old new &optional switched) - ;; Sometimes we'd like to have the following behavior: if REVERSE go - ;; to the new file, otherwise go to the old. But that means that by - ;; default we use the old file, which is the opposite of the default - ;; for diff-goto-source, and is thus confusing. Also when you don't - ;; know about it it's pretty surprising. - ;; TODO: make it possible to ask explicitly for this behavior. - ;; - ;; This is duplicated in diff-test-hunk. - (diff-find-source-location nil reverse) + (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched) + ;; Sometimes we'd like to have the following behavior: if + ;; REVERSE go to the new file, otherwise go to the old. + ;; But that means that by default we use the old file, which is + ;; the opposite of the default for diff-goto-source, and is thus + ;; confusing. Also when you don't know about it it's + ;; pretty surprising. + ;; TODO: make it possible to ask explicitly for this behavior. + ;; + ;; This is duplicated in diff-test-hunk. + (diff-find-source-location nil reverse))) (cond ((null line-offset) (error "Can't find the text to patch")) @@ -1713,8 +1777,8 @@ With a prefix argument, REVERSE the hunk." "See whether it's possible to apply the current hunk. With a prefix argument, try to REVERSE the hunk." (interactive "P") - (destructuring-bind (buf line-offset pos src _dst &optional switched) - (diff-find-source-location nil reverse) + (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) + (diff-find-source-location nil reverse))) (set-window-point (display-buffer buf) (+ (car pos) (cdr src))) (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))) @@ -1733,8 +1797,8 @@ then `diff-jump-to-old-file' is also set, for the next invocations." ;; This is a convenient detail when using smerge-diff. (if event (posn-set-point (event-end event))) (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) - (destructuring-bind (buf line-offset pos src _dst &optional switched) - (diff-find-source-location other-file rev) + (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) + (diff-find-source-location other-file rev))) (pop-to-buffer buf) (goto-char (+ (car pos) (cdr src))) (diff-hunk-status-msg line-offset (diff-xor rev switched) t)))) @@ -1751,10 +1815,11 @@ For use in `add-log-current-defun-function'." (when (looking-at diff-hunk-header-re) (forward-line 1) (re-search-forward "^[^ ]" nil t)) - (destructuring-bind (&optional buf _line-offset pos src dst switched) - ;; Use `noprompt' since this is used in which-func-mode and such. - (ignore-errors ;Signals errors in place of prompting. - (diff-find-source-location nil nil 'noprompt)) + (pcase-let ((`(,buf ,_line-offset ,pos ,src ,dst ,switched) + (ignore-errors ;Signals errors in place of prompting. + ;; Use `noprompt' since this is used in which-func-mode + ;; and such. + (diff-find-source-location nil nil 'noprompt)))) (when buf (beginning-of-line) (or (when (memq (char-after) '(?< ?-)) @@ -1776,9 +1841,8 @@ For use in `add-log-current-defun-function'." (defun diff-ignore-whitespace-hunk () "Re-diff the current hunk, ignoring whitespace differences." (interactive) - (let* ((char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder) - (point)))) - (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b"))) + (let* ((char-offset (- (point) (diff-beginning-of-hunk t))) + (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b"))) (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") (error "Can't find line number")) (string-to-number (match-string 1)))) @@ -1800,13 +1864,13 @@ For use in `add-log-current-defun-function'." (let ((status (call-process diff-command nil t nil opts file1 file2))) - (case status - (0 nil) ;Nothing to reformat. + (pcase status + (0 nil) ;Nothing to reformat. (1 (goto-char (point-min)) - ;; Remove the file-header. - (when (re-search-forward diff-hunk-header-re nil t) - (delete-region (point-min) (match-beginning 0)))) - (t (goto-char (point-max)) + ;; Remove the file-header. + (when (re-search-forward diff-hunk-header-re nil t) + (delete-region (point-min) (match-beginning 0)))) + (_ (goto-char (point-max)) (unless (bolp) (insert "\n")) (insert hunk))) (setq hunk (buffer-string)) @@ -1822,17 +1886,35 @@ For use in `add-log-current-defun-function'." (defface diff-refine-change '((((class color) (min-colors 88) (background light)) - :background "grey85") + :background "#ffff55") (((class color) (min-colors 88) (background dark)) - :background "grey60") - (((class color) (background light)) - :background "yellow") - (((class color) (background dark)) - :background "green") - (t :weight bold)) + :background "#aaaa22") + (t :inverse-video t)) "Face used for char-based changes shown by `diff-refine-hunk'." :group 'diff-mode) +(defface diff-refine-removed + '((default + :inherit diff-refine-change) + (((class color) (min-colors 88) (background light)) + :background "#ffaaaa") + (((class color) (min-colors 88) (background dark)) + :background "#aa2222")) + "Face used for removed characters shown by `diff-refine-hunk'." + :group 'diff-mode + :version "24.2") + +(defface diff-refine-added + '((default + :inherit diff-refine-change) + (((class color) (min-colors 88) (background light)) + :background "#aaffaa") + (((class color) (min-colors 88) (background dark)) + :background "#22aa22")) + "Face used for added characters shown by `diff-refine-hunk'." + :group 'diff-mode + :version "24.2") + (defun diff-refine-preproc () (while (re-search-forward "^[+>]" nil t) ;; Remove spurious changes due to the fact that one side of the hunk is @@ -1846,18 +1928,20 @@ For use in `add-log-current-defun-function'." ) (declare-function smerge-refine-subst "smerge-mode" - (beg1 end1 beg2 end2 props &optional preproc)) + (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)) (defun diff-refine-hunk () "Highlight changes of hunk at point at a finer granularity." (interactive) (require 'smerge-mode) (save-excursion - (diff-beginning-of-hunk 'try-harder) + (diff-beginning-of-hunk t) (let* ((start (point)) (style (diff-hunk-style)) ;Skips the hunk header as well. (beg (point)) - (props '((diff-mode . fine) (face diff-refine-change))) + (props-c '((diff-mode . fine) (face diff-refine-change))) + (props-r '((diff-mode . fine) (face diff-refine-removed))) + (props-a '((diff-mode . fine) (face diff-refine-added))) ;; Be careful to go back to `start' so diff-end-of-hunk gets ;; to read the hunk header's line info. (end (progn (goto-char start) (diff-end-of-hunk) (point)))) @@ -1865,14 +1949,14 @@ For use in `add-log-current-defun-function'." (remove-overlays beg end 'diff-mode 'fine) (goto-char beg) - (case style - (unified + (pcase style + (`unified (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+" end t) (smerge-refine-subst (match-beginning 0) (match-end 1) (match-end 1) (match-end 0) - props 'diff-refine-preproc))) - (context + nil 'diff-refine-preproc props-r props-a))) + (`context (let* ((middle (save-excursion (re-search-forward "^---"))) (other middle)) (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) @@ -1883,15 +1967,23 @@ For use in `add-log-current-defun-function'." (setq other (match-end 0)) (match-beginning 0)) other - props 'diff-refine-preproc)))) - (t ;; Normal diffs. + (if diff-use-changed-face props-c) + 'diff-refine-preproc + (unless diff-use-changed-face props-r) + (unless diff-use-changed-face props-a))))) + (_ ;; Normal diffs. (let ((beg1 (1+ (point)))) (when (re-search-forward "^---.*\n" end t) ;; It's a combined add&remove, so there's something to do. (smerge-refine-subst beg1 (match-beginning 0) (match-end 0) end - props 'diff-refine-preproc)))))))) + nil 'diff-refine-preproc props-r props-a)))))))) +(defun diff-undo (&optional arg) + "Perform `undo', ignoring the buffer's read-only status." + (interactive "P") + (let ((inhibit-read-only t)) + (undo arg))) (defun diff-add-change-log-entries-other-window () "Iterate through the current diff and create ChangeLog entries. @@ -1924,6 +2016,47 @@ I.e. like `add-change-log-entry-other-window' but applied to all hunks." ;; When there's no more hunks, diff-hunk-next signals an error. (error nil)))) +(defun diff-remove-trailing-whitespace () + "When on a buffer that contains a diff, inspects the +differences and removes trailing whitespace (spaces, tabs) from +the lines modified or introduced by this diff. Shows a message +with the name of the altered buffers, which are unsaved. If a +file referenced on the diff has no buffer and needs to be fixed, +a buffer visiting that file is created." + (interactive) + (goto-char (point-min)) + (let + ;; We assume that the diff header has no trailing whitespace. + ((modified-buffers nil) + (white-positions nil)) + (while (re-search-forward "^[+!>].*[ \t]+$" (point-max) t) + (save-excursion + (cl-destructuring-bind (buf line-offset pos src _dst &optional _switched) + (diff-find-source-location t t) + (when line-offset + (set-buffer buf) + (save-excursion + (goto-char (+ (car pos) (cdr src))) + (beginning-of-line) + (when (re-search-forward "\\([ \t]+\\)$" (line-end-position) t) + (when (not (member buf modified-buffers)) + (push buf modified-buffers)) + (goto-char (match-end 0)) + (push (point-marker) white-positions) + (goto-char (match-beginning 0)) + (push (point-marker) white-positions) + (push buf white-positions))))))) + (while white-positions + (save-excursion + (set-buffer (pop white-positions)) + (delete-region (pop white-positions) (pop white-positions)))) + (if modified-buffers + (let ((msg "Deleted new trailing whitespace from:")) + (dolist (f modified-buffers) + (setq msg (concat msg " `" (buffer-name f) "'"))) + (message "%s" msg)) + (message "No trailing whitespace fixes needed.")))) + ;; provide the package (provide 'diff-mode)