bug#33567: Syntactic fontification of diff hunks

[Juri Linkov <juri@linkov.net>]

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

> I don't think one can understand what the feature does just by reading
> the doc string.  I think something very basic is missing here, without
> which the rest of the doc text cannot be unlocked.  Perhaps just
> elaborating on what exactly "syntax highlighting" means in this
> context would be enough.
>
> Also, judging by my reading of the code, the description of what the
> various non-nil values do is not entirely accurate, and might not be
> what the user expects by reading the above description.

I tried to explain this more thoughtfully in a new version of the docstring.

>> +                 (const :tag "Without full source or get it from files" t)))
>
> This description is backwards, I think: you should start with "with
> source files".  (But maybe I misunderstand the whole issue, see
> above.)

Fixed in a new version.  Also please note why `t' is not the default.
This is to avoid trying to read local files while a received patch
is displayed in the mail attachment.  I think to avoid such situations
when it will try to read random files, better to use the same method
as is used in diff buffers created by a VC command - it sets a special
variable `diff-vc-backend' that guarantees that diff buffer is created
with file paths relative to the process that created these buffers.
I propose for commands that compare files like diff, diff-backup,
dired-diff, dired-backup-diff also to set a similar variable e.g.
`diff-files' that will guarantee that file paths are valid to read.

>> +                                      ;; Restore restore previous window configuration
>> +                                      ;; because when vc-find-revision can't find a revision
>> +                                      ;; (e.g. for /dev/null), it jumps to another window
>> +                                      ;; using pop-to-buffer in vc-do-command when
>> +                                      ;; the buffer name doesn't begin with a space char.
>
> Nitpicking: can this comment please be refilled to not exceed "normal"
> line width?

Fixing the described problem will remove this comment,
but I have no idea how better to do this.  The problem is that
we need to provide own created buffer to the call to `vc-find-revision'.
Currently it has the following function signature:

  (defun vc-find-revision (file revision &optional backend)

But VC API in the comments in the beginning of vc.el
is documented with a different function signature:

  ;; * find-revision (file rev buffer)
  ;;
  ;;   Fetch revision REV of file FILE and put it into BUFFER.
  ;;   If REV is the empty string, fetch the head of the trunk.
  ;;   The implementation should pass the value of vc-checkout-switches
  ;;   to the backend command.

This means that to fix the problem we need the call as is documented
with the argument BUFFER, but the current implementation without
such argument doesn't correspond to the documentation.

BTW, while deciding what to do with this, could you please confirm
if I correctly fixed another problem in vc-find-revision-no-save.
Recently in bug#33319 I added this function but now discovered
a problem with encoding.  A vc process outputs lines to the buffer
with no-conversion, so in the patch below I added recode-region
to convert output to the buffer's encoding.  coding-system-for-write
that I removed was copied from vc-find-revision-save where is was
needed for write-region called from the macro with-temp-file,
but vc-find-revision-no-save doesn't write output to the file.

>> +     ((not (eq diff-font-lock-syntax 'vc))
>> +      (let ((file (car (diff-hunk-file-names old))))
>> +        (if (and file (file-exists-p file))
>
> This assumes that the file name is relative to the default-directory
> of the buffer with the diffs, right?  How reasonable is such an
> assumption for when browsing diffs?  Should we perhaps allow the user
> to specify the directory of the sources?

This assumption should be true for all cases when the diff buffer is created
using commands like dired-diff, dired-backup-diff, diff, diff-backup.

But when navigating a diff output saved to a file that was moved to
another directory, currently diff-mode asks for a directory interactively,
that is not possible to do for non-interactive fontification.

As a general solution is should be possible to specify the default
directory in the local variables at the first line of the diff files
as currently already is used in compilation/grep buffers like

-*- mode: diff-mode; default-directory: "..." -*-

> Also, if the diffs are from Git, they begin with a/, b/, etc. dummy
> directories, which usually don't exist in the file system.

This is not a problem because diff-find-file-name used in the patch
strips such a/, b/ prefixes to get the existing file name.


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

diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index de43544864..00ec1226d7 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -2008,8 +2008,7 @@ vc-find-revision-no-save
       (with-current-buffer filebuf
 	(let ((failed t))
 	  (unwind-protect
-	      (let ((coding-system-for-read 'no-conversion)
-		    (coding-system-for-write 'no-conversion))
+	      (let ((coding-system-for-read 'no-conversion))
 		(with-current-buffer (create-file-buffer filename)
                   (setq buffer-file-name filename)
 		  (let ((outbuf (current-buffer)))
@@ -2019,6 +2018,9 @@ vc-find-revision-no-save
 			(vc-call find-revision file revision outbuf))))
                   (goto-char (point-min))
                   (normal-mode)
+                  (recode-region (point-min) (point-max)
+                                 (car (detect-coding-region (point-min) (point-max)))
+                                 'no-conversion)
 	          (set-buffer-modified-p nil)
                   (setq buffer-read-only t))
 		(setq failed nil))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 4adef02984..02421e2630 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -103,6 +103,31 @@ diff-font-lock-prettify
   :version "27.1"
   :type 'boolean)
 
+(defcustom diff-font-lock-syntax 'vc
+  "If non-nil, diff hunk's font-lock includes language syntax highlighting.
+This highlighting is the same as added by `font-lock-mode' when
+corresponding source files are visited from the diff buffer.
+In diff hunks syntax highlighting is added over diff own
+highlighted changes.
+
+If `vc', highlight syntax only in Diff buffers created by a version control
+system that provides all necessary context for reliable highlighting.
+For working revisions get highlighting according to the working
+copy of the file.
+
+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.
+
+If t, additionally to trying to use a version control system to get
+old revisions for fontification, also try to get fontification based
+on existing files, and on failure get fontification from hunk alone."
+  :version "27.1"
+  :type '(choice (const :tag "Don't highlight syntax" nil)
+                 (const :tag "Use version control" vc)
+                 (const :tag "Hunk-based only" hunk-only)
+                 (const :tag "Try everything including files" t)))
+
 (defvar diff-vc-backend nil
   "The VC backend that created the current Diff buffer, if any.")
 
@@ -406,6 +431,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)))
 
@@ -1348,6 +1374,7 @@ diff-next-error
 
 (defun diff--font-lock-cleanup ()
   (remove-overlays nil nil 'diff-mode 'fine)
+  (remove-overlays nil nil 'diff-mode 'syntax)
   (when font-lock-mode
     (make-local-variable 'font-lock-extra-managed-props)
     ;; Added when diff--font-lock-prettify is non-nil!
@@ -1748,7 +1775,7 @@ diff-find-source-location
                                 (vc-working-revision file)))))
 	   (buf (if revision
                     (let ((vc-find-revision-no-save t))
-                      (vc-find-revision file revision diff-vc-backend))
+                      (vc-find-revision (expand-file-name file) revision diff-vc-backend))
                   (find-file-noselect file))))
       ;; Update the user preference if he so wished.
       (when (> (prefix-numeric-value other-file) 8)
@@ -2316,6 +2343,197 @@ 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 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))
+                  ;; 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))
+                     (no-init t))
+                (unless (and buffer (buffer-live-p buffer))
+                  (let* ((vc-find-revision-no-save t)
+                         (vc-buffer (save-window-excursion
+                                      ;; Restore restore previous window configuration
+                                      ;; because when vc-find-revision can't find a revision
+                                      ;; (e.g. for /dev/null), it jumps to another window
+                                      ;; using pop-to-buffer in vc-do-command when
+                                      ;; the buffer name doesn't begin with a space char.
+                                      (ignore-errors
+                                        (vc-find-revision (expand-file-name file)
+                                                          revision diff-vc-backend)))))
+                    (when vc-buffer
+                      (with-current-buffer (get-buffer-create buffer-name)
+                        (insert-buffer-substring-no-properties vc-buffer)
+                        (setq buffer (current-buffer) no-init nil))
+                      (puthash buffer-name buffer diff-syntax-fontify-revisions)
+                      (kill-buffer vc-buffer))))
+                (when buffer
+                  (with-current-buffer buffer
+                    (setq props (diff-syntax-fontify-props file text line-nb no-init))))))
+          ;; 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))))))
+     ((eq diff-font-lock-syntax '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)))))
+     ((not (eq diff-font-lock-syntax 'vc))
+      (let ((file (car (diff-hunk-file-names old))))
+        (if (and file (file-exists-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)))))))
+
+    ;; Put properties over the hunk text
+    (when props
+      (goto-char beg)
+      (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)))
+        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,