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 d3b8d06604cd6a585d98a62b0a6505e5febac702..136e69f9a76c770ecad32c9996ebe105992cab5c 100644 (file)
--- 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 cff29bed1b6706dddaddfa920d8217ddb196dd37..a36ac969e55c46c05543381a6cfbbbe4a6ebbb03 100644 (file)
--- 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 b1d0fd3d17cc3ea4a68d9bd1b068a6f40b56b9cc..d52ca2156d2273c14c5e9978e14a5162485b55ab 100644 (file)
--- 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.