From: Juri Linkov <juri@linkov.net>
To: 33567@debbugs.gnu.org
Subject: bug#33567: Syntactic fontification of diff hunks
Date: Sat, 01 Dec 2018 23:55:40 +0200 [thread overview]
Message-ID: <878t18j4is.fsf@mail.linkov.net> (raw)
[-- Attachment #1: Type: text/plain, Size: 454 bytes --]
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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: diff-font-lock-syntax.patch --]
[-- Type: text/x-diff, Size: 10780 bytes --]
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,
next reply other threads:[~2018-12-01 21:55 UTC|newest]
Thread overview: 61+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-12-01 21:55 Juri Linkov [this message]
2018-12-02 6:56 ` bug#33567: Syntactic fontification of diff hunks Eli Zaretskii
2018-12-03 0:34 ` Juri Linkov
2018-12-03 6:49 ` Eli Zaretskii
2018-12-03 23:36 ` Juri Linkov
2018-12-04 7:01 ` Eli Zaretskii
2018-12-04 23:16 ` Juri Linkov
2018-12-05 7:19 ` Eli Zaretskii
2018-12-05 23:25 ` Juri Linkov
2018-12-06 6:53 ` Eli Zaretskii
2018-12-11 0:38 ` Juri Linkov
2018-12-11 6:23 ` Eli Zaretskii
2018-12-12 0:28 ` Juri Linkov
2018-12-12 17:11 ` Eli Zaretskii
2018-12-03 23:59 ` Juri Linkov
2018-12-04 7:36 ` Eli Zaretskii
2018-12-04 23:28 ` Juri Linkov
2018-12-05 7:25 ` Eli Zaretskii
2018-12-05 23:35 ` Juri Linkov
2018-12-12 23:17 ` Juri Linkov
2018-12-14 9:13 ` Eli Zaretskii
2018-12-16 23:27 ` Juri Linkov
2018-12-17 16:13 ` Eli Zaretskii
2018-12-17 23:11 ` Juri Linkov
2018-12-18 0:14 ` Juri Linkov
2018-12-18 15:55 ` Dmitry Gutov
2018-12-18 22:35 ` Juri Linkov
2018-12-18 23:33 ` Dmitry Gutov
2018-12-19 0:11 ` Juri Linkov
2018-12-19 0:48 ` Dmitry Gutov
2018-12-19 1:35 ` Dmitry Gutov
2018-12-19 21:49 ` Juri Linkov
2018-12-19 22:50 ` Dmitry Gutov
2018-12-20 22:00 ` Juri Linkov
2018-12-24 2:29 ` Dmitry Gutov
2018-12-25 20:35 ` Juri Linkov
2018-12-25 21:15 ` Dmitry Gutov
2018-12-26 22:49 ` Juri Linkov
2018-12-26 23:16 ` Dmitry Gutov
2018-12-27 0:18 ` Juri Linkov
2018-12-27 0:45 ` Dmitry Gutov
2018-12-27 3:34 ` Eli Zaretskii
2018-12-27 3:32 ` Eli Zaretskii
2018-12-19 21:51 ` Juri Linkov
2018-12-20 0:11 ` Dmitry Gutov
2018-12-20 21:50 ` Juri Linkov
2018-12-20 1:15 ` Dmitry Gutov
2018-12-20 22:17 ` Juri Linkov
2018-12-25 20:39 ` Juri Linkov
2018-12-26 1:40 ` Dmitry Gutov
2018-12-26 22:59 ` Juri Linkov
2018-12-26 23:56 ` Dmitry Gutov
2018-12-27 20:39 ` Juri Linkov
2018-12-29 23:07 ` Juri Linkov
2018-12-30 23:07 ` Dmitry Gutov
2018-12-26 0:43 ` Dmitry Gutov
2018-12-03 11:24 ` Dmitry Gutov
2018-12-03 23:24 ` Juri Linkov
2018-12-04 0:20 ` Dmitry Gutov
2018-12-04 6:46 ` Eli Zaretskii
2018-12-04 22:58 ` Juri Linkov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=878t18j4is.fsf@mail.linkov.net \
--to=juri@linkov.net \
--cc=33567@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).