From: Noam Postavsky Date: Sat, 4 May 2019 18:47:29 +0000 (-0400) Subject: Avoid slow overlay ansi coloring in eshell (Bug#29854) X-Git-Tag: emacs-27.0.90~2993 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4fd9048e940d38364caf4abe9b209f9288c78544;p=emacs.git Avoid slow overlay ansi coloring in eshell (Bug#29854) * lisp/ansi-color.el (ansi-color-apply-on-region): Reset temporary markers after finishing with them. (ansi-color-apply-text-property-face): New function. * lisp/eshell/esh-mode.el (eshell-handle-ansi-color): * lisp/man.el (Man-fontify-manpage): Use it as the `ansi-color-apply-face-function' while calling `ansi-color-apply-on-region'. Use `font-lock-face' to propertize instead of `face'. --- diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index d3b8d06604c..136e69f9a76 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -415,7 +415,11 @@ this." ;; if the rest of the region should have a face, put it there (funcall ansi-color-apply-face-function start-marker end-marker (ansi-color--find-face codes)) - (setq ansi-color-context-region (if codes (list codes))))))) + (setq ansi-color-context-region (if codes (list codes))))) + ;; Clean up our temporary markers. + (unless (eq start-marker (cadr ansi-color-context-region)) + (set-marker start-marker nil)) + (set-marker end-marker nil))) (defun ansi-color-apply-overlay-face (beg end face) "Make an overlay from BEG to END, and apply face FACE. @@ -425,6 +429,12 @@ If FACE is nil, do nothing." (ansi-color-make-extent beg end) face))) +(defun ansi-color-apply-text-property-face (beg end face) + "Set the `font-lock-face' property to FACE in region BEG..END. +If FACE is nil, do nothing." + (when face + (put-text-property beg end 'font-lock-face face))) + ;; This function helps you look for overlapping overlays. This is ;; useful in comint-buffers. Overlapping overlays should not happen! ;; A possible cause for bugs are the markers. If you create an overlay diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index cff29bed1b6..a36ac969e55 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -1014,11 +1014,13 @@ This function could be in the list `eshell-output-filter-functions'." 'eshell-handle-control-codes) (autoload 'ansi-color-apply-on-region "ansi-color") +(defvar ansi-color-apply-face-function) (defun eshell-handle-ansi-color () "Handle ANSI color codes." - (ansi-color-apply-on-region eshell-last-output-start - eshell-last-output-end)) + (let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face)) + (ansi-color-apply-on-region eshell-last-output-start + eshell-last-output-end))) (custom-add-option 'eshell-output-filter-functions 'eshell-handle-ansi-color) diff --git a/lisp/man.el b/lisp/man.el index b1d0fd3d17c..d52ca2156d2 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1206,10 +1206,7 @@ Same for the ANSI bold and normal escape sequences." (interactive) (goto-char (point-min)) ;; Fontify ANSI escapes. - (let ((ansi-color-apply-face-function - (lambda (beg end face) - (when face - (put-text-property beg end 'face face)))) + (let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face) (ansi-color-map Man-ansi-color-map)) (ansi-color-apply-on-region (point-min) (point-max))) ;; Other highlighting. @@ -1220,31 +1217,33 @@ Same for the ANSI bold and normal escape sequences." (goto-char (point-min)) (while (and (search-forward "__\b\b" nil t) (not (eobp))) (backward-delete-char 4) - (put-text-property (point) (1+ (point)) 'face 'Man-underline)) + (put-text-property (point) (1+ (point)) + 'font-lock-face 'Man-underline)) (goto-char (point-min)) (while (search-forward "\b\b__" nil t) (backward-delete-char 4) - (put-text-property (1- (point)) (point) 'face 'Man-underline)))) + (put-text-property (1- (point)) (point) + 'font-lock-face 'Man-underline)))) (goto-char (point-min)) (while (and (search-forward "_\b" nil t) (not (eobp))) (backward-delete-char 2) - (put-text-property (point) (1+ (point)) 'face 'Man-underline)) + (put-text-property (point) (1+ (point)) 'font-lock-face 'Man-underline)) (goto-char (point-min)) (while (search-forward "\b_" nil t) (backward-delete-char 2) - (put-text-property (1- (point)) (point) 'face 'Man-underline)) + (put-text-property (1- (point)) (point) 'font-lock-face 'Man-underline)) (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t) (replace-match "\\1") - (put-text-property (1- (point)) (point) 'face 'Man-overstrike)) + (put-text-property (1- (point)) (point) 'font-lock-face 'Man-overstrike)) (goto-char (point-min)) (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o") - (put-text-property (1- (point)) (point) 'face 'bold)) + (put-text-property (1- (point)) (point) 'font-lock-face 'bold)) (goto-char (point-min)) (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+") - (put-text-property (1- (point)) (point) 'face 'bold)) + (put-text-property (1- (point)) (point) 'font-lock-face 'bold)) ;; When the header is longer than the manpage name, groff tries to ;; condense it to a shorter line interspersed with ^H. Remove ^H with ;; their preceding chars (but don't put Man-overstrike). (Bug#5566) @@ -1258,7 +1257,7 @@ Same for the ANSI bold and normal escape sequences." (while (re-search-forward Man-heading-regexp nil t) (put-text-property (match-beginning 0) (match-end 0) - 'face 'Man-overstrike)))) + 'font-lock-face 'Man-overstrike)))) (defun Man-highlight-references (&optional xref-man-type) "Highlight the references on mouse-over.