From 12e442317862f32c35a990290e0fddf1db05d4ff Mon Sep 17 00:00:00 2001
From: Jared Finder <jared@finder.org>
Date: Thu, 3 Dec 2020 22:42:05 -0800
Subject: [PATCH 1/3] Improve behavior for `make-help-screen'

* lisp/help-macro.el (make-help-screen): Don't read just the ESC in a
terminal escape sequence.  Add keymap to control scrolling logic for
help screen.  Then add mouse wheel to that keymap.
---
 lisp/help-macro.el | 75 ++++++++++++++++++++++++----------------------
 1 file changed, 39 insertions(+), 36 deletions(-)

diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 791b10a878..5197ae496f 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -103,10 +103,14 @@ make-help-screen
 	   (when three-step-help
 	     (message "%s" line-prompt))
 	   (let* ((help-screen (documentation (quote ,doc-fn)))
+                  (help-chars (append (list ?? help-char) help-event-list))
+                  ;; Commands in this map are executed with errors
+                  ;; ignored.
+                  (navigation-map (make-sparse-keymap))
 		  ;; We bind overriding-local-map for very small
 		  ;; sections, *excluding* where we switch buffers
 		  ;; and where we execute the chosen help command.
-		  (local-map (make-sparse-keymap))
+		  (local-map (make-composed-keymap navigation-map ,helped-map))
 		  (new-minor-mode-map-alist minor-mode-map-alist)
 		  (prev-frame (selected-frame))
 		  config new-frame key char)
@@ -117,22 +121,32 @@ make-help-screen
 				    t t help-screen)))
 	     (unwind-protect
 		 (let ((minor-mode-map-alist nil))
-		   (setcdr local-map ,helped-map)
 		   (define-key local-map [t] 'undefined)
-		   ;; Make the scroll bar keep working normally.
-		   (define-key local-map [vertical-scroll-bar]
-		     (lookup-key global-map [vertical-scroll-bar]))
-		   (if three-step-help
-		       (progn
-			 (setq key (let ((overriding-local-map local-map))
-				     (read-key-sequence nil)))
-			 ;; Make the HELP key translate to C-h.
-			 (if (lookup-key function-key-map key)
-			     (setq key (lookup-key function-key-map key)))
-			 (setq char (aref key 0)))
-		     (setq char ??))
-		   (when (or (eq char ??) (eq char help-char)
-			     (memq char help-event-list))
+                   ;; Make terminal escape sequences be fully read.
+                   (define-key local-map "\e" nil)
+
+                   ;; Custom navigation commands.
+                   (dolist (key '("\C-v" "\s"))
+                     (define-key navigation-map key 'scroll-up))
+                   (dolist (key '("\M-v" "\d" [delete] [backspace]))
+                     (define-key navigation-map key 'scroll-down))
+                   ;; Navigation commands that keep working normally.
+                   (dolist (key '(;; Clicks in the scrollbar
+                                  [vertical-scroll-bar]
+                                  ;; Mouse wheel events
+                                  [mouse-4] [mouse-5] [down-mouse-4]
+                                  [down-mouse-5]
+                                  ;; Frame switching
+                                  [switch-frame]))
+                     (define-key navigation-map key
+                       (lookup-key global-map key)))
+
+                   (setq key (if three-step-help
+                                 (let ((overriding-local-map local-map))
+                                   (read-key-sequence-vector nil))
+                               [??])
+                         char (aref key 0))
+		   (when (memq char help-chars)
 		     (setq config (current-window-configuration))
 		     (pop-to-buffer " *Metahelp*" nil t)
 		     (and (fboundp 'make-frame)
@@ -148,32 +162,21 @@ make-help-screen
 		       (help-mode)
 		       (setq new-minor-mode-map-alist minor-mode-map-alist))
 		     (goto-char (point-min))
-		     (while (or (memq char (append help-event-list
-						   (cons help-char '(?? ?\C-v ?\s ?\177 delete backspace vertical-scroll-bar ?\M-v))))
-				(eq (car-safe char) 'switch-frame)
-				(equal key "\M-v"))
-		       (condition-case nil
-			   (cond
-			    ((eq (car-safe char) 'switch-frame)
-			     (handle-switch-frame char))
-			    ((memq char '(?\C-v ?\s))
-			     (scroll-up))
-			    ((or (memq char '(?\177 ?\M-v delete backspace))
-				 (equal key "\M-v"))
-			     (scroll-down)))
-			 (error nil))
+                     (while (or (memq (event-basic-type char) help-chars)
+                                (lookup-key navigation-map key))
+                       (let ((binding (lookup-key navigation-map key)))
+                         (when binding
+                           (condition-case nil
+                               (command-execute binding nil key)
+                             (error nil))))
 		       (let ((cursor-in-echo-area t)
 			     (overriding-local-map local-map))
-			 (setq key (read-key-sequence
+			 (setq key (read-key-sequence-vector
 				    (format "Type one of the options listed%s: "
 					    (if (pos-visible-in-window-p
 						 (point-max))
 						"" ", or SPACE or DEL to scroll")))
-			       char (aref key 0)))
-
-		       ;; If this is a scroll bar command, just run it.
-		       (when (eq char 'vertical-scroll-bar)
-			 (command-execute (lookup-key local-map key) nil key))))
+			       char (aref key 0)))))
 		   ;; We don't need the prompt any more.
 		   (message "")
 		   ;; Mouse clicks are not part of the help feature,
-- 
2.20.1