Re: comint-last-output-overlay -- overlapping overlays

[Alex Schroeder]

Miles Bader <address@hidden> writes:

> and then I typed `ls --color /dev' into the shell buffer.
>
> The result: redisplay is still dog slow, and feels basically the same as
> it does when I turn comint field support back on.  [I'll note that it's
> not really unusably slow on my system, just slow enough to be annoying
> whenever I do single-line scrolls or something]
>
> So it seems that the redisplay problems aren't really due to overlapping
> overlays, but simply the presence of _lots_ of overlays in close
> proximity (like the every-file-name-has-one case of `ls --color /dev').

I'm not so sure.  I fixed a bug in ansi-color.el recently (without
checking it into Emacs CVS) which still caused the occasional
overlapping overlay.  The bug is that very seldomly (once every 400
overlays, for example) one overlay will not terminate correctly.
Assuming 1200 files ins /dev and the bug on file 400 and 800, this
results in at least 800 (buggy overlay 1 overlapping the remaining
overlays) + 400 (overlay 2 overlapping the remaining overlays)
overlaps!

This 1-in-400-bug made ls --color /dev dog slow in Emacs 20 (more than
one minute).  After fixing the bug listing /dev is reasonably fast.
Therefore I suggest you try the following patch for ansi-color.el and
check again.

If that works for you, could you commit it as well?

Alex.


2001-11-15  Alex Schroeder  <address@hidden>

        * ansi-color.el: require cl if dolist is not defined.
        (ansi-color-keep-old-overlays): New variable.
        (ansi-color-remove-old-overlays): New function.  When loading
        ansi-color, this function will be added to
        comint-output-filter-functions unless comint-truncate-buffer is
        already in that list.
        (ansi-color-apply-on-region): Don't create overlays for zero
        length regions and for regions which will be revisited in the
        following run.
        (ansi-color-make-extent): Added fix for insert-before-marks
        related bug in comint.el in Emacs 20.  This bug caused overlapping
        overlays on Emacs 20 from time to time.  Instead of creating a new
        overlay always, an existing overlay may be extended instead.
        (ansi-color-freeze-overlay): Deleted function.  This was supposed
        to fix the aforementioned bug and didn't.
        (ansi-color-extent-list): New function.
        (ansi-color-delete-extent): New function.

Index: ansi-color.el
===================================================================
RCS file: /var/cvs/emacs/ansi-colors/ansi-color.el,v
retrieving revision 1.30
diff -c -r1.30 ansi-color.el
*** ansi-color.el       2001/06/08 08:09:47     1.30
--- ansi-color.el       2001/11/15 01:28:25
***************
*** 4,10 ****
  
  ;; Author: Alex Schroeder <address@hidden>
  ;; Maintainer: Alex Schroeder <address@hidden>
! ;; Version: 3.4.4
  ;; Keywords: comm processes terminals services
  ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?AnsiColor
  
--- 4,10 ----
  
  ;; Author: Alex Schroeder <address@hidden>
  ;; Maintainer: Alex Schroeder <address@hidden>
! ;; Version: 3.4.5
  ;; Keywords: comm processes terminals services
  ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?AnsiColor
  
***************
*** 91,96 ****
--- 91,100 ----
  
  ;;; Code:
  
+ (eval-when-compile
+   (unless (functionp 'dolist)
+     (require 'cl)))
+ 
  ;; Customization
  
  (defgroup ansi-colors nil
***************
*** 152,157 ****
--- 156,173 ----
    :initialize 'custom-initialize-default
    :group 'ansi-colors)
  
+ (defcustom ansi-color-keep-old-overlays 5000
+   "*The maximum size of the buffer with ansi-color overlays.
+ Since too many overlays consume a lot of resources, they should be
+ removed from the output.  This can happen by automatically truncating
+ the buffer (see `comint-buffer-maximum-size') or by actively searching
+ and removing old overlays.  This variable controls for how far back from
+ `process-mark' the old overlays are kept.  The overlays are removed when
+ `ansi-color-remove-old-overlays' is on `comint-output-filter-functions'."
+   :type 'integer
+   :version "21.2"
+   :group 'ansi-colors)
+ 
  (defconst ansi-color-regexp "\033\\[\\([0-9;]*\\)m"
    "Regexp that matches SGR control sequences.")
  
***************
*** 199,204 ****
--- 215,245 ----
    (setq ansi-color-for-comint-mode 'filter))
  
  ;;;###autoload
+ (defun ansi-color-remove-old-overlays (string)
+   "Remove old overlays from the buffer.
+ An overlay is considered old when it ends more than a certain distance
+ from `process-mark'.  You can set this distance using the variable
+ `ansi-color-keep-old-overlays'.
+ 
+ Emacs will add this function to `comint-output-filter-functions'
+ automatically."
+   (let* ((end-marker (process-mark (get-buffer-process (current-buffer))))
+        (extents (ansi-color-extent-list
+                  (point-min)
+                  (- end-marker ansi-color-keep-old-overlays))))
+     (dolist (extent extents)
+       (ansi-color-delete-extent extent))))
+ 
+ ;; We can avoid too many overlays by either truncating the buffer, or by
+ ;; removing the old overlays.  XEmacs doesn't have this problem.
+ (unless (or (featurep 'xemacs)
+           (and (boundp 'comint-output-filter-functions)
+                (memq 'comint-truncate-buffer
+                      comint-output-filter-functions)))
+   (add-hook 'comint-output-filter-functions
+           'ansi-color-remove-old-overlays))
+ 
+ ;;;###autoload
  (defun ansi-color-process-output (string)
    "Maybe translate SGR control sequences of comint output into 
text-properties.
  
***************
*** 223,229 ****
  (add-hook 'comint-output-filter-functions
          'ansi-color-process-output)
  
- 
  ;; Alternative font-lock-unfontify-region-function for Emacs only
  
  
--- 264,269 ----
***************
*** 428,435 ****
        (goto-char start-marker)
        ;; find the next escape sequence
        (while (re-search-forward ansi-color-regexp end-marker t)
!       ;; colorize the old block from start to end using old face
!       (when face
          (ansi-color-set-extent-face
           (ansi-color-make-extent start-marker (match-beginning 0))
           face))
--- 468,476 ----
        (goto-char start-marker)
        ;; find the next escape sequence
        (while (re-search-forward ansi-color-regexp end-marker t)
!       ;; colorize the old block from start to end using old face, but
!       ;; only if there actually is a face and a non-zero block
!       (when (and face (< start-marker (match-beginning 0)))
          (ansi-color-set-extent-face
           (ansi-color-make-extent start-marker (match-beginning 0))
           face))
***************
*** 443,487 ****
        (setq face (ansi-color-apply-sequence escape-sequence face)))
        ;; search for the possible start of a new escape sequence
        (if (re-search-forward "\033" end-marker t)
!         (progn
!           ;; if the rest of the region should have a face, put it there
!           (when face
!             (ansi-color-set-extent-face
!              (ansi-color-make-extent start-marker (point))
!              face))
!           ;; save face and point
!           (setq ansi-color-context-region
!                 (list face (copy-marker (match-beginning 0)))))
!       ;; if the rest of the region should have a face, put it there
        (if face
            (progn
!             (ansi-color-set-extent-face
!              (ansi-color-make-extent start-marker end-marker)
!              face)
              (setq ansi-color-context-region (list face)))
-         ;; reset context
          (setq ansi-color-context-region nil))))))
  
- ;; This function helps you look for overlapping overlays.  This is
- ;; usefull in comint-buffers.  Overlapping overlays should not happen!
- ;; A possible cause for bugs are the markers.  If you create an overlay
- ;; up to the end of the region, then that end might coincide with the
- ;; process-mark.  As text is added BEFORE the process-mark, the overlay
- ;; will keep growing.  Therefore, as more overlays are created later on,
- ;; there will be TWO OR MORE overlays covering the buffer at that point.
- ;; This function helps you check your buffer for these situations.
- ; (defun ansi-color-debug-overlays ()
- ;   (interactive)
- ;   (let ((pos (point-min)))
- ;     (while (< pos (point-max))
- ;       (if (<= 2 (length (overlays-at pos)))
- ;       (progn
- ;         (goto-char pos)
- ;         (error "%d overlays at %d" (length (overlays-at pos)) pos))
- ;     (let (message-log-max)
- ;       (message  "Reached %d." pos)))
- ;       (setq pos (next-overlay-change pos)))))
- 
  ;; Emacs/XEmacs compatibility layer
  
  (defun ansi-color-make-face (property color)
--- 484,504 ----
        (setq face (ansi-color-apply-sequence escape-sequence face)))
        ;; search for the possible start of a new escape sequence
        (if (re-search-forward "\033" end-marker t)
!         ;; save the start of this potential escape sequence as next
!         ;; start-marker
!         (setq ansi-color-context-region
!               (list face (copy-marker (match-beginning 0))))
!       ;; if no potential escape sequence was found, do the right
!       ;; thing: if the rest of the region should have a face, put it
!       ;; there and do not save a start-marker for the next run
        (if face
            (progn
!             (ansi-color-set-extent-face
!              (ansi-color-make-extent start-marker end-marker)
!              face)
              (setq ansi-color-context-region (list face)))
          (setq ansi-color-context-region nil))))))
  
  ;; Emacs/XEmacs compatibility layer
  
  (defun ansi-color-make-face (property color)
***************
*** 510,535 ****
  uses `make-overlay'.  XEmacs can use a buffer or a string for OBJECT,
  Emacs requires OBJECT to be a buffer."
    (if (functionp 'make-extent)
!       (make-extent from to object)
      ;; In Emacs, the overlay might end at the process-mark in comint
      ;; buffers.  In that case, new text will be inserted before the
      ;; process-mark, ie. inside the overlay (using insert-before-marks).
!     ;; In order to avoid this, we use the `insert-behind-hooks' overlay
!     ;; property to make sure it works.
!     (let ((overlay (make-overlay from to object)))
!       (overlay-put overlay 'modification-hooks '(ansi-color-freeze-overlay))
!       overlay)))
! 
! (defun ansi-color-freeze-overlay (overlay is-after begin end &optional len)
!   "Prevent OVERLAY from being extended.
! This function can be used for the `modification-hooks' overlay
! property."
!   ;; if stuff was inserted at the end of the overlay
!   (when (and is-after
!            (= 0 len)
!            (= end (overlay-end overlay)))
!     ;; reset the end of the overlay
!     (move-overlay overlay (overlay-start overlay) begin)))
  
  (defun ansi-color-set-extent-face (extent face)
    "Set the `face' property of EXTENT to FACE.
--- 527,561 ----
  uses `make-overlay'.  XEmacs can use a buffer or a string for OBJECT,
  Emacs requires OBJECT to be a buffer."
    (if (functionp 'make-extent)
!       (let ((extent (make-extent from to object)))
!       (set-extent-property extent 'ansi-color t)
!       extent)
      ;; In Emacs, the overlay might end at the process-mark in comint
      ;; buffers.  In that case, new text will be inserted before the
      ;; process-mark, ie. inside the overlay (using insert-before-marks).
!     ;; In order to avoid this, we reuse any ansi-color overlays which
!     ;; ends at FROM and extend it.
!     (let ((overlays (overlays-at from))
!         overlay result)
!       ;; try to find an ansi-color overlay at FROM
!       (while (and (not result) overlays)
!       (setq overlay (car overlays)
!             overlays (cdr overlays))
!       (when (overlay-get overlay 'ansi-color)
!         (setq result t)))
!       (if result
!         ;; extend the overlay to the required end point
!         (move-overlay overlay (overlay-start overlay) to)
!       ;; create a new one instead
!       (setq overlay (make-overlay from to object))
!       (overlay-put overlay 'ansi-color t)
!       ;; Uncomment the following two lines when debugging overlays --
!       ;; this may be necessary because lots of overlapping overlays are
!       ;; even worse than overlapping overlays.  This allows us to *see*
!       ;; wether any overlays are overlapping.  That should not happen.
!       ;; (overlay-put overlay 'before-string "<")
!       ;; (overlay-put overlay 'after-string ">")
!       overlay))))
  
  (defun ansi-color-set-extent-face (extent face)
    "Set the `face' property of EXTENT to FACE.
***************
*** 537,542 ****
--- 563,593 ----
    (if (functionp 'set-extent-face)
        (set-extent-face extent face)
      (overlay-put extent 'face face)))
+ 
+ (defun ansi-color-extent-list (from to)
+   "Return all the extents in the range [FROM, TO).
+ Only extents created by `ansi-color-make-extent' are returned.
+ 
+ XEmacs uses `extent-list', Emacs uses `overlays-in'."
+   (let (result)
+     (if (functionp 'extent-list)
+       (let ((extents (extent-list (current-buffer) from to)))
+         (dolist (extent extents)
+           (when (extent-property extent 'ansi-color t)
+             (set result (cons extent result)))))
+       (let ((overlays (overlays-in from to)))
+       (dolist (overlay overlays)
+         (when (overlay-get overlay 'ansi-color)
+           (setq result (cons overlay result))))))
+     result))
+ 
+ (defun ansi-color-delete-extent (extent)
+   "Delete EXTENT.
+ 
+ XEmacs uses `delete-extent', Emacs uses `delete-overlay'."
+   (if (functionp 'delete-extent)
+       (delete-extent extent)
+     (delete-overlay extent)))
  
  ;; Helper functions