Emacs -- runtime of putting / deleting overlays increases each run

Question

I am looking for some assistance, please, to track down why the runtime of following overlay function increases with each successive run.

From what I can tell, the runtime should be the same if the text in the buffer remains the same -- i.e., just moving the cursor left / right should not increase the runtime (but it does).

I tried the following, but to no avail: (setq buffer-undo-list t); killing all local variables; (setq-default cache-long-scans nil).

This function is a scaled down version for purposes of creating a minimal working example. The full version starts of with a .1 second runtime and increases .1 seconds each successive run until the function becomes unusable.

(add-hook 'post-command-hook (lambda ()
  (draw-vertical-line (window-start) (window-end))))

(defun draw-vertical-line (start end)
  "Erase and redraw the vertical-line between START and END."
(measure-time
  (setq my-cursor-point (point))
  (setq my-current-col (current-column))
  (save-excursion
    (if (not (eq start (progn (goto-char start) (point-at-bol))))
      (setq start (progn (goto-char start) (beginning-of-line) (point)))))
    (save-excursion
      (let* (my-last-column my-overlay beg-ov end-ov)
        (goto-char end)
        (mapc #'(lambda (o) (when (overlay-get o 'my-overlay-properties)
          (delete-overlay o))) (overlays-in start end))
        (goto-char end)
        (while (re-search-backward "\n" start t)
          (setq my-last-column (current-column))
          (my-not-wrapped-line-function) )))))

(defun my-not-wrapped-line-function ()
  (unless (eq (buffer-size) 0)
    (setq beg-ov (save-excursion (move-to-column my-current-col) (point)))
    (setq end-ov (+ 1 beg-ov))
    (setq my-overlay (make-overlay beg-ov end-ov ))
    (cond
      ;; text, excluding tabs
      ((and
          (or
            (< my-current-col my-last-column)
            (and (eobp) (= my-current-col my-last-column)))
          (not-tab-looking-back-p)
          (not (eq my-cursor-point beg-ov)))
        (overlay-put my-overlay 'my-overlay-properties t)
        (overlay-put my-overlay 'text-exclude-tabs t)
        (overlay-put my-overlay 'face '(:background "yellow" :foreground "black") ) )
      ;; tab with text to the right
      ((and
          (tab-left-p)
          (tab-looking-forward-p)
          (tab-p)
          (not (eq my-cursor-point beg-ov))
          (< my-current-col my-last-column))
        (overlay-put my-overlay 'my-overlay-properties t)
        (overlay-put my-overlay 'tab-text-right t)
        (overlay-put my-overlay 'face '(:foreground "purple" :weight bold) ) )
      ;; tab with text to the left
      ((and
          (not-tab-left-p)
          (tab-p)
          (not (eq my-cursor-point beg-ov))
          (< my-current-col my-last-column))
        (overlay-put my-overlay 'my-overlay-properties t)
        (overlay-put my-overlay 'tab-text-left t)
        (overlay-put my-overlay 'face '(:foreground "green" :weight bold) ) )
      ;; tab sandwiched between a tab on each side
      ((and
          (tab-p)
          (tab-sandwiched-p)
          (not (eq my-cursor-point beg-ov))
          (< my-current-col my-last-column))
        (overlay-put my-overlay 'my-overlay-properties t)
        (overlay-put my-overlay 'tab-sandwiched t)
        (overlay-put my-overlay 'face '(:foreground "orange" :weight bold) ) )
      ;; end of line, but not wrapped
      ((and
          (= my-current-col my-last-column)
          (eolp)
          (not (eq my-cursor-point beg-ov)))
        (overlay-put my-overlay 'my-overlay-properties t)
        (overlay-put my-overlay 'eol t)
        (overlay-put my-overlay 'face '(:foreground "brown" :weight bold) ) ) 
      ;; cursor -- not wrapped -- not end of line
      ((and
          (not
            (catch 'found
              (dolist (ol (overlays-at beg-ov))
                (and (overlay-get ol 'hl-p)
                     (throw 'found t)))))
          (not (region-active-p))
          (eq my-cursor-point beg-ov)
          (not (eq (preceding-char) 9))
          (< my-current-col my-last-column))
        (overlay-put my-overlay 'my-overlay-properties t)
        (overlay-put my-overlay 'my-cursor-not-wrapped-not-eol t)
        (overlay-put my-overlay 'face '(:background "black" :weight bold) ) )
      ;; cursor -- end of line, but not a wrapped line
      ((and
          (not (region-active-p))
          (eq my-cursor-point beg-ov)
          ;; (not (eq (preceding-char) 9))
          (= my-current-col my-last-column))
        (overlay-put my-overlay 'my-overlay-properties t)
        (overlay-put my-overlay 'my-cursor-eol-not-wrapped t)
        (overlay-put my-overlay 'face '(:foreground "SteelBlue" :weight bold) ) ) )))

(defvar my-cursor-point nil
"Point used to prevent the formation of a cursor overlay.
It must be set within the function `draw-vertical-line`.")
(make-variable-buffer-local 'my-cursor-point)

(defsubst tab-left-p ()
  (not (not (save-excursion
    (if my-current-col
      (move-to-column my-current-col)
      (current-column))
    (unless (bobp) (backward-char 1)) (eq (char-after (point)) 9)))))

(defsubst not-tab-left-p ()
  (not (save-excursion
    (if my-current-col
      (move-to-column my-current-col)
      (current-column))
    (unless (bobp) (backward-char 1)) (eq (char-after (point)) 9))))

(defsubst tab-p ()
  (save-excursion 
    (if my-current-col
      (move-to-column my-current-col)
      (current-column))
    (eq (char-after (point)) 9)))

(defsubst not-tab-looking-back-p ()
  (not (save-excursion
    (if my-current-col
      (move-to-column (+ 1 my-current-col))
      (move-to-column (+ 1 (current-column))))
    (eq (preceding-char) 9))))

(defsubst tab-looking-forward-p ()
  (not (save-excursion
    (if my-current-col
      (move-to-column (+ 1 my-current-col))
      (move-to-column (+ 1 current-column)))
    (eq (char-after (point)) 9))))

(defsubst tab-sandwiched-p ()
  (let ((my-current-col
      (if my-current-col
        my-current-col
        (current-column))))
    (not (eq
      (save-excursion (move-to-column my-current-col)
        (re-search-backward "\t" (point-at-bol) t) (point))
      (save-excursion (move-to-column (+ my-current-col 1))
        (re-search-backward "\t" (point-at-bol) t) (point))))))

(defmacro measure-time (&rest body)
  "Measure the time it takes to evaluate BODY."
  `(let ((time (current-time)))
     ,@body
     (message "%.06f" (float-time (time-since time)))))

Answer 1

Since my guess in the comments was correct, posting an actual answer for more visibility in case someone has a similar problem:

delete-overlay may not be doing what you expect. From the manual:

— Function: delete-overlay overlay

This function deletes overlay. The overlay continues to exist as a Lisp object, and its property list is unchanged, but it ceases to be attached to the buffer it belonged to, and ceases to have any effect on display.

A deleted overlay is not permanently disconnected. You can give it a position in a buffer again by calling move-overlay.

Maybe you have a giant pile of disconnected overlays eating up memory or causing a lot of processing.

Answer 2

The current implementation of overlays is algorithnically very poor. Many basic operations (such as move-overlay, inserting/deleting text, or even sometimes just moving point) have time O(N), where N is the number of overlays. Sometimes you can tremendously speed things up by jusdicious use of overlay-recenter.

We know how to fix those algorithmic problems, and I'd be very happy to help someone work on the implementation.