[Emacs-diffs] master 4fd9048: Avoid slow overlay ansi coloring in eshell (Bug#29854)

[Noam Postavsky]

branch: master
commit 4fd9048e940d38364caf4abe9b209f9288c78544
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    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'.
---
 lisp/ansi-color.el      | 12 +++++++++++-
 lisp/eshell/esh-mode.el |  6 ++++--
 lisp/man.el             | 23 +++++++++++------------
 3 files changed, 26 insertions(+), 15 deletions(-)

diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index d3b8d06..136e69f 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 cff29be..a36ac96 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 b1d0fd3..d52ca21 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.