Syntactic fontification of diff hunks (bug#33567)

* lisp/vc/diff-mode.el (diff-font-lock-syntax): New defcustom.
(diff-default-directory): New buffer-local variable.
(diff-indicator-removed, diff-indicator-added)
(diff-indicator-changed): Set foreground to distinctive colors.
(diff-context): Remove colors to make room for syntax highlighting.
(diff-font-lock-keywords): Add diff--font-lock-syntax.
(diff--font-lock-cleanup): Remove diff-mode syntax overlays.
(diff--font-lock-syntax, diff--font-lock-syntax--refresh)
(diff-syntax-fontify-revisions, diff-syntax-fontify-hunk)
(diff-syntax-fontify-props): New functions.

* lisp/vc/diff.el (diff-no-select): Set diff-default-directory to
default-directory.

* doc/emacs/files.texi (Diff Mode): Document diff-font-lock-syntax.
This commit is contained in:
Juri Linkov 2018-12-18 01:11:15 +02:00
parent c5e02f2bce
commit 6973b1489b
4 changed files with 249 additions and 7 deletions

View file

@ -1617,6 +1617,10 @@ displayed in the echo area). With a prefix argument, it tries to
modify the original (``old'') source files rather than the patched
(``new'') source files.
@vindex diff-font-lock-syntax
If non-@code{nil}, fragments of source in hunks are highlighted
according to the appropriate major mode.
@node Copying and Naming
@section Copying, Naming and Renaming Files

View file

@ -413,6 +413,12 @@ and compares their entire trees.
*** Hunks are now automatically refined by default.
To disable it, set the new defcustom 'diff-font-lock-refine' to nil.
+++
*** Better syntax highlighting of Diff hunks.
Fragments of source in Diff hunks are now by default highlighted
according to the appropriate major mode. Customize the new option
'diff-font-lock-syntax' to nil to disable this.
*** File headers can be shortened, mimicking Magit's diff format.
To enable it, set the new defcustom 'diff-font-lock-prettify' to t.

View file

@ -56,6 +56,7 @@
(eval-when-compile (require 'cl-lib))
(autoload 'vc-find-revision "vc")
(autoload 'vc-find-revision-no-save "vc")
(defvar vc-find-revision-no-save)
(defvar add-log-buffer-file-name-function)
@ -103,12 +104,42 @@ when editing big diffs)."
: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 revision-based or file-based method fails, use hunk-based method to 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.")
(make-variable-buffer-local 'diff-default-directory)
(defvar diff-outline-regexp
"\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)")
@ -295,19 +326,25 @@ well."
:version "25.1")
(defface diff-indicator-removed
'((t :inherit diff-removed))
'((default :inherit diff-removed)
(((class color) (min-colors 88))
:foreground "#aa2222"))
"`diff-mode' face used to highlight indicator of removed lines (-, <)."
:version "22.1")
(defvar diff-indicator-removed-face 'diff-indicator-removed)
(defface diff-indicator-added
'((t :inherit diff-added))
'((default :inherit diff-added)
(((class color) (min-colors 88))
:foreground "#22aa22"))
"`diff-mode' face used to highlight indicator of added lines (+, >)."
:version "22.1")
(defvar diff-indicator-added-face 'diff-indicator-added)
(defface diff-indicator-changed
'((t :inherit diff-changed))
'((default :inherit diff-changed)
(((class color) (min-colors 88))
:foreground "#aaaa22"))
"`diff-mode' face used to highlight indicator of changed lines."
:version "22.1")
(defvar diff-indicator-changed-face 'diff-indicator-changed)
@ -317,10 +354,7 @@ well."
"`diff-mode' face used to highlight function names produced by \"diff -p\".")
(defface diff-context
'((((class color grayscale) (min-colors 88) (background light))
:foreground "#333333")
(((class color grayscale) (min-colors 88) (background dark))
:foreground "#dddddd"))
'((t nil))
"`diff-mode' face used to highlight context and other side-information."
:version "25.1")
@ -406,6 +440,7 @@ and the face `diff-added' for added lines.")
(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 +1383,7 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
(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!
@ -2316,6 +2352,199 @@ fixed, visit it in a buffer."
'display "")))))
nil)
;;; Syntax highlighting from font-lock
(defun diff--font-lock-syntax (max)
"Apply source language syntax highlighting from font-lock.
Calls `diff-syntax-fontify' on every hunk found between point
and the position in MAX."
(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 (beg end)
"Highlight source language syntax in diff hunk between BEG and END."
(save-excursion
(diff-syntax-fontify-hunk beg end t)
(diff-syntax-fontify-hunk beg 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 hunk between BEG and END.
When OLD is non-nil, highlight the hunk from the old source."
(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.
FILE is the name of the source file. TEXT is the literal source text from
hunk. LINE-NB is a pair of numbers: start line number and the number of
lines in the hunk. NO-INIT means no initialization is needed to set major
mode. When HUNK-ONLY is non-nil, then don't verify the existence of the
hunk text in the source file. Otherwise, don't highlight the hunk if the
hunk text is not found in the source file."
(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,

View file

@ -121,6 +121,8 @@ Possible values are:
nil -- no, it does not
check -- try to probe whether it does")
(defvar diff-default-directory)
(defun diff-no-select (old new &optional switches no-async buf)
;; Noninteractive helper for creating and reverting diff buffers
(unless (bufferp new) (setq new (expand-file-name new)))
@ -165,6 +167,7 @@ Possible values are:
(lambda (_ignore-auto _noconfirm)
(diff-no-select old new switches no-async (current-buffer))))
(setq default-directory thisdir)
(setq diff-default-directory default-directory)
(let ((inhibit-read-only t))
(insert command "\n"))
(if (and (not no-async) (fboundp 'make-process))