Merge changes from emacs-23 branch.
[bpt/emacs.git] / lisp / help.el
CommitLineData
1a06eabd
ER
1;;; help.el --- help commands for Emacs
2
0d30b337 3;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002,
114f9c96 4;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
3a801d0c 5
e5167999 6;; Maintainer: FSF
fd7fa35a 7;; Keywords: help, internal
bd78fa1d 8;; Package: emacs
e5167999 9
433ae6f6
RS
10;; This file is part of GNU Emacs.
11
eb3fa2cf 12;; GNU Emacs is free software: you can redistribute it and/or modify
433ae6f6 13;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
433ae6f6
RS
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
eb3fa2cf 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
433ae6f6 24
d9ecc911
ER
25;;; Commentary:
26
a1c9f209 27;; This code implements GNU Emacs' on-line help system, the one invoked by
95ac0a6f 28;; `M-x help-for-help'.
d9ecc911 29
e5167999
ER
30;;; Code:
31
8aa3a187
RS
32;; Get the macro make-help-screen when this is compiled,
33;; or run interpreted, but not when the compiled code is loaded.
b1fe9304 34(eval-when-compile (require 'help-macro))
788d62cf
MB
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)
41b8542b 39
cde56121
MR
40;; The variable `help-window' below is used by `help-mode-finish' to
41;; communicate the window displaying help (the "help window") to the
42;; macro `with-help-window'. The latter sets `help-window' to t before
43;; invoking `with-output-to-temp-buffer'. If and only if `help-window'
44;; is eq to t, `help-mode-finish' (called by `temp-buffer-setup-hook')
45;; sets `help-window' to the window selected by `display-buffer'.
b3d8e4a0 46;; Exiting `with-help-window' and calling `help-print-return-message'
cde56121
MR
47;; reset `help-window' to nil.
48(defvar help-window nil
49 "Window chosen for displaying help.")
50
51;; `help-window-point-marker' is a marker you can move to a valid
52;; position of the buffer shown in the help window in order to override
53;; the standard positioning mechanism (`point-min') chosen by
54;; `with-output-to-temp-buffer'. `with-help-window' has this point
55;; nowhere before exiting. Currently used by `view-lossage' to assert
56;; that the last keystrokes are always visible.
7b01c8d7 57(defvar help-window-point-marker (make-marker)
cde56121
MR
58 "Marker to override default `window-point' of `help-window'.")
59
604aa5f0
SM
60(defvar help-map
61 (let ((map (make-sparse-keymap)))
62 (define-key map (char-to-string help-char) 'help-for-help)
63 (define-key map [help] 'help-for-help)
64 (define-key map [f1] 'help-for-help)
65 (define-key map "." 'display-local-help)
66 (define-key map "?" 'help-for-help)
67
d4a18332 68 (define-key map "\C-a" 'about-emacs)
604aa5f0 69 (define-key map "\C-c" 'describe-copying)
7b01c8d7
KS
70 (define-key map "\C-d" 'view-emacs-debugging)
71 (define-key map "\C-e" 'view-external-packages)
604aa5f0
SM
72 (define-key map "\C-f" 'view-emacs-FAQ)
73 (define-key map "\C-m" 'view-order-manuals)
74 (define-key map "\C-n" 'view-emacs-news)
7b01c8d7
KS
75 (define-key map "\C-o" 'describe-distribution)
76 (define-key map "\C-p" 'view-emacs-problems)
77 (define-key map "\C-t" 'view-emacs-todo)
604aa5f0
SM
78 (define-key map "\C-w" 'describe-no-warranty)
79
80 ;; This does not fit the pattern, but it is natural given the C-\ command.
81 (define-key map "\C-\\" 'describe-input-method)
82
83 (define-key map "C" 'describe-coding-system)
84 (define-key map "F" 'Info-goto-emacs-command-node)
85 (define-key map "I" 'describe-input-method)
86 (define-key map "K" 'Info-goto-emacs-key-command-node)
87 (define-key map "L" 'describe-language-environment)
88 (define-key map "S" 'info-lookup-symbol)
89
90 (define-key map "a" 'apropos-command)
91 (define-key map "b" 'describe-bindings)
92 (define-key map "c" 'describe-key-briefly)
93 (define-key map "d" 'apropos-documentation)
94 (define-key map "e" 'view-echo-area-messages)
95 (define-key map "f" 'describe-function)
7b01c8d7 96 (define-key map "g" 'describe-gnu-project)
604aa5f0
SM
97 (define-key map "h" 'view-hello-file)
98
99 (define-key map "i" 'info)
100 (define-key map "4i" 'info-other-window)
101
102 (define-key map "k" 'describe-key)
103 (define-key map "l" 'view-lossage)
104 (define-key map "m" 'describe-mode)
105 (define-key map "n" 'view-emacs-news)
106 (define-key map "p" 'finder-by-keyword)
cb6c4991 107 (define-key map "P" 'describe-package)
604aa5f0
SM
108 (define-key map "r" 'info-emacs-manual)
109 (define-key map "s" 'describe-syntax)
110 (define-key map "t" 'help-with-tutorial)
111 (define-key map "w" 'where-is)
112 (define-key map "v" 'describe-variable)
113 (define-key map "q" 'help-quit)
114 map)
433ae6f6
RS
115 "Keymap for characters following the Help key.")
116
e17d2fd1 117(define-key global-map (char-to-string help-char) 'help-command)
0af3df1c
RS
118(define-key global-map [help] 'help-command)
119(define-key global-map [f1] 'help-command)
433ae6f6
RS
120(fset 'help-command help-map)
121
3e9c095d
RS
122(autoload 'finder-by-keyword "finder"
123 "Find packages matching a given keyword." t)
06b98c51 124
e25e90b4
DP
125;; insert-button makes the action nil if it is not store somewhere
126(defvar help-button-cache nil)
127
0cf0d828 128\f
2fc9d9f4 129(defun help-quit ()
3120a677 130 "Just exit from the Help command's command loop."
2fc9d9f4
RS
131 (interactive)
132 nil)
133
01364a75
RS
134(defvar help-return-method nil
135 "What to do to \"exit\" the help buffer.
136This is a list
a8e7142c
EZ
137 (WINDOW . t) delete the selected window (and possibly its frame,
138 see `quit-window' and `View-quit'), go to WINDOW.
01364a75
RS
139 (WINDOW . quit-window) do quit-window, then select WINDOW.
140 (WINDOW BUF START POINT) display BUF at START, POINT, then select WINDOW.")
141
b3d8e4a0
SM
142(define-obsolete-function-alias 'print-help-return-message 'help-print-return-message "23.2")
143(defun help-print-return-message (&optional function)
433ae6f6 144 "Display or return message saying how to restore windows after help command.
d009b6e9
RS
145This function assumes that `standard-output' is the help buffer.
146It computes a message, and applies the optional argument FUNCTION to it.
a8e7142c
EZ
147If FUNCTION is nil, it applies `message', thus displaying the message.
148In addition, this function sets up `help-return-method', which see, that
149specifies what to do when the user exits the help buffer."
cde56121
MR
150 ;; Reset `help-window' here to avoid confusing `help-mode-finish'.
151 (setq help-window nil)
433ae6f6 152 (and (not (get-buffer-window standard-output))
d536293f 153 (let ((first-message
a8e7142c
EZ
154 (cond ((or
155 pop-up-frames
156 (special-display-p (buffer-name standard-output)))
01364a75 157 (setq help-return-method (cons (selected-window) t))
d536293f
RS
158 ;; If the help output buffer is a special display buffer,
159 ;; don't say anything about how to get rid of it.
160 ;; First of all, the user will do that with the window
161 ;; manager, not with Emacs.
162 ;; Secondly, the buffer has not been displayed yet,
163 ;; so we don't know whether its frame will be selected.
d536293f 164 nil)
f3ad2fc8
GM
165 (display-buffer-reuse-frames
166 (setq help-return-method (cons (selected-window)
167 'quit-window))
168 nil)
d536293f 169 ((not (one-window-p t))
01364a75
RS
170 (setq help-return-method
171 (cons (selected-window) 'quit-window))
cb0b6766 172 "Type \\[display-buffer] RET to restore the other window.")
d536293f 173 (pop-up-windows
01364a75 174 (setq help-return-method (cons (selected-window) t))
d536293f
RS
175 "Type \\[delete-other-windows] to remove help window.")
176 (t
01364a75
RS
177 (setq help-return-method
178 (list (selected-window) (window-buffer)
179 (window-start) (window-point)))
d536293f
RS
180 "Type \\[switch-to-buffer] RET to remove help window."))))
181 (funcall (or function 'message)
182 (concat
183 (if first-message
376b2a24
DL
184 (substitute-command-keys first-message))
185 (if first-message " ")
125a8d70
RS
186 ;; If the help buffer will go in a separate frame,
187 ;; it's no use mentioning a command to scroll, so don't.
7b057a3d
EZ
188 (if (or pop-up-windows
189 (special-display-p (buffer-name standard-output)))
125a8d70 190 nil
a1c9f209 191 (if (same-window-p (buffer-name standard-output))
125a8d70
RS
192 ;; Say how to scroll this window.
193 (substitute-command-keys
194 "\\[scroll-up] to scroll the help.")
195 ;; Say how to scroll some other window.
6e7f5182 196 (substitute-command-keys
125a8d70 197 "\\[scroll-other-window] to scroll the help."))))))))
433ae6f6 198
433ae6f6
RS
199;; So keyboard macro definitions are documented correctly
200(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
201
a4bdcdf3
RS
202(defalias 'help 'help-for-help-internal)
203;; find-function can find this.
204(defalias 'help-for-help 'help-for-help-internal)
205;; It can't find this, but nobody will look.
206(make-help-screen help-for-help-internal
9cd39aff 207 (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?")
ce9a0ccb
SM
208 ;; Don't purecopy this one, because it's not evaluated (it's
209 ;; directly used as a docstring in a function definition, so it'll
210 ;; be moved to the DOC file anyway: no need for purecopying it).
788d62cf
MB
211 "You have typed %THIS-KEY%, the help character. Type a Help option:
212\(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.)
213
7b01c8d7
KS
214a PATTERN Show commands whose name matches the PATTERN (a list of words
215 or a regexp). See also the `apropos' command.
216b Display all key bindings.
217c KEYS Display the command name run by the given key sequence.
218C CODING Describe the given coding system, or RET for current ones.
219d PATTERN Show a list of functions, variables, and other items whose
220 documentation matches the PATTERN (a list of words or a regexp).
221e Go to the *Messages* buffer which logs echo-area messages.
222f FUNCTION Display documentation for the given function.
223F COMMAND Show the on-line manual's section that describes the command.
224g Display information about the GNU project.
225h Display the HELLO file which illustrates various scripts.
226i Start the Info documentation reader: read on-line manuals.
227I METHOD Describe a specific input method, or RET for current.
228k KEYS Display the full documentation for the key sequence.
229K KEYS Show the on-line manual's section for the command bound to KEYS.
90ad3541 230l Show last 300 input keystrokes (lossage).
7b01c8d7
KS
231L LANG-ENV Describes a specific language environment, or RET for current.
232m Display documentation of current minor modes and current major mode,
233 including their special commands.
234n Display news of recent Emacs changes.
235p TOPIC Find packages matching a given topic keyword.
236r Display the Emacs manual in Info mode.
237s Display contents of current syntax table, plus explanations.
238S SYMBOL Show the section for the given symbol in the on-line manual
239 for the programming language used in this buffer.
240t Start the Emacs learn-by-doing tutorial.
241v VARIABLE Display the given variable's documentation and value.
242w COMMAND Display which keystrokes invoke the given command (where-is).
243. Display any available local help at point in the echo area.
244
245C-a Information about Emacs.
246C-c Emacs copying permission (GNU General Public License).
247C-d Instructions for debugging GNU Emacs.
248C-e External packages and information about Emacs.
249C-f Emacs FAQ.
250C-m How to order printed Emacs manuals.
251C-n News of recent Emacs changes.
252C-o Emacs ordering and distribution information.
253C-p Info about known Emacs problems.
254C-t Emacs TODO list.
ce9a0ccb 255C-w Information on absence of warranty for GNU Emacs."
788d62cf
MB
256 help-map)
257
258\f
259
260(defun function-called-at-point ()
261 "Return a function around point or else called by the list containing point.
262If that doesn't give a function, return nil."
2e6750c8
SM
263 (with-syntax-table emacs-lisp-mode-syntax-table
264 (or (condition-case ()
265 (save-excursion
266 (or (not (zerop (skip-syntax-backward "_w")))
267 (eq (char-syntax (following-char)) ?w)
268 (eq (char-syntax (following-char)) ?_)
269 (forward-sexp -1))
270 (skip-chars-forward "'")
271 (let ((obj (read (current-buffer))))
272 (and (symbolp obj) (fboundp obj) obj)))
273 (error nil))
274 (condition-case ()
275 (save-excursion
276 (save-restriction
277 (narrow-to-region (max (point-min)
278 (- (point) 1000)) (point-max))
279 ;; Move up to surrounding paren, then after the open.
280 (backward-up-list 1)
281 (forward-char 1)
282 ;; If there is space here, this is probably something
283 ;; other than a real Lisp function call, so ignore it.
284 (if (looking-at "[ \t]")
285 (error "Probably not a Lisp function call"))
286 (let ((obj (read (current-buffer))))
287 (and (symbolp obj) (fboundp obj) obj))))
288 (error nil))
289 (let* ((str (find-tag-default))
290 (sym (if str (intern-soft str))))
291 (if (and sym (fboundp sym))
292 sym
293 (save-match-data
294 (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
295 (setq sym (intern-soft (match-string 1 str)))
296 (and (fboundp sym) sym))))))))
788d62cf
MB
297
298\f
299;;; `User' help functions
300
7b01c8d7
KS
301(defun view-help-file (file &optional dir)
302 (view-file (expand-file-name file (or dir data-directory)))
3ffb948c 303 (goto-address-mode 1)
7b01c8d7
KS
304 (goto-char (point-min)))
305
433ae6f6
RS
306(defun describe-distribution ()
307 "Display info on how to obtain the latest version of GNU Emacs."
308 (interactive)
7b01c8d7 309 (view-help-file "DISTRIB"))
433ae6f6
RS
310
311(defun describe-copying ()
312 "Display info on how you may redistribute copies of GNU Emacs."
313 (interactive)
7b01c8d7 314 (view-help-file "COPYING"))
433ae6f6 315
7b01c8d7 316(defun describe-gnu-project ()
76766f2d
RS
317 "Display info on the GNU project."
318 (interactive)
7b01c8d7 319 (view-help-file "THE-GNU-PROJECT"))
76766f2d 320
4e44f5ce
KS
321(define-obsolete-function-alias 'describe-project 'describe-gnu-project "22.2")
322
433ae6f6
RS
323(defun describe-no-warranty ()
324 "Display info on all the kinds of warranty Emacs does NOT have."
325 (interactive)
326 (describe-copying)
327 (let (case-fold-search)
e7e2b26c
GM
328 (search-forward "Disclaimer of Warranty")
329 (forward-line 0)
433ae6f6
RS
330 (recenter 0)))
331
61c6b658 332(defun describe-prefix-bindings ()
c7cba9cb
RS
333 "Describe the bindings of the prefix used to reach this command.
334The prefix described consists of all but the last event
335of the key sequence that ran this command."
61c6b658 336 (interactive)
0f101663 337 (let ((key (this-command-keys)))
ccc06dcc
KH
338 (describe-bindings
339 (if (stringp key)
340 (substring key 0 (1- (length key)))
341 (let ((prefix (make-vector (1- (length key)) nil))
342 (i 0))
343 (while (< i (length prefix))
344 (aset prefix i (aref key i))
345 (setq i (1+ i)))
346 prefix)))))
788d62cf 347;; Make C-h after a prefix, when not specifically bound,
c7cba9cb 348;; run describe-prefix-bindings.
61c6b658
RS
349(setq prefix-help-command 'describe-prefix-bindings)
350
e38cc268 351(defun view-emacs-news (&optional version)
382d018a 352 "Display info on recent changes to Emacs.
598ea453 353With argument, display info only for the selected version."
382d018a 354 (interactive "P")
e38cc268
KS
355 (unless version
356 (setq version emacs-major-version))
357 (when (consp version)
358 (let* ((all-versions
359 (let (res)
cc6650af 360 (mapc
e38cc268
KS
361 (lambda (file)
362 (with-temp-buffer
363 (insert-file-contents
364 (expand-file-name file data-directory))
365 (while (re-search-forward
366 (if (member file '("NEWS.18" "NEWS.1-17"))
367 "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
368 "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)
369 (setq res (cons (match-string-no-properties 1) res)))))
370 (cons "NEWS"
371 (directory-files data-directory nil
372 "^NEWS\\.[0-9][-0-9]*$" nil)))
373 (sort (delete-dups res) (lambda (a b) (string< b a)))))
8c9fc4be 374 (current (car all-versions)))
e38cc268
KS
375 (setq version (completing-read
376 (format "Read NEWS for the version (default %s): " current)
377 all-versions nil nil nil nil current))
378 (if (integerp (string-to-number version))
379 (setq version (string-to-number version))
380 (unless (or (member version all-versions)
381 (<= (string-to-number version) (string-to-number current)))
382 (error "No news about version %s" version)))))
383 (when (integerp version)
384 (cond ((<= version 12)
385 (setq version (format "1.%d" version)))
386 ((<= version 18)
387 (setq version (format "%d" version)))
388 ((> version emacs-major-version)
e08b54f2 389 (error "No news about Emacs %d (yet)" version))))
e38cc268
KS
390 (let* ((vn (if (stringp version)
391 (string-to-number version)
392 version))
393 (file (cond
394 ((>= vn emacs-major-version) "NEWS")
395 ((< vn 18) "NEWS.1-17")
8c9fc4be
KS
396 (t (format "NEWS.%d" vn))))
397 res)
e38cc268
KS
398 (view-file (expand-file-name file data-directory))
399 (widen)
400 (goto-char (point-min))
401 (when (stringp version)
402 (when (re-search-forward
403 (concat (if (< vn 19)
404 "Changes in Emacs[ \t]*"
405 "^\* [^0-9\n]*") version "$")
406 nil t)
407 (beginning-of-line)
408 (narrow-to-region
409 (point)
410 (save-excursion
411 (while (and (setq res
412 (re-search-forward
413 (if (< vn 19)
414 "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
415 "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t))
416 (equal (match-string-no-properties 1) version)))
417 (or res (goto-char (point-max)))
418 (beginning-of-line)
419 (point)))))))
420
7b01c8d7 421(defun view-emacs-todo (&optional arg)
1ebc1f01
RS
422 "Display the Emacs TODO list."
423 (interactive "P")
7b01c8d7 424 (view-help-file "TODO"))
1ebc1f01 425
4e44f5ce
KS
426(define-obsolete-function-alias 'view-todo 'view-emacs-todo "22.2")
427
428
4f16ea85
RS
429(defun view-echo-area-messages ()
430 "View the log of recent echo-area messages: the `*Messages*' buffer.
431The number of messages retained in that buffer
432is specified by the variable `message-log-max'."
433 (interactive)
434 (switch-to-buffer (get-buffer-create "*Messages*")))
435
754084bb
GM
436(defun view-order-manuals ()
437 "Display the Emacs ORDERS file."
438 (interactive)
7b01c8d7 439 (view-help-file "ORDERS"))
754084bb 440
7ee71cf1
RS
441(defun view-emacs-FAQ ()
442 "Display the Emacs Frequently Asked Questions (FAQ) file."
443 (interactive)
94ea540b 444 ;; (find-file-read-only (expand-file-name "FAQ" data-directory))
279b772d 445 (info "(efaq)"))
7ee71cf1 446
4cbff657
DL
447(defun view-emacs-problems ()
448 "Display info on known problems with Emacs and possible workarounds."
449 (interactive)
7b01c8d7
KS
450 (view-help-file "PROBLEMS"))
451
452(defun view-emacs-debugging ()
453 "Display info on how to debug Emacs problems."
454 (interactive)
455 (view-help-file "DEBUG"))
456
457(defun view-external-packages ()
458 "Display external packages and information about Emacs."
459 (interactive)
460 (view-help-file "MORE.STUFF"))
4cbff657 461
433ae6f6 462(defun view-lossage ()
6b8d1c72 463 "Display last 300 input keystrokes.
50b57199
EZ
464
465To record all your input on a file, use `open-dribble-file'."
433ae6f6 466 (interactive)
32226619
JB
467 (help-setup-xref (list #'view-lossage)
468 (called-interactively-p 'interactive))
cde56121 469 (with-help-window (help-buffer)
02dfca16
SM
470 (princ (mapconcat (lambda (key)
471 (if (or (integerp key) (symbolp key) (listp key))
472 (single-key-description key)
473 (prin1-to-string key nil)))
298a7c8c
RS
474 (recent-keys)
475 " "))
b0fbf754 476 (with-current-buffer standard-output
433ae6f6
RS
477 (goto-char (point-min))
478 (while (progn (move-to-column 50) (not (eobp)))
e5fe3a6c
JB
479 (when (search-forward " " nil t)
480 (delete-char -1))
cde56121
MR
481 (insert "\n"))
482 ;; jidanni wants to see the last keystrokes immediately.
483 (set-marker help-window-point-marker (point)))))
433ae6f6 484
788d62cf
MB
485\f
486;; Key bindings
433ae6f6 487
4c45295b 488(defun describe-bindings (&optional prefix buffer)
a8ad43aa
RS
489 "Show a list of all defined keys, and their definitions.
490We put that list in a buffer, and display the buffer.
491
492The optional argument PREFIX, if non-nil, should be a key sequence;
4c45295b
KH
493then we display only bindings that start with that prefix.
494The optional argument BUFFER specifies which buffer's bindings
abca4ad7
LT
495to display (default, the current buffer). BUFFER can be a buffer
496or a buffer name."
3e5929af 497 (interactive)
4c45295b 498 (or buffer (setq buffer (current-buffer)))
32226619
JB
499 (help-setup-xref (list #'describe-bindings prefix buffer)
500 (called-interactively-p 'interactive))
4c45295b 501 (with-current-buffer buffer
3e5929af 502 (describe-bindings-internal nil prefix)))
a8ad43aa 503
94ea540b
SM
504;; This function used to be in keymap.c.
505(defun describe-bindings-internal (&optional menus prefix)
506 "Show a list of all defined keys, and their definitions.
507We put that list in a buffer, and display the buffer.
508
509The optional argument MENUS, if non-nil, says to mention menu bindings.
510\(Ordinarily these are omitted from the output.)
511The optional argument PREFIX, if non-nil, should be a key sequence;
512then we display only bindings that start with that prefix."
94ea540b 513 (let ((buf (current-buffer)))
cde56121 514 (with-help-window "*Help*"
94ea540b
SM
515 (with-current-buffer standard-output
516 (describe-buffer-bindings buf prefix menus)))))
517
e88a2c59 518(defun where-is (definition &optional insert)
b2c85790 519 "Print message listing key sequences that invoke the command DEFINITION.
e88a2c59
RS
520Argument is a command definition, usually a symbol with a function definition.
521If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
54c0b967
RS
522 (interactive
523 (let ((fn (function-called-at-point))
788d62cf 524 (enable-recursive-minibuffers t)
54c0b967 525 val)
3829bcc5
SM
526 (setq val (completing-read
527 (if fn
528 (format "Where is command (default %s): " fn)
529 "Where is command: ")
530 obarray 'commandp t))
531 (list (if (equal val "") fn (intern val)) current-prefix-arg)))
463d75ac 532 (unless definition (error "No command"))
7a698dc1 533 (let ((func (indirect-function definition))
3829bcc5 534 (defs nil)
7a698dc1 535 (standard-output (if insert (current-buffer) t)))
740b479c 536 ;; In DEFS, find all symbols that are aliases for DEFINITION.
3829bcc5
SM
537 (mapatoms (lambda (symbol)
538 (and (fboundp symbol)
539 (not (eq symbol definition))
d92c2757
RS
540 (eq func (condition-case ()
541 (indirect-function symbol)
542 (error symbol)))
3829bcc5 543 (push symbol defs))))
740b479c
RS
544 ;; Look at all the symbols--first DEFINITION,
545 ;; then its aliases.
546 (dolist (symbol (cons definition defs))
547 (let* ((remapped (command-remapping symbol))
548 (keys (where-is-internal
549 symbol overriding-local-map nil nil remapped))
550 (keys (mapconcat 'key-description keys ", "))
551 string)
552 (setq string
553 (if insert
554 (if (> (length keys) 0)
555 (if remapped
556 (format "%s (%s) (remapped from %s)"
557 keys remapped symbol)
558 (format "%s (%s)" keys symbol))
559 (format "M-x %s RET" symbol))
560 (if (> (length keys) 0)
561 (if remapped
562 (format "%s is remapped to %s which is on %s"
a5f43550 563 symbol remapped keys)
740b479c
RS
564 (format "%s is on %s" symbol keys))
565 ;; If this is the command the user asked about,
566 ;; and it is not on any key, say so.
567 ;; For other symbols, its aliases, say nothing
568 ;; about them unless they are on keys.
569 (if (eq symbol definition)
570 (format "%s is not on any key" symbol)))))
571 (when string
572 (unless (eq symbol definition)
573 (princ ";\n its alias "))
574 (princ string)))))
54c0b967
RS
575 nil)
576
02dfca16
SM
577(defun help-key-description (key untranslated)
578 (let ((string (key-description key)))
ae1bb8ac
SM
579 (if (or (not untranslated)
580 (and (eq (aref untranslated 0) ?\e) (not (eq (aref key 0) ?\e))))
02dfca16
SM
581 string
582 (let ((otherstring (key-description untranslated)))
583 (if (equal string otherstring)
584 string
585 (format "%s (translated from %s)" string otherstring))))))
71296446 586
6527c983
EZ
587(defun describe-key-briefly (&optional key insert untranslated)
588 "Print the name of the function KEY invokes. KEY is a string.
589If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
590If non-nil, UNTRANSLATED is a vector of the untranslated events.
591It can also be a number in which case the untranslated events from
592the last key hit are used.
593
594If KEY is a menu item or a tool-bar button that is disabled, this command
8ee320fc 595temporarily enables it to allow getting help on disabled items and buttons."
2c8ed538
RS
596 (interactive
597 (let ((enable-disabled-menus-and-buttons t)
598 (cursor-in-echo-area t)
599 saved-yank-menu)
600 (unwind-protect
601 (let (key)
602 ;; If yank-menu is empty, populate it temporarily, so that
603 ;; "Select and Paste" menu can generate a complete event.
604 (when (null (cdr yank-menu))
605 (setq saved-yank-menu (copy-sequence yank-menu))
606 (menu-bar-update-yank-menu "(any string)" nil))
607 (setq key (read-key-sequence "Describe key (or click or menu item): "))
46d91fa0 608 ;; If KEY is a down-event, read and discard the
91a2acb2
DK
609 ;; corresponding up-event. Note that there are also
610 ;; down-events on scroll bars and mode lines: the actual
611 ;; event then is in the second element of the vector.
612 (and (vectorp key)
badf89ea
RS
613 (let ((last-idx (1- (length key))))
614 (and (eventp (aref key last-idx))
615 (memq 'down (event-modifiers (aref key last-idx)))))
91a2acb2 616 (read-event))
2c8ed538
RS
617 (list
618 key
774a814f
RS
619 (if current-prefix-arg (prefix-numeric-value current-prefix-arg))
620 1))
2c8ed538
RS
621 ;; Put yank-menu back as it was, if we changed it.
622 (when saved-yank-menu
623 (setq yank-menu (copy-sequence saved-yank-menu))
624 (fset 'yank-menu (cons 'keymap yank-menu))))))
02dfca16
SM
625 (if (numberp untranslated)
626 (setq untranslated (this-single-command-raw-keys)))
91a2acb2
DK
627 (let* ((event (if (and (symbolp (aref key 0))
628 (> (length key) 1)
629 (consp (aref key 1)))
630 (aref key 1)
631 (aref key 0)))
632 (modifiers (event-modifiers event))
633 (standard-output (if insert (current-buffer) t))
24a27882
KS
634 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
635 (memq 'drag modifiers)) " at that spot" ""))
636 (defn (key-binding key t))
637 key-desc)
638 ;; Handle the case where we faked an entry in "Select and Paste" menu.
639 (if (and (eq defn nil)
640 (stringp (aref key (1- (length key))))
641 (eq (key-binding (substring key 0 -1)) 'yank-menu))
642 (setq defn 'menu-bar-select-yank))
643 ;; Don't bother user with strings from (e.g.) the select-paste menu.
644 (if (stringp (aref key (1- (length key))))
645 (aset key (1- (length key)) "(any string)"))
646 (if (and (> (length untranslated) 0)
647 (stringp (aref untranslated (1- (length untranslated)))))
648 (aset untranslated (1- (length untranslated)) "(any string)"))
649 ;; Now describe the key, perhaps as changed.
650 (setq key-desc (help-key-description key untranslated))
651 (if (or (null defn) (integerp defn) (equal defn 'undefined))
652 (princ (format "%s%s is undefined" key-desc mouse-msg))
653 (princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
96ede6b2 654
6527c983
EZ
655(defun describe-key (&optional key untranslated up-event)
656 "Display documentation of the function invoked by KEY.
657KEY can be any kind of a key sequence; it can include keyboard events,
658mouse events, and/or menu events. When calling from a program,
659pass KEY as a string or a vector.
660
661If non-nil, UNTRANSLATED is a vector of the corresponding untranslated events.
662It can also be a number, in which case the untranslated events from
663the last key sequence entered are used.
664UP-EVENT is the up-event that was discarded by reading KEY, or nil.
665
666If KEY is a menu item or a tool-bar button that is disabled, this command
8ee320fc 667temporarily enables it to allow getting help on disabled items and buttons."
2c8ed538
RS
668 (interactive
669 (let ((enable-disabled-menus-and-buttons t)
670 (cursor-in-echo-area t)
671 saved-yank-menu)
672 (unwind-protect
673 (let (key)
674 ;; If yank-menu is empty, populate it temporarily, so that
675 ;; "Select and Paste" menu can generate a complete event.
676 (when (null (cdr yank-menu))
677 (setq saved-yank-menu (copy-sequence yank-menu))
678 (menu-bar-update-yank-menu "(any string)" nil))
679 (setq key (read-key-sequence "Describe key (or click or menu item): "))
680 (list
681 key
682 (prefix-numeric-value current-prefix-arg)
c3f82997 683 ;; If KEY is a down-event, read and include the
badf89ea
RS
684 ;; corresponding up-event. Note that there are also
685 ;; down-events on scroll bars and mode lines: the actual
686 ;; event then is in the second element of the vector.
91a2acb2 687 (and (vectorp key)
badf89ea
RS
688 (let ((last-idx (1- (length key))))
689 (and (eventp (aref key last-idx))
690 (memq 'down (event-modifiers (aref key last-idx)))))
91a2acb2 691 (or (and (eventp (aref key 0))
98da283b
CY
692 (memq 'down (event-modifiers (aref key 0)))
693 ;; However, for the C-down-mouse-2 popup
694 ;; menu, there is no subsequent up-event. In
695 ;; this case, the up-event is the next
696 ;; element in the supplied vector.
697 (= (length key) 1))
91a2acb2
DK
698 (and (> (length key) 1)
699 (eventp (aref key 1))
700 (memq 'down (event-modifiers (aref key 1)))))
701 (read-event))))
2c8ed538
RS
702 ;; Put yank-menu back as it was, if we changed it.
703 (when saved-yank-menu
704 (setq yank-menu (copy-sequence saved-yank-menu))
705 (fset 'yank-menu (cons 'keymap yank-menu))))))
02dfca16
SM
706 (if (numberp untranslated)
707 (setq untranslated (this-single-command-raw-keys)))
05ca18a8
KS
708 (let* ((event (aref key (if (and (symbolp (aref key 0))
709 (> (length key) 1)
710 (consp (aref key 1)))
711 1
712 0)))
91a2acb2 713 (modifiers (event-modifiers event))
24a27882
KS
714 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
715 (memq 'drag modifiers)) " at that spot" ""))
05ca18a8
KS
716 (defn (key-binding key t))
717 defn-up defn-up-tricky ev-type
718 mouse-1-remapped mouse-1-tricky)
91a2acb2 719
05ca18a8 720 ;; Handle the case where we faked an entry in "Select and Paste" menu.
24a27882 721 (when (and (eq defn nil)
91a2acb2
DK
722 (stringp (aref key (1- (length key))))
723 (eq (key-binding (substring key 0 -1)) 'yank-menu))
24a27882
KS
724 (setq defn 'menu-bar-select-yank))
725 (if (or (null defn) (integerp defn) (equal defn 'undefined))
726 (message "%s%s is undefined"
727 (help-key-description key untranslated) mouse-msg)
32226619
JB
728 (help-setup-xref (list #'describe-function defn)
729 (called-interactively-p 'interactive))
24a27882
KS
730 ;; Don't bother user with strings from (e.g.) the select-paste menu.
731 (when (stringp (aref key (1- (length key))))
732 (aset key (1- (length key)) "(any string)"))
733 (when (and untranslated
91a2acb2 734 (stringp (aref untranslated (1- (length untranslated)))))
24a27882
KS
735 (aset untranslated (1- (length untranslated))
736 "(any string)"))
737 ;; Need to do this before erasing *Help* buffer in case event
738 ;; is a mouse click in an existing *Help* buffer.
739 (when up-event
740 (setq ev-type (event-basic-type up-event))
741 (let ((sequence (vector up-event)))
742 (when (and (eq ev-type 'mouse-1)
743 mouse-1-click-follows-link
744 (not (eq mouse-1-click-follows-link 'double))
745 (setq mouse-1-remapped
746 (mouse-on-link-p (event-start up-event))))
747 (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link)
748 (> mouse-1-click-follows-link 0)))
749 (cond ((stringp mouse-1-remapped)
750 (setq sequence mouse-1-remapped))
751 ((vectorp mouse-1-remapped)
752 (setcar up-event (elt mouse-1-remapped 0)))
753 (t (setcar up-event 'mouse-2))))
754 (setq defn-up (key-binding sequence nil nil (event-start up-event)))
755 (when mouse-1-tricky
756 (setq sequence (vector up-event))
757 (aset sequence 0 'mouse-1)
758 (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))))))
cde56121 759 (with-help-window (help-buffer)
24a27882
KS
760 (princ (help-key-description key untranslated))
761 (princ (format "\
b96817c3 762%s runs the command %S, which is "
24a27882
KS
763 mouse-msg defn))
764 (describe-function-1 defn)
05ca18a8 765 (when up-event
24a27882
KS
766 (unless (or (null defn-up)
767 (integerp defn-up)
768 (equal defn-up 'undefined))
769 (princ (format "
770
771----------------- up-event %s----------------
772
e8579ebc 773%s%s%s runs the command %S, which is "
24a27882 774 (if mouse-1-tricky "(short click) " "")
e8579ebc
CY
775 (key-description (vector up-event))
776 mouse-msg
24a27882 777 (if mouse-1-remapped
b96817c3 778 " is remapped to <mouse-2>, which" "")
24a27882
KS
779 defn-up))
780 (describe-function-1 defn-up))
781 (unless (or (null defn-up-tricky)
782 (integerp defn-up-tricky)
783 (eq defn-up-tricky 'undefined))
784 (princ (format "
785
786----------------- up-event (long click) ----------------
787
788Pressing <%S>%s for longer than %d milli-seconds
b96817c3 789runs the command %S, which is "
24a27882
KS
790 ev-type mouse-msg
791 mouse-1-click-follows-link
792 defn-up-tricky))
cde56121 793 (describe-function-1 defn-up-tricky)))))))
400a1b1f 794\f
788d62cf
MB
795(defun describe-mode (&optional buffer)
796 "Display documentation of current major mode and minor modes.
efde809a
JPW
797A brief summary of the minor modes comes first, followed by the
798major mode description. This is followed by detailed
799descriptions of the minor modes, each on a separate page.
800
801For this to work correctly for a minor mode, the mode's indicator
802variable \(listed in `minor-mode-alist') must also be a function
803whose documentation describes the minor mode."
f3b5dd74 804 (interactive "@")
dd39c336
SM
805 (unless buffer (setq buffer (current-buffer)))
806 (help-setup-xref (list #'describe-mode buffer)
32226619 807 (called-interactively-p 'interactive))
9639be74
RS
808 ;; For the sake of help-do-xref and help-xref-go-back,
809 ;; don't switch buffers before calling `help-buffer'.
cde56121 810 (with-help-window (help-buffer)
dd39c336 811 (with-current-buffer buffer
f6c57ef6 812 (let (minor-modes)
dd39c336
SM
813 ;; Older packages do not register in minor-mode-list but only in
814 ;; minor-mode-alist.
815 (dolist (x minor-mode-alist)
816 (setq x (car x))
817 (unless (memq x minor-mode-list)
818 (push x minor-mode-list)))
f6c57ef6
RS
819 ;; Find enabled minor mode we will want to mention.
820 (dolist (mode minor-mode-list)
821 ;; Document a minor mode if it is listed in minor-mode-alist,
822 ;; non-nil, and has a function definition.
af5f4483
SM
823 (let ((fmode (or (get mode :minor-mode-function) mode)))
824 (and (boundp mode) (symbol-value mode)
825 (fboundp fmode)
826 (let ((pretty-minor-mode
827 (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
828 (symbol-name fmode))
829 (capitalize
830 (substring (symbol-name fmode)
831 0 (match-beginning 0)))
832 fmode)))
833 (push (list fmode pretty-minor-mode
834 (format-mode-line (assq mode minor-mode-alist)))
835 minor-modes)))))
f6c57ef6
RS
836 (setq minor-modes
837 (sort minor-modes
af5f4483 838 (lambda (a b) (string-lessp (cadr a) (cadr b)))))
f6c57ef6 839 (when minor-modes
71723367 840 (princ "Enabled minor modes:\n")
e25e90b4
DP
841 (make-local-variable 'help-button-cache)
842 (with-current-buffer standard-output
843 (dolist (mode minor-modes)
af5f4483
SM
844 (let ((mode-function (nth 0 mode))
845 (pretty-minor-mode (nth 1 mode))
e25e90b4
DP
846 (indicator (nth 2 mode)))
847 (add-text-properties 0 (length pretty-minor-mode)
848 '(face bold) pretty-minor-mode)
849 (save-excursion
850 (goto-char (point-max))
851 (princ "\n\f\n")
852 (push (point-marker) help-button-cache)
853 ;; Document the minor modes fully.
854 (insert pretty-minor-mode)
71723367
RS
855 (princ (format " minor mode (%s):\n"
856 (if (zerop (length indicator))
857 "no indicator"
858 (format "indicator%s"
d8a869ea 859 indicator))))
e25e90b4 860 (princ (documentation mode-function)))
e25e90b4
DP
861 (insert-button pretty-minor-mode
862 'action (car help-button-cache)
72b64ad5 863 'follow-link t
e25e90b4 864 'help-echo "mouse-2, RET: show full information")
71723367
RS
865 (newline)))
866 (forward-line -1)
867 (fill-paragraph nil)
868 (forward-line 1))
869
870 (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
f6c57ef6 871 ;; Document the major mode.
e25e90b4
DP
872 (let ((mode mode-name))
873 (with-current-buffer standard-output
4e6d3170 874 (let ((start (point)))
145fe412 875 (insert (format-mode-line mode nil nil buffer))
4e6d3170 876 (add-text-properties start (point) '(face bold)))))
f6c57ef6 877 (princ " mode:\n")
309d5b43 878 (princ (documentation major-mode)))))
6460e534 879 ;; For the sake of IELM and maybe others
309d5b43 880 nil)
400a1b1f 881
f6c57ef6 882
8e864068 883(defun describe-minor-mode (minor-mode)
335028c3
MY
884 "Display documentation of a minor mode given as MINOR-MODE.
885MINOR-MODE can be a minor mode symbol or a minor mode indicator string
886appeared on the mode-line."
7ada28ac 887 (interactive (list (completing-read
335028c3
MY
888 "Minor mode: "
889 (nconc
890 (describe-minor-mode-completion-table-for-symbol)
891 (describe-minor-mode-completion-table-for-indicator)
892 ))))
893 (if (symbolp minor-mode)
894 (setq minor-mode (symbol-name minor-mode)))
895 (let ((symbols (describe-minor-mode-completion-table-for-symbol))
896 (indicators (describe-minor-mode-completion-table-for-indicator)))
897 (cond
898 ((member minor-mode symbols)
899 (describe-minor-mode-from-symbol (intern minor-mode)))
900 ((member minor-mode indicators)
901 (describe-minor-mode-from-indicator minor-mode))
902 (t
903 (error "No such minor mode: %s" minor-mode)))))
904
7ada28ac 905;; symbol
335028c3
MY
906(defun describe-minor-mode-completion-table-for-symbol ()
907 ;; In order to list up all minor modes, minor-mode-list
908 ;; is used here instead of minor-mode-alist.
909 (delq nil (mapcar 'symbol-name minor-mode-list)))
910(defun describe-minor-mode-from-symbol (symbol)
911 "Display documentation of a minor mode given as a symbol, SYMBOL"
7ada28ac 912 (interactive (list (intern (completing-read
335028c3
MY
913 "Minor mode symbol: "
914 (describe-minor-mode-completion-table-for-symbol)))))
915 (if (fboundp symbol)
916 (describe-function symbol)
917 (describe-variable symbol)))
918
919;; indicator
920(defun describe-minor-mode-completion-table-for-indicator ()
7ada28ac 921 (delq nil
335028c3
MY
922 (mapcar (lambda (x)
923 (let ((i (format-mode-line x)))
924 ;; remove first space if existed
925 (cond
926 ((= 0 (length i))
927 nil)
94318c8a 928 ((eq (aref i 0) ?\s)
335028c3 929 (substring i 1))
7ada28ac 930 (t
335028c3
MY
931 i))))
932 minor-mode-alist)))
8e864068 933(defun describe-minor-mode-from-indicator (indicator)
335028c3
MY
934 "Display documentation of a minor mode specified by INDICATOR.
935If you call this function interactively, you can give indicator which
936is currently activated with completion."
7ada28ac
LT
937 (interactive (list
938 (completing-read
8e864068 939 "Minor mode indicator: "
335028c3 940 (describe-minor-mode-completion-table-for-indicator))))
8e864068
JB
941 (let ((minor-mode (lookup-minor-mode-from-indicator indicator)))
942 (if minor-mode
335028c3 943 (describe-minor-mode-from-symbol minor-mode)
8e864068
JB
944 (error "Cannot find minor mode for `%s'" indicator))))
945
946(defun lookup-minor-mode-from-indicator (indicator)
947 "Return a minor mode symbol from its indicator on the modeline."
335028c3 948 ;; remove first space if existed
7ada28ac 949 (if (and (< 0 (length indicator))
94318c8a 950 (eq (aref indicator 0) ?\s))
335028c3 951 (setq indicator (substring indicator 1)))
8e864068
JB
952 (let ((minor-modes minor-mode-alist)
953 result)
954 (while minor-modes
955 (let* ((minor-mode (car (car minor-modes)))
7ada28ac 956 (anindicator (format-mode-line
335028c3
MY
957 (car (cdr (car minor-modes))))))
958 ;; remove first space if existed
7ada28ac 959 (if (and (stringp anindicator)
335028c3 960 (> (length anindicator) 0)
94318c8a 961 (eq (aref anindicator 0) ?\s))
335028c3
MY
962 (setq anindicator (substring anindicator 1)))
963 (if (equal indicator anindicator)
8e864068
JB
964 (setq result minor-mode
965 minor-modes nil)
966 (setq minor-modes (cdr minor-modes)))))
967 result))
968
48ce3c22
RS
969\f
970;;; Automatic resizing of temporary buffers.
971
4483ddc5 972(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
4e6d3170 973 "Maximum height of a window displaying a temporary buffer.
90e357ae
RS
974This is effective only when Temp Buffer Resize mode is enabled.
975The value is the maximum height (in lines) which `resize-temp-buffer-window'
48ce3c22 976will give to a window displaying a temporary buffer.
90e357ae
RS
977It can also be a function to be called to choose the height for such a buffer.
978It gets one argumemt, the buffer, and should return a positive integer."
48ce3c22
RS
979 :type '(choice integer function)
980 :group 'help
981 :version "20.4")
982
4e1ede6c
SM
983(define-minor-mode temp-buffer-resize-mode
984 "Toggle the mode which makes windows smaller for temporary buffers.
48ce3c22
RS
985With prefix argument ARG, turn the resizing of windows displaying temporary
986buffers on if ARG is positive or off otherwise.
4e1ede6c
SM
987This makes the window the right height for its contents, but never
988more than `temp-buffer-max-height' nor less than `window-min-height'.
989This applies to `help', `apropos' and `completion' buffers, and some others."
b0fbf754 990 :global t :group 'help
4e1ede6c 991 (if temp-buffer-resize-mode
57f43907 992 ;; `help-make-xrefs' may add a `back' button and thus increase the
4e1ede6c
SM
993 ;; text size, so `resize-temp-buffer-window' must be run *after* it.
994 (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
8304a3bb 995 (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
48ce3c22
RS
996
997(defun resize-temp-buffer-window ()
2a5f11a2 998 "Resize the selected window to fit its contents.
4483ddc5 999Will not make it higher than `temp-buffer-max-height' nor smaller than
b2c85790 1000`window-min-height'. Do nothing if it is the only window on its frame, if it
48ce3c22
RS
1001is not as wide as the frame or if some of the window's contents are scrolled
1002out of view."
1003 (unless (or (one-window-p 'nomini)
1004 (not (pos-visible-in-window-p (point-min)))
2a5f11a2 1005 (not (window-full-width-p)))
d9c30bdf
MB
1006 (fit-window-to-buffer
1007 (selected-window)
1008 (if (functionp temp-buffer-max-height)
1009 (funcall temp-buffer-max-height (current-buffer))
1010 temp-buffer-max-height))))
48ce3c22 1011
172892e3 1012\f
cde56121
MR
1013;;; help-window
1014
1015(defcustom help-window-select 'other
1016 "Non-nil means select help window for viewing.
1017Choices are:
1018 never (nil) Select help window only if there is no other window
1019 on its frame.
1020 other Select help window unless the selected window is the
1021 only other window on its frame.
1022 always (t) Always select the help window.
1023
1024This option has effect if and only if the help window was created
1025by `with-help-window'"
1026 :type '(choice (const :tag "never (nil)" nil)
1027 (const :tag "other" other)
1028 (const :tag "always (t)" t))
1029 :group 'help
1030 :version "23.1")
1031
1032(defun help-window-display-message (quit-part window &optional other)
1033 "Display message telling how to quit and scroll help window.
1034QUIT-PART is a string telling how to quit the help window WINDOW.
1035Optional argument OTHER non-nil means return text telling how to
1036scroll the \"other\" window."
1037 (let ((scroll-part
1038 (cond
1039 ((pos-visible-in-window-p
1040 (with-current-buffer (window-buffer window)
1041 (point-max)) window)
1042 ;; Buffer end is visible.
1043 ".")
1044 (other ", \\[scroll-other-window] to scroll help.")
1045 (t ", \\[scroll-up] to scroll help."))))
f6e7ec02 1046 (message "%s"
cde56121
MR
1047 (substitute-command-keys (concat quit-part scroll-part)))))
1048
1049(defun help-window-setup-finish (window &optional reuse keep-frame)
1050 "Finish setting up help window WINDOW.
1051Select WINDOW according to the value of `help-window-select'.
1052Display message telling how to scroll and eventually quit WINDOW.
1053
6baa27a2
CY
1054Optional argument REUSE non-nil means WINDOW has been reused by
1055`display-buffer'. Optional argument KEEP-FRAME non-nil means
1056that quitting should not delete WINDOW's frame."
cde56121
MR
1057 (let ((number-of-windows
1058 (length (window-list (window-frame window) 'no-mini window))))
1059 (cond
1060 ((eq window (selected-window))
1061 ;; The help window is the selected window, probably the
1062 ;; `pop-up-windows' nil case.
1063 (help-window-display-message
1064 (if reuse
1065 "Type \"q\" to restore this window"
1066 ;; This should not be taken.
1067 "Type \"q\" to quit") window))
1068 ((= number-of-windows 1)
1069 ;; The help window is alone on a frame and not the selected
1070 ;; window, could be the `pop-up-frames' t case.
1071 (help-window-display-message
1072 (cond
1073 (keep-frame "Type \"q\" to delete this window")
1074 (reuse "Type \"q\" to restore this window")
1075 (view-remove-frame-by-deleting "Type \"q\" to delete this frame")
1076 (t "Type \"q\" to iconify this frame"))
1077 window))
1078 ((and (= number-of-windows 2)
1079 (eq (window-frame window) (window-frame (selected-window))))
1080 ;; There are two windows on the help window's frame and the other
1081 ;; window is the selected one.
1082 (if (memq help-window-select '(nil other))
1083 ;; Do not select the help window.
1084 (help-window-display-message
1085 (if reuse
1086 ;; Offer `display-buffer' for consistency with
b3d8e4a0 1087 ;; `help-print-return-message'. This is hardly TRT when
cde56121
MR
1088 ;; the other window and the selected window display the
1089 ;; same buffer but has been handled this way ever since.
1090 "Type \\[display-buffer] RET to restore the other window"
1091 ;; The classic "two windows" configuration.
1092 "Type \\[delete-other-windows] to delete the help window")
1093 window t)
1094 ;; Select help window and tell how to quit.
1095 (select-window window)
1096 (help-window-display-message
1097 (if reuse
1098 "Type \"q\" to restore this window"
1099 "Type \"q\" to delete this window") window)))
1100 (help-window-select
1101 ;; Issuing a message with 3 or more windows on the same frame
1102 ;; without selecting the help window doesn't make any sense.
1103 (select-window window)
1104 (help-window-display-message
1105 (if reuse
1106 "Type \"q\" to restore this window"
1107 "Type \"q\" to delete this window") window)))))
1108
1109(defun help-window-setup (list-of-frames list-of-window-tuples)
1110 "Set up help window.
1111LIST-OF-FRAMES and LIST-OF-WINDOW-TUPLES are the lists of frames
1112and window quadruples built by `with-help-window'. The help
1113window itself is specified by the variable `help-window'."
1114 (let* ((help-buffer (window-buffer help-window))
1115 ;; `help-buffer' now denotes the help window's buffer.
1116 (view-entry
1117 (assq help-window
1118 (buffer-local-value 'view-return-to-alist help-buffer)))
1119 (help-entry (assq help-window list-of-window-tuples)))
1120
1121 ;; Handle `help-window-point-marker'.
1122 (when (eq (marker-buffer help-window-point-marker) help-buffer)
1123 (set-window-point help-window help-window-point-marker)
1124 ;; Reset `help-window-point-marker'.
1125 (set-marker help-window-point-marker nil))
1126
1127 (cond
1128 (view-entry
1129 ;; `view-return-to-alist' has an entry for the help window.
1130 (cond
1131 ((eq help-window (selected-window))
1132 ;; The help window is the selected window, probably because the
1133 ;; user followed a backward/forward button or a cross reference.
1134 ;; In this case just purge stale entries from
1135 ;; `view-return-to-alist' but leave the entry alone and don't
1136 ;; display a message.
1137 (view-return-to-alist-update help-buffer))
1138 ((and help-entry (eq (cadr help-entry) help-buffer))
1139 ;; The help window was not selected but displayed the help
1140 ;; buffer. In this case reuse existing exit information but try
1141 ;; to get back to the selected window when quitting. Don't
1142 ;; display a message since the user must have seen one before.
1143 (view-return-to-alist-update
1144 help-buffer (cons help-window
1145 (cons (selected-window) (cddr view-entry)))))
1146 (help-entry
1147 ;; The help window was not selected, did display the help buffer
1148 ;; earlier, but displayed another buffer when help was invoked.
1149 ;; Set up things so that quitting will show that buffer again.
1150 (view-return-to-alist-update
1151 help-buffer (cons help-window
1152 (cons (selected-window) (cdr help-entry))))
1153 (help-window-setup-finish help-window t))
1154 (t
1155 ;; The help window is new but `view-return-to-alist' had an
1156 ;; entry for it. This should never happen.
1157 (view-return-to-alist-update
1158 help-buffer (cons help-window
1159 (cons (selected-window) 'quit-window)))
1160 (help-window-setup-finish help-window t))))
1161 (help-entry
1162 ;; `view-return-to-alist' does not have an entry for help window
1163 ;; but `list-of-window-tuples' does. Hence `display-buffer' must
1164 ;; have reused an existing window.
1165 (if (eq (cadr help-entry) help-buffer)
1166 ;; The help window displayed `help-buffer' before but no
1167 ;; `view-return-to-alist' entry was found probably because the
1168 ;; user manually switched to the help buffer. Set up things
1169 ;; for `quit-window' although `view-exit-action' should be
1170 ;; able to handle this case all by itself.
1171 (progn
1172 (view-return-to-alist-update
1173 help-buffer (cons help-window
1174 (cons (selected-window) 'quit-window)))
1175 (help-window-setup-finish help-window t))
1176 ;; The help window displayed another buffer before. Set up
1177 ;; things in a way that quitting can orderly show that buffer
1178 ;; again. The window-start and window-point information from
1179 ;; `list-of-window-tuples' provide the necessary information.
1180 (view-return-to-alist-update
1181 help-buffer (cons help-window
1182 (cons (selected-window) (cdr help-entry))))
1183 (help-window-setup-finish help-window t)))
1184 ((memq (window-frame help-window) list-of-frames)
1185 ;; The help window is a new window on an existing frame. This
1186 ;; case must be handled specially by `help-window-setup-finish'
1187 ;; and `view-mode-exit' to ascertain that quitting does _not_
1188 ;; inadvertently delete the frame.
1189 (view-return-to-alist-update
1190 help-buffer (cons help-window
1191 (cons (selected-window) 'keep-frame)))
1192 (help-window-setup-finish help-window nil t))
1193 (t
1194 ;; The help window is shown on a new frame. In this case quitting
1195 ;; shall handle both, the help window _and_ its frame. We changed
1196 ;; the default of `view-remove-frame-by-deleting' to t in order to
1197 ;; intuitively DTRT here.
1198 (view-return-to-alist-update
1199 help-buffer (cons help-window (cons (selected-window) t)))
1200 (help-window-setup-finish help-window)))))
1201
1202;; `with-help-window' is a wrapper for `with-output-to-temp-buffer'
1203;; providing the following additional twists:
1204
1205;; (1) Issue more accurate messages telling how to scroll and quit the
1206;; help window.
1207
1208;; (2) Make `view-mode-exit' DTRT in more cases.
1209
1210;; (3) An option (customizable via `help-window-select') to select the
1211;; help window automatically.
1212
1213;; (4) A marker (`help-window-point-marker') to move point in the help
1214;; window to an arbitrary buffer position.
1215
b3d8e4a0 1216;; Note: It's usually always wrong to use `help-print-return-message' in
cde56121
MR
1217;; the body of `with-help-window'.
1218(defmacro with-help-window (buffer-name &rest body)
1219 "Display buffer BUFFER-NAME in a help window evaluating BODY.
1220Select help window if the actual value of the user option
eff26424 1221`help-window-select' says so. Return last value in BODY."
cde56121
MR
1222 (declare (indent 1) (debug t))
1223 ;; Bind list-of-frames to `frame-list' and list-of-window-tuples to a
1224 ;; list of one <window window-buffer window-start window-point> tuple
1225 ;; for each live window.
1226 `(let ((list-of-frames (frame-list))
1227 (list-of-window-tuples
1228 (let (list)
1229 (walk-windows
1230 (lambda (window)
1231 (push (list window (window-buffer window)
1232 (window-start window) (window-point window))
1233 list))
1234 'no-mini t)
1235 list)))
eff26424
MR
1236 ;; Make `help-window' t to trigger `help-mode-finish' to set
1237 ;; `help-window' to the actual help window.
cde56121
MR
1238 (setq help-window t)
1239 ;; Make `help-window-point-marker' point nowhere (the only place
1240 ;; where this should be set to a buffer position is within BODY).
1241 (set-marker help-window-point-marker nil)
eff26424
MR
1242 (prog1
1243 ;; Return value returned by `with-output-to-temp-buffer'.
1244 (with-output-to-temp-buffer ,buffer-name
1245 (progn ,@body))
1246 (when (windowp help-window)
1247 ;; Set up help window.
1248 (help-window-setup list-of-frames list-of-window-tuples))
1249 ;; Reset `help-window' to nil to avoid confusing future calls of
1250 ;; `help-mode-finish' with plain `with-output-to-temp-buffer'.
1251 (setq help-window nil))))
cde56121 1252\f
172892e3
JB
1253(provide 'help)
1254
dd39c336 1255;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423
1a06eabd 1256;;; help.el ends here