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

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

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

haj@posteo.de (Harald Jörg) writes:

> haj@posteo.de (Harald Jörg) writes:
>
>> 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.
>
> Sorry - the previous message contained a bad patch.  Please use the
> attached patch instead!

Oh my.  It's too late.  This time I forgot to actually attach the patch.
-- 
Sorry,
haj

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

From 42b13aa9bfba74c7a4c6e9285f768615772fda8c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Harald=20J=C3=B6rg?= <haj@posteo.de>
Date: Fri, 2 Apr 2021 00:46:38 +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 | 32 +++++++++++++++++++-------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 7612f8d284..7878e91096 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,9 +4517,9 @@ cperl-find-pods-heres
 			       ;; (1- e) 'toend)
 			       (search-forward ")" (1- e) 'toend)
 			       ;;)
-			       (message
-				"Couldn't find end of (?#...)-comment in a REx, pos=%s"
-				REx-subgr-start))))
+			       (setq warning-message
+				     (format "Couldn't find end of (?#...)-comment in a REx, pos=%s"
+				             REx-subgr-start)))))
 			    (if (>= (point) e)
 				(goto-char (1- e)))
 			    (cond
@@ -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,6 +4617,7 @@ cperl-find-pods-heres
       ;; cperl-mode-syntax-table.
       ;; (set-syntax-table cperl-mode-syntax-table)
       )
+    (when warning-message (message warning-message))
     (list (car err-l) overshoot)))
 
 (defun cperl-find-pods-heres-region (min max)
-- 
2.20.1