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,