Commit 4fd9048e authored by Noam Postavsky's avatar Noam Postavsky
Browse files

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'.
parent 37963ed4
Pipeline #1556 failed with stage
in 58 minutes and 22 seconds
......@@ -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
......
......@@ -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)
......
......@@ -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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment