bug#47549: 26.3; cperl-mode: buffer view is being re-positioned outside user control [PATCH]

[haj@posteo.de (Harald Jörg)]

[-- Attachment #1: Type: text/plain, Size: 3142 bytes --]

Jim McKim writes:

> - Starting from 'emacs -Q'
>
> - Invoke CPerl mode via 'M-X cperl-mode'.
>
> - Edit (or create) a buffer that has more lines than the display window.
>
> - Open another window (same size), via 'C-x 5 2'.
>
> - Position the view in that second window to the end of the buffer, via
> 'ESC->'.
>
> - In the first window, near the top of the buffer, enter this string,
> the start of a pair of escaped [] brackets within a perl regexp range:
>
> my $x = qr/[\[\
>
> - Enter the second escaped ']':
>
> my $x = qr/[\[\]
>
> When it is entered, a diagnostic like
>
>   Couldn't find end of charclass in a REx, pos=33584

The "pos" in that message should be the character position of the
beginning of the charclass - 33584 seems to be not near the top of the
buffer?  But I guess this isn't relevant - see below.

> is displayed in the echo area at the bottom of the edit window and then
> the other window displaying that buffer is scrolled (repositioned) back
> to the same view as the window being edited, outside the user's control,
> abandoning its previous position.
> 
> The views, the windows, that are repositioned are those of any latter
> part of the buffer.
>
> Peculiarly, identical edits in latter portions of the buffer do not
> cause a similar repositioning of top-of-buffer views although they do
> generate the diagnostic.
>
> This is just one example of how the repositioning happens. In general,
> any edit that results in a message being displayed in the echo area
> causes the view to be repositioned.
>
> In the cperl source (git cperl-master), it looks like these
> diagnostics are generated via elisp's (message) function. Is this
> repositioning a side effect of that function?

A similar report occured on Perlmonks recently (coincidence?), and ever
since then I've been trying to reproduce it.  I seem to have collected
some relevant components now, but still fail to construct a situation
where an _inactive_ frame is scrolled:

 - The qr// construct is apparently unclosed.  I'm writing "apparently"
   because somewhere in the following source code there will be a slash
   which cperl-mode takes for closing the qr construct.  There are good
   chances that this occurs outside of the visible portion of the
   screen.

 - cperl-mode writes some diagnostics while its point is at the
   (presumed) end of the qr// construct.  It appears that Emacs tries to
   make that point visible when the message is printed - it scrolls
   forward, changing (window-start) so that the (presumed) end of the
   qr// construct is centered.

 - After the parsing process is done, cperl-mode jumps back to the
   original point - but the original value of (window-start) is lost,
   Emacs now centers the window at the original position.  This makes
   the active frame "jump" which should not happen.

The patch avoids this situation by postponing any output from
`cperl-find-pods-heres' until the code has restored the original window
position.  This works for me in interactive tests.

Unfortunately, I failed to come up with an automated test for that
situation: Batch tests have no window.

-- 
Cheers,
haj

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: cperl-mode: Don't reposition frames --]
[-- Type: text/x-diff, Size: 4583 bytes --]

From 7f2651308f43281621af8c481c74d5b0481a302f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Harald=20J=C3=B6rg?= <haj@posteo.de>
Date: Thu, 1 Apr 2021 22:30:56 +0200
Subject: [PATCH] ; cperl-mode: Don't reposition the window when writing
 messages

* lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Avoid
printing messages while point is off-screen (Bug#47549)
---
 lisp/progmodes/cperl-mode.el | 30 ++++++++++++++++++------------
 1 file changed, 18 insertions(+), 12 deletions(-)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 7612f8d284..176ea166f8 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -3608,7 +3608,8 @@ cperl-find-pods-heres
 		;; 1+6+2+1+1+6+1+1+1=20 extra () before this:
 		"\\|"
 		"\\\\\\(['`\"($]\\)")	; BACKWACKED something-hairy
-	     ""))))
+	     "")))
+         warning-message)
     (unwind-protect
 	(progn
 	  (save-excursion
@@ -3671,7 +3672,7 @@ cperl-find-pods-heres
 			(looking-at "\\(cut\\|end\\)\\>"))
 		    (if (or (nth 3 state) (nth 4 state) ignore-max)
 			nil		; Doing a chunk only
-		      (message "=cut is not preceded by a POD section")
+		      (setq warning-message "=cut is not preceded by a POD section")
 		      (or (car err-l) (setcar err-l (point))))
 		  (beginning-of-line)
 
@@ -3686,7 +3687,7 @@ cperl-find-pods-heres
 			(goto-char b)
 			(if (re-search-forward "\n=\\(cut\\|end\\)\\>" stop-point 'toend)
 			    (progn
-			      (message "=cut is not preceded by an empty line")
+			      (setq warning-message "=cut is not preceded by an empty line")
 			      (setq b1 t)
 			      (or (car err-l) (setcar err-l b))))))
 		  (beginning-of-line 2)	; An empty line after =cut is not POD!
@@ -3829,7 +3830,8 @@ cperl-find-pods-heres
 		    (progn		; Pretend we matched at the end
 		      (goto-char (point-max))
 		      (re-search-forward "\\'")
-		      (message "End of here-document `%s' not found." tag)
+		      (setq warning-message
+                            (format "End of here-document `%s' not found." tag))
 		      (or (car err-l) (setcar err-l b))))
 		  (if cperl-pod-here-fontify
 		      (progn
@@ -3906,7 +3908,8 @@ cperl-find-pods-heres
 						    'face font-lock-string-face)
 		      (cperl-commentify (point) (+ (point) 2) nil)
 		      (cperl-put-do-not-fontify (point) (+ (point) 2) t))
-		  (message "End of format `%s' not found." name)
+		  (setq warning-message
+                        (format "End of format `%s' not found." name))
 		  (or (car err-l) (setcar err-l b)))
 		(forward-line)
 		(if (> (point) max)
@@ -4426,8 +4429,9 @@ cperl-find-pods-heres
 					  REx-subgr-end argument) ; continue
 				  (setq argument nil)))
 			      (and argument
-				   (message "Couldn't find end of charclass in a REx, pos=%s"
-					    REx-subgr-start))
+				   (setq warning-message
+                                         (format "Couldn't find end of charclass in a REx, pos=%s"
+					         REx-subgr-start)))
 			      (setq argument (1- (point)))
 			      (goto-char REx-subgr-end)
 			      (cperl-highlight-charclass
@@ -4483,7 +4487,8 @@ cperl-find-pods-heres
 					   (setq qtag "Can't find })")))
 				  (progn
 				    (goto-char (1- e))
-				    (message "%s" qtag))
+				    (setq warning-message
+                                          (format "%s" qtag)))
 				(cperl-postpone-fontification
 				 (1- tag) (1- (point))
 				 'face font-lock-variable-name-face)
@@ -4512,7 +4517,7 @@ cperl-find-pods-heres
 			       ;; (1- e) 'toend)
 			       (search-forward ")" (1- e) 'toend)
 			       ;;)
-			       (message
+			       (setq warning-message
 				"Couldn't find end of (?#...)-comment in a REx, pos=%s"
 				REx-subgr-start))))
 			    (if (>= (point) e)
@@ -4592,8 +4597,8 @@ cperl-find-pods-heres
 	      (if (> (point) stop-point)
 		  (progn
 		    (if end
-			(message "Garbage after __END__/__DATA__ ignored")
-		      (message "Unbalanced syntax found while scanning")
+			(setq warning-message "Garbage after __END__/__DATA__ ignored")
+		      (setq warning-message "Unbalanced syntax found while scanning")
 		      (or (car err-l) (setcar err-l b)))
 		    (goto-char stop-point))))
 	    (setq cperl-syntax-state (cons state-point state)
@@ -4612,7 +4617,8 @@ cperl-find-pods-heres
       ;; cperl-mode-syntax-table.
       ;; (set-syntax-table cperl-mode-syntax-table)
       )
-    (list (car err-l) overshoot)))
+    (list (car err-l) overshoot)
+    (when warning-message (message warning-message))))
 
 (defun cperl-find-pods-heres-region (min max)
   (interactive "r")
-- 
2.20.1