Line data Source code
1 : ;;; help-macro.el --- makes command line help such as help-for-help
2 :
3 : ;; Copyright (C) 1993-1994, 2001-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Lynn Slater <lrs@indetech.com>
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Created: Mon Oct 1 11:42:39 1990
8 : ;; Adapted-By: ESR
9 : ;; Package: emacs
10 :
11 : ;; This file is part of GNU Emacs.
12 :
13 : ;; GNU Emacs is free software: you can redistribute it and/or modify
14 : ;; it under the terms of the GNU General Public License as published by
15 : ;; the Free Software Foundation, either version 3 of the License, or
16 : ;; (at your option) any later version.
17 :
18 : ;; GNU Emacs is distributed in the hope that it will be useful,
19 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 : ;; GNU General Public License for more details.
22 :
23 : ;; You should have received a copy of the GNU General Public License
24 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 :
26 : ;;; Commentary:
27 :
28 : ;; This file supplies the macro make-help-screen which constructs
29 : ;; single character dispatching with browsable help such as that provided
30 : ;; by help-for-help. This can be used to make many modes easier to use; for
31 : ;; example, the GNU Emacs Empire Tool uses this for every "nested" mode map
32 : ;; called from the main mode map.
33 :
34 : ;; The name of this package was changed from help-screen.el to
35 : ;; help-macro.el in order to fit in a 14-character limit.
36 :
37 : ;;-> *********************** Example of use *********************************
38 :
39 : ;;->(make-help-screen help-for-empire-redistribute-map
40 : ;;-> "c:civ m:mil p:population f:food ?"
41 : ;;-> "You have discovered the GEET redistribution commands
42 : ;;-> From here, you can use the following options:
43 : ;;->
44 : ;;->c Redistribute civs from overfull sectors into connected underfull ones
45 : ;;-> The functions typically named by empire-ideal-civ-fcn control
46 : ;;-> based in part on empire-sector-civ-threshold
47 : ;;->m Redistribute military using levels given by empire-ideal-mil-fcn
48 : ;;->p Redistribute excess population to highways for max pop growth
49 : ;;-> Excess is any sector so full babies will not be born.
50 : ;;->f Even out food on highways to highway min and leave levels
51 : ;;-> This is good to pump max food to all warehouses/dist pts
52 : ;;->
53 : ;;->
54 : ;;->Use \\[help-for-empire-redistribute-map] for help on redistribution.
55 : ;;->Use \\[help-for-empire-extract-map] for help on data extraction.
56 : ;;->Please use \\[describe-key] to find out more about any of the other keys."
57 : ;;-> empire-shell-redistribute-map)
58 :
59 : ;;-> (define-key c-mp "\C-h" 'help-for-empire-redistribute-map)
60 : ;;-> (define-key c-mp help-character 'help-for-empire-redistribute-map)
61 :
62 : ;;; Change Log:
63 : ;;
64 : ;; 22-Jan-1991 Lynn Slater x2048
65 : ;; Last Modified: Mon Oct 1 11:43:52 1990 #3 (Lynn Slater)
66 : ;; documented better
67 :
68 : ;;; Code:
69 :
70 : (require 'backquote)
71 :
72 : ;; This needs to be autoloaded because it is used in the
73 : ;; make-help-screen macro. Using (bound-and-true-p three-step-help)
74 : ;; is not an acceptable alternative, because nothing loads help-macro
75 : ;; in a normal session, so any user customization would never be applied.
76 : ;;;###autoload
77 : (defcustom three-step-help nil
78 : "Non-nil means give more info about Help command in three steps.
79 : The three steps are simple prompt, prompt with all options, and
80 : window listing and describing the options.
81 : A value of nil means skip the middle step, so that \\[help-command] \\[help-command]
82 : gives the window that lists the options."
83 : :type 'boolean
84 : :group 'help)
85 :
86 : (defmacro make-help-screen (fname help-line help-text helped-map)
87 : "Construct help-menu function name FNAME.
88 : When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP.
89 : If the command is the help character, FNAME displays HELP-TEXT
90 : and continues trying to read a command using HELPED-MAP.
91 : If HELP-TEXT contains the sequence `%THIS-KEY%', that is replaced
92 : with the key sequence that invoked FNAME.
93 : When FNAME finally does get a command, it executes that command
94 : and then returns."
95 1 : (let ((doc-fn (intern (concat (symbol-name fname) "-doc"))))
96 1 : `(progn
97 1 : (defun ,doc-fn () ,help-text nil)
98 1 : (defun ,fname ()
99 : "Help command."
100 : (interactive)
101 : (let ((line-prompt
102 1 : (substitute-command-keys ,help-line)))
103 : (when three-step-help
104 : (message "%s" line-prompt))
105 1 : (let* ((help-screen (documentation (quote ,doc-fn)))
106 : ;; We bind overriding-local-map for very small
107 : ;; sections, *excluding* where we switch buffers
108 : ;; and where we execute the chosen help command.
109 : (local-map (make-sparse-keymap))
110 : (new-minor-mode-map-alist minor-mode-map-alist)
111 : (prev-frame (selected-frame))
112 : config new-frame key char)
113 : (when (string-match "%THIS-KEY%" help-screen)
114 : (setq help-screen
115 : (replace-match (key-description
116 : (substring (this-command-keys) 0 -1))
117 : t t help-screen)))
118 : (unwind-protect
119 : (let ((minor-mode-map-alist nil))
120 1 : (setcdr local-map ,helped-map)
121 : (define-key local-map [t] 'undefined)
122 : ;; Make the scroll bar keep working normally.
123 : (define-key local-map [vertical-scroll-bar]
124 : (lookup-key global-map [vertical-scroll-bar]))
125 : (if three-step-help
126 : (progn
127 : (setq key (let ((overriding-local-map local-map))
128 : (read-key-sequence nil)))
129 : ;; Make the HELP key translate to C-h.
130 : (if (lookup-key function-key-map key)
131 : (setq key (lookup-key function-key-map key)))
132 : (setq char (aref key 0)))
133 : (setq char ??))
134 : (when (or (eq char ??) (eq char help-char)
135 : (memq char help-event-list))
136 : (setq config (current-window-configuration))
137 : (pop-to-buffer " *Metahelp*" nil t)
138 : (and (fboundp 'make-frame)
139 : (not (eq (window-frame)
140 : prev-frame))
141 : (setq new-frame (window-frame)
142 : config nil))
143 : (setq buffer-read-only nil)
144 : (let ((inhibit-read-only t))
145 : (erase-buffer)
146 : (insert help-screen))
147 : (let ((minor-mode-map-alist new-minor-mode-map-alist))
148 : (help-mode)
149 : (setq new-minor-mode-map-alist minor-mode-map-alist))
150 : (goto-char (point-min))
151 : (while (or (memq char (append help-event-list
152 : (cons help-char '(?? ?\C-v ?\s ?\177 delete backspace vertical-scroll-bar ?\M-v))))
153 : (eq (car-safe char) 'switch-frame)
154 : (equal key "\M-v"))
155 : (condition-case nil
156 : (cond
157 : ((eq (car-safe char) 'switch-frame)
158 : (handle-switch-frame char))
159 : ((memq char '(?\C-v ?\s))
160 : (scroll-up))
161 : ((or (memq char '(?\177 ?\M-v delete backspace))
162 : (equal key "\M-v"))
163 : (scroll-down)))
164 : (error nil))
165 : (let ((cursor-in-echo-area t)
166 : (overriding-local-map local-map))
167 : (setq key (read-key-sequence
168 : (format "Type one of the options listed%s: "
169 : (if (pos-visible-in-window-p
170 : (point-max))
171 : "" ", or SPACE or DEL to scroll")))
172 : char (aref key 0)))
173 :
174 : ;; If this is a scroll bar command, just run it.
175 : (when (eq char 'vertical-scroll-bar)
176 : (command-execute (lookup-key local-map key) nil key))))
177 : ;; We don't need the prompt any more.
178 : (message "")
179 : ;; Mouse clicks are not part of the help feature,
180 : ;; so reexecute them in the standard environment.
181 : (if (listp char)
182 : (setq unread-command-events
183 : (cons char unread-command-events)
184 : config nil)
185 : (let ((defn (lookup-key local-map key)))
186 : (if defn
187 : (progn
188 : (when config
189 : (set-window-configuration config)
190 : (setq config nil))
191 : ;; Temporarily rebind `minor-mode-map-alist'
192 : ;; to `new-minor-mode-map-alist' (Bug#10454).
193 : (let ((minor-mode-map-alist new-minor-mode-map-alist))
194 : ;; `defn' must make sure that its frame is
195 : ;; selected, so we won't iconify it below.
196 : (call-interactively defn))
197 : (when new-frame
198 : ;; Do not iconify the selected frame.
199 : (unless (eq new-frame (selected-frame))
200 : (iconify-frame new-frame))
201 : (setq new-frame nil)))
202 : (ding)))))
203 : (when config
204 : (set-window-configuration config))
205 : (when new-frame
206 : (iconify-frame new-frame))
207 1 : (setq minor-mode-map-alist new-minor-mode-map-alist))))))))
208 :
209 : (provide 'help-macro)
210 :
211 : ;;; help-macro.el ends here
|