diff options
Diffstat (limited to 'lisp/diff-mode.el')
| -rw-r--r-- | lisp/diff-mode.el | 383 |
1 files changed, 267 insertions, 116 deletions
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index a79fb577453..609c5ef6490 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -48,8 +48,6 @@ ;; Or maybe just make it into a ".rej to diff3-markers converter". ;; Maybe just use `wiggle' (by Neil Brown) to do it for us. ;; -;; - Refine hunk on a word-by-word basis. -;; ;; - in diff-apply-hunk, strip context in replace-match to better ;; preserve markers and spacing. ;; - Handle `diff -b' output in context->unified. @@ -72,7 +70,7 @@ :group 'diff-mode) (defcustom diff-jump-to-old-file nil - "*Non-nil means `diff-goto-source' jumps to the old file. + "Non-nil means `diff-goto-source' jumps to the old file. Else, it jumps to the new file." :type 'boolean :group 'diff-mode) @@ -157,7 +155,8 @@ when editing big diffs)." ("\C-c\C-u" . diff-context->unified) ;; `d' because it duplicates the context :-( --Stef ("\C-c\C-d" . diff-unified->context) - ("\C-c\C-w" . diff-refine-hunk) + ("\C-c\C-w" . diff-refine-ignore-spaces-hunk) + ("\C-c\C-b" . diff-fine-highlight) ;No reason for `b' :-( ("\C-c\C-f" . next-error-follow-minor-mode)) "Keymap for `diff-mode'. See also `diff-mode-shared-map'.") @@ -174,8 +173,9 @@ when editing big diffs)." ["Unified -> Context" diff-unified->context t] ;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)] "-----" - ["Split hunk" diff-split-hunk t] - ["Refine hunk" diff-refine-hunk t] + ["Split hunk" diff-split-hunk (diff-splittable-p)] + ["Ignore whitespace changes" diff-refine-ignore-spaces-hunk t] + ["Highlight fine changes" diff-fine-highlight t] ["Kill current hunk" diff-hunk-kill t] ["Kill current file's hunks" diff-file-kill t] "-----" @@ -351,8 +351,11 @@ when editing big diffs)." ("^--- .+ ----$" . diff-hunk-header-face) ;context ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) ;normal ("^---$" . diff-hunk-header-face) ;normal - ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\S-+\\)\\(.*[^*-]\\)?\n" - (0 diff-header-face) (2 diff-file-header-face prepend)) + ;; For file headers, accept files with spaces, but be careful to rule + ;; out false-positives when matching hunk headers. + ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^\t\n]+?\\)\\(?:\t.*\\| \\(\\*\\*\\*\\*\\|----\\)\\)?\n" + (0 diff-header-face) + (2 (if (not (match-end 3)) diff-file-header-face) prepend)) ("^\\([-<]\\)\\(.*\n\\)" (1 diff-indicator-removed-face) (2 diff-removed-face)) ("^\\([+>]\\)\\(.*\n\\)" @@ -385,12 +388,15 @@ when editing big diffs)." (defconst diff-file-header-re (concat "^\\(--- .+\n\\+\\+\\+ \\|\\*\\*\\* .+\n--- \\|[^-+!<>0-9@* ]\\).+\n" (substring diff-hunk-header-re 1))) (defvar diff-narrowed-to nil) -(defun diff-end-of-hunk (&optional style) +(defun diff-hunk-style (&optional style) (when (looking-at diff-hunk-header-re) - (unless style - ;; Especially important for unified (because headers are ambiguous). - (setq style (cdr (assq (char-after) '((?@ . unified) (?* . context)))))) + (setq style (cdr (assq (char-after) '((?@ . unified) (?* . context))))) (goto-char (match-end 0))) + style) + +(defun diff-end-of-hunk (&optional style) + ;; Especially important for unified (because headers are ambiguous). + (setq style (diff-hunk-style style)) (let ((end (and (re-search-forward (case style ;; A `unified' header is ambiguous. (unified (concat "^[^-+# \\]\\|" @@ -418,13 +424,29 @@ but in the file header instead, in which case move forward to the first hunk." (diff-beginning-of-file-and-junk) (diff-hunk-next)))))) +(defun diff-unified-hunk-p () + (save-excursion + (ignore-errors + (diff-beginning-of-hunk) + (looking-at "^@@")))) + (defun diff-beginning-of-file () (beginning-of-line) (unless (looking-at diff-file-header-re) - (forward-line 2) - (condition-case () - (re-search-backward diff-file-header-re) - (error (error "Can't find the beginning of the file"))))) + (let ((start (point)) + res) + ;; diff-file-header-re may need to match up to 4 lines, so in case + ;; we're inside the header, we need to move up to 3 lines forward. + (forward-line 3) + (if (and (setq res (re-search-backward diff-file-header-re nil t)) + ;; Maybe the 3 lines forward were too much and we matched + ;; a file header after our starting point :-( + (or (<= (point) start) + (setq res (re-search-backward diff-file-header-re nil t)))) + res + (goto-char start) + (error "Can't find the beginning of the file"))))) + (defun diff-end-of-file () (re-search-forward "^[-+#!<>0-9@* \\]" nil t) @@ -477,26 +499,34 @@ If the prefix ARG is given, restrict the view to the current file instead." "Go to the beginning of file-related diff-info. This is like `diff-beginning-of-file' except it tries to skip back over leading data such as \"Index: ...\" and such." - (let ((start (point)) - (file (condition-case err (progn (diff-beginning-of-file) (point)) - (error err))) - ;; prevhunk is one of the limits. - (prevhunk (save-excursion (ignore-errors (diff-hunk-prev) (point)))) - err) - (when (consp file) - ;; Presumably, we started before the file header, in the leading junk. - (setq err file) - (diff-file-next) - (setq file (point))) - (let ((index (save-excursion - (re-search-backward "^Index: " prevhunk t)))) - (when index (setq file index)) - (if (<= file start) - (goto-char file) - ;; File starts *after* the starting point: we really weren't in - ;; a file diff but elsewhere. - (goto-char start) - (signal (car err) (cdr err)))))) + (let* ((start (point)) + (prevfile (condition-case err + (save-excursion (diff-beginning-of-file) (point)) + (error err))) + (err (if (consp prevfile) prevfile)) + (nextfile (ignore-errors + (save-excursion + (goto-char start) (diff-file-next) (point)))) + ;; prevhunk is one of the limits. + (prevhunk (save-excursion + (ignore-errors + (if (numberp prevfile) (goto-char prevfile)) + (diff-hunk-prev) (point)))) + (previndex (save-excursion + (re-search-backward "^Index: " prevhunk t)))) + ;; If we're in the junk, we should use nextfile instead of prevfile. + (if (and (numberp nextfile) + (or (not (numberp prevfile)) + (and previndex (> previndex prevfile)))) + (setq prevfile nextfile)) + (if (and previndex (numberp prevfile) (< previndex prevfile)) + (setq prevfile previndex)) + (if (and (numberp prevfile) (<= prevfile start)) + (goto-char prevfile) + ;; File starts *after* the starting point: we really weren't in + ;; a file diff but elsewhere. + (goto-char start) + (signal (car err) (cdr err))))) (defun diff-file-kill () "Kill current file's hunks." @@ -530,6 +560,13 @@ data such as \"Index: ...\" and such." (while (re-search-forward re end t) (incf n)) n))) +(defun diff-splittable-p () + (save-excursion + (beginning-of-line) + (and (looking-at "^[-+ ]") + (progn (forward-line -1) (looking-at "^[-+ ]")) + (diff-unified-hunk-p)))) + (defun diff-split-hunk () "Split the current (unified diff) hunk at point into two hunks." (interactive) @@ -624,9 +661,11 @@ If the OLD prefix arg is passed, tell the file NAME of the old file." (list (if old (match-string 2) (match-string 4)) (if old (match-string 4) (match-string 2))))))))) -(defun diff-find-file-name (&optional old prefix) +(defun diff-find-file-name (&optional old batch prefix) "Return the file corresponding to the current patch. Non-nil OLD means that we want the old file. +Non-nil BATCH means to prefer returning an incorrect answer than to prompt +the user. PREFIX is only used internally: don't use it." (save-excursion (unless (looking-at diff-file-header-re) @@ -663,7 +702,10 @@ PREFIX is only used internally: don't use it." (boundp 'cvs-pcl-cvs-dirchange-re) (save-excursion (re-search-backward cvs-pcl-cvs-dirchange-re nil t)) - (diff-find-file-name old (match-string 1))) + (diff-find-file-name old batch (match-string 1))) + ;; Invent something, if necessary. + (when batch + (or (car fs) default-directory)) ;; if all else fails, ask the user (let ((file (read-file-name (format "Use file %s: " (or (first fs) "")) nil (first fs) t (first fs)))) @@ -711,7 +753,12 @@ else cover the whole buffer." (let ((line1 (match-string 4)) (lines1 (match-string 5)) (line2 (match-string 6)) - (lines2 (match-string 7))) + (lines2 (match-string 7)) + ;; Variables to use the special undo function. + (old-undo buffer-undo-list) + (old-end (marker-position end)) + (start (match-beginning 0)) + (reversible t)) (replace-match (concat "***************\n*** " line1 "," (number-to-string (+ (string-to-number line1) @@ -753,6 +800,14 @@ 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)) + ;; Normally, lines in a substitution come with + ;; first the removals and then the additions, and + ;; the context->unified function follows this + ;; convention, of course. Yet, other alternatives + ;; are valid as well, but they preclude the use of + ;; context->unified as an undo command. + (setq reversible nil)) (while (not (eobp)) (case (char-after) (?\s (insert " ") (setq modif nil) (backward-char 1)) @@ -771,7 +826,15 @@ else cover the whole buffer." (forward-line 1) (when delete (delete-region last-pt (point)) - (setq delete nil))))))))))))))) + (setq delete nil))))))) + (unless (or (not reversible) (eq buffer-undo-list t)) + ;; Drop the many undo entries and replace them with + ;; a single entry that uses diff-context->unified to do + ;; the work. + (setq buffer-undo-list + (cons (list 'apply (- old-end end) start (point-max) + 'diff-context->unified start (point-max)) + old-undo))))))))))) (defun diff-context->unified (start end &optional to-context) "Convert context diffs to unified diffs. @@ -785,68 +848,89 @@ With a prefix argument, convert unified format to context format." (diff-unified->context start end) (unless (markerp end) (setq end (copy-marker end t))) (let ( ;;(diff-inhibit-after-change t) - (inhibit-read-only t)) + (inhibit-read-only t)) (save-excursion - (goto-char start) - (while (and (re-search-forward "^\\(\\(\\*\\*\\*\\) .+\n\\(---\\) .+\\|\\*\\{15\\}.*\n\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]+\\) \\*\\*\\*\\*\\)$" nil t) - (< (point) end)) - (combine-after-change-calls - (if (match-beginning 2) - ;; we matched a file header - (progn - ;; use reverse order to make sure the indices are kept valid - (replace-match "+++" t t nil 3) - (replace-match "---" t t nil 2)) - ;; we matched a hunk header - (let ((line1s (match-string 4)) - (line1e (match-string 5)) - (pt1 (match-beginning 0))) - (replace-match "") - (unless (re-search-forward - "^--- \\([0-9]+\\),\\(-?[0-9]+\\) ----$" nil t) - (error "Can't find matching `--- n1,n2 ----' line")) - (let ((line2s (match-string 1)) - (line2e (match-string 2)) - (pt2 (progn - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) - (point-marker)))) - (goto-char pt1) - (forward-line 1) - (while (< (point) pt2) - (case (char-after) - ((?! ?-) (delete-char 2) (insert "-") (forward-line 1)) - (?\s ;merge with the other half of the chunk - (let* ((endline2 - (save-excursion - (goto-char pt2) (forward-line 1) (point))) - (c (char-after pt2))) - (case c - ((?! ?+) - (insert "+" - (prog1 (buffer-substring (+ pt2 2) endline2) - (delete-region pt2 endline2)))) - (?\s ;FIXME: check consistency - (delete-region pt2 endline2) - (delete-char 1) - (forward-line 1)) - (?\\ (forward-line 1)) - (t (delete-char 1) (forward-line 1))))) - (t (forward-line 1)))) - (while (looking-at "[+! ] ") - (if (/= (char-after) ?!) (forward-char 1) - (delete-char 1) (insert "+")) - (delete-char 1) (forward-line 1)) - (save-excursion - (goto-char pt1) - (insert "@@ -" line1s "," - (number-to-string (- (string-to-number line1e) - (string-to-number line1s) - -1)) - " +" line2s "," - (number-to-string (- (string-to-number line2e) - (string-to-number line2s) - -1)) " @@"))))))))))) + (goto-char start) + (while (and (re-search-forward "^\\(\\(\\*\\*\\*\\) .+\n\\(---\\) .+\\|\\*\\{15\\}.*\n\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]+\\) \\*\\*\\*\\*\\)$" nil t) + (< (point) end)) + (combine-after-change-calls + (if (match-beginning 2) + ;; we matched a file header + (progn + ;; use reverse order to make sure the indices are kept valid + (replace-match "+++" t t nil 3) + (replace-match "---" t t nil 2)) + ;; we matched a hunk header + (let ((line1s (match-string 4)) + (line1e (match-string 5)) + (pt1 (match-beginning 0)) + ;; Variables to use the special undo function. + (old-undo buffer-undo-list) + (old-end (marker-position end)) + (reversible t)) + (replace-match "") + (unless (re-search-forward + "^--- \\([0-9]+\\),\\(-?[0-9]+\\) ----$" nil t) + (error "Can't find matching `--- n1,n2 ----' line")) + (let ((line2s (match-string 1)) + (line2e (match-string 2)) + (pt2 (progn + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point))) + (point-marker)))) + (goto-char pt1) + (forward-line 1) + (while (< (point) pt2) + (case (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 + (let* ((endline2 + (save-excursion + (goto-char pt2) (forward-line 1) (point)))) + (case (char-after pt2) + ((?! ?+) + (insert "+" + (prog1 (buffer-substring (+ pt2 2) endline2) + (delete-region pt2 endline2)))) + (?\s + (unless (= (- endline2 pt2) + (- (line-beginning-position 2) (point))) + ;; If the two lines we're merging don't have the + ;; same length (can happen with "diff -b"), then + ;; diff-unified->context will not properly undo + ;; this operation. + (setq reversible nil)) + (delete-region pt2 endline2) + (delete-char 1) + (forward-line 1)) + (?\\ (forward-line 1)) + (t (setq reversible nil) + (delete-char 1) (forward-line 1))))) + (t (setq reversible nil) (forward-line 1)))) + (while (looking-at "[+! ] ") + (if (/= (char-after) ?!) (forward-char 1) + (delete-char 1) (insert "+")) + (delete-char 1) (forward-line 1)) + (save-excursion + (goto-char pt1) + (insert "@@ -" line1s "," + (number-to-string (- (string-to-number line1e) + (string-to-number line1s) + -1)) + " +" line2s "," + (number-to-string (- (string-to-number line2e) + (string-to-number line2s) + -1)) " @@")) + (set-marker pt2 nil) + ;; The whole procedure succeeded, let's replace the myriad + ;; of undo elements with just a single special one. + (unless (or (not reversible) (eq buffer-undo-list t)) + (setq buffer-undo-list + (cons (list 'apply (- old-end end) pt1 (point) + 'diff-unified->context pt1 (point)) + old-undo))) + ))))))))) (defun diff-reverse-direction (start end) "Reverse the direction of the diffs. @@ -1159,26 +1243,30 @@ Only works for unified diffs." ;; A context diff. ((eq (char-after) ?*) - (if (not (looking-at "\\*\\{15\\}\\(?: .*\\)?\n\\*\\*\\* \\([0-9]+\\),\\([0-9]+\\) \\*\\*\\*\\*")) + (if (not (looking-at "\\*\\{15\\}\\(?: .*\\)?\n\\*\\*\\* \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? \\*\\*\\*\\*")) (error "Unrecognized context diff first hunk header format") (forward-line 2) (diff-sanity-check-context-hunk-half - (1+ (- (string-to-number (match-string 2)) - (string-to-number (match-string 1))))) - (if (not (looking-at "--- \\([0-9]+\\),\\([0-9]+\\) ----$")) + (if (match-string 2) + (1+ (- (string-to-number (match-string 2)) + (string-to-number (match-string 1)))) + 1)) + (if (not (looking-at "--- \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? ----$")) (error "Unrecognized context diff second hunk header format") (forward-line) (diff-sanity-check-context-hunk-half - (1+ (- (string-to-number (match-string 2)) - (string-to-number (match-string 1)))))))) + (if (match-string 2) + (1+ (- (string-to-number (match-string 2)) + (string-to-number (match-string 1)))) + 1))))) ;; A unified diff. ((eq (char-after) ?@) (if (not (looking-at - "@@ -[0-9]+,\\([0-9]+\\) \\+[0-9]+,\\([0-9]+\\) @@")) + "@@ -[0-9]+\\(?:,\\([0-9]+\\)\\)? \\+[0-9]+\\(?:,\\([0-9]+\\)\\)? @@")) (error "Unrecognized unified diff hunk header format") - (let ((before (string-to-number (match-string 1))) - (after (string-to-number (match-string 2)))) + (let ((before (if (match-string 1) (string-to-number (match-string 1)) 1)) + (after (if (match-string 2) (string-to-number (match-string 2)) 1))) (forward-line) (while (case (char-after) @@ -1326,7 +1414,7 @@ Whitespace differences are ignored." (if (> (- (car forw) orig) (- orig (car back))) back forw) (or back forw)))) -(defsubst diff-xor (a b) (if a (not b) b)) +(defsubst diff-xor (a b) (if a (if (not b) a) b)) (defun diff-find-source-location (&optional other-file reverse) "Find out (BUF LINE-OFFSET POS SRC DST SWITCHED). @@ -1409,8 +1497,15 @@ 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) - ;; If REVERSE go to the new file, otherwise go to the old. - (diff-find-source-location (not reverse) reverse) + ;; 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")) @@ -1454,8 +1549,7 @@ With a prefix argument, REVERSE the hunk." With a prefix argument, try to REVERSE the hunk." (interactive "P") (destructuring-bind (buf line-offset pos src dst &optional switched) - ;; If REVERSE go to the new file, otherwise go to the old. - (diff-find-source-location (not reverse) reverse) + (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))) @@ -1506,7 +1600,7 @@ For use in `add-log-current-defun-function'." (goto-char (+ (car pos) (cdr src))) (add-log-current-defun)))))) -(defun diff-refine-hunk () +(defun diff-refine-ignore-spaces-hunk () "Refine the current hunk by ignoring space differences." (interactive) (let* ((char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder) @@ -1551,6 +1645,63 @@ For use in `add-log-current-defun-function'." (delete-file file1) (delete-file file2)))) +;;; Fine change highlighting. + +(defface diff-fine-change + '((t :background "yellow")) + "Face used for char-based changes shown by `diff-fine-highlight'.") + +(defun diff-fine-highlight-preproc () + (while (re-search-forward "^." nil t) + ;; Replace the hunk's leading prefix (+, -, !, <, or >) on each line + ;; with something constant, otherwise it'll be flagged as changes + ;; (since it's typically "-" on one side and "+" on the other). + ;; Note that we keep the same number of chars: we treat the prefix + ;; as part of the texts-to-diff, so that finding the right char + ;; afterwards will be easier. This only makes sense because we make + ;; diffs at char-granularity. + (replace-match " "))) + +(defun diff-fine-highlight () + "Highlight changes of hunk at point at a finer granularity." + (interactive) + (require 'smerge-mode) + (diff-beginning-of-hunk 'try-harder) + (let* ((style (diff-hunk-style)) ;Skips the hunk header as well. + (beg (point)) + (props '((diff-mode . fine) (face diff-fine-change))) + (end (progn (diff-end-of-hunk) (point)))) + + (remove-overlays beg end 'diff-mode 'fine) + + (goto-char beg) + (case 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-fine-highlight-preproc))) + (context + (let* ((middle (save-excursion (re-search-forward "^---"))) + (other middle)) + (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) + (smerge-refine-subst (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 + props 'diff-fine-highlight-preproc)))) + (t ;; 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-fine-highlight-preproc))))))) + + ;; provide the package (provide 'diff-mode) |