bug#41513: `compute-motion' can miscount buffer positions in the presence of 'before-string/'after-string overlays

[Stephen Bach <sjbach@sjbach.com>]

[-- Attachment #1.1: Type: text/plain, Size: 2973 bytes --]

Hi,

Please see the attached demonstration code, runnable with `emacs -Q' and
`eval-buffer'.

When `compute-motion' scans along a buffer range that covers an overlay
with a 'buffer-string or 'after-string property [*] having as its content a
sort-of tricky but not too tricky propertized string (described below),
`compute-motion' can/will return an incorrect POS value.

E.g. an overlay with this plist:

  '(before-string #("AAA" 0 3 (display ""))

This overlay is effectively a no-op for redisplay - the "AAA" string that
would have been printed at the start of the overlay interval is not printed
because its presentation is suppressed by the string's 'display property.
This is right and proper.

However, `compute-motion' appears to interpret this overlay as having an
effective visible length of -3 rather than 0. Ditto if the overlay had
instead had an 'after-string property with the same content. [*] The
effective length being negative suggests to me an overcorrection rather
than missing logic.

([*] Aside: I believe `compute-motion' sometimes also miscalculates
'display as an overlay property for cases where one might reasonably expect
it to work- but I limit this report to 'before-string and 'after-string.)

Popular packages such as flycheck and git-gutter use this pattern of
overlay to annotate the margin and the fringe. The pattern is increasingly
common which in turn increasingly limits the application of
`compute-motion' as a reliable exposed function.

The miscounting appears to exist at least as far back as Emacs 24. Might
there be a mitigation/workaround? I like `compute-motion' despite its
complicated signature and complicated return value (and despite its
apparently rare use in the extended ecosystem) - it's fast and it involves
no cursor movement to perform its measurements.

Thanks for reading.


Testcase output:
=======================================

-------------------------------------
Without overlay:
- ‘point’ at col 30: <31>
- buffer content on and after col 30: <30   35   40   45   50>
- posn coord at col 30: <(30 . 0)>
- buffer pos of col 30 according to ‘compute-motion’: <31>     [ok]
- coord of col 30 according to ‘compute-motion’: <(30 . 0)>
-------------------------------------
With ’before-string overlay:
- ‘point’ at col 30: <31>
- buffer content on and after col 30: <30   35   40   45   50>
- posn coord at col 30: <(30 . 0)>
- buffer pos of col 30 according to ‘compute-motion’: <28>     <<<
INCONSISTENT
- coord of col 30 according to ‘compute-motion’: <(30 . 0)>
-------------------------------------
With ’after-string overlay:
- ‘point’ at col 30: <31>
- buffer content on and after col 30: <30   35   40   45   50>
- posn coord at col 30: <(30 . 0)>
- buffer pos of col 30 according to ‘compute-motion’: <28>     <<<
INCONSISTENT
- coord of col 30 according to ‘compute-motion’: <(30 . 0)>

[-- Attachment #1.2: Type: text/html, Size: 3333 bytes --]

[-- Attachment #2: compute-motion-testcase.el --]
[-- Type: application/octet-stream, Size: 3034 bytes --]

;;; -*- mode: lisp-interaction -*-

;; Summary: use `compute-motion' to measure the buffer position of the visual
;; coordinate '(0 . 30) in a new buffer with some content. Here, column 30 is
;; at (after) buffer position 31.
;;
;; `compute-motion' calculates this correctly unless it scans over a
;; 'before-string or 'after-string overlay of the style shown in
;; `testcase-apply-overlay' in which case it returns buffer position 28.

(defun testcase-recreate-buffer (testcase-buffer)
  (when (get-buffer testcase-buffer)
    (kill-buffer testcase-buffer))
  (with-current-buffer (get-buffer-create testcase-buffer)
    (insert "     5    10   15   20   25   30   35   40   45   50\n")
    (goto-char (point-min))))

(defun testcase-measure-at-col-30 (testcase-buffer)
  (let ((prev-buffer (current-buffer)))
    (switch-to-buffer testcase-buffer)
    (goto-char (point-min))
    (move-to-column 30)
    (redisplay)  ; hack: make posn-at-point return non-nil
    (message "- `point' at col 30: <%s>" (point))
    (message "- buffer content on and after col 30: <%s>"
             (buffer-substring (point) (line-end-position)))
    (message "- posn coord at col 30: <%s>" (posn-col-row (posn-at-point)))
    (pcase-let ((`(,pos ,col ,row _ _)
                 (compute-motion (point-min)
                                 '(0 . 0)
                                 (point-max)
                                 (posn-col-row (posn-at-point))
                                 nil nil nil)))
      (message "- buffer pos of col 30 according to `compute-motion': <%s> %s"
               pos
               (if (eq pos (point))
                   "    [ok]"
                 "    <<< INCONSISTENT"))
      (message "- coord of col 30 according to `compute-motion': <%s>"
               (cons col row)))
    (switch-to-buffer prev-buffer)))

(defun testcase-apply-overlay (buf overlay-pos prop-sym)
  (with-current-buffer buf
    (let* ((ol (make-overlay overlay-pos overlay-pos
                             (current-buffer) nil nil)))
      (overlay-put ol
                   prop-sym
                   (propertize "AAA" 'display ""))
      ol)))

(let ((testcase-buffer "*compute-motion bug*"))
  (message "\n=======================================\n")
  (let ((prev-buffer (current-buffer)))
    (message "-------------------------------------")
    (message "Without overlay:")
    (testcase-recreate-buffer testcase-buffer)
    (testcase-measure-at-col-30 testcase-buffer)

    (message "-------------------------------------")
    (message "With 'before-string overlay:")
    (testcase-recreate-buffer testcase-buffer)
    (testcase-apply-overlay testcase-buffer 20 'before-string)
    (testcase-measure-at-col-30 testcase-buffer)

    (message "-------------------------------------")
    (message "With 'after-string overlay:")
    (testcase-recreate-buffer testcase-buffer)
    (testcase-apply-overlay testcase-buffer 20 'after-string)
    (testcase-measure-at-col-30 testcase-buffer)

    (switch-to-buffer prev-buffer))
  nil)