;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: convenience patch diff vc
;; to the corresponding source file.
;; Inspired by Pavel Machek's patch-mode.el (<pavel@@atrey.karlin.mff.cuni.cz>)
-;; 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:
;; - 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)
;;;;
(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)
([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)
;; but not all since they may hide useful M-<foo> global
;; bindings when editing.
(set-keymap-parent map diff-mode-shared-map)
- (dolist (key '("A" "r" "R" "g" "q" "W"))
+ (dolist (key '("A" "r" "R" "g" "q" "W" "z"))
(define-key map key nil))
map))
;; From compilation-minor-mode.
["Unified -> Context" diff-unified->context
:help "Convert unified diffs to context diffs"]
;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)]
+ ["Remove trailing whitespace" diff-delete-trailing-whitespace
+ :help "Remove trailing whitespace problems introduced by the diff"]
["Show trailing whitespace" whitespace-mode
:style toggle :selected (bound-and-true-p whitespace-mode)
:help "Show trailing whitespace in modified lines"]
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
: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)
: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."
(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")
'((((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")
(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))
("^\\([+>]\\)\\(.*\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)
("^\\(#\\)\\(.*\\)"
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).
(let* ((nold (string-to-number (or (match-string 2) "1")))
(nnew (string-to-number (or (match-string 4) "1")))
(endold
- (save-excursion
- (re-search-forward (if diff-valid-unified-empty-line
- "^[- \n]" "^[- ]")
+ (save-excursion
+ (re-search-forward (if diff-valid-unified-empty-line
+ "^[- \n]" "^[- ]")
nil t nold)
- (line-beginning-position 2)))
+ (line-beginning-position
+ ;; Skip potential "\ No newline at end of file".
+ (if (looking-at ".*\n\\\\") 3 2))))
(endnew
;; The hunk may end with a bunch of "+" lines, so the `end' is
;; then further than computed above.
(re-search-forward (if diff-valid-unified-empty-line
"^[+ \n]" "^[+ ]")
nil t nnew)
- (line-beginning-position 2))))
+ (line-beginning-position
+ ;; Skip potential "\ No newline at end of file".
+ (if (looking-at ".*\n\\\\") 3 2)))))
(setq end (max endold endnew)))))
;; 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
(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
(goto-char (match-beginning 1))
(beginning-of-line)))
+(defvar diff--auto-refine-data nil)
+
;; Define diff-{hunk,file}-{prev,next}
(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))))
+ (when diff-auto-refine-mode
+ (unless (prog1 diff--auto-refine-data
+ (setq diff--auto-refine-data
+ (cons (current-buffer) (point-marker))))
+ (run-at-time 0.0 nil
+ (lambda ()
+ (when diff--auto-refine-data
+ (let ((buffer (car diff--auto-refine-data))
+ (point (cdr diff--auto-refine-data)))
+ (setq diff--auto-refine-data nil)
+ (with-local-quit
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char point)
+ (diff-refine-hunk))))))))))))
(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.
(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."
(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 ()
(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)
;; 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))
(diff-find-file-name old noprompt (match-string 1)))
;; if all else fails, ask the user
(unless noprompt
- (let ((file (read-file-name (format "Use file %s: "
- (or (first fs) ""))
- nil (first fs) t (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
+ (file-name-nondirectory file)))
(set (make-local-variable 'diff-remembered-files-alist)
(cons (cons fs file) diff-remembered-files-alist))
file))))))
"Convert unified diffs to context diffs.
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole buffer."
- (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
+ (interactive (if (or current-prefix-arg (use-region-p))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
(unless (markerp end) (setq end (copy-marker end t)))
(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 ","
(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
;; 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
START and END are either taken from the region
\(when it is highlighted) or else cover the whole buffer.
With a prefix argument, convert unified format to context format."
- (interactive (if (and transient-mark-mode mark-active)
+ (interactive (if (use-region-p)
(list (region-beginning) (region-end) current-prefix-arg)
(list (point-min) (point-max) current-prefix-arg)))
(if to-context
(inhibit-read-only t))
(save-excursion
(goto-char start)
- (while (and (re-search-forward "^\\(\\(\\*\\*\\*\\) .+\n\\(---\\) .+\\|\\*\\{15\\}.*\n\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]+\\) \\*\\*\\*\\*\\)$" nil t)
+ (while (and (re-search-forward "^\\(\\(\\*\\*\\*\\) .+\n\\(---\\) .+\\|\\*\\{15\\}.*\n\\*\\*\\* \\([0-9]+\\),\\(-?[0-9]+\\) \\*\\*\\*\\*\\)\\(?: \\(.*\\)\\|$\\)" nil t)
(< (point) end))
(combine-after-change-calls
(if (match-beginning 2)
;; Variables to use the special undo function.
(old-undo buffer-undo-list)
(old-end (marker-position end))
- (reversible t))
+ ;; We currently throw away the comment that can follow
+ ;; the hunk header. FIXME: Preserve it instead!
+ (reversible (not (match-end 6))))
(replace-match "")
(unless (re-search-forward
diff-context-mid-hunk-header-re nil t)
(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)
(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 "+"))
"Reverse the direction of the diffs.
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole buffer."
- (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
+ (interactive (if (or current-prefix-arg (use-region-p))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
(unless (markerp end) (setq end (copy-marker end t)))
(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
"Fixup the hunk headers (in case the buffer was modified).
START and END are either taken from the region (if a prefix arg is given) or
else cover the whole buffer."
- (interactive (if (or current-prefix-arg (and transient-mark-mode mark-active))
+ (interactive (if (or current-prefix-arg (use-region-p))
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
(let ((inhibit-read-only t))
(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))
(re-search-forward diff-context-mid-hunk-header-re
nil t)))))
(when (and ;; Don't try to fixup changes in the hunk header.
- (> (car diff-unhandled-changes) start)
+ (>= (car diff-unhandled-changes) start)
;; Don't try to fixup changes in the mid-hunk header either.
(or (not mid)
(< (cdr diff-unhandled-changes) (match-beginning 0))
\\{diff-mode-map}"
(set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults)
+ (add-hook 'font-lock-mode-hook
+ (lambda () (remove-overlays nil nil 'diff-mode 'fine))
+ nil 'local)
(set (make-local-variable 'outline-regexp) diff-outline-regexp)
(set (make-local-variable 'imenu-generic-expression)
diff-imenu-generic-expression)
(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
;;; 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))
+ ;; FIXME: For buffers filled from async processes, this search
+ ;; will simply fail because the buffer is still empty :-(
+ (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
(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)
(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))
;; 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))
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),
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"))
"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)))
;; 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))))
(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) '(?< ?-))
(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))))
(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))
(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 "#ffbbbb")
+ (((class color) (min-colors 88) (background dark))
+ :background "#aa2222"))
+ "Face used for removed characters shown by `diff-refine-hunk'."
+ :group 'diff-mode
+ :version "24.3")
+
+(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.3")
+
(defun diff-refine-preproc ()
(while (re-search-forward "^[+>]" nil t)
;; Remove spurious changes due to the fact that one side of the hunk is
)
(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))))
(remove-overlays beg end 'diff-mode 'fine)
(goto-char beg)
- (case style
- (unified
- (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
- end t)
+ (pcase style
+ (`unified
+ (while (re-search-forward
+ (eval-when-compile
+ (let ((no-LF-at-eol-re "\\(?:\\\\.*\n\\)?"))
+ (concat "^\\(?:-.*\n\\)+" no-LF-at-eol-re
+ "\\(\\)"
+ "\\(?:\\+.*\n\\)+" no-LF-at-eol-re)))
+ 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)
(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.
;; When there's no more hunks, diff-hunk-next signals an error.
(error nil))))
+(defun diff-delete-trailing-whitespace (&optional other-file)
+ "Remove trailing whitespace from lines modified in this diff.
+This edits both the current Diff mode buffer and the patched
+source file(s). If `diff-jump-to-old-file' is non-nil, edit the
+original (unpatched) source file instead. With a prefix argument
+OTHER-FILE, flip the choice of which source file to edit.
+
+If a file referenced in the diff has no buffer and needs to be
+fixed, visit it in a buffer."
+ (interactive "P")
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((other (diff-xor other-file diff-jump-to-old-file))
+ (modified-buffers nil)
+ (style (save-excursion
+ (when (re-search-forward diff-hunk-header-re nil t)
+ (goto-char (match-beginning 0))
+ (diff-hunk-style))))
+ (regexp (concat "^[" (if other "-<" "+>") "!]"
+ (if (eq style 'context) " " "")
+ ".*?\\([ \t]+\\)$"))
+ (inhibit-read-only t)
+ (end-marker (make-marker))
+ hunk-end)
+ ;; Move to the first hunk.
+ (re-search-forward diff-hunk-header-re nil 1)
+ (while (progn (save-excursion
+ (re-search-forward diff-hunk-header-re nil 1)
+ (setq hunk-end (point)))
+ (< (point) hunk-end))
+ ;; For context diffs, search only in the appropriate half of
+ ;; the hunk. For other diffs, search within the entire hunk.
+ (if (not (eq style 'context))
+ (set-marker end-marker hunk-end)
+ (let ((mid-hunk
+ (save-excursion
+ (re-search-forward diff-context-mid-hunk-header-re hunk-end)
+ (point))))
+ (if other
+ (set-marker end-marker mid-hunk)
+ (goto-char mid-hunk)
+ (set-marker end-marker hunk-end))))
+ (while (re-search-forward regexp end-marker t)
+ (let ((match-data (match-data)))
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,_switched)
+ (diff-find-source-location other-file)))
+ (when line-offset
+ ;; Remove the whitespace in the Diff mode buffer.
+ (set-match-data match-data)
+ (replace-match "" t t nil 1)
+ ;; Remove the whitespace in the source buffer.
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (+ (car pos) (cdr src)))
+ (beginning-of-line)
+ (when (re-search-forward "\\([ \t]+\\)$" (line-end-position) t)
+ (unless (memq buf modified-buffers)
+ (push buf modified-buffers))
+ (replace-match ""))))))))
+ (goto-char hunk-end))
+ (if modified-buffers
+ (message "Deleted trailing whitespace from %s."
+ (mapconcat (lambda (buf) (concat "`" (buffer-name buf) "'"))
+ modified-buffers ", "))
+ (message "No trailing whitespace to delete.")))))
+
;; provide the package
(provide 'diff-mode)