Subject: [PATCH] Test and fix term-buffer-vertical-motion

From: Stephane Zermatten <[email-masked]>
Date: Thu, 10 Apr 2025 20:39:26 +0300

Tags: patch

In my code, I'm using hidden terminal buffers created by term.el, then
periodically copy their content to another buffer. The term-mode buffer
is not normally shown on any window. https://github.com/szermatt/mistty

This doesn't work very well with the default
term-buffer-vertical-motion implementation. I get very strange
behavior from term in such a case that disappear if the term buffer is
shown on any window.

To reproduce one issue:

 - Open term.el, go to term-emulate-terminal and replace:
             (setf term-vertical-motion
               (if (eq (window-buffer) (current-buffer))
                   'vertical-motion
                 'term-buffer-vertical-motion))
   with:
              (setf term-vertical-motion 'term-buffer-vertical-motion)

   (It is cheating a bit but much easier than trying to control a term
   buffer that's not tied to a window.)

 - Start zsh with M-x term (because it supports right prompts)

 - Type RPS1='< right'

 - Now type any command, such as "echo ok" and press enter. The
   command disappear with no output. The output never leaves the
   current line.

 - Type RPS1='' to go back to normal

That's with term-suppress-hard-newline left to nil, the default value.

The problem, I've found, is that term-buffer-vertical-motion has
issues with some corner cases, one of which is line whose width
correspond exactly to the line width.

It's especially annoying given that vertical-motion with
term-suppress-hard-newline nil could very well just be replaced by
forward-line, and I'm doing just that as a workaround:

(cl-letf (((symbol-function 'term-buffer-vertical-motion)
          (lambda (count)
            (let ((start-point (point))
                  (res (forward-line count)))
              (setq res (- count res))
              (when (and (> count 0)
                         (= (point) (point-max))
                         (> (point) start-point)
                         (not (eq ?\n (char-before (point-max)))))
                (cl-decf res))
              res))))

In this patch, however, to be nicer in the case where
term-suppress-hard-newline is non-nil, I propose to test
term-buffer-vertical-motion and fix the issues.
term-buffer-vertical-motion should always behave like
vertical-motion (assuming no display shenanigans or characters with
different width), so I used that for comparison.

In GNU Emacs 30.1 (build 2, x86_64-apple-darwin23.6.0, NS appkit-2487.70
 Version 14.7.4 (Build 23H420)) of 2025-03-24 built on boomer.zia
Windowing system distributor 'Apple', version 10.3.2487
System Description:  macOS 14.7.4

Configured using:
 'configure --disable-dependency-tracking --disable-silent-rules
 --enable-locallisppath=/usr/local/share/emacs/site-lisp
 --infodir=/usr/local/Cellar/emacs-plus@30/30.1/share/info/emacs
 --prefix=/usr/local/Cellar/emacs-plus@30/30.1
 --with-native-compilation=aot --with-xml2 --with-gnutls
 --without-compress-install --without-dbus --without-imagemagick
 --with-modules --with-rsvg --with-webp --with-ns
 --disable-ns-self-contained 'CFLAGS=-O2 -DFD_SETSIZE=10000
 -DDARWIN_UNLIMITED_SELECT -I/usr/local/opt/sqlite/include
 -I/usr/local/opt/gcc/include -I/usr/local/opt/libgccjit/include'
 'LDFLAGS=-L/usr/local/opt/sqlite/lib -L/usr/local/lib/gcc/14
 -I/usr/local/opt/gcc/include -I/usr/local/opt/libgccjit/include''

>From 807237230038126f52ae1ac5b5f5023c80d660df Mon Sep 17 00:00:00 2001
From: Stephane Zermatten <[email-masked]>
Date: Wed, 2 Apr 2025 18:44:59 +0300
Subject: [PATCH] Test and fix term-buffer-vertical-motion

term-buffer-vertical-motion simulates vertical-motion when no window is
available. This change makes sure that the simulation is correct when
point is at the beginning or end of lines. The fix is relevant even when
term-suppress-hard-newline is nil.

* lisp/term.el
---
 lisp/term.el            |  81 ++++++-----
 test/lisp/term-tests.el | 303 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 348 insertions(+), 36 deletions(-)

diff --git a/lisp/term.el b/lisp/term.el
index 862103d88e6..1defafc3ad1 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -2858,42 +2858,51 @@ term-vertical-motion
 
 (defun term-buffer-vertical-motion (count)
   (cond ((= count 0)
-	 (move-to-column (* term-width (/ (current-column) term-width)))
-	 0)
-	((> count 0)
-	 (let ((H)
-	       (todo (+ count (/ (current-column) term-width))))
-	   (end-of-line)
-	   ;; The loop iterates over buffer lines;
-	   ;; H is the number of screen lines in the current line, i.e.
-	   ;; the ceiling of dividing the buffer line width by term-width.
-	   (while (and (<= (setq H (max (/ (+ (current-column) term-width -1)
-					   term-width)
-					1))
-			   todo)
-		       (not (eobp)))
-	     (setq todo (- todo H))
-	     (forward-char) ;; Move past the ?\n
-	     (end-of-line)) ;; and on to the end of the next line.
-	   (if (and (>= todo H) (> todo 0))
-	       (+ (- count todo) H -1) ;; Hit end of buffer.
-	     (move-to-column (* todo term-width))
-	     count)))
-	(t ;; (< count 0) ;; Similar algorithm, but for upward motion.
-	 (let ((H)
-	       (todo (- count)))
-	   (while (and (<= (setq H (max (/ (+ (current-column) term-width -1)
-					   term-width)
-					1))
-			   todo)
-		       (progn (beginning-of-line)
-			      (not (bobp))))
-	     (setq todo (- todo H))
-	     (backward-char)) ;; Move to end of previous line.
-	   (if (and (>= todo H) (> todo 0))
-	       (+ count todo (- 1 H)) ;; Hit beginning of buffer.
-	     (move-to-column (* (- H todo 1) term-width))
-	     count)))))
+         (let ((col (current-column)))
+           (when (and (eq ?\n (char-after (point))) (> col 0))
+             (decf col))
+           (move-to-column (* term-width (/ col term-width))))
+         0)
+        ((> count 0)
+         (let ((H)
+               (todo (if (eolp)
+                         count
+                       (+ count (/ (current-column) term-width)))))
+           (end-of-line)
+           ;; The loop iterates over buffer lines;
+           ;; H is the number of screen lines in the current line, i.e.
+           ;; the ceiling of dividing the buffer line width by term-width.
+           (while (and (<= (setq H (max (/ (+ (current-column) term-width -1)
+                                           term-width)
+                                        1))
+                           todo)
+                       (not (eobp)))
+             (setq todo (- todo H))
+             (forward-char) ;; Move past the ?\n
+             (end-of-line)) ;; and on to the end of the next line.
+           (if (and (>= todo H) (> todo 0))
+               (+ (- count todo) H -1) ;; Hit end of buffer.
+             (move-to-column (* todo term-width))
+             count)))
+        (t ;; (< count 0) ;; Similar algorithm, but for upward motion.
+         (let ((H)
+               (todo (- count)))
+           (while (and (<= (setq H (max (/ (+ (current-column)
+                                              term-width
+                                              (if (eolp) -1 0))
+                                           term-width)
+                                        1))
+                           todo)
+                       (progn
+                         (beginning-of-line)
+
+                         (not (bobp))))
+             (setq todo (- todo H))
+             (backward-char)) ;; Move to end of previous line.
+           (if (and (>= todo H) (> todo 0))
+               (+ count todo (- 1 H)) ;; Hit beginning of buffer.
+             (move-to-column (* (- H todo 1) term-width))
+             count)))))
 
 ;; The term-start-line-column variable is used as a cache.
 (defun term-start-line-column ()
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index 5ef8c1174df..bc40b3acab0 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -102,6 +102,46 @@ term-test-screen-from-input
       (if return-var (buffer-local-value return-var (current-buffer))
         (buffer-substring (point-min) (point-max))))))
 
+(defun term-test-vertical-motion (count text start-point)
+  "Run `term-buffer-vertical-motion' COUNT and return the result.
+
+This function sets up a buffer with TEXT as content, move the point to
+START-POINT, then call `term-buffer-vertical-motion' and return a CONS
+containing its return value and the final point.
+
+`term-width' must be set for`term-buffer-vertical-motion' to work.
+
+Additionally, if `term-width' correspond to `window-max-chars-per-line',
+which under batch test is 79, this function compares the result with
+`vertical-motion' and reports any inconsistencies as a special return
+value meant to fail the tests. This is basically a 3-way test.
+
+The result from `vertical-motion' is always the correct one, since
+`term-buffer-vertical-motion' simulates it."
+  (ert-with-test-buffer ()
+    (insert text)
+    (let ((actual (save-excursion
+                    (goto-char start-point)
+                    (cons (term-buffer-vertical-motion count)
+                          (point)))))
+      (if (= (window-max-chars-per-line) term-width)
+          ;; Since term-width allows it, compare with vertical-motion,
+          ;; which term-buffer-vertical-motion simulates. If the two
+          ;; report inconsistent result, the returned value cause the
+          ;; test to fail.
+          (let ((goal (if (equal (window-max-chars-per-line)
+                                 term-width)
+                          (save-excursion
+                            (goto-char start-point)
+                            (cons (vertical-motion count)
+                                  (point))))))
+            (if (equal actual goal)
+                actual
+            `(inconsistent-result actual ,actual goal ,goal)))
+
+        ;; The result from term-buffer-vertical-motion
+        actual))))
+
 (ert-deftest term-simple-lines ()
   (skip-when (memq system-type '(windows-nt ms-dos)))
   (let ((str "\
@@ -418,6 +458,269 @@ term-undecodable-input
                    (term-test-screen-from-input
                     40 1 bytes)))))
 
+(ert-deftest term-buffer-vertical-motion-0-unwrapped-line ()
+  (let* ((term-width 79) ; usual win body width in batch mode
+         (line (concat (make-string term-width ?1) "\n")))
+    ;; vertical-motion 0 goes to the beginning of the line
+    (should
+     (equal '(0 . 1)
+            ;; from the beginning of the line
+            (term-test-vertical-motion 0 line 1)))
+    (should
+     (equal '(0 . 1)
+            ;; from the middle of the line
+            (term-test-vertical-motion 0 line 5)))
+    (should
+     (equal '(0 . 1)
+            ;; from the \n
+            (term-test-vertical-motion 0 line 80)))))
+
+(ert-deftest term-buffer-vertical-motion-0-wrapped-line ()
+  (let* ((term-width 79) ; usual win body width in batch mode
+         (line (concat (make-string term-width ?1)
+                       (make-string term-width ?2)
+                       (make-string term-width ?3)
+                       "\n"))
+         (line-1-bol 1)
+         (line-2-bol (+ line-1-bol term-width))
+         (line-3-bol (+ line-2-bol term-width))
+         (final-newline (+ line-3-bol term-width)))
+    ;; vertical-motion 0 goes to the beginning of the line, taking
+    ;; wrapping into account.
+
+    ;; vertical-motion 0 from line 1
+    (should
+     (equal (cons 0 line-1-bol)
+            (term-test-vertical-motion 0 line line-1-bol)))
+    (should
+     (equal (cons 0 line-1-bol)
+            (term-test-vertical-motion 0 line (+ line-1-bol 5))))
+    (should
+     (equal (cons 0 line-1-bol)
+            (term-test-vertical-motion 0 line (+ line-1-bol 9))))
+
+    ;; vertical-motion 0 from line 2
+    (should
+     (equal (cons 0 line-2-bol)
+            (term-test-vertical-motion 0 line line-2-bol)))
+    (should
+     (equal (cons 0 line-2-bol)
+            (term-test-vertical-motion 0 line (+ line-2-bol 5))))
+    (should
+     (equal (cons 0 line-2-bol)
+            (term-test-vertical-motion 0 line (+ line-2-bol 9))))
+
+    ;; vertical-motion 0 from line 3
+    (should
+     (equal (cons 0 line-3-bol)
+            (term-test-vertical-motion 0 line line-3-bol)))
+    (should
+     (equal (cons 0 line-3-bol)
+            (term-test-vertical-motion 0 line (+ line-3-bol 5))))
+    (should
+     (equal (cons 0 line-3-bol)
+            (term-test-vertical-motion 0 line (+ line-3-bol 9))))
+    (should
+     (equal (cons 0 line-3-bol)
+            (term-test-vertical-motion 0 line final-newline)))))
+
+(ert-deftest term-buffer-vertical-motion-down-unwrapped-lines ()
+  (let* ((term-width 79) ; usual win body width in batch mode
+         (text (concat (make-string 79 ?1) "\n"
+                       (make-string 79 ?2) "\n"))
+         (line-1-bol 1)
+         (line-1-middle 5)
+         (line-1-newline (+ line-1-bol term-width))
+         (line-2-bol (+ line-1-bol term-width 1))
+         (line-3-bol (+ line-2-bol term-width 1)))
+    ;; vertical-motion count, with count >0, goes down count lines to
+    ;; the beginning of that line.
+
+    ;; vertical-motion 1 from line 1
+    (should
+     (equal (cons 1 line-2-bol)
+            (term-test-vertical-motion 1 text line-1-bol)))
+    (should
+     (equal (cons 1 line-2-bol)
+            (term-test-vertical-motion 1 text line-1-middle)))
+    (should
+     (equal (cons 1 line-2-bol)
+            (term-test-vertical-motion 1 text line-1-newline)))
+
+    ;; vertical-motion 2 from line 1
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 2 text line-1-bol)))
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 2 text line-1-middle)))
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 2 text line-1-newline)))
+
+    ;; vertical motion 3 from line 1
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 3 text line-1-bol)))
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 3 text line-1-middle)))
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 3 text line-1-newline)))))
+
+(ert-deftest term-buffer-vertical-motion-down-wrapped-lines ()
+  (let* ((term-width 79) ; usual win body width in batch mode
+         (text (concat (make-string term-width ?1)
+                       (make-string term-width ?2)
+                       "\n"
+                       (make-string term-width ?3)
+                       "\n"))
+        (line-1-bol 1)
+        (line-1-middle 5)
+        (line-1-eol (+ line-1-bol term-width -1))
+        (line-2-bol (+ line-1-bol term-width))
+        (line-3-bol (+ line-2-bol term-width 1))
+        (final-newline (1+ (length text))))
+    ;; vertical-motion count, with count >0, goes down count lines to
+    ;; the beginning of that line, taking wrapping into account.
+
+    ;; vertical-motion 1 from line 1
+    (should
+     (equal (cons 1 line-2-bol)
+            (term-test-vertical-motion 1 text line-1-bol)))
+    (should
+     (equal (cons 1 line-2-bol)
+            (term-test-vertical-motion 1 text line-1-middle)))
+    (should
+     (equal (cons 1 line-2-bol)
+            (term-test-vertical-motion 1 text line-1-eol)))
+
+    ;; vertical-motion 2 from line 1
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 2 text line-1-bol)))
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 2 text line-1-middle)))
+    (should
+     (equal (cons 2 line-3-bol)
+            (term-test-vertical-motion 2 text line-1-eol)))
+
+    ;; vertical-motion 3 from line 1
+    (should
+     (equal (cons 3 final-newline)
+            (term-test-vertical-motion 3 text line-1-bol)))
+    (should
+     (equal (cons 3 final-newline)
+            (term-test-vertical-motion 3 text line-1-middle)))
+    (should
+     (equal (cons 3 final-newline)
+            (term-test-vertical-motion 3 text line-1-eol)))
+
+    ;; vertical-motion 4 from line 1
+    (should
+     (equal (cons 3 final-newline)
+            (term-test-vertical-motion 4 text line-1-bol)))
+    (should
+     (equal (cons 3 final-newline)
+            (term-test-vertical-motion 4 text line-1-middle)))
+    (should
+     (equal (cons 3 final-newline)
+            (term-test-vertical-motion 4 text line-1-eol)))))
+
+(ert-deftest term-buffer-vertical-motion-up-unwrapped-lines ()
+  (let* ((term-width 79) ; usual win body width in batch mode
+         (text (concat (make-string 79 ?1) "\n"
+                       (make-string 79 ?2) "\n"
+                       (make-string 79 ?3) "\n"))
+         (line-1-bol 1)
+         (line-2-bol (+ line-1-bol term-width 1))
+         (line-3-bol (+ line-2-bol term-width 1))
+         (line-3-middle (+ line-3-bol 5))
+         (line-3-newline (+ line-3-bol term-width 1)))
+    ;; vertical-motion count, with count <0, goes up count lines to
+    ;; the beginning of that line.
+
+    ;; vertical-motion -1 from line 3
+    (should
+     (equal (cons -1 line-2-bol)
+            (term-test-vertical-motion -1 text line-3-bol)))
+    (should
+     (equal (cons -1 line-2-bol)
+            (term-test-vertical-motion -1 text line-3-middle)))
+    (should
+     (equal (cons -1 line-3-bol)
+            (term-test-vertical-motion -1 text line-3-newline)))
+
+    ;; vertical-motion -2 from line 3
+    (should
+     (equal (cons -2 line-1-bol)
+            (term-test-vertical-motion -2 text line-3-bol)))
+    (should
+     (equal (cons -2 line-1-bol)
+            (term-test-vertical-motion -2 text line-3-middle)))
+    (should
+     (equal (cons -2 line-2-bol)
+            (term-test-vertical-motion -2 text line-3-newline)))
+
+    ;; vertical-motion -2 from line 3 goes to point-min
+    (should
+     (equal '(-2 . 1)
+            (term-test-vertical-motion -3 text line-3-bol)))
+    (should
+     (equal '(-2 . 1)
+            (term-test-vertical-motion -3 text line-3-middle)))
+    (should
+     (equal '(-3 . 1)
+            (term-test-vertical-motion -3 text line-3-newline)))))
+
+(ert-deftest term-buffer-vertical-motion-up-wrapped-lines ()
+  (let* ((term-width 79) ; usual win body width in batch mode
+         (text (concat (make-string 79 ?1)
+                       (make-string 79 ?2)
+                       (make-string 79 ?3) "\n"))
+         (line-1-bol 1)
+         (line-2-bol (+ line-1-bol term-width))
+         (line-3-bol (+ line-2-bol term-width))
+         (line-3-middle (+ line-3-bol 5))
+         (line-3-newline (+ line-3-bol term-width 1)))
+    ;; vertical-motion count, with count <0, goes up count lines to
+    ;; the beginning of that line, taking wrapping into account.
+
+    ;; vertical-motion -1 from line 3
+    (should
+     (equal (cons -1 line-3-bol)
+            (term-test-vertical-motion -1 text line-3-newline)))
+    (should
+     (equal (cons -1 line-2-bol)
+            (term-test-vertical-motion -1 text line-3-middle)))
+    (should
+     (equal (cons -1 line-2-bol)
+            (term-test-vertical-motion -1 text line-3-bol)))
+
+    ;; vertical-motion -2 from line 3
+    (should
+     (equal (cons -2 line-2-bol)
+            (term-test-vertical-motion -2 text line-3-newline)))
+    (should
+     (equal (cons -2 line-1-bol)
+            (term-test-vertical-motion -2 text line-3-middle)))
+    (should
+     (equal (cons -2 line-1-bol)
+            (term-test-vertical-motion -2 text line-3-bol)))
+
+    ;; vertical-motion -2 from line 3 goes to point-min
+    (should
+     (equal '(-3 . 1)
+            (term-test-vertical-motion -3 text line-3-newline)))
+    (should
+     (equal '(-2 . 1)
+            (term-test-vertical-motion -3 text line-3-middle)))
+    (should
+     (equal '(-2 . 1)
+            (term-test-vertical-motion -3 text line-3-bol)))))
+
 (provide 'term-tests)
 
 ;;; term-tests.el ends here
-- 
2.47.0