master 946280365d4: (make-help-screen): Move most of the code out to a function

[Stefan Monnier]

branch: master
commit 946280365d40104dffd5329eebefc02329f72041
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    (make-help-screen): Move most of the code out to a function
    
    This avoids problems like variable-name capture and lets compiler messages
    point to the actual source code.
    
    * lisp/help-macro.el (help--help-screen): New function, extracted from
    `make-help-screen`.
    (make-help-screen): Use it.
---
 lisp/help-macro.el | 275 +++++++++++++++++++++++++++--------------------------
 1 file changed, 140 insertions(+), 135 deletions(-)

diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index cea8b379ec0..8a16e85a329 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -92,141 +92,146 @@ and then returns."
   `(defun ,fname ()
      "Help command."
      (interactive)
-     (let ((line-prompt
-            (substitute-command-keys ,help-line))
-           (help-buffer-under-preparation t))
-       (when three-step-help
-         (message "%s" line-prompt))
-       (let* ((help-screen ,help-text)
-              ;; 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))
-              (new-minor-mode-map-alist minor-mode-map-alist)
-              (prev-frame (selected-frame))
-              config new-frame key char)
-         (when (string-match "%THIS-KEY%" help-screen)
-           (setq help-screen
-                 (replace-match (help--key-description-fontified
-                                 (substring (this-command-keys) 0 -1))
-                                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))
-                 (setq config (current-window-configuration))
-                 (pop-to-buffer (or ,buffer-name " *Metahelp*") nil t)
-                 (and (fboundp 'make-frame)
-                      (not (eq (window-frame)
-                               prev-frame))
-                      (setq new-frame (window-frame)
-                            config nil))
-                 (setq buffer-read-only nil)
-                 (let ((inhibit-read-only t))
-                   (erase-buffer)
-                   (insert (substitute-command-keys help-screen)))
-                 (let ((minor-mode-map-alist new-minor-mode-map-alist))
-                   (help-mode)
-                   (variable-pitch-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 ?\M-v ?\S-\s
-                                                                  deletechar 
backspace vertical-scroll-bar
-                                                                  home end 
next prior up down))))
-                            (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 next end))
-                         (scroll-up))
-                        ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar 
backspace prior home))
-                             (equal key "\M-v"))
-                         (scroll-down))
-                        ((memq char '(down))
-                         (scroll-up 1))
-                        ((memq char '(up))
-                         (scroll-down 1)))
-                     (error nil))
-                   (let ((cursor-in-echo-area t)
-                         (overriding-local-map local-map))
-                     (frame-toggle-on-screen-keyboard (selected-frame) nil)
-                     (setq key (read-key-sequence
-                                (format "Type one of listed options%s: "
-                                        (if (pos-visible-in-window-p
-                                             (point-max))
-                                            ""
-                                          (concat  ", or "
-                                                   
(help--key-description-fontified (kbd "<PageDown>"))
-                                                   "/"
-                                                   
(help--key-description-fontified (kbd "<PageUp>"))
-                                                   "/"
-                                                   
(help--key-description-fontified (kbd "SPC"))
-                                                   "/"
-                                                   
(help--key-description-fontified (kbd "DEL"))
-                                                   " to scroll")))
-                                nil nil nil nil
-                                ;; Disable ``text conversion''.  OS
-                                ;; input methods might otherwise chose
-                                ;; to insert user input directly into
-                                ;; a buffer.
-                                t)
-                           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))))
-               ;; We don't need the prompt any more.
-               (message "")
-               ;; Mouse clicks are not part of the help feature,
-               ;; so reexecute them in the standard environment.
-               (if (listp char)
-                   (setq unread-command-events
-                         (cons char unread-command-events)
-                         config nil)
-                 (let ((defn (lookup-key local-map key)))
-                   (if defn
-                       (progn
-                         (when config
-                           (set-window-configuration config)
-                           (setq config nil))
-                         ;; Temporarily rebind `minor-mode-map-alist'
-                         ;; to `new-minor-mode-map-alist' (Bug#10454).
-                         (let ((minor-mode-map-alist new-minor-mode-map-alist))
-                           ;; `defn' must make sure that its frame is
-                           ;; selected, so we won't iconify it below.
-                           (call-interactively defn))
-                         (when new-frame
-                           ;; Do not iconify the selected frame.
-                           (unless (eq new-frame (selected-frame))
-                             (iconify-frame new-frame))
-                           (setq new-frame nil)))
-                     (unless (equal (key-description key) "C-g")
-                       (message (substitute-command-keys
-                                (format "No help command is bound to `\\`%s''"
-                                        (key-description key))))
-                       (ding))))))
-           (when config
-             (set-window-configuration config))
-           (when new-frame
-             (iconify-frame new-frame))
-           (setq minor-mode-map-alist new-minor-mode-map-alist))))))
+     (help--help-screen ,help-line ,help-text ,helped-map ,buffer-name)))
+
+
+;;;###autoload
+(defun help--help-screen (help-line help-text helped-map buffer-name)
+  (let ((line-prompt
+         (substitute-command-keys help-line))
+        (help-buffer-under-preparation t))
+    (when three-step-help
+      (message "%s" line-prompt))
+    (let* ((help-screen help-text)
+           ;; 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))
+           (new-minor-mode-map-alist minor-mode-map-alist)
+           (prev-frame (selected-frame))
+           config new-frame key char)
+      (when (string-match "%THIS-KEY%" help-screen)
+        (setq help-screen
+              (replace-match (help--key-description-fontified
+                              (substring (this-command-keys) 0 -1))
+                             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))
+              (setq config (current-window-configuration))
+              (pop-to-buffer (or buffer-name " *Metahelp*") nil t)
+              (and (fboundp 'make-frame)
+                   (not (eq (window-frame)
+                            prev-frame))
+                   (setq new-frame (window-frame)
+                         config nil))
+              (setq buffer-read-only nil)
+              (let ((inhibit-read-only t))
+                (erase-buffer)
+                (insert (substitute-command-keys help-screen)))
+              (let ((minor-mode-map-alist new-minor-mode-map-alist))
+                (help-mode)
+                (variable-pitch-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 ?\M-v ?\S-\s
+                                                               deletechar 
backspace vertical-scroll-bar
+                                                               home end next 
prior up down))))
+                         (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 next end))
+                      (scroll-up))
+                     ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace 
prior home))
+                          (equal key "\M-v"))
+                      (scroll-down))
+                     ((memq char '(down))
+                      (scroll-up 1))
+                     ((memq char '(up))
+                      (scroll-down 1)))
+                  (error nil))
+                (let ((cursor-in-echo-area t)
+                      (overriding-local-map local-map))
+                  (frame-toggle-on-screen-keyboard (selected-frame) nil)
+                  (setq key (read-key-sequence
+                             (format "Type one of listed options%s: "
+                                     (if (pos-visible-in-window-p
+                                          (point-max))
+                                         ""
+                                       (concat  ", or "
+                                                
(help--key-description-fontified (kbd "<PageDown>"))
+                                                "/"
+                                                
(help--key-description-fontified (kbd "<PageUp>"))
+                                                "/"
+                                                
(help--key-description-fontified (kbd "SPC"))
+                                                "/"
+                                                
(help--key-description-fontified (kbd "DEL"))
+                                                " to scroll")))
+                             nil nil nil nil
+                             ;; Disable ``text conversion''.  OS
+                             ;; input methods might otherwise chose
+                             ;; to insert user input directly into
+                             ;; a buffer.
+                             t)
+                        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))))
+            ;; We don't need the prompt any more.
+            (message "")
+            ;; Mouse clicks are not part of the help feature,
+            ;; so reexecute them in the standard environment.
+            (if (listp char)
+                (setq unread-command-events
+                      (cons char unread-command-events)
+                      config nil)
+              (let ((defn (lookup-key local-map key)))
+                (if defn
+                    (progn
+                      (when config
+                        (set-window-configuration config)
+                        (setq config nil))
+                      ;; Temporarily rebind `minor-mode-map-alist'
+                      ;; to `new-minor-mode-map-alist' (Bug#10454).
+                      (let ((minor-mode-map-alist new-minor-mode-map-alist))
+                        ;; `defn' must make sure that its frame is
+                        ;; selected, so we won't iconify it below.
+                        (call-interactively defn))
+                      (when new-frame
+                        ;; Do not iconify the selected frame.
+                        (unless (eq new-frame (selected-frame))
+                          (iconify-frame new-frame))
+                        (setq new-frame nil)))
+                  (unless (equal (key-description key) "C-g")
+                    (message (substitute-command-keys
+                              (format "No help command is bound to `\\`%s''"
+                                      (key-description key))))
+                    (ding))))))
+        (when config
+          (set-window-configuration config))
+        (when new-frame
+          (iconify-frame new-frame))
+        (setq minor-mode-map-alist new-minor-mode-map-alist)))))
 
 (provide 'help-macro)