(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.

1 files changed, 146 insertions, 65 deletions

diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index d4244126f23..706a532938d 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -386,12 +386,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 "^[^-+# \\]\\|"
@@ -843,68 +846,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.
@@ -1610,6 +1634,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)