Emacs——放置/删除覆盖的运行时间增加了每次运行

Question

我正在寻求一些帮助，以找出为什么以下叠加函数的运行时间会随着每次连续运行而增加。

据我所知，如果缓冲区中的文本保持不变，则运行时间应该是相同的——即，仅向左/向右移动光标应该不会增加运行时间(但它确实)。

我尝试了以下方法，但无济于事:(setq buffer-undo-list t);杀死所有局部变量； (setq-default cache-long-scans nil)。

这个函数是一个缩小版本，用于创建一个最小的工作示例。完整版从 0.1 秒的运行时间开始，每次连续运行增加 0.1 秒，直到函数变得不可用。

(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

当前叠加层的实现在算法上非常差。许多基本操作(例如移动叠加、插入/删除文本，甚至有时只是移动点)的时间都是 O(N)，其中 N 是叠加的次数。有时，明智地使用 overlay-recenter 可以大大加快速度。

我们知道如何解决这些算法问题，我很乐意帮助其他人进行实现工作。