bug#52561: 28.0.50; [PATCH] Tall characters create scrolling stasis

[dick . r . chiang]

After this prints "all bad", try M-v (scroll-down).

emacs-27.2 -Q --eval \
  "(progn \
     (switch-to-buffer \"xdisp-tests--scroll-down-leaves-cursor-behind\") \
     (insert \"Óscar\" \"\n\") \
     (dotimes (_ (/ (1+ (window-pixel-height)) (line-pixel-height))) \
        (insert \"line\" \"\n\")) \
     (goto-char (point-max)) \
     (redisplay) \
     (scroll-down) \
     (redisplay) \
     (princ (format \"all %s\n\" (if (= (window-start) 1) \"good\" \"bad\")) \
            (function external-debugging-output)))"


>From 8c6b54f2853d21f52fb729688436c0f765d7cbfe Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang@gmail.com>
Date: Thu, 16 Dec 2021 17:55:05 -0500
Subject: [PATCH] Tall characters create scrolling stasis

* lisp/emacs-lisp/multisession.el (multisession--set-value-sqlite):
You gotta do what you gotta do.
* src/xdisp.c (redisplay_window): VPOS is a screen line measure;
Y is a pixel measure.
* test/lisp/emacs-lisp/multisession-tests.el (multi-test--on-conflict-p):
You gotta do what you gotta do.
(multi-test-sqlite-simple): You gotta do what you gotta do.
(multi-test-sqlite-busy): You gotta do what you gotta do.
(multi-test-files-simple): You gotta do what you gotta do.
(multi-test-files-busy): You gotta do what you gotta do.
(multi-test-files-some-values): You gotta do what you gotta do.
* test/src/xdisp-tests.el (xdisp-tests--scroll-down-leaves-cursor-behind):
Test scrolling stasis bug.
---
 lisp/emacs-lisp/multisession.el            |  2 +
 src/xdisp.c                                | 33 ++++------
 test/lisp/emacs-lisp/multisession-tests.el | 77 ++++++++++++++--------
 test/src/xdisp-tests.el                    | 18 +++++
 4 files changed, 81 insertions(+), 49 deletions(-)

diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index 17c9384134..5c77ac9a81 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -223,6 +223,8 @@ multisession--set-value-sqlite
       (condition-case nil
           (ignore (read-from-string pvalue))
         (error (error "Unable to store unreadable value: %s" pvalue)))
+      ;; I get near "ON" syntax error with 3.22.0
+      ;; https://stackoverflow.com/a/51531835/5132008
       (sqlite-execute
        multisession--db
        "insert into multisession(package, key, sequence, value) values(?, ?, 
1, ?) on conflict(package, key) do update set sequence = sequence + 1, value = 
?"
diff --git a/src/xdisp.c b/src/xdisp.c
index 5e549c9c63..65632ff167 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -18921,7 +18921,7 @@ redisplay_window (Lisp_Object window, bool 
just_this_one_p)
   if (w->force_start)
     {
       /* We set this later on if we have to adjust point.  */
-      int new_vpos = -1;
+      int new_y = -1;
 
       w->force_start = false;
       w->vscroll = 0;
@@ -18991,28 +18991,16 @@ redisplay_window (Lisp_Object window, bool 
just_this_one_p)
                                      NULL, 0);
            }
          if (r)
-           new_vpos = MATRIX_ROW_BOTTOM_Y (r);
+           new_y = MATRIX_ROW_BOTTOM_Y (r);
          else  /* Give up and just move to the middle of the window.  */
-           new_vpos = window_box_height (w) / 2;
+           new_y = window_box_height (w) / 2;
        }
 
       if (!cursor_row_fully_visible_p (w, false, false, false))
        {
          /* Point does appear, but on a line partly visible at end of window.
             Move it back to a fully-visible line.  */
-         new_vpos = window_box_height (w);
-         /* But if window_box_height suggests a Y coordinate that is
-            not less than we already have, that line will clearly not
-            be fully visible, so give up and scroll the display.
-            This can happen when the default face uses a font whose
-            dimensions are different from the frame's default
-            font.  */
-         if (new_vpos >= w->cursor.y)
-           {
-             w->cursor.vpos = -1;
-             clear_glyph_matrix (w->desired_matrix);
-             goto try_to_scroll;
-           }
+         new_y =  WINDOW_BOX_HEIGHT_NO_MODE_LINE (w);
        }
       else if (w->cursor.vpos >= 0)
        {
@@ -19052,13 +19040,18 @@ redisplay_window (Lisp_Object window, bool 
just_this_one_p)
 
       /* If we need to move point for either of the above reasons,
         now actually do it.  */
-      if (new_vpos >= 0)
+      if (new_y >= 0)
        {
          struct glyph_row *row;
 
-         row = MATRIX_FIRST_TEXT_ROW (w->desired_matrix);
-         while (MATRIX_ROW_BOTTOM_Y (row) < new_vpos)
-           ++row;
+         for (row = MATRIX_FIRST_TEXT_ROW (w->desired_matrix);
+              row < MATRIX_BOTTOM_TEXT_ROW (w->desired_matrix, w);
+              ++row)
+           if (MATRIX_ROW_BOTTOM_Y (row) - row->extra_line_spacing > new_y)
+             {
+               row--;
+               break;
+             }
 
          TEMP_SET_PT_BOTH (MATRIX_ROW_START_CHARPOS (row),
                            MATRIX_ROW_START_BYTEPOS (row));
diff --git a/test/lisp/emacs-lisp/multisession-tests.el 
b/test/lisp/emacs-lisp/multisession-tests.el
index 41fcde04f2..8160f9115a 100644
--- a/test/lisp/emacs-lisp/multisession-tests.el
+++ b/test/lisp/emacs-lisp/multisession-tests.el
@@ -26,6 +26,13 @@
 (require 'ert-x)
 (require 'cl-lib)
 
+(defsubst multi-test--on-conflict-p ()
+  (when (bound-and-true-p multisession--db)
+    (let ((result (with-sqlite-transaction multisession--db
+                   (sqlite-select multisession--db "select 
sqlite_version()"))))
+      (version-list-<= (version-to-list "3.24.0")
+                       (version-to-list (seq-find #'stringp (cl-first 
result)))))))
+
 (ert-deftest multi-test-sqlite-simple ()
   (skip-unless (sqlite-available-p))
   (ert-with-temp-file dir
@@ -38,6 +45,7 @@ multi-test-sqlite-simple
             (define-multisession-variable foo 0
               ""
               :synchronized t)
+            (skip-unless (multi-test--on-conflict-p))
             (should (= (multisession-value foo) 0))
             (cl-incf (multisession-value foo))
             (should (= (multisession-value foo) 1))
@@ -56,11 +64,12 @@ multi-test-sqlite-simple
                               :synchronized t)
                             (cl-incf (multisession-value foo))))))
             (should (= (multisession-value foo) 2)))
-        (sqlite-close multisession--db)
+        (when multisession--db
+          (sqlite-close multisession--db))
         (setq multisession--db nil)))))
 
 (ert-deftest multi-test-sqlite-busy ()
-  (skip-unless (and t (sqlite-available-p)))
+  (skip-unless (sqlite-available-p))
   (ert-with-temp-file dir
     :directory t
     (let ((user-init-file "/tmp/foo.el")
@@ -72,6 +81,7 @@ multi-test-sqlite-busy
             (define-multisession-variable bar 0
               ""
               :synchronized t)
+            (skip-unless (multi-test--on-conflict-p))
             (should (= (multisession-value bar) 0))
             (cl-incf (multisession-value bar))
             (should (= (multisession-value bar) 1))
@@ -93,45 +103,53 @@ multi-test-sqlite-busy
                                     (cl-incf (multisession-value bar))))))))
             (while (process-live-p proc)
               (ignore-error 'sqlite-locked-error
-                (message "bar %s" (multisession-value bar))
-                ;;(cl-incf (multisession-value bar))
-                )
-              (sleep-for 0.1))
+                (message "bar %s" (multisession-value bar)))
+              (accept-process-output nil 0.1))
             (message "bar ends up as %s" (multisession-value bar))
             (should (< (multisession-value bar) 1003)))
-        (sqlite-close multisession--db)
+        (when (process-live-p proc)
+          (kill-process proc))
+        (when multisession--db
+          (sqlite-close multisession--db))
         (setq multisession--db nil)))))
 
 (ert-deftest multi-test-files-simple ()
+  (skip-unless (sqlite-available-p))
   (ert-with-temp-file dir
     :directory t
     (let ((user-init-file "/tmp/sfoo.el")
           (multisession-storage 'files)
           (multisession-directory dir))
-      (define-multisession-variable sfoo 0
-        ""
-        :synchronized t)
-      (should (= (multisession-value sfoo) 0))
-      (cl-incf (multisession-value sfoo))
-      (should (= (multisession-value sfoo) 1))
-      (call-process
-       (concat invocation-directory invocation-name)
-       nil t nil
-       "-Q" "-batch"
-       "--eval" (prin1-to-string
-                 `(progn
-                    (require 'multisession)
-                    (let ((multisession-directory ,dir)
-                          (multisession-storage 'files)
-                          (user-init-file "/tmp/sfoo.el"))
-                      (define-multisession-variable sfoo 0
-                        ""
-                        :synchronized t)
-                      (cl-incf (multisession-value sfoo))))))
-      (should (= (multisession-value sfoo) 2)))))
+      (unwind-protect
+          (progn
+            (define-multisession-variable sfoo 0
+              ""
+              :synchronized t)
+            (skip-unless (multi-test--on-conflict-p))
+            (should (= (multisession-value sfoo) 0))
+            (cl-incf (multisession-value sfoo))
+            (should (= (multisession-value sfoo) 1))
+            (call-process
+             (concat invocation-directory invocation-name)
+             nil t nil
+             "-Q" "-batch"
+             "--eval" (prin1-to-string
+                       `(progn
+                          (require 'multisession)
+                          (let ((multisession-directory ,dir)
+                                (multisession-storage 'files)
+                                (user-init-file "/tmp/sfoo.el"))
+                            (define-multisession-variable sfoo 0
+                              ""
+                              :synchronized t)
+                            (cl-incf (multisession-value sfoo))))))
+            (should (= (multisession-value sfoo) 2)))
+        (when multisession--db
+          (sqlite-close multisession--db))
+        (setq multisession--db nil)))))
 
 (ert-deftest multi-test-files-busy ()
-  (skip-unless (and t (sqlite-available-p)))
+  (skip-unless (sqlite-available-p))
   (ert-with-temp-file dir
     :directory t
     (let ((user-init-file "/tmp/foo.el")
@@ -168,6 +186,7 @@ multi-test-files-busy
       (should (< (multisession-value sbar) 2000)))))
 
 (ert-deftest multi-test-files-some-values ()
+  (skip-unless (sqlite-available-p))
   (ert-with-temp-file dir
     :directory t
     (let ((user-init-file "/tmp/sfoo.el")
diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el
index ae4aacd9c7..f79406e531 100644
--- a/test/src/xdisp-tests.el
+++ b/test/src/xdisp-tests.el
@@ -170,4 +170,22 @@ test-get-display-property
     (should (equal (get-display-property 2 'height) 2.0))
     (should (equal (get-display-property 2 'space-width) 20))))
 
+(ert-deftest xdisp-tests--scroll-down-leaves-cursor-behind ()
+  "When first line contains accented, and therefore taller
+character, e.g., Óscar, scrolling down (moving window-start up)
+has resulted in a no-op."
+  (skip-unless (not noninteractive))
+  (switch-to-buffer "xdisp-tests--scroll-down-leaves-cursor-behind")
+
+  (insert "Óscar" "\n")
+  (dotimes (_ (/ (1+ (window-pixel-height)) (line-pixel-height)))
+    (insert "line" "\n"))
+  (goto-char (point-max))
+  (redisplay)
+  (scroll-down)
+  (redisplay)
+  (should (= (window-start) 1))
+  (let (kill-buffer-query-functions)
+    (kill-buffer "xdisp-tests--scroll-down-leaves-cursor-behind")))
+
 ;;; xdisp-tests.el ends here
-- 
2.26.2



In Commercial Emacs 28.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 
3.22.30, cairo version 1.15.10)
 of 2021-12-16 built on dick
Repository revision: 2eb60be235d820a7e37ef37c23b6f5b10849f11c
Repository branch: dev
Windowing system distributor 'The X.Org Foundation', version 11.0.11906000
System Description: Ubuntu 18.04.4 LTS

Configured using:
 'configure --prefix=/home/dick/.local --with-tree-sitter
 --enable-dumping-overwrite 'CFLAGS=-g3 -O2
 -I/home/dick/.local/include/' LDFLAGS=-L/home/dick/.local/lib'
Configured features:
CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG JSON
TREE_SITTER LCMS2 LIBSELINUX LIBXML2 MODULES NOTIFY INOTIFY PDUMPER PNG
RSVG SECCOMP SOUND THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM
XPM GTK3 ZLIB
Important settings:
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Magit

Minor modes in effect:
  async-bytecomp-package-mode: t
  global-git-commit-mode: t
  shell-dirtrack-mode: t
  projectile-mode: t
  flx-ido-mode: t
  override-global-mode: t
  winner-mode: t
  tooltip-mode: t
  show-paren-mode: t
  mouse-wheel-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  buffer-read-only: t
  column-number-mode: t
  line-number-mode: t
  transient-mark-mode: t

Load-path shadows:
/home/dick/gomacro-mode/gomacro-mode hides 
/home/dick/.emacs.d/elpa/gomacro-mode-20200326.1103/gomacro-mode
/home/dick/.emacs.d/elpa/hydra-20170924.2259/lv hides 
/home/dick/.emacs.d/elpa/lv-20191106.1238/lv
/home/dick/.emacs.d/elpa/magit-3.3.0/magit-section-pkg hides 
/home/dick/.emacs.d/elpa/magit-section-3.3.0/magit-section-pkg
/home/dick/org-gcal.el/org-gcal hides 
/home/dick/.emacs.d/elpa/org-gcal-0.3/org-gcal
/home/dick/.emacs.d/elpa/tree-sitter-20211211.1220/tree-sitter hides 
/home/dick/.local/share/emacs/28.0.50/lisp/tree-sitter
/home/dick/.emacs.d/lisp/json hides 
/home/dick/.local/share/emacs/28.0.50/lisp/json
/home/dick/.emacs.d/elpa/transient-0.3.6/transient hides 
/home/dick/.local/share/emacs/28.0.50/lisp/transient
/home/dick/.emacs.d/elpa/hierarchy-20171221.1151/hierarchy hides 
/home/dick/.local/share/emacs/28.0.50/lisp/emacs-lisp/hierarchy
/home/dick/.local/share/emacs/28.0.50/lisp/emacs-lisp/eieio-compat hides 
/home/dick/.local/share/emacs/28.0.50/lisp/obsolete/eieio-compat

Features:
(shadow bbdb-message footnote emacsbug sendmail sh-script executable
multisession sqlite ag vc-svn find-dired pulse help-fns radix-tree
cl-print debug backtrace find-func tramp-archive tramp-gvfs tramp-cache
zeroconf rect magit-extras mule-util face-remap magit-patch-changelog
magit-patch magit-submodule magit-obsolete magit-popup async-bytecomp
async magit-blame magit-stash magit-reflog magit-bisect magit-push
magit-pull magit-fetch magit-clone magit-remote magit-commit
magit-sequence magit-notes magit-worktree magit-tag magit-merge
magit-branch magit-reset magit-files magit-refs magit-status magit
magit-repos magit-apply magit-wip magit-log which-func imenu magit-diff
smerge-mode diff git-commit log-edit pcvs-util add-log magit-core
magit-margin magit-transient magit-process with-editor server magit-mode
transient misearch multi-isearch vc-git diff-mode vc vc-dispatcher
bug-reference cc-mode cc-fonts cc-guess cc-menus cc-cmds cc-styles
cc-align cc-engine cc-vars cc-defs sort smiley qp mail-extr gnus-async
gnus-ml gnus-notifications gnus-fun notifications gnus-kill gnus-dup
disp-table utf-7 mm-archive shr-color jka-compr url-cache eww xdg
url-queue nnrss nnfolder nndiscourse benchmark rbenv nnhackernews
nntwitter nntwitter-api bbdb-gnus gnus-demon nntp nnmairix nnml nnreddit
gnus-topic url-http url-auth url-gw network-stream gnutls nsm request
virtualenvwrapper gud s json-rpc python tramp-sh tramp tramp-loaddefs
trampver tramp-integration files-x tramp-compat shell pcomplete ls-lisp
format-spec gnus-score score-mode gnus-bcklg gnus-srvr gnus-cite
anaphora bbdb-mua bbdb-com bbdb bbdb-site timezone gnus-delay gnus-draft
gnus-cache gnus-agent gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime
smime dig gnus-sum shr pixel-fill kinsoku svg dom nndraft nnmh
gnus-group mm-url gnus-undo use-package use-package-delight
use-package-diminish gnus-start gnus-dbus dbus xml gnus-cloud nnimap
nnmail mail-source utf7 netrc nnoo parse-time iso8601 gnus-spec gnus-int
gnus-range message yank-media rmc puny dired-x dired dired-loaddefs
rfc822 mml mml-sec epa epg rfc6068 epg-config mm-decode mm-bodies
mm-encode mailabbrev gmm-utils mailheader gnus-win paredit-ext paredit
subed subed-vtt subed-srt subed-common subed-mpv subed-debug
subed-config inf-ruby ruby-mode smie company pcase
haskell-interactive-mode haskell-presentation-mode haskell-process
haskell-session haskell-compile haskell-mode haskell-cabal haskell-utils
haskell-font-lock haskell-indentation haskell-string
haskell-sort-imports haskell-lexeme haskell-align-imports
haskell-complete-module haskell-ghc-support noutline outline
flymake-proc flymake warnings etags fileloop generator xref project
dabbrev haskell-customize hydra lv use-package-ensure solarized-theme
solarized-definitions projectile lisp-mnt mail-parse rfc2231 ibuf-ext
ibuffer ibuffer-loaddefs thingatpt magit-autorevert autorevert
filenotify magit-git magit-section magit-utils crm dash rx grep compile
comint ansi-color gnus nnheader gnus-util rmail rmail-loaddefs rfc2047
rfc2045 ietf-drums mm-util mail-prsvr mail-utils text-property-search
time-date flx-ido flx google-translate-default-ui
google-translate-core-ui facemenu color ido google-translate-core
google-translate-tk google-translate-backend use-package-bind-key
bind-key auto-complete easy-mmode advice edmacro kmacro popup cus-edit
pp cus-load wid-edit emms-player-mplayer emms-player-simple emms
emms-compat cl-extra help-mode use-package-core derived winner ring
finder-inf json-reformat-autoloads json-snatcher-autoloads
sml-mode-autoloads tornado-template-mode-autoloads info package
browse-url url url-proxy url-privacy url-expand url-methods url-history
url-cookie url-domsuf url-util mailcap url-handlers url-parse
auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs
password-cache json map url-vars seq gv subr-x byte-opt bytecomp
byte-compile cconv cl-loaddefs cl-lib iso-transl tooltip eldoc paren
electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tree-sitter tabulated-list replace newcomment
text-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow
isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax
font-core term/tty-colors frame minibuffer cl-generic cham georgian
utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean
japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european
ethiopic indian cyrillic chinese composite emoji-zwj charscript charprop
case-table epa-hook jka-cmpr-hook help simple abbrev obarray
cl-preloaded nadvice button loaddefs faces cus-face macroexp files
window text-properties overlay sha1 md5 base64 format env code-pages
mule custom widget keymap hashtable-print-readable backquote threads
dbusbind inotify lcms2 dynamic-setting system-font-setting
font-render-setting cairo move-toolbar gtk x-toolkit x multi-tty
make-network-process emacs)

Memory information:
((conses 16 888365 168035)
 (symbols 48 41336 1)
 (strings 32 183253 37994)
 (string-bytes 1 5901118)
 (vectors 16 103243)
 (vector-slots 8 2785892 156279)
 (floats 8 1879 1890)
 (intervals 56 9658 1445)
 (buffers 992 41))