Mercurial > emacs
changeset 85100:c04703192cb6
(diff-hunk-style): New fun.
(diff-end-of-hunk): Use it.
(diff-context->unified): Use the new `apply' undo element, if applicable,
so as to save undo-log space.
(diff-fine-change): New face.
(diff-fine-highlight-preproc): New function.
(diff-fine-highlight): New command.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Tue, 09 Oct 2007 04:12:24 +0000 |
| parents | ccdbfad065e3 |
| children | edbef40c9bbb |
| files | etc/NEWS lisp/ChangeLog lisp/diff-mode.el |
| diffstat | 3 files changed, 155 insertions(+), 65 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Tue Oct 09 03:38:57 2007 +0000 +++ b/etc/NEWS Tue Oct 09 04:12:24 2007 +0000 @@ -152,6 +152,7 @@ * Changes in Specialized Modes and Packages in Emacs 23.1 +** diff-fine-highlight highlights char-level details of changes in a diff hunk. ** archive-mode has basic support to browse Rar archives. ** talk.el has been extended for multiple tty support.
--- a/lisp/ChangeLog Tue Oct 09 03:38:57 2007 +0000 +++ b/lisp/ChangeLog Tue Oct 09 04:12:24 2007 +0000 @@ -1,5 +1,13 @@ 2007-10-09 Stefan Monnier <monnier@iro.umontreal.ca> + * diff-mode.el (diff-hunk-style): New fun. + (diff-end-of-hunk): Use it. + (diff-context->unified): Use the new `apply' undo element, + if applicable, so as to save undo-log space. + (diff-fine-change): New face. + (diff-fine-highlight-preproc): New function. + (diff-fine-highlight): New command. + * smerge-mode.el (smerge-refine-chopup-region): Add `preproc' argument. (smerge-refine-highlight-change): Add `props' argument. (smerge-refine-subst): New function holding most of smerge-refine.
--- a/lisp/diff-mode.el Tue Oct 09 03:38:57 2007 +0000 +++ b/lisp/diff-mode.el Tue Oct 09 04:12:24 2007 +0000 @@ -386,12 +386,15 @@ (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 "^[^-+# \\]\\|" @@ -843,68 +846,89 @@ (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. @@ -1610,6 +1634,63 @@ (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)