(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.
This commit is contained in:
Stefan Monnier
parent
c214fc9626
commit
946280365d
1 changed files with 139 additions and 134 deletions
|
|
@ -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)))
|
||||
(help--help-screen ,help-line ,help-text ,helped-map ,buffer-name)))
|
||||
|
||||
;; 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))))))
|
||||
|
||||
;;;###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)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue