Subject: bug#33567: closed (Re: bug#33567: Syntactic fontification of diff hunks)

From: [email-masked] (GNU bug Tracking System)
Date: Mon, 17 Dec 2018 23:13:02 +0000

Your bug report

#33567: Syntactic fontification of diff hunks

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
33567: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=33567
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#33567: Syntactic fontification of diff hunks
From: Juri Linkov <[email-masked]>
To: Eli Zaretskii <[email-masked]>
Cc: [email-masked]
Date: Tue, 18 Dec 2018 01:11:49 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

>> Also with more highlighting in diff hunks now diff indicators need more
>> distinctive colors that I also tested.
>
> Thanks, this LGTM.

Pushed to master and closed.

Subject: Syntactic fontification of diff hunks
From: Juri Linkov <[email-masked]>
To: [email-masked]
Date: Sat, 01 Dec 2018 23:55:40 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

Tags: patch
Severity: wishlist

For a long time after announcing this feature in
https://lists.gnu.org/archive/html/emacs-devel/2018-08/msg00537.html
I received requests in private mails asking when I'll submit a complete patch.
I'm sorry, it took much time addressing all concerns raised in that thread,
and testing in many possible scenarios.  Based on the feedback, I rewrote it
several times, and now finally it's optimized to be fast and reliable.

diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 4adef02984..68b2f9e522 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -103,6 +103,21 @@ diff-font-lock-prettify
   :version "27.1"
   :type 'boolean)
 
+(defcustom diff-font-lock-syntax 'vc
+  "If non-nil, diff hunk font-lock includes syntax highlighting.
+If `vc', highlight syntax only in Diff buffers created by a version control
+system that provides all necessary context for reliable highlighting.
+If t, additionally try to get more context from existing files, or when
+source files are not found, still try to highlight hunks without enough
+context that sometimes might result in wrong fontification.
+If `hunk-only', fontification is based on hunk alone, without full source.
+This is the fastest, but less reliable."
+  :version "27.1"
+  :type '(choice (const :tag "Don't highlight syntax" nil)
+                 (const :tag "Only under version control" vc)
+                 (const :tag "Hunk-based only" hunk-only)
+                 (const :tag "Without full source or get it from files" t)))
+
 (defvar diff-vc-backend nil
   "The VC backend that created the current Diff buffer, if any.")
 
@@ -406,6 +421,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 +2333,195 @@ 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 file
+                (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)
+      (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))))
+     ((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)
+      (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,