Line data Source code
1 : ;;; help.el --- help commands for Emacs
2 :
3 : ;; Copyright (C) 1985-1986, 1993-1994, 1998-2017 Free Software
4 : ;; Foundation, Inc.
5 :
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: help, internal
8 : ;; Package: emacs
9 :
10 : ;; This file is part of GNU Emacs.
11 :
12 : ;; GNU Emacs is free software: you can redistribute it and/or modify
13 : ;; it under the terms of the GNU General Public License as published by
14 : ;; the Free Software Foundation, either version 3 of the License, or
15 : ;; (at your option) any later version.
16 :
17 : ;; GNU Emacs is distributed in the hope that it will be useful,
18 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 : ;; GNU General Public License for more details.
21 :
22 : ;; You should have received a copy of the GNU General Public License
23 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 :
25 : ;;; Commentary:
26 :
27 : ;; This code implements GNU Emacs's built-in help system, the one invoked by
28 : ;; `M-x help-for-help'.
29 :
30 : ;;; Code:
31 :
32 : ;; Get the macro make-help-screen when this is compiled,
33 : ;; or run interpreted, but not when the compiled code is loaded.
34 : (eval-when-compile (require 'help-macro))
35 :
36 : ;; This makes `with-output-to-temp-buffer' buffers use `help-mode'.
37 : (add-hook 'temp-buffer-setup-hook 'help-mode-setup)
38 : (add-hook 'temp-buffer-show-hook 'help-mode-finish)
39 :
40 : ;; `help-window-point-marker' is a marker you can move to a valid
41 : ;; position of the buffer shown in the help window in order to override
42 : ;; the standard positioning mechanism (`point-min') chosen by
43 : ;; `with-output-to-temp-buffer' and `with-temp-buffer-window'.
44 : ;; `with-help-window' has this point nowhere before exiting. Currently
45 : ;; used by `view-lossage' to assert that the last keystrokes are always
46 : ;; visible.
47 : (defvar help-window-point-marker (make-marker)
48 : "Marker to override default `window-point' in help windows.")
49 :
50 : (defvar help-window-old-frame nil
51 : "Frame selected at the time `with-help-window' is invoked.")
52 :
53 : (defvar help-map
54 : (let ((map (make-sparse-keymap)))
55 : (define-key map (char-to-string help-char) 'help-for-help)
56 : (define-key map [help] 'help-for-help)
57 : (define-key map [f1] 'help-for-help)
58 : (define-key map "." 'display-local-help)
59 : (define-key map "?" 'help-for-help)
60 :
61 : (define-key map "\C-a" 'about-emacs)
62 : (define-key map "\C-c" 'describe-copying)
63 : (define-key map "\C-d" 'view-emacs-debugging)
64 : (define-key map "\C-e" 'view-external-packages)
65 : (define-key map "\C-f" 'view-emacs-FAQ)
66 : (define-key map "\C-m" 'view-order-manuals)
67 : (define-key map "\C-n" 'view-emacs-news)
68 : (define-key map "\C-o" 'describe-distribution)
69 : (define-key map "\C-p" 'view-emacs-problems)
70 : (define-key map "\C-t" 'view-emacs-todo)
71 : (define-key map "\C-w" 'describe-no-warranty)
72 :
73 : ;; This does not fit the pattern, but it is natural given the C-\ command.
74 : (define-key map "\C-\\" 'describe-input-method)
75 :
76 : (define-key map "C" 'describe-coding-system)
77 : (define-key map "F" 'Info-goto-emacs-command-node)
78 : (define-key map "I" 'describe-input-method)
79 : (define-key map "K" 'Info-goto-emacs-key-command-node)
80 : (define-key map "L" 'describe-language-environment)
81 : (define-key map "S" 'info-lookup-symbol)
82 :
83 : (define-key map "a" 'apropos-command)
84 : (define-key map "b" 'describe-bindings)
85 : (define-key map "c" 'describe-key-briefly)
86 : (define-key map "d" 'apropos-documentation)
87 : (define-key map "e" 'view-echo-area-messages)
88 : (define-key map "f" 'describe-function)
89 : (define-key map "g" 'describe-gnu-project)
90 : (define-key map "h" 'view-hello-file)
91 :
92 : (define-key map "i" 'info)
93 : (define-key map "4i" 'info-other-window)
94 :
95 : (define-key map "k" 'describe-key)
96 : (define-key map "l" 'view-lossage)
97 : (define-key map "m" 'describe-mode)
98 : (define-key map "o" 'describe-symbol)
99 : (define-key map "n" 'view-emacs-news)
100 : (define-key map "p" 'finder-by-keyword)
101 : (define-key map "P" 'describe-package)
102 : (define-key map "r" 'info-emacs-manual)
103 : (define-key map "s" 'describe-syntax)
104 : (define-key map "t" 'help-with-tutorial)
105 : (define-key map "w" 'where-is)
106 : (define-key map "v" 'describe-variable)
107 : (define-key map "q" 'help-quit)
108 : map)
109 : "Keymap for characters following the Help key.")
110 :
111 : (define-key global-map (char-to-string help-char) 'help-command)
112 : (define-key global-map [help] 'help-command)
113 : (define-key global-map [f1] 'help-command)
114 : (fset 'help-command help-map)
115 :
116 : ;; insert-button makes the action nil if it is not store somewhere
117 : (defvar help-button-cache nil)
118 :
119 :
120 : (defun help-quit ()
121 : "Just exit from the Help command's command loop."
122 : (interactive)
123 : nil)
124 :
125 : (defvar help-return-method nil
126 : "What to do to \"exit\" the help buffer.
127 : This is a list
128 : (WINDOW . t) delete the selected window (and possibly its frame,
129 : see `quit-window'), go to WINDOW.
130 : (WINDOW . quit-window) do quit-window, then select WINDOW.
131 : (WINDOW BUF START POINT) display BUF at START, POINT, then select WINDOW.")
132 :
133 : (define-obsolete-function-alias 'print-help-return-message 'help-print-return-message "23.2")
134 : (defun help-print-return-message (&optional function)
135 : "Display or return message saying how to restore windows after help command.
136 : This function assumes that `standard-output' is the help buffer.
137 : It computes a message, and applies the optional argument FUNCTION to it.
138 : If FUNCTION is nil, it applies `message', thus displaying the message.
139 : In addition, this function sets up `help-return-method', which see, that
140 : specifies what to do when the user exits the help buffer.
141 :
142 : Do not call this in the scope of `with-help-window'."
143 0 : (and (not (get-buffer-window standard-output))
144 0 : (let ((first-message
145 0 : (cond ((or
146 0 : pop-up-frames
147 0 : (special-display-p (buffer-name standard-output)))
148 0 : (setq help-return-method (cons (selected-window) t))
149 : ;; If the help output buffer is a special display buffer,
150 : ;; don't say anything about how to get rid of it.
151 : ;; First of all, the user will do that with the window
152 : ;; manager, not with Emacs.
153 : ;; Secondly, the buffer has not been displayed yet,
154 : ;; so we don't know whether its frame will be selected.
155 : nil)
156 0 : ((not (one-window-p t))
157 0 : (setq help-return-method
158 0 : (cons (selected-window) 'quit-window))
159 : "Type \\[display-buffer] RET to restore the other window.")
160 0 : (pop-up-windows
161 0 : (setq help-return-method (cons (selected-window) t))
162 : "Type \\[delete-other-windows] to remove help window.")
163 : (t
164 0 : (setq help-return-method
165 0 : (list (selected-window) (window-buffer)
166 0 : (window-start) (window-point)))
167 0 : "Type \\[switch-to-buffer] RET to remove help window."))))
168 0 : (funcall (or function 'message)
169 0 : (concat
170 0 : (if first-message
171 0 : (substitute-command-keys first-message))
172 0 : (if first-message " ")
173 : ;; If the help buffer will go in a separate frame,
174 : ;; it's no use mentioning a command to scroll, so don't.
175 0 : (if (or pop-up-windows
176 0 : (special-display-p (buffer-name standard-output)))
177 : nil
178 0 : (if (same-window-p (buffer-name standard-output))
179 : ;; Say how to scroll this window.
180 0 : (substitute-command-keys
181 0 : "\\[scroll-up] to scroll the help.")
182 : ;; Say how to scroll some other window.
183 0 : (substitute-command-keys
184 0 : "\\[scroll-other-window] to scroll the help."))))))))
185 :
186 : ;; So keyboard macro definitions are documented correctly
187 : (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
188 :
189 : (defalias 'help 'help-for-help-internal)
190 : ;; find-function can find this.
191 : (defalias 'help-for-help 'help-for-help-internal)
192 : ;; It can't find this, but nobody will look.
193 : (make-help-screen help-for-help-internal
194 : (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?")
195 : ;; Don't purecopy this one, because it's not evaluated (it's
196 : ;; directly used as a docstring in a function definition, so it'll
197 : ;; be moved to the DOC file anyway: no need for purecopying it).
198 : "You have typed %THIS-KEY%, the help character. Type a Help option:
199 : \(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.)
200 :
201 : a PATTERN Show commands whose name matches the PATTERN (a list of words
202 : or a regexp). See also the `apropos' command.
203 : b Display all key bindings.
204 : c KEYS Display the command name run by the given key sequence.
205 : C CODING Describe the given coding system, or RET for current ones.
206 : d PATTERN Show a list of functions, variables, and other items whose
207 : documentation matches the PATTERN (a list of words or a regexp).
208 : e Go to the *Messages* buffer which logs echo-area messages.
209 : f FUNCTION Display documentation for the given function.
210 : F COMMAND Show the Emacs manual's section that describes the command.
211 : g Display information about the GNU project.
212 : h Display the HELLO file which illustrates various scripts.
213 : i Start the Info documentation reader: read included manuals.
214 : I METHOD Describe a specific input method, or RET for current.
215 : k KEYS Display the full documentation for the key sequence.
216 : K KEYS Show the Emacs manual's section for the command bound to KEYS.
217 : l Show last 300 input keystrokes (lossage).
218 : L LANG-ENV Describes a specific language environment, or RET for current.
219 : m Display documentation of current minor modes and current major mode,
220 : including their special commands.
221 : n Display news of recent Emacs changes.
222 : o SYMBOL Display the given function or variable's documentation and value.
223 : p TOPIC Find packages matching a given topic keyword.
224 : P PACKAGE Describe the given Emacs Lisp package.
225 : r Display the Emacs manual in Info mode.
226 : s Display contents of current syntax table, plus explanations.
227 : S SYMBOL Show the section for the given symbol in the Info manual
228 : for the programming language used in this buffer.
229 : t Start the Emacs learn-by-doing tutorial.
230 : v VARIABLE Display the given variable's documentation and value.
231 : w COMMAND Display which keystrokes invoke the given command (where-is).
232 : . Display any available local help at point in the echo area.
233 :
234 : C-a Information about Emacs.
235 : C-c Emacs copying permission (GNU General Public License).
236 : C-d Instructions for debugging GNU Emacs.
237 : C-e External packages and information about Emacs.
238 : C-f Emacs FAQ.
239 : C-m How to order printed Emacs manuals.
240 : C-n News of recent Emacs changes.
241 : C-o Emacs ordering and distribution information.
242 : C-p Info about known Emacs problems.
243 : C-t Emacs TODO list.
244 : C-w Information on absence of warranty for GNU Emacs."
245 : help-map)
246 :
247 :
248 :
249 : (defun function-called-at-point ()
250 : "Return a function around point or else called by the list containing point.
251 : If that doesn't give a function, return nil."
252 0 : (with-syntax-table emacs-lisp-mode-syntax-table
253 0 : (or (condition-case ()
254 0 : (save-excursion
255 0 : (or (not (zerop (skip-syntax-backward "_w")))
256 0 : (eq (char-syntax (following-char)) ?w)
257 0 : (eq (char-syntax (following-char)) ?_)
258 0 : (forward-sexp -1))
259 0 : (skip-chars-forward "'")
260 0 : (let ((obj (read (current-buffer))))
261 0 : (and (symbolp obj) (fboundp obj) obj)))
262 0 : (error nil))
263 0 : (condition-case ()
264 0 : (save-excursion
265 0 : (save-restriction
266 0 : (narrow-to-region (max (point-min)
267 0 : (- (point) 1000)) (point-max))
268 : ;; Move up to surrounding paren, then after the open.
269 0 : (backward-up-list 1)
270 0 : (forward-char 1)
271 : ;; If there is space here, this is probably something
272 : ;; other than a real Lisp function call, so ignore it.
273 0 : (if (looking-at "[ \t]")
274 0 : (error "Probably not a Lisp function call"))
275 0 : (let ((obj (read (current-buffer))))
276 0 : (and (symbolp obj) (fboundp obj) obj))))
277 0 : (error nil))
278 0 : (let* ((str (find-tag-default))
279 0 : (sym (if str (intern-soft str))))
280 0 : (if (and sym (fboundp sym))
281 0 : sym
282 0 : (save-match-data
283 0 : (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
284 0 : (setq sym (intern-soft (match-string 1 str)))
285 0 : (and (fboundp sym) sym))))))))
286 :
287 :
288 : ;;; `User' help functions
289 :
290 : (defun view-help-file (file &optional dir)
291 0 : (view-file (expand-file-name file (or dir data-directory)))
292 0 : (goto-address-mode 1)
293 0 : (goto-char (point-min)))
294 :
295 : (defun describe-distribution ()
296 : "Display info on how to obtain the latest version of GNU Emacs."
297 : (interactive)
298 0 : (view-help-file "DISTRIB"))
299 :
300 : (defun describe-copying ()
301 : "Display info on how you may redistribute copies of GNU Emacs."
302 : (interactive)
303 0 : (view-help-file "COPYING"))
304 :
305 : ;; Maybe this command should just be removed.
306 : (defun describe-gnu-project ()
307 : "Browse online information on the GNU project."
308 : (interactive)
309 0 : (browse-url "http://www.gnu.org/gnu/thegnuproject.html"))
310 :
311 : (define-obsolete-function-alias 'describe-project 'describe-gnu-project "22.2")
312 :
313 : (defun describe-no-warranty ()
314 : "Display info on all the kinds of warranty Emacs does NOT have."
315 : (interactive)
316 0 : (describe-copying)
317 0 : (let (case-fold-search)
318 0 : (search-forward "Disclaimer of Warranty")
319 0 : (forward-line 0)
320 0 : (recenter 0)))
321 :
322 : (defun describe-prefix-bindings ()
323 : "Describe the bindings of the prefix used to reach this command.
324 : The prefix described consists of all but the last event
325 : of the key sequence that ran this command."
326 : (interactive)
327 0 : (let ((key (this-command-keys)))
328 0 : (describe-bindings
329 0 : (if (stringp key)
330 0 : (substring key 0 (1- (length key)))
331 0 : (let ((prefix (make-vector (1- (length key)) nil))
332 : (i 0))
333 0 : (while (< i (length prefix))
334 0 : (aset prefix i (aref key i))
335 0 : (setq i (1+ i)))
336 0 : prefix)))))
337 : ;; Make C-h after a prefix, when not specifically bound,
338 : ;; run describe-prefix-bindings.
339 : (setq prefix-help-command 'describe-prefix-bindings)
340 :
341 : (defun view-emacs-news (&optional version)
342 : "Display info on recent changes to Emacs.
343 : With argument, display info only for the selected version."
344 : (interactive "P")
345 0 : (unless version
346 0 : (setq version emacs-major-version))
347 0 : (when (consp version)
348 0 : (let* ((all-versions
349 0 : (let (res)
350 0 : (mapc
351 : (lambda (file)
352 0 : (with-temp-buffer
353 0 : (insert-file-contents
354 0 : (expand-file-name file data-directory))
355 0 : (while (re-search-forward
356 0 : (if (member file '("NEWS.18" "NEWS.1-17"))
357 : "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
358 0 : "^\\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)
359 0 : (setq res (cons (match-string-no-properties 1) res)))))
360 0 : (cons "NEWS"
361 0 : (directory-files data-directory nil
362 0 : "^NEWS\\.[0-9][-0-9]*$" nil)))
363 0 : (sort (delete-dups res) #'string>)))
364 0 : (current (car all-versions)))
365 0 : (setq version (completing-read
366 0 : (format "Read NEWS for the version (default %s): " current)
367 0 : all-versions nil nil nil nil current))
368 0 : (if (integerp (string-to-number version))
369 0 : (setq version (string-to-number version))
370 0 : (unless (or (member version all-versions)
371 0 : (<= (string-to-number version) (string-to-number current)))
372 0 : (error "No news about version %s" version)))))
373 0 : (when (integerp version)
374 0 : (cond ((<= version 12)
375 0 : (setq version (format "1.%d" version)))
376 0 : ((<= version 18)
377 0 : (setq version (format "%d" version)))
378 0 : ((> version emacs-major-version)
379 0 : (error "No news about Emacs %d (yet)" version))))
380 0 : (let* ((vn (if (stringp version)
381 0 : (string-to-number version)
382 0 : version))
383 0 : (file (cond
384 0 : ((>= vn emacs-major-version) "NEWS")
385 0 : ((< vn 18) "NEWS.1-17")
386 0 : (t (format "NEWS.%d" vn))))
387 : res)
388 0 : (view-file (expand-file-name file data-directory))
389 0 : (widen)
390 0 : (goto-char (point-min))
391 0 : (when (stringp version)
392 0 : (when (re-search-forward
393 0 : (concat (if (< vn 19)
394 : "Changes in Emacs[ \t]*"
395 0 : "^\\* [^0-9\n]*") version "$")
396 0 : nil t)
397 0 : (beginning-of-line)
398 0 : (narrow-to-region
399 0 : (point)
400 0 : (save-excursion
401 0 : (while (and (setq res
402 0 : (re-search-forward
403 0 : (if (< vn 19)
404 : "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
405 0 : "^\\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t))
406 0 : (equal (match-string-no-properties 1) version)))
407 0 : (or res (goto-char (point-max)))
408 0 : (beginning-of-line)
409 0 : (point)))))))
410 :
411 : (defun view-emacs-todo (&optional _arg)
412 : "Display the Emacs TODO list."
413 : (interactive "P")
414 0 : (view-help-file "TODO"))
415 :
416 : (define-obsolete-function-alias 'view-todo 'view-emacs-todo "22.2")
417 :
418 :
419 : (defun view-echo-area-messages ()
420 : "View the log of recent echo-area messages: the `*Messages*' buffer.
421 : The number of messages retained in that buffer
422 : is specified by the variable `message-log-max'."
423 : (interactive)
424 0 : (with-current-buffer (messages-buffer)
425 0 : (goto-char (point-max))
426 0 : (display-buffer (current-buffer))))
427 :
428 : (defun view-order-manuals ()
429 : "Display information on how to buy printed copies of Emacs manuals."
430 : (interactive)
431 : ;; (view-help-file "ORDERS")
432 0 : (info "(emacs)Printed Books"))
433 :
434 : (defun view-emacs-FAQ ()
435 : "Display the Emacs Frequently Asked Questions (FAQ) file."
436 : (interactive)
437 : ;; (find-file-read-only (expand-file-name "FAQ" data-directory))
438 0 : (info "(efaq)"))
439 :
440 : (defun view-emacs-problems ()
441 : "Display info on known problems with Emacs and possible workarounds."
442 : (interactive)
443 0 : (view-help-file "PROBLEMS"))
444 :
445 : (defun view-emacs-debugging ()
446 : "Display info on how to debug Emacs problems."
447 : (interactive)
448 0 : (view-help-file "DEBUG"))
449 :
450 : ;; This used to visit MORE.STUFF; maybe it should just be removed.
451 : (defun view-external-packages ()
452 : "Display info on where to get more Emacs packages."
453 : (interactive)
454 0 : (info "(efaq)Packages that do not come with Emacs"))
455 :
456 : (defun view-lossage ()
457 : "Display last few input keystrokes and the commands run.
458 :
459 : To record all your input, use `open-dribble-file'."
460 : (interactive)
461 0 : (help-setup-xref (list #'view-lossage)
462 0 : (called-interactively-p 'interactive))
463 0 : (with-help-window (help-buffer)
464 0 : (princ " ")
465 0 : (princ (mapconcat (lambda (key)
466 0 : (cond
467 0 : ((and (consp key) (null (car key)))
468 0 : (format "[%s]\n" (if (symbolp (cdr key)) (cdr key)
469 0 : "anonymous-command")))
470 0 : ((or (integerp key) (symbolp key) (listp key))
471 0 : (single-key-description key))
472 : (t
473 0 : (prin1-to-string key nil))))
474 0 : (recent-keys 'include-cmds)
475 0 : " "))
476 0 : (with-current-buffer standard-output
477 0 : (goto-char (point-min))
478 0 : (while (not (eobp))
479 0 : (move-to-column 50)
480 0 : (unless (eolp)
481 0 : (fill-region (line-beginning-position) (line-end-position)))
482 0 : (forward-line 1))
483 : ;; jidanni wants to see the last keystrokes immediately.
484 0 : (set-marker help-window-point-marker (point)))))
485 :
486 :
487 : ;; Key bindings
488 :
489 : (defun describe-bindings (&optional prefix buffer)
490 : "Display a buffer showing a list of all defined keys, and their definitions.
491 : The keys are displayed in order of precedence.
492 :
493 : The optional argument PREFIX, if non-nil, should be a key sequence;
494 : then we display only bindings that start with that prefix.
495 : The optional argument BUFFER specifies which buffer's bindings
496 : to display (default, the current buffer). BUFFER can be a buffer
497 : or a buffer name."
498 : (interactive)
499 0 : (or buffer (setq buffer (current-buffer)))
500 0 : (help-setup-xref (list #'describe-bindings prefix buffer)
501 0 : (called-interactively-p 'interactive))
502 0 : (with-help-window (help-buffer)
503 : ;; Be aware that `describe-buffer-bindings' puts its output into
504 : ;; the current buffer.
505 0 : (with-current-buffer (help-buffer)
506 0 : (describe-buffer-bindings buffer prefix))))
507 :
508 : ;; This function used to be in keymap.c.
509 : (defun describe-bindings-internal (&optional menus prefix)
510 : "Show a list of all defined keys, and their definitions.
511 : We put that list in a buffer, and display the buffer.
512 :
513 : The optional argument MENUS, if non-nil, says to mention menu bindings.
514 : \(Ordinarily these are omitted from the output.)
515 : The optional argument PREFIX, if non-nil, should be a key sequence;
516 : then we display only bindings that start with that prefix."
517 : (declare (obsolete describe-buffer-bindings "24.4"))
518 0 : (let ((buf (current-buffer)))
519 0 : (with-help-window (help-buffer)
520 : ;; Be aware that `describe-buffer-bindings' puts its output into
521 : ;; the current buffer.
522 0 : (with-current-buffer (help-buffer)
523 0 : (describe-buffer-bindings buf prefix menus)))))
524 :
525 : (defun where-is (definition &optional insert)
526 : "Print message listing key sequences that invoke the command DEFINITION.
527 : Argument is a command definition, usually a symbol with a function definition.
528 : If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
529 : (interactive
530 0 : (let ((fn (function-called-at-point))
531 : (enable-recursive-minibuffers t)
532 : val)
533 0 : (setq val (completing-read
534 0 : (if fn
535 0 : (format "Where is command (default %s): " fn)
536 0 : "Where is command: ")
537 0 : obarray 'commandp t nil nil
538 0 : (and fn (symbol-name fn))))
539 0 : (list (unless (equal val "") (intern val))
540 0 : current-prefix-arg)))
541 0 : (unless definition (error "No command"))
542 0 : (let ((func (indirect-function definition))
543 : (defs nil)
544 0 : (standard-output (if insert (current-buffer) standard-output)))
545 : ;; In DEFS, find all symbols that are aliases for DEFINITION.
546 0 : (mapatoms (lambda (symbol)
547 0 : (and (fboundp symbol)
548 0 : (not (eq symbol definition))
549 0 : (eq func (condition-case ()
550 0 : (indirect-function symbol)
551 0 : (error symbol)))
552 0 : (push symbol defs))))
553 : ;; Look at all the symbols--first DEFINITION,
554 : ;; then its aliases.
555 0 : (dolist (symbol (cons definition defs))
556 0 : (let* ((remapped (command-remapping symbol))
557 0 : (keys (where-is-internal
558 0 : symbol overriding-local-map nil nil remapped))
559 0 : (keys (mapconcat 'key-description keys ", "))
560 : string)
561 0 : (setq string
562 0 : (if insert
563 0 : (if (> (length keys) 0)
564 0 : (if remapped
565 0 : (format "%s (%s) (remapped from %s)"
566 0 : keys remapped symbol)
567 0 : (format "%s (%s)" keys symbol))
568 0 : (format "M-x %s RET" symbol))
569 0 : (if (> (length keys) 0)
570 0 : (if remapped
571 0 : (format "%s is remapped to %s which is on %s"
572 0 : symbol remapped keys)
573 0 : (format "%s is on %s" symbol keys))
574 : ;; If this is the command the user asked about,
575 : ;; and it is not on any key, say so.
576 : ;; For other symbols, its aliases, say nothing
577 : ;; about them unless they are on keys.
578 0 : (if (eq symbol definition)
579 0 : (format "%s is not on any key" symbol)))))
580 0 : (when string
581 0 : (unless (eq symbol definition)
582 0 : (princ ";\n its alias "))
583 0 : (princ string)))))
584 : nil)
585 :
586 : (defun help-key-description (key untranslated)
587 0 : (let ((string (key-description key)))
588 0 : (if (or (not untranslated)
589 0 : (and (eq (aref untranslated 0) ?\e) (not (eq (aref key 0) ?\e))))
590 0 : string
591 0 : (let ((otherstring (key-description untranslated)))
592 0 : (if (equal string otherstring)
593 0 : string
594 0 : (format "%s (translated from %s)" string otherstring))))))
595 :
596 : (defun help--analyze-key (key untranslated)
597 : "Get information about KEY its corresponding UNTRANSLATED events.
598 : Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)."
599 0 : (if (numberp untranslated)
600 0 : (setq untranslated (this-single-command-raw-keys)))
601 0 : (let* ((event (aref key (if (and (symbolp (aref key 0))
602 0 : (> (length key) 1)
603 0 : (consp (aref key 1)))
604 : 1
605 0 : 0)))
606 0 : (modifiers (event-modifiers event))
607 0 : (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
608 0 : (memq 'drag modifiers)) " at that spot" ""))
609 0 : (defn (key-binding key t)))
610 : ;; Handle the case where we faked an entry in "Select and Paste" menu.
611 0 : (when (and (eq defn nil)
612 0 : (stringp (aref key (1- (length key))))
613 0 : (eq (key-binding (substring key 0 -1)) 'yank-menu))
614 0 : (setq defn 'menu-bar-select-yank))
615 : ;; Don't bother user with strings from (e.g.) the select-paste menu.
616 0 : (when (stringp (aref key (1- (length key))))
617 0 : (aset key (1- (length key)) "(any string)"))
618 0 : (when (and untranslated
619 0 : (stringp (aref untranslated (1- (length untranslated)))))
620 0 : (aset untranslated (1- (length untranslated)) "(any string)"))
621 0 : (list
622 : ;; Now describe the key, perhaps as changed.
623 0 : (let ((key-desc (help-key-description key untranslated)))
624 0 : (if (or (null defn) (integerp defn) (equal defn 'undefined))
625 0 : (format "%s%s is undefined" key-desc mouse-msg)
626 0 : (format "%s%s runs the command %S" key-desc mouse-msg defn)))
627 0 : defn event mouse-msg)))
628 :
629 : (defun describe-key-briefly (&optional key insert untranslated)
630 : "Print the name of the function KEY invokes. KEY is a string.
631 : If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
632 : If non-nil, UNTRANSLATED is a vector of the untranslated events.
633 : It can also be a number in which case the untranslated events from
634 : the last key hit are used.
635 :
636 : If KEY is a menu item or a tool-bar button that is disabled, this command
637 : temporarily enables it to allow getting help on disabled items and buttons."
638 : (interactive
639 : ;; Ignore mouse movement events because it's too easy to miss the
640 : ;; message while moving the mouse.
641 0 : (pcase-let ((`(,key ,_up-event) (help-read-key-sequence 'no-mouse-movement)))
642 0 : `(,key ,current-prefix-arg 1)))
643 0 : (princ (car (help--analyze-key key untranslated))
644 0 : (if insert (current-buffer) standard-output)))
645 :
646 : (defun help--key-binding-keymap (key &optional accept-default no-remap position)
647 : "Return a keymap holding a binding for KEY within current keymaps.
648 : The effect of the arguments KEY, ACCEPT-DEFAULT, NO-REMAP and
649 : POSITION is as documented in the function `key-binding'."
650 0 : (let* ((active-maps (current-active-maps t position))
651 : map found)
652 : ;; We loop over active maps like key-binding does.
653 0 : (while (and
654 0 : (not found)
655 0 : (setq map (pop active-maps)))
656 0 : (setq found (lookup-key map key accept-default))
657 0 : (when (integerp found)
658 : ;; The first `found' characters of KEY were found but not the
659 : ;; whole sequence.
660 0 : (setq found nil)))
661 0 : (when found
662 0 : (if (and (symbolp found)
663 0 : (not no-remap)
664 0 : (command-remapping found))
665 : ;; The user might want to know in which map the binding is
666 : ;; found, or in which map the remapping is found. The
667 : ;; default is to show the latter.
668 0 : (help--key-binding-keymap (vector 'remap found))
669 0 : map))))
670 :
671 : (defun help--binding-locus (key position)
672 : "Describe in which keymap KEY is defined.
673 : Return a symbol pointing to that keymap if one exists ; otherwise
674 : return nil. The argument POSITION is as documented in the
675 : function `key-binding'."
676 0 : (let ((map (help--key-binding-keymap key t nil position)))
677 0 : (when map
678 0 : (catch 'found
679 0 : (let ((advertised-syms (nconc
680 0 : (list 'overriding-terminal-local-map
681 0 : 'overriding-local-map)
682 0 : (delq nil
683 0 : (mapcar
684 : (lambda (mode-and-map)
685 0 : (let ((mode (car mode-and-map)))
686 0 : (when (symbol-value mode)
687 0 : (intern-soft
688 0 : (format "%s-map" mode)))))
689 0 : minor-mode-map-alist))
690 0 : (list 'global-map
691 0 : (intern-soft (format "%s-map" major-mode)))))
692 : found)
693 : ;; Look into these advertised symbols first.
694 0 : (dolist (sym advertised-syms)
695 0 : (when (and
696 0 : (boundp sym)
697 0 : (eq map (symbol-value sym)))
698 0 : (throw 'found sym)))
699 : ;; Only look in other symbols otherwise.
700 0 : (mapatoms
701 : (lambda (x)
702 0 : (when (and (boundp x)
703 : ;; Avoid let-bound symbols.
704 0 : (special-variable-p x)
705 0 : (eq (symbol-value x) map))
706 0 : (throw 'found x))))
707 0 : nil)))))
708 :
709 : (defun help-read-key-sequence (&optional no-mouse-movement)
710 : "Reads a key sequence from the user.
711 : Returns a list of the form (KEY UP-EVENT), where KEY is the key
712 : sequence, and UP-EVENT is the up-event that was discarded by
713 : reading KEY, or nil.
714 : If NO-MOUSE-MOVEMENT is non-nil, ignore key sequences starting
715 : with `mouse-movement' events."
716 0 : (let ((enable-disabled-menus-and-buttons t)
717 : (cursor-in-echo-area t)
718 : saved-yank-menu)
719 0 : (unwind-protect
720 0 : (let (key)
721 : ;; If yank-menu is empty, populate it temporarily, so that
722 : ;; "Select and Paste" menu can generate a complete event.
723 0 : (when (null (cdr yank-menu))
724 0 : (setq saved-yank-menu (copy-sequence yank-menu))
725 0 : (menu-bar-update-yank-menu "(any string)" nil))
726 0 : (while
727 0 : (pcase (setq key (read-key-sequence "\
728 0 : Describe the following key, mouse click, or menu item: "))
729 0 : ((and (pred vectorp) (let `(,key0 . ,_) (aref key 0))
730 0 : (guard (symbolp key0)) (let keyname (symbol-name key0)))
731 0 : (if no-mouse-movement
732 0 : (string-match "mouse-movement" keyname)
733 0 : (and (string-match "\\(mouse\\|down\\|click\\|drag\\)"
734 0 : keyname)
735 0 : (not (sit-for (/ double-click-time 1000.0) t)))))))
736 0 : (list
737 0 : key
738 : ;; If KEY is a down-event, read and include the
739 : ;; corresponding up-event. Note that there are also
740 : ;; down-events on scroll bars and mode lines: the actual
741 : ;; event then is in the second element of the vector.
742 0 : (and (vectorp key)
743 0 : (let ((last-idx (1- (length key))))
744 0 : (and (eventp (aref key last-idx))
745 0 : (memq 'down (event-modifiers (aref key last-idx)))))
746 0 : (or (and (eventp (aref key 0))
747 0 : (memq 'down (event-modifiers (aref key 0)))
748 : ;; However, for the C-down-mouse-2 popup
749 : ;; menu, there is no subsequent up-event. In
750 : ;; this case, the up-event is the next
751 : ;; element in the supplied vector.
752 0 : (= (length key) 1))
753 0 : (and (> (length key) 1)
754 0 : (eventp (aref key 1))
755 0 : (memq 'down (event-modifiers (aref key 1)))))
756 0 : (read-event))))
757 : ;; Put yank-menu back as it was, if we changed it.
758 0 : (when saved-yank-menu
759 0 : (setq yank-menu (copy-sequence saved-yank-menu))
760 0 : (fset 'yank-menu (cons 'keymap yank-menu))))))
761 :
762 : (defun describe-key (&optional key untranslated up-event)
763 : "Display documentation of the function invoked by KEY.
764 : KEY can be any kind of a key sequence; it can include keyboard events,
765 : mouse events, and/or menu events. When calling from a program,
766 : pass KEY as a string or a vector.
767 :
768 : If non-nil, UNTRANSLATED is a vector of the corresponding untranslated events.
769 : It can also be a number, in which case the untranslated events from
770 : the last key sequence entered are used.
771 : UP-EVENT is the up-event that was discarded by reading KEY, or nil.
772 :
773 : If KEY is a menu item or a tool-bar button that is disabled, this command
774 : temporarily enables it to allow getting help on disabled items and buttons."
775 : (interactive
776 0 : (pcase-let ((`(,key ,up-event) (help-read-key-sequence)))
777 0 : `(,key ,(prefix-numeric-value current-prefix-arg) ,up-event)))
778 0 : (pcase-let ((`(,brief-desc ,defn ,event ,mouse-msg)
779 0 : (help--analyze-key key untranslated))
780 : (defn-up nil) (defn-up-tricky nil)
781 : (key-locus-up nil) (key-locus-up-tricky nil)
782 : (mouse-1-remapped nil) (mouse-1-tricky nil)
783 : (ev-type nil))
784 0 : (if (or (null defn)
785 0 : (integerp defn)
786 0 : (equal defn 'undefined))
787 0 : (message "%s" brief-desc)
788 0 : (help-setup-xref (list #'describe-function defn)
789 0 : (called-interactively-p 'interactive))
790 : ;; Need to do this before erasing *Help* buffer in case event
791 : ;; is a mouse click in an existing *Help* buffer.
792 0 : (when up-event
793 0 : (setq ev-type (event-basic-type up-event))
794 0 : (let ((sequence (vector up-event)))
795 0 : (when (and (eq ev-type 'mouse-1)
796 0 : mouse-1-click-follows-link
797 0 : (not (eq mouse-1-click-follows-link 'double))
798 0 : (setq mouse-1-remapped
799 0 : (mouse-on-link-p (event-start up-event))))
800 0 : (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link)
801 0 : (> mouse-1-click-follows-link 0)))
802 0 : (cond ((stringp mouse-1-remapped)
803 0 : (setq sequence mouse-1-remapped))
804 0 : ((vectorp mouse-1-remapped)
805 0 : (setcar up-event (elt mouse-1-remapped 0)))
806 0 : (t (setcar up-event 'mouse-2))))
807 0 : (setq defn-up (key-binding sequence nil nil (event-start up-event)))
808 0 : (setq key-locus-up (help--binding-locus sequence (event-start up-event)))
809 0 : (when mouse-1-tricky
810 0 : (setq sequence (vector up-event))
811 0 : (aset sequence 0 'mouse-1)
812 0 : (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))
813 0 : (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event))))))
814 0 : (with-help-window (help-buffer)
815 0 : (princ brief-desc)
816 0 : (let ((key-locus (help--binding-locus key (event-start event))))
817 0 : (when key-locus
818 0 : (princ (format " (found in %s)" key-locus))))
819 0 : (princ ", which is ")
820 0 : (describe-function-1 defn)
821 0 : (when up-event
822 0 : (unless (or (null defn-up)
823 0 : (integerp defn-up)
824 0 : (equal defn-up 'undefined))
825 0 : (princ (format "
826 :
827 : ----------------- up-event %s----------------
828 :
829 : %s%s%s runs the command %S%s, which is "
830 0 : (if mouse-1-tricky "(short click) " "")
831 0 : (key-description (vector up-event))
832 0 : mouse-msg
833 0 : (if mouse-1-remapped
834 0 : " is remapped to <mouse-2>, which" "")
835 0 : defn-up (if key-locus-up
836 0 : (format " (found in %s)" key-locus-up)
837 0 : "")))
838 0 : (describe-function-1 defn-up))
839 0 : (unless (or (null defn-up-tricky)
840 0 : (integerp defn-up-tricky)
841 0 : (eq defn-up-tricky 'undefined))
842 0 : (princ (format "
843 :
844 : ----------------- up-event (long click) ----------------
845 :
846 : Pressing <%S>%s for longer than %d milli-seconds
847 : runs the command %S%s, which is "
848 0 : ev-type mouse-msg
849 0 : mouse-1-click-follows-link
850 0 : defn-up-tricky (if key-locus-up-tricky
851 0 : (format " (found in %s)" key-locus-up-tricky)
852 0 : "")))
853 0 : (describe-function-1 defn-up-tricky)))))))
854 :
855 : (defun describe-mode (&optional buffer)
856 : "Display documentation of current major mode and minor modes.
857 : A brief summary of the minor modes comes first, followed by the
858 : major mode description. This is followed by detailed
859 : descriptions of the minor modes, each on a separate page.
860 :
861 : For this to work correctly for a minor mode, the mode's indicator
862 : variable \(listed in `minor-mode-alist') must also be a function
863 : whose documentation describes the minor mode.
864 :
865 : If called from Lisp with a non-nil BUFFER argument, display
866 : documentation for the major and minor modes of that buffer."
867 : (interactive "@")
868 0 : (unless buffer (setq buffer (current-buffer)))
869 0 : (help-setup-xref (list #'describe-mode buffer)
870 0 : (called-interactively-p 'interactive))
871 : ;; For the sake of help-do-xref and help-xref-go-back,
872 : ;; don't switch buffers before calling `help-buffer'.
873 0 : (with-help-window (help-buffer)
874 0 : (with-current-buffer buffer
875 0 : (let (minor-modes)
876 : ;; Older packages do not register in minor-mode-list but only in
877 : ;; minor-mode-alist.
878 0 : (dolist (x minor-mode-alist)
879 0 : (setq x (car x))
880 0 : (unless (memq x minor-mode-list)
881 0 : (push x minor-mode-list)))
882 : ;; Find enabled minor mode we will want to mention.
883 0 : (dolist (mode minor-mode-list)
884 : ;; Document a minor mode if it is listed in minor-mode-alist,
885 : ;; non-nil, and has a function definition.
886 0 : (let ((fmode (or (get mode :minor-mode-function) mode)))
887 0 : (and (boundp mode) (symbol-value mode)
888 0 : (fboundp fmode)
889 0 : (let ((pretty-minor-mode
890 0 : (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
891 0 : (symbol-name fmode))
892 0 : (capitalize
893 0 : (substring (symbol-name fmode)
894 0 : 0 (match-beginning 0)))
895 0 : fmode)))
896 0 : (push (list fmode pretty-minor-mode
897 0 : (format-mode-line (assq mode minor-mode-alist)))
898 0 : minor-modes)))))
899 0 : (setq minor-modes
900 0 : (sort minor-modes
901 0 : (lambda (a b) (string-lessp (cadr a) (cadr b)))))
902 0 : (when minor-modes
903 0 : (princ "Enabled minor modes:\n")
904 0 : (make-local-variable 'help-button-cache)
905 0 : (with-current-buffer standard-output
906 0 : (dolist (mode minor-modes)
907 0 : (let ((mode-function (nth 0 mode))
908 0 : (pretty-minor-mode (nth 1 mode))
909 0 : (indicator (nth 2 mode)))
910 0 : (save-excursion
911 0 : (goto-char (point-max))
912 0 : (princ "\n\f\n")
913 0 : (push (point-marker) help-button-cache)
914 : ;; Document the minor modes fully.
915 0 : (insert-text-button
916 0 : pretty-minor-mode 'type 'help-function
917 0 : 'help-args (list mode-function)
918 0 : 'button '(t))
919 0 : (princ (format " minor mode (%s):\n"
920 0 : (if (zerop (length indicator))
921 : "no indicator"
922 0 : (format "indicator%s"
923 0 : indicator))))
924 0 : (princ (documentation mode-function)))
925 0 : (insert-button pretty-minor-mode
926 0 : 'action (car help-button-cache)
927 : 'follow-link t
928 0 : 'help-echo "mouse-2, RET: show full information")
929 0 : (newline)))
930 0 : (forward-line -1)
931 0 : (fill-paragraph nil)
932 0 : (forward-line 1))
933 :
934 0 : (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
935 : ;; Document the major mode.
936 0 : (let ((mode mode-name))
937 0 : (with-current-buffer standard-output
938 0 : (let ((start (point)))
939 0 : (insert (format-mode-line mode nil nil buffer))
940 0 : (add-text-properties start (point) '(face bold)))))
941 0 : (princ " mode")
942 0 : (let* ((mode major-mode)
943 0 : (file-name (find-lisp-object-file-name mode nil)))
944 0 : (when file-name
945 0 : (princ (format-message " defined in `%s'"
946 0 : (file-name-nondirectory file-name)))
947 : ;; Make a hyperlink to the library.
948 0 : (with-current-buffer standard-output
949 0 : (save-excursion
950 0 : (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
951 0 : nil t)
952 0 : (help-xref-button 1 'help-function-def mode file-name)))))
953 0 : (princ ":\n")
954 0 : (princ (documentation major-mode)))))
955 : ;; For the sake of IELM and maybe others
956 : nil)
957 :
958 :
959 : (defun describe-minor-mode (minor-mode)
960 : "Display documentation of a minor mode given as MINOR-MODE.
961 : MINOR-MODE can be a minor mode symbol or a minor mode indicator string
962 : appeared on the mode-line."
963 0 : (interactive (list (completing-read
964 : "Minor mode: "
965 0 : (nconc
966 0 : (describe-minor-mode-completion-table-for-symbol)
967 0 : (describe-minor-mode-completion-table-for-indicator)
968 0 : ))))
969 0 : (if (symbolp minor-mode)
970 0 : (setq minor-mode (symbol-name minor-mode)))
971 0 : (let ((symbols (describe-minor-mode-completion-table-for-symbol))
972 0 : (indicators (describe-minor-mode-completion-table-for-indicator)))
973 0 : (cond
974 0 : ((member minor-mode symbols)
975 0 : (describe-minor-mode-from-symbol (intern minor-mode)))
976 0 : ((member minor-mode indicators)
977 0 : (describe-minor-mode-from-indicator minor-mode))
978 : (t
979 0 : (error "No such minor mode: %s" minor-mode)))))
980 :
981 : ;; symbol
982 : (defun describe-minor-mode-completion-table-for-symbol ()
983 : ;; In order to list up all minor modes, minor-mode-list
984 : ;; is used here instead of minor-mode-alist.
985 0 : (delq nil (mapcar 'symbol-name minor-mode-list)))
986 :
987 : (defun describe-minor-mode-from-symbol (symbol)
988 : "Display documentation of a minor mode given as a symbol, SYMBOL"
989 0 : (interactive (list (intern (completing-read
990 : "Minor mode symbol: "
991 0 : (describe-minor-mode-completion-table-for-symbol)))))
992 0 : (if (fboundp symbol)
993 0 : (describe-function symbol)
994 0 : (describe-variable symbol)))
995 :
996 : ;; indicator
997 : (defun describe-minor-mode-completion-table-for-indicator ()
998 0 : (delq nil
999 0 : (mapcar (lambda (x)
1000 0 : (let ((i (format-mode-line x)))
1001 : ;; remove first space if existed
1002 0 : (cond
1003 0 : ((= 0 (length i))
1004 : nil)
1005 0 : ((eq (aref i 0) ?\s)
1006 0 : (substring i 1))
1007 : (t
1008 0 : i))))
1009 0 : minor-mode-alist)))
1010 :
1011 : (defun describe-minor-mode-from-indicator (indicator)
1012 : "Display documentation of a minor mode specified by INDICATOR.
1013 : If you call this function interactively, you can give indicator which
1014 : is currently activated with completion."
1015 0 : (interactive (list
1016 0 : (completing-read
1017 : "Minor mode indicator: "
1018 0 : (describe-minor-mode-completion-table-for-indicator))))
1019 0 : (let ((minor-mode (lookup-minor-mode-from-indicator indicator)))
1020 0 : (if minor-mode
1021 0 : (describe-minor-mode-from-symbol minor-mode)
1022 0 : (error "Cannot find minor mode for `%s'" indicator))))
1023 :
1024 : (defun lookup-minor-mode-from-indicator (indicator)
1025 : "Return a minor mode symbol from its indicator on the mode line."
1026 : ;; remove first space if existed
1027 0 : (if (and (< 0 (length indicator))
1028 0 : (eq (aref indicator 0) ?\s))
1029 0 : (setq indicator (substring indicator 1)))
1030 0 : (let ((minor-modes minor-mode-alist)
1031 : result)
1032 0 : (while minor-modes
1033 0 : (let* ((minor-mode (car (car minor-modes)))
1034 0 : (anindicator (format-mode-line
1035 0 : (car (cdr (car minor-modes))))))
1036 : ;; remove first space if existed
1037 0 : (if (and (stringp anindicator)
1038 0 : (> (length anindicator) 0)
1039 0 : (eq (aref anindicator 0) ?\s))
1040 0 : (setq anindicator (substring anindicator 1)))
1041 0 : (if (equal indicator anindicator)
1042 0 : (setq result minor-mode
1043 0 : minor-modes nil)
1044 0 : (setq minor-modes (cdr minor-modes)))))
1045 0 : result))
1046 :
1047 : ;;; Automatic resizing of temporary buffers.
1048 : (defcustom temp-buffer-max-height
1049 : (lambda (buffer)
1050 : (if (and (display-graphic-p) (eq (selected-window) (frame-root-window)))
1051 : (/ (x-display-pixel-height) (frame-char-height) 2)
1052 : (/ (- (frame-height) 2) 2)))
1053 : "Maximum height of a window displaying a temporary buffer.
1054 : This is effective only when Temp Buffer Resize mode is enabled.
1055 : The value is the maximum height (in lines) which
1056 : `resize-temp-buffer-window' will give to a window displaying a
1057 : temporary buffer. It can also be a function to be called to
1058 : choose the height for such a buffer. It gets one argument, the
1059 : buffer, and should return a positive integer. At the time the
1060 : function is called, the window to be resized is selected."
1061 : :type '(choice integer function)
1062 : :group 'help
1063 : :version "24.3")
1064 :
1065 : (defcustom temp-buffer-max-width
1066 : (lambda (buffer)
1067 : (if (and (display-graphic-p) (eq (selected-window) (frame-root-window)))
1068 : (/ (x-display-pixel-width) (frame-char-width) 2)
1069 : (/ (- (frame-width) 2) 2)))
1070 : "Maximum width of a window displaying a temporary buffer.
1071 : This is effective only when Temp Buffer Resize mode is enabled.
1072 : The value is the maximum width (in columns) which
1073 : `resize-temp-buffer-window' will give to a window displaying a
1074 : temporary buffer. It can also be a function to be called to
1075 : choose the width for such a buffer. It gets one argument, the
1076 : buffer, and should return a positive integer. At the time the
1077 : function is called, the window to be resized is selected."
1078 : :type '(choice integer function)
1079 : :group 'help
1080 : :version "24.4")
1081 :
1082 : (define-minor-mode temp-buffer-resize-mode
1083 : "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
1084 : With a prefix argument ARG, enable Temp Buffer Resize mode if ARG
1085 : is positive, and disable it otherwise. If called from Lisp,
1086 : enable the mode if ARG is omitted or nil.
1087 :
1088 : When Temp Buffer Resize mode is enabled, the windows in which we
1089 : show a temporary buffer are automatically resized in height to
1090 : fit the buffer's contents, but never more than
1091 : `temp-buffer-max-height' nor less than `window-min-height'.
1092 :
1093 : A window is resized only if it has been specially created for the
1094 : buffer. Windows that have shown another buffer before are not
1095 : resized. A frame is resized only if `fit-frame-to-buffer' is
1096 : non-nil.
1097 :
1098 : This mode is used by `help', `apropos' and `completion' buffers,
1099 : and some others."
1100 : :global t :group 'help
1101 0 : (if temp-buffer-resize-mode
1102 : ;; `help-make-xrefs' may add a `back' button and thus increase the
1103 : ;; text size, so `resize-temp-buffer-window' must be run *after* it.
1104 0 : (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
1105 0 : (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
1106 :
1107 : (defun resize-temp-buffer-window (&optional window)
1108 : "Resize WINDOW to fit its contents.
1109 : WINDOW must be a live window and defaults to the selected one.
1110 : Do not resize if WINDOW was not created by `display-buffer'.
1111 :
1112 : If WINDOW is part of a vertical combination, restrain its new
1113 : size by `temp-buffer-max-height' and do not resize if its minimum
1114 : accessible position is scrolled out of view. If WINDOW is part
1115 : of a horizontal combination, restrain its new size by
1116 : `temp-buffer-max-width'. In both cases, the value of the option
1117 : `fit-window-to-buffer-horizontally' can inhibit resizing.
1118 :
1119 : If WINDOW is the root window of its frame, resize the frame
1120 : provided `fit-frame-to-buffer' is non-nil.
1121 :
1122 : This function may call `preserve-window-size' to preserve the
1123 : size of WINDOW."
1124 0 : (setq window (window-normalize-window window t))
1125 0 : (let ((height (if (functionp temp-buffer-max-height)
1126 0 : (with-selected-window window
1127 0 : (funcall temp-buffer-max-height (window-buffer)))
1128 0 : temp-buffer-max-height))
1129 0 : (width (if (functionp temp-buffer-max-width)
1130 0 : (with-selected-window window
1131 0 : (funcall temp-buffer-max-width (window-buffer)))
1132 0 : temp-buffer-max-width))
1133 0 : (quit-cadr (cadr (window-parameter window 'quit-restore))))
1134 : ;; Resize WINDOW iff it was made by `display-buffer'.
1135 0 : (when (or (and (eq quit-cadr 'window)
1136 0 : (or (and (window-combined-p window)
1137 0 : (not (eq fit-window-to-buffer-horizontally
1138 0 : 'only))
1139 0 : (pos-visible-in-window-p (point-min) window))
1140 0 : (and (window-combined-p window t)
1141 0 : fit-window-to-buffer-horizontally)))
1142 0 : (and (eq quit-cadr 'frame)
1143 0 : fit-frame-to-buffer
1144 0 : (eq window (frame-root-window window))))
1145 0 : (fit-window-to-buffer window height nil width nil t))))
1146 :
1147 : ;;; Help windows.
1148 : (defcustom help-window-select nil
1149 : "Non-nil means select help window for viewing.
1150 : Choices are:
1151 :
1152 : never (nil) Select help window only if there is no other window
1153 : on its frame.
1154 :
1155 : other Select help window if and only if it appears on the
1156 : previously selected frame, that frame contains at
1157 : least two other windows and the help window is
1158 : either new or showed a different buffer before.
1159 :
1160 : always (t) Always select the help window.
1161 :
1162 : If this option is non-nil and the help window appears on another
1163 : frame, then give that frame input focus too. Note also that if
1164 : the help window appears on another frame, it may get selected and
1165 : its frame get input focus even if this option is nil.
1166 :
1167 : This option has effect if and only if the help window was created
1168 : by `with-help-window'."
1169 : :type '(choice (const :tag "never (nil)" nil)
1170 : (const :tag "other" other)
1171 : (const :tag "always (t)" t))
1172 : :group 'help
1173 : :version "23.1")
1174 :
1175 : (defcustom help-enable-auto-load t
1176 : "Whether Help commands can perform autoloading.
1177 : If non-nil, whenever \\[describe-function] is called for an
1178 : autoloaded function whose docstring contains any key substitution
1179 : construct (see `substitute-command-keys'), the library is loaded,
1180 : so that the documentation can show the right key bindings."
1181 : :type 'boolean
1182 : :group 'help
1183 : :version "24.3")
1184 :
1185 : (defun help-window-display-message (quit-part window &optional scroll)
1186 : "Display message telling how to quit and scroll help window.
1187 : QUIT-PART is a string telling how to quit the help window WINDOW.
1188 : Optional argument SCROLL non-nil means tell how to scroll WINDOW.
1189 : SCROLL equal `other' means tell how to scroll the \"other\"
1190 : window."
1191 0 : (let ((scroll-part
1192 0 : (cond
1193 : ;; If we don't have QUIT-PART we probably reuse a window
1194 : ;; showing the same buffer so we don't show any message.
1195 0 : ((not quit-part) nil)
1196 0 : ((pos-visible-in-window-p
1197 0 : (with-current-buffer (window-buffer window)
1198 0 : (point-max)) window t)
1199 : ;; Buffer end is at least partially visible, no need to talk
1200 : ;; about scrolling.
1201 : ".")
1202 0 : ((eq scroll 'other)
1203 : ", \\[scroll-other-window] to scroll help.")
1204 0 : (scroll ", \\[scroll-up] to scroll help."))))
1205 0 : (message "%s"
1206 0 : (substitute-command-keys (concat quit-part scroll-part)))))
1207 :
1208 : (defun help-window-setup (window &optional value)
1209 : "Set up help window WINDOW for `with-help-window'.
1210 : WINDOW is the window used for displaying the help buffer.
1211 : Return VALUE."
1212 0 : (let* ((help-buffer (when (window-live-p window)
1213 0 : (window-buffer window)))
1214 0 : (help-setup (when (window-live-p window)
1215 0 : (car (window-parameter window 'quit-restore))))
1216 0 : (frame (window-frame window)))
1217 :
1218 0 : (when help-buffer
1219 : ;; Handle `help-window-point-marker'.
1220 0 : (when (eq (marker-buffer help-window-point-marker) help-buffer)
1221 0 : (set-window-point window help-window-point-marker)
1222 : ;; Reset `help-window-point-marker'.
1223 0 : (set-marker help-window-point-marker nil))
1224 :
1225 : ;; If the help window appears on another frame, select it if
1226 : ;; `help-window-select' is non-nil and give that frame input focus
1227 : ;; too. See also Bug#19012.
1228 0 : (when (and help-window-select
1229 0 : (frame-live-p help-window-old-frame)
1230 0 : (not (eq frame help-window-old-frame)))
1231 0 : (select-window window)
1232 0 : (select-frame-set-input-focus frame))
1233 :
1234 0 : (cond
1235 0 : ((or (eq window (selected-window))
1236 : ;; If the help window is on the selected frame, select
1237 : ;; it if `help-window-select' is t or `help-window-select'
1238 : ;; is 'other, the frame contains at least three windows, and
1239 : ;; the help window did show another buffer before. See also
1240 : ;; Bug#11039.
1241 0 : (and (eq frame (selected-frame))
1242 0 : (or (eq help-window-select t)
1243 0 : (and (eq help-window-select 'other)
1244 0 : (> (length (window-list nil 'no-mini)) 2)
1245 0 : (not (eq help-setup 'same))))
1246 0 : (select-window window)))
1247 : ;; The help window is or gets selected ...
1248 0 : (help-window-display-message
1249 0 : (cond
1250 0 : ((eq help-setup 'window)
1251 : ;; ... and is new, ...
1252 : "Type \"q\" to delete help window")
1253 0 : ((eq help-setup 'frame)
1254 : ;; ... on a new frame, ...
1255 : "Type \"q\" to quit the help frame")
1256 0 : ((eq help-setup 'other)
1257 : ;; ... or displayed some other buffer before.
1258 0 : "Type \"q\" to restore previous buffer"))
1259 0 : window t))
1260 0 : ((and (eq (window-frame window) help-window-old-frame)
1261 0 : (= (length (window-list nil 'no-mini)) 2))
1262 : ;; There are two windows on the help window's frame and the
1263 : ;; other one is the selected one.
1264 0 : (help-window-display-message
1265 0 : (cond
1266 0 : ((eq help-setup 'window)
1267 : "Type \\[delete-other-windows] to delete the help window")
1268 0 : ((eq help-setup 'other)
1269 0 : "Type \"q\" in help window to restore its previous buffer"))
1270 0 : window 'other))
1271 : (t
1272 : ;; The help window is not selected ...
1273 0 : (help-window-display-message
1274 0 : (cond
1275 0 : ((eq help-setup 'window)
1276 : ;; ... and is new, ...
1277 : "Type \"q\" in help window to delete it")
1278 0 : ((eq help-setup 'other)
1279 : ;; ... or displayed some other buffer before.
1280 0 : "Type \"q\" in help window to restore previous buffer"))
1281 0 : window))))
1282 : ;; Return VALUE.
1283 0 : value))
1284 :
1285 : ;; `with-help-window' is a wrapper for `with-temp-buffer-window'
1286 : ;; providing the following additional twists:
1287 :
1288 : ;; (1) It puts the buffer in `help-mode' (via `help-mode-setup') and
1289 : ;; adds cross references (via `help-mode-finish').
1290 :
1291 : ;; (2) It issues a message telling how to scroll and quit the help
1292 : ;; window (via `help-window-setup').
1293 :
1294 : ;; (3) An option (customizable via `help-window-select') to select the
1295 : ;; help window automatically.
1296 :
1297 : ;; (4) A marker (`help-window-point-marker') to move point in the help
1298 : ;; window to an arbitrary buffer position.
1299 : (defmacro with-help-window (buffer-name &rest body)
1300 : "Display buffer named BUFFER-NAME in a help window.
1301 : Evaluate the forms in BODY with standard output bound to a buffer
1302 : called BUFFER-NAME (creating it if it does not exist), put that
1303 : buffer in `help-mode', display the buffer in a window (see
1304 : `with-temp-buffer-window' for details) and issue a message how to
1305 : deal with that \"help\" window when it's no more needed. Select
1306 : the help window if the current value of the user option
1307 : `help-window-select' says so. Return last value in BODY."
1308 : (declare (indent 1) (debug t))
1309 3 : `(progn
1310 : ;; Make `help-window-point-marker' point nowhere. The only place
1311 : ;; where this should be set to a buffer position is within BODY.
1312 : (set-marker help-window-point-marker nil)
1313 : (let ((temp-buffer-window-setup-hook
1314 : (cons 'help-mode-setup temp-buffer-window-setup-hook))
1315 : (temp-buffer-window-show-hook
1316 : (cons 'help-mode-finish temp-buffer-window-show-hook)))
1317 : (setq help-window-old-frame (selected-frame))
1318 : (with-temp-buffer-window
1319 3 : ,buffer-name nil 'help-window-setup (progn ,@body)))))
1320 :
1321 : ;; Called from C, on encountering `help-char' when reading a char.
1322 : ;; Don't print to *Help*; that would clobber Help history.
1323 : (defun help-form-show ()
1324 : "Display the output of a non-nil `help-form'."
1325 0 : (let ((msg (eval help-form)))
1326 0 : (if (stringp msg)
1327 0 : (with-output-to-temp-buffer " *Char Help*"
1328 0 : (princ msg)))))
1329 :
1330 :
1331 : (defun help--docstring-quote (string)
1332 : "Return a doc string that represents STRING.
1333 : The result, when formatted by `substitute-command-keys', should equal STRING."
1334 42 : (replace-regexp-in-string "['\\`‘’]" "\\\\=\\&" string))
1335 :
1336 : ;; The following functions used to be in help-fns.el, which is not preloaded.
1337 : ;; But for various reasons, they are more widely needed, so they were
1338 : ;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001
1339 :
1340 : (defun help-split-fundoc (docstring def)
1341 : "Split a function DOCSTRING into the actual doc and the usage info.
1342 : Return (USAGE . DOC) or nil if there's no usage info, where USAGE info
1343 : is a string describing the argument list of DEF, such as
1344 : \"(apply FUNCTION &rest ARGUMENTS)\".
1345 : DEF is the function whose usage we're looking for in DOCSTRING."
1346 : ;; Functions can get the calling sequence at the end of the doc string.
1347 : ;; In cases where `function' has been fset to a subr we can't search for
1348 : ;; function's name in the doc string so we use `fn' as the anonymous
1349 : ;; function name instead.
1350 1 : (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
1351 0 : (let ((doc (unless (zerop (match-beginning 0))
1352 0 : (substring docstring 0 (match-beginning 0))))
1353 0 : (usage-tail (match-string 1 docstring)))
1354 0 : (cons (format "(%s%s"
1355 : ;; Replace `fn' with the actual function name.
1356 0 : (if (symbolp def)
1357 0 : (help--docstring-quote (format "%S" def))
1358 0 : 'anonymous)
1359 0 : usage-tail)
1360 1 : doc))))
1361 :
1362 : (defun help-add-fundoc-usage (docstring arglist)
1363 : "Add the usage info to DOCSTRING.
1364 : If DOCSTRING already has a usage info, then just return it unchanged.
1365 : The usage info is built from ARGLIST. DOCSTRING can be nil.
1366 : ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
1367 42 : (unless (stringp docstring) (setq docstring ""))
1368 42 : (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)
1369 42 : (eq arglist t))
1370 0 : docstring
1371 42 : (concat docstring
1372 42 : (if (string-match "\n?\n\\'" docstring)
1373 2 : (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
1374 42 : "\n\n")
1375 42 : (if (stringp arglist)
1376 23 : (if (string-match "\\`[^ ]+\\(.*\\))\\'" arglist)
1377 23 : (concat "(fn" (match-string 1 arglist) ")")
1378 23 : (error "Unrecognized usage format"))
1379 42 : (help--make-usage-docstring 'fn arglist)))))
1380 :
1381 : (defun help-function-arglist (def &optional preserve-names)
1382 : "Return a formal argument list for the function DEF.
1383 : If PRESERVE-NAMES is non-nil, return a formal arglist that uses
1384 : the same names as used in the original source code, when possible."
1385 : ;; Handle symbols aliased to other symbols.
1386 1 : (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
1387 : ;; Advice wrappers have "catch all" args, so fetch the actual underlying
1388 : ;; function to find the real arguments.
1389 1 : (while (advice--p def) (setq def (advice--cdr def)))
1390 : ;; If definition is a macro, find the function inside it.
1391 1 : (if (eq (car-safe def) 'macro) (setq def (cdr def)))
1392 1 : (cond
1393 1 : ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
1394 1 : ((eq (car-safe def) 'lambda) (nth 1 def))
1395 1 : ((eq (car-safe def) 'closure) (nth 2 def))
1396 1 : ((or (and (byte-code-function-p def) (integerp (aref def 0)))
1397 1 : (subrp def) (module-function-p def))
1398 1 : (or (when preserve-names
1399 1 : (let* ((doc (condition-case nil (documentation def) (error nil)))
1400 1 : (docargs (if doc (car (help-split-fundoc doc nil))))
1401 1 : (arglist (if docargs
1402 1 : (cdar (read-from-string (downcase docargs)))))
1403 : (valid t))
1404 : ;; Check validity.
1405 1 : (dolist (arg arglist)
1406 0 : (unless (and (symbolp arg)
1407 0 : (let ((name (symbol-name arg)))
1408 0 : (if (eq (aref name 0) ?&)
1409 0 : (memq arg '(&rest &optional))
1410 0 : (not (string-match "\\." name)))))
1411 1 : (setq valid nil)))
1412 1 : (when valid arglist)))
1413 1 : (let* ((arity (func-arity def))
1414 1 : (max (cdr arity))
1415 1 : (min (car arity))
1416 : (arglist ()))
1417 1 : (dotimes (i min)
1418 1 : (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
1419 1 : (when (and (integerp max) (> max min))
1420 0 : (push '&optional arglist)
1421 0 : (dotimes (i (- max min))
1422 0 : (push (intern (concat "arg" (number-to-string (+ 1 i min))))
1423 1 : arglist)))
1424 1 : (unless (integerp max) (push '&rest arglist) (push 'rest arglist))
1425 1 : (nreverse arglist))))
1426 0 : ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
1427 : "[Arg list not available until function definition is loaded.]")
1428 1 : (t t)))
1429 :
1430 : (defun help--make-usage (function arglist)
1431 19 : (cons (if (symbolp function) function 'anonymous)
1432 19 : (mapcar (lambda (arg)
1433 43 : (if (not (symbolp arg)) arg
1434 43 : (let ((name (symbol-name arg)))
1435 43 : (cond
1436 43 : ((string-match "\\`&" name) arg)
1437 37 : ((string-match "\\`_." name)
1438 7 : (intern (upcase (substring name 1))))
1439 43 : (t (intern (upcase name)))))))
1440 19 : arglist)))
1441 :
1442 : (define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1")
1443 :
1444 : (defun help--make-usage-docstring (fn arglist)
1445 19 : (let ((print-escape-newlines t))
1446 19 : (help--docstring-quote (format "%S" (help--make-usage fn arglist)))))
1447 :
1448 :
1449 : (provide 'help)
1450 :
1451 : ;;; help.el ends here
|