bug#33567: Syntactic fontification of diff hunks

[Juri Linkov <juri@linkov.net>]

[-- Attachment #1: Type: text/plain, Size: 798 bytes --]

> Users still can use all diff-mode commands to visit source files from them.
> Only language syntax fontification in diffs will fall back to hunk-only
> when a diff buffer is not created by a diff command.  This is to avoid all
> possible dangers of automatically visiting files in arbitrary diff buffers.

Due to the new variable `diff-default-directory', we can simplify the
customization options of `diff-font-lock-syntax'.  The default `t' is
the safest and the most reliable: it extracts revisions from VC when
the Diff buffer is created by a VC command, and extracts files from the
file system only in case the Diff buffer is created by a file-based
Diff command that sets the new variable `diff-default-directory'.

Here is a more less final version that I tested on many different diffs:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: diff-font-lock-syntax.3.patch --]
[-- Type: text/x-diff, Size: 12671 bytes --]

diff --git a/etc/NEWS b/etc/NEWS
index decc5e3954..1024e9e9f5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -273,6 +273,8 @@ To disable it, set the new defcustom 'diff-font-lock-refine' to nil.
 *** File headers can be shortened, mimicking Magit's diff format
 To enable it, set the new defcustom 'diff-font-lock-prettify to t.
 
+*** Source language syntax is highlighted in diff hunks when 'diff-font-lock-syntax' is t.
+
 ** Browse-url
 
 *** The function 'browse-url-emacs' can now visit a URL in selected window.
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index b47be51e24..07f311c24e 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -1617,6 +1617,9 @@ Diff Mode
 modify the original (``old'') source files rather than the patched
 (``new'') source files.
 
+@vindex diff-font-lock-syntax
+  If non-nil, diff hunk font-lock includes source language syntax highlighting.
+
 @node Copying and Naming
 @section Copying, Naming and Renaming Files
 
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index ac94586cac..93fa54b1fb 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -165,6 +167,7 @@ diff-no-select
            (lambda (_ignore-auto _noconfirm)
              (diff-no-select old new switches no-async (current-buffer))))
       (setq default-directory thisdir)
+      (set (make-local-variable 'diff-default-directory) default-directory)
       (let ((inhibit-read-only t))
 	(insert command "\n"))
       (if (and (not no-async) (fboundp 'make-process))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 4adef02984..99ddb19f87 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -103,12 +104,41 @@ diff-font-lock-prettify
   :version "27.1"
   :type 'boolean)
 
+(defcustom diff-font-lock-syntax t
+  "If non-nil, diff hunk font-lock includes source language syntax highlighting.
+This highlighting is the same as added by `font-lock-mode'
+when corresponding source files are visited normally.
+Syntax highlighting is added over diff own highlighted changes.
+
+If t, the default, highlight syntax only in Diff buffers created by Diff
+commands that compare files or by VC commands that compare revisions.
+These provide all necessary context for reliable highlighting.  This value
+requires support from a VC backend to find the files being compared.
+For diffs against the working-tree version of a file, the highlighting is
+based on the current file contents.  File-based fontification tries to
+infer fontification from the compared files.
+
+If some method fails, get fontification from hunk alone if the value is
+`hunk-also'.
+
+If `hunk-only', fontification is based on hunk alone, without full source.
+It tries to highlight hunks without enough context that sometimes might result
+in wrong fontification.  This is the fastest option, but less reliable."
+  :version "27.1"
+  :type '(choice (const :tag "Don't highlight syntax" nil)
+                 (const :tag "Hunk-based also" hunk-also)
+                 (const :tag "Hunk-based only" hunk-only)
+                 (const :tag "Highlight syntax" t)))
+
 (defvar diff-vc-backend nil
   "The VC backend that created the current Diff buffer, if any.")
 
 (defvar diff-vc-revisions nil
   "The VC revisions compared in the current Diff buffer, if any.")
 
+(defvar diff-default-directory nil
+  "The default directory where the current Diff buffer was created.")
+
 (defvar diff-outline-regexp
   "\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)")
 
@@ -406,6 +436,7 @@ diff-font-lock-keywords
      (1 font-lock-comment-delimiter-face)
      (2 font-lock-comment-face))
     ("^[^-=+*!<>#].*\n" (0 'diff-context))
+    (,#'diff--font-lock-syntax)
     (,#'diff--font-lock-prettify)
     (,#'diff--font-lock-refined)))
 
@@ -2316,6 +2348,189 @@ diff--font-lock-prettify
                              'display "")))))
   nil)
 
+;;; Syntax highlighting from font-lock
+
+(defun diff--font-lock-syntax (max)
+  "Syntax highlighting from font-lock."
+  (when diff-font-lock-syntax
+    (when (get-char-property (point) 'diff--font-lock-syntax)
+      (goto-char (next-single-char-property-change
+                  (point) 'diff--font-lock-syntax nil max)))
+    (let* ((min (point))
+           (beg (or (ignore-errors (diff-beginning-of-hunk))
+                    (ignore-errors (diff-hunk-next) (point))
+                    max)))
+      (while (< beg max)
+        (let ((end
+               (save-excursion (goto-char beg) (diff-end-of-hunk) (point))))
+          (if (< end min) (setq beg min))
+          (unless (or (< end beg)
+                      (get-char-property beg 'diff--font-lock-syntax))
+            (diff-syntax-fontify beg end)
+            (let ((ol (make-overlay beg end)))
+              (overlay-put ol 'diff--font-lock-syntax t)
+              (overlay-put ol 'diff-mode 'syntax)
+              (overlay-put ol 'evaporate t)
+              (overlay-put ol 'modification-hooks
+                           '(diff--font-lock-syntax--refresh))))
+          (goto-char (max beg end))
+          (setq beg (or (ignore-errors (diff-hunk-next) (point)) max))))))
+  nil)
+
+(defun diff--font-lock-syntax--refresh (ol _after _beg _end &optional _len)
+  (delete-overlay ol))
+
+(defun diff-syntax-fontify (start end)
+  (save-excursion
+    (diff-syntax-fontify-hunk start end t)
+    (diff-syntax-fontify-hunk start end nil)))
+
+(defvar diff-syntax-fontify-revisions (make-hash-table :test 'equal))
+
+(defun diff-syntax-fontify-hunk (beg end old)
+  "Highlight source language syntax in diff hunks."
+  (remove-overlays beg end 'diff-mode 'syntax)
+  (goto-char beg)
+  (let* ((hunk (buffer-substring-no-properties beg end))
+         (text (or (ignore-errors (diff-hunk-text hunk (not old) nil)) ""))
+	 (line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?")
+		   (if old (match-string 1)
+		     (if (match-end 3) (match-string 3) (match-string 1)))))
+         (line-nb (and line (string-match "\\([0-9]+\\),\\([0-9]+\\)" line)
+                       (list (string-to-number (match-string 1 line))
+                             (string-to-number (match-string 2 line)))))
+         props)
+    (cond
+     ((and diff-vc-backend (not (eq diff-font-lock-syntax 'hunk-only)))
+      (let* ((file (diff-find-file-name old t))
+             (revision (and file (if (not old) (nth 1 diff-vc-revisions)
+                                   (or (nth 0 diff-vc-revisions)
+                                       (vc-working-revision file))))))
+        (if file
+            (if (not revision)
+                ;; Get properties from the current working revision
+                (when (and (not old) (file-exists-p file) (file-regular-p file))
+                  ;; Try to reuse an existing buffer
+                  (if (get-file-buffer (expand-file-name file))
+                      (with-current-buffer (get-file-buffer (expand-file-name file))
+                        (setq props (diff-syntax-fontify-props nil text line-nb t)))
+                    ;; Get properties from the file
+                    (with-temp-buffer
+                      (insert-file-contents file t)
+                      (setq props (diff-syntax-fontify-props file text line-nb)))))
+              ;; Get properties from a cached revision
+              (let* ((buffer-name (format " diff-syntax:%s.~%s~"
+                                          (expand-file-name file) revision))
+                     (buffer (gethash buffer-name diff-syntax-fontify-revisions)))
+                (unless (and buffer (buffer-live-p buffer))
+                  (let* ((vc-buffer (ignore-errors
+                                      (vc-find-revision-no-save
+                                       (expand-file-name file) revision
+                                       diff-vc-backend
+                                       (get-buffer-create buffer-name)))))
+                    (when vc-buffer
+                      (setq buffer vc-buffer)
+                      (puthash buffer-name buffer diff-syntax-fontify-revisions))))
+                (when buffer
+                  (with-current-buffer buffer
+                    (setq props (diff-syntax-fontify-props file text line-nb t))))))
+          ;; If file is unavailable, get properties from the hunk alone
+          (setq file (car (diff-hunk-file-names old)))
+          (with-temp-buffer
+            (insert text)
+            (setq props (diff-syntax-fontify-props file text line-nb nil t))))))
+     ((and diff-default-directory (not (eq diff-font-lock-syntax 'hunk-only)))
+      (let ((file (car (diff-hunk-file-names old))))
+        (if (and file (file-exists-p file) (file-regular-p file))
+            ;; Try to get full text from the file
+            (with-temp-buffer
+              (insert-file-contents file t)
+              (setq props (diff-syntax-fontify-props file text line-nb)))
+          ;; Otherwise, get properties from the hunk alone
+          (with-temp-buffer
+            (insert text)
+            (setq props (diff-syntax-fontify-props file text line-nb nil t))))))
+     ((memq diff-font-lock-syntax '(hunk-also hunk-only))
+      (let ((file (car (diff-hunk-file-names old))))
+        (with-temp-buffer
+          (insert text)
+          (setq props (diff-syntax-fontify-props file text line-nb nil t))))))
+
+    ;; Put properties over the hunk text
+    (goto-char beg)
+    (when (and props (eq (diff-hunk-style) 'unified))
+      (while (< (progn (forward-line 1) (point)) end)
+        (when (or (and (not old) (not (looking-at-p "[-<]")))
+                  (and      old  (not (looking-at-p "[+>]"))))
+          (if (and old (not (looking-at-p "[-<]")))
+              ;; Fontify context lines only from new source,
+              ;; don't refontify context lines from old source.
+              (pop props)
+            (let ((line-props (pop props))
+                  (bol (1+ (point))))
+              (dolist (prop line-props)
+                (let ((ol (make-overlay (+ bol (nth 0 prop))
+                                        (+ bol (nth 1 prop))
+                                        nil 'front-advance nil)))
+                  (overlay-put ol 'evaporate t)
+                  (overlay-put ol 'face (nth 2 prop)))))))))))
+
+(defun diff-syntax-fontify-props (file text line-nb &optional no-init hunk-only)
+  "Get font-lock properties from the source code."
+  (unless no-init
+    (buffer-disable-undo)
+    (font-lock-mode -1)
+    (let ((enable-local-variables :safe) ;; to find `mode:'
+          (buffer-file-name file))
+      (set-auto-mode)
+      (when (and (memq 'generic-mode-find-file-hook find-file-hook)
+                 (fboundp 'generic-mode-find-file-hook))
+        (generic-mode-find-file-hook))))
+
+  (let ((font-lock-defaults (or font-lock-defaults '(nil t)))
+        (inhibit-read-only t)
+        props beg end)
+    (goto-char (point-min))
+    (if hunk-only
+        (setq beg (point-min) end (point-max))
+      (forward-line (1- (nth 0 line-nb)))
+      ;; non-regexp looking-at to compare hunk text for verification
+      (if (search-forward text (+ (point) (length text)) t)
+          (setq beg (- (point) (length text)) end (point))
+        (goto-char (point-min))
+        (if (search-forward text nil t)
+            (setq beg (- (point) (length text)) end (point)))))
+
+    (when (and beg end)
+      (goto-char beg)
+      (when (text-property-not-all beg end 'fontified t)
+        (if file
+            ;; In a temporary or cached buffer
+            (save-excursion
+              (font-lock-fontify-region beg end)
+              (put-text-property beg end 'fontified t))
+          ;; In an existing buffer
+          (font-lock-ensure beg end)))
+
+      (while (< (point) end)
+        (let* ((bol (point))
+               (eol (line-end-position))
+               line-props
+               (searching t)
+               (from (point)) to
+               (val (get-text-property from 'face)))
+          (while searching
+            (setq to (next-single-property-change from 'face nil eol))
+            (when val (push (list (- from bol) (- to bol) val) line-props))
+            (setq val (get-text-property to 'face) from to)
+            (unless (< to eol) (setq searching nil)))
+          (when val (push (list from eol val) line-props))
+          (push (nreverse line-props) props))
+        (forward-line 1)))
+    (set-buffer-modified-p nil)
+    (nreverse props)))
+
+
 (defun diff--filter-substring (str)
   (when diff-font-lock-prettify
     ;; Strip the `display' properties added by diff-font-lock-prettify,