help.el 35.9 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; help.el --- help commands for Emacs

3 4
;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002,
;;   2003, 2004, 2005 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

Eric S. Raymond's avatar
Eric S. Raymond committed
6
;; Maintainer: FSF
Eric S. Raymond's avatar
Eric S. Raymond committed
7
;; Keywords: help, internal
Eric S. Raymond's avatar
Eric S. Raymond committed
8

Richard M. Stallman's avatar
Richard M. Stallman committed
9 10 11 12
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Eric S. Raymond's avatar
Eric S. Raymond committed
13
;; the Free Software Foundation; either version 2, or (at your option)
Richard M. Stallman's avatar
Richard M. Stallman committed
14 15 16 17 18 19 20 21
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
22
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
25

26 27
;;; Commentary:

28
;; This code implements GNU Emacs' on-line help system, the one invoked by
29
;; `M-x help-for-help'.
30

Eric S. Raymond's avatar
Eric S. Raymond committed
31 32
;;; Code:

33 34
;; Get the macro make-help-screen when this is compiled,
;; or run interpreted, but not when the compiled code is loaded.
35
(eval-when-compile (require 'help-macro))
36 37 38 39

;; This makes `with-output-to-temp-buffer' buffers use `help-mode'.
(add-hook 'temp-buffer-setup-hook 'help-mode-setup)
(add-hook 'temp-buffer-show-hook 'help-mode-finish)
40

41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
(defvar help-map
  (let ((map (make-sparse-keymap)))
    (define-key map (char-to-string help-char) 'help-for-help)
    (define-key map [help] 'help-for-help)
    (define-key map [f1] 'help-for-help)
    (define-key map "." 'display-local-help)
    (define-key map "?" 'help-for-help)

    (define-key map "\C-c" 'describe-copying)
    (define-key map "\C-d" 'describe-distribution)
    (define-key map "\C-e" 'view-emacs-problems)
    (define-key map "\C-f" 'view-emacs-FAQ)
    (define-key map "\C-m" 'view-order-manuals)
    (define-key map "\C-n" 'view-emacs-news)
    (define-key map "\C-p" 'describe-project)
    (define-key map "\C-t" 'view-todo)
    (define-key map "\C-w" 'describe-no-warranty)

    ;; This does not fit the pattern, but it is natural given the C-\ command.
    (define-key map "\C-\\" 'describe-input-method)

    (define-key map "C" 'describe-coding-system)
    (define-key map "F" 'Info-goto-emacs-command-node)
    (define-key map "I" 'describe-input-method)
    (define-key map "K" 'Info-goto-emacs-key-command-node)
    (define-key map "L" 'describe-language-environment)
    (define-key map "S" 'info-lookup-symbol)

    (define-key map "a" 'apropos-command)
    (define-key map "b" 'describe-bindings)
    (define-key map "c" 'describe-key-briefly)
    (define-key map "d" 'apropos-documentation)
    (define-key map "e" 'view-echo-area-messages)
    (define-key map "f" 'describe-function)
    (define-key map "h" 'view-hello-file)

    (define-key map "i" 'info)
    (define-key map "4i" 'info-other-window)

    (define-key map "k" 'describe-key)
    (define-key map "l" 'view-lossage)
    (define-key map "m" 'describe-mode)
    (define-key map "n" 'view-emacs-news)
    (define-key map "p" 'finder-by-keyword)
    (define-key map "r" 'info-emacs-manual)
    (define-key map "s" 'describe-syntax)
    (define-key map "t" 'help-with-tutorial)
    (define-key map "w" 'where-is)
    (define-key map "v" 'describe-variable)
    (define-key map "q" 'help-quit)
    map)
Richard M. Stallman's avatar
Richard M. Stallman committed
92 93
  "Keymap for characters following the Help key.")

Eric S. Raymond's avatar
Eric S. Raymond committed
94
(define-key global-map (char-to-string help-char) 'help-command)
95 96
(define-key global-map [help] 'help-command)
(define-key global-map [f1] 'help-command)
Richard M. Stallman's avatar
Richard M. Stallman committed
97 98
(fset 'help-command help-map)

99 100
(autoload 'finder-by-keyword "finder"
  "Find packages matching a given keyword." t)
101

102 103 104
;; insert-button makes the action nil if it is not store somewhere
(defvar help-button-cache nil)

105

Richard M. Stallman's avatar
Richard M. Stallman committed
106
(defun help-quit ()
Richard M. Stallman's avatar
Richard M. Stallman committed
107
  "Just exit from the Help command's command loop."
Richard M. Stallman's avatar
Richard M. Stallman committed
108 109 110
  (interactive)
  nil)

111 112 113
(defvar help-return-method nil
  "What to do to \"exit\" the help buffer.
This is a list
114 115
 (WINDOW . t)              delete the selected window (and possibly its frame,
                           see `quit-window' and `View-quit'), go to WINDOW.
116 117 118
 (WINDOW . quit-window)    do quit-window, then select WINDOW.
 (WINDOW BUF START POINT)  display BUF at START, POINT, then select WINDOW.")

Richard M. Stallman's avatar
Richard M. Stallman committed
119 120
(defun print-help-return-message (&optional function)
  "Display or return message saying how to restore windows after help command.
121 122
This function assumes that `standard-output' is the help buffer.
It computes a message, and applies the optional argument FUNCTION to it.
123 124 125
If FUNCTION is nil, it applies `message', thus displaying the message.
In addition, this function sets up `help-return-method', which see, that
specifies what to do when the user exits the help buffer."
Richard M. Stallman's avatar
Richard M. Stallman committed
126
  (and (not (get-buffer-window standard-output))
127
       (let ((first-message
128 129 130
	      (cond ((or
		      pop-up-frames
		      (special-display-p (buffer-name standard-output)))
131
		     (setq help-return-method (cons (selected-window) t))
132 133 134 135 136 137 138
		     ;; If the help output buffer is a special display buffer,
		     ;; don't say anything about how to get rid of it.
		     ;; First of all, the user will do that with the window
		     ;; manager, not with Emacs.
		     ;; Secondly, the buffer has not been displayed yet,
		     ;; so we don't know whether its frame will be selected.
		     nil)
139 140 141 142
		    (display-buffer-reuse-frames
		     (setq help-return-method (cons (selected-window)
						    'quit-window))
		     nil)
143
		    ((not (one-window-p t))
144 145
		     (setq help-return-method
			   (cons (selected-window) 'quit-window))
146 147
		     "Type \\[switch-to-buffer-other-window] RET to restore the other window.")
		    (pop-up-windows
148
		     (setq help-return-method (cons (selected-window) t))
149 150
		     "Type \\[delete-other-windows] to remove help window.")
		    (t
151 152 153
		     (setq help-return-method
			   (list (selected-window) (window-buffer)
				 (window-start) (window-point)))
154 155 156 157
		     "Type \\[switch-to-buffer] RET to remove help window."))))
	 (funcall (or function 'message)
		  (concat
		   (if first-message
Dave Love's avatar
Dave Love committed
158 159
		       (substitute-command-keys first-message))
		   (if first-message "  ")
160 161
		   ;; If the help buffer will go in a separate frame,
		   ;; it's no use mentioning a command to scroll, so don't.
162 163
		   (if (or pop-up-windows
			   (special-display-p (buffer-name standard-output)))
164
		       nil
165
		     (if (same-window-p (buffer-name standard-output))
166 167 168 169
			 ;; Say how to scroll this window.
			 (substitute-command-keys
			  "\\[scroll-up] to scroll the help.")
		       ;; Say how to scroll some other window.
170
		       (substitute-command-keys
171
			"\\[scroll-other-window] to scroll the help."))))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
172 173 174 175

;; So keyboard macro definitions are documented correctly
(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))

176 177 178 179 180
(defalias 'help 'help-for-help-internal)
;; find-function can find this.
(defalias 'help-for-help 'help-for-help-internal)
;; It can't find this, but nobody will look.
(make-help-screen help-for-help-internal
181
  "a b c C e f F i I k C-k l L m p r s t v w C-c C-d C-f C-n C-p C-t C-w . or ? :"
182 183 184
  "You have typed %THIS-KEY%, the help character.  Type a Help option:
\(Use SPC or DEL to scroll through this text.  Type \\<help-map>\\[help-quit] to exit the Help command.)

185
a  command-apropos.  Give a list of words or a regexp, to get a list of
186
        commands whose names match.  See also the  apropos  command.
187 188 189 190 191 192
b  describe-bindings.  Display table of all key bindings.
c  describe-key-briefly.  Type a command key sequence;
	it prints the function name that sequence runs.
C  describe-coding-system.  This describes either a specific coding system
        (if you type its name) or the coding systems currently in use
	(if you type just RET).
193 194 195
d  apropos-documentation.  Give a pattern (a list or words or a regexp), and
	see a list of functions, variables, and other items whose built-in
	doucmentation string matches that pattern.  See also the apropos command.
Eli Zaretskii's avatar
Eli Zaretskii committed
196 197 198
e  view-echo-area-messages.  Show the buffer where the echo-area messages
	are stored.
f  describe-function.  Type a function name and get its documentation.
199
F  Info-goto-emacs-command-node.  Type a function name;
Eli Zaretskii's avatar
Eli Zaretskii committed
200 201
	it takes you to the on-line manual's section that describes
	the command.
Richard M. Stallman's avatar
Richard M. Stallman committed
202
h  Display the HELLO file which illustrates various scripts.
Eli Zaretskii's avatar
Eli Zaretskii committed
203
i  info. The Info documentation reader: read on-line manuals.
204 205 206
I  describe-input-method.  Describe a specific input method (if you type
	its name) or the current input method (if you type just RET).
k  describe-key.  Type a command key sequence;
Eli Zaretskii's avatar
Eli Zaretskii committed
207
	it displays the full documentation for that key sequence.
208
K Info-goto-emacs-key-command-node.  Type a command key sequence;
Eli Zaretskii's avatar
Eli Zaretskii committed
209 210
	it takes you to the on-line manual's section that describes
	the command bound to that key.
211 212 213 214
l  view-lossage.  Show last 100 characters you typed.
L  describe-language-environment.  This describes either a
	specific language environment (if you type its name)
	or the current language environment (if you type just RET).
Eli Zaretskii's avatar
Eli Zaretskii committed
215
m  describe-mode.  Display documentation of current minor modes,
216
	and the current major mode, including their special commands.
Eli Zaretskii's avatar
Eli Zaretskii committed
217
n  view-emacs-news.  Display news of recent Emacs changes.
218
p  finder-by-keyword. Find packages matching a given topic keyword.
219
r  info-emacs-manual.  Display the Emacs manual in Info mode.
220
s  describe-syntax.  Display contents of syntax table, plus explanations.
221 222
S  info-lookup-symbol.  Display the definition of a specific symbol
        as found in the manual for the language this buffer is written in.
223 224 225 226 227
t  help-with-tutorial.  Select the Emacs learn-by-doing tutorial.
v  describe-variable.  Type name of a variable;
	it displays the variable's documentation and value.
w  where-is.  Type command name; it prints which keystrokes
	invoke that command.
228 229
.  display-local-help.  Display any available local help at point
        in the echo area.
230

231
C-c Display Emacs copying permission (GNU General Public License).
232
C-d Display Emacs ordering information.
233 234 235
C-e Display info about Emacs problems.
C-f Display the Emacs FAQ.
C-m Display how to order printed Emacs manuals.
236 237
C-n Display news of recent Emacs changes.
C-p Display information about the GNU project.
238
C-t Display the Emacs TODO list.
239 240 241 242 243 244 245 246
C-w Display information on absence of warranty for GNU Emacs."
  help-map)



(defun function-called-at-point ()
  "Return a function around point or else called by the list containing point.
If that doesn't give a function, return nil."
247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
  (or (with-syntax-table emacs-lisp-mode-syntax-table
	(or (condition-case ()
		(save-excursion
		  (or (not (zerop (skip-syntax-backward "_w")))
		      (eq (char-syntax (following-char)) ?w)
		      (eq (char-syntax (following-char)) ?_)
		      (forward-sexp -1))
		  (skip-chars-forward "'")
		  (let ((obj (read (current-buffer))))
		    (and (symbolp obj) (fboundp obj) obj)))
	      (error nil))
	    (condition-case ()
		(save-excursion
		  (save-restriction
		    (narrow-to-region (max (point-min)
					   (- (point) 1000)) (point-max))
		    ;; Move up to surrounding paren, then after the open.
		    (backward-up-list 1)
		    (forward-char 1)
		    ;; If there is space here, this is probably something
		    ;; other than a real Lisp function call, so ignore it.
		    (if (looking-at "[ \t]")
			(error "Probably not a Lisp function call"))
		    (let ((obj (read (current-buffer))))
		      (and (symbolp obj) (fboundp obj) obj))))
	      (error nil))))
      (let* ((str (find-tag-default))
274 275 276 277 278 279 280
	     (sym (if str (intern-soft str))))
	(if (and sym (fboundp sym))
	    sym
	  (save-match-data
	    (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str))
	      (setq sym (intern-soft (match-string 1 str)))
	      (and (fboundp sym) sym)))))))
281 282 283 284


;;; `User' help functions

Richard M. Stallman's avatar
Richard M. Stallman committed
285 286 287
(defun describe-distribution ()
  "Display info on how to obtain the latest version of GNU Emacs."
  (interactive)
288
  (view-file (expand-file-name "DISTRIB" data-directory)))
Richard M. Stallman's avatar
Richard M. Stallman committed
289 290 291 292

(defun describe-copying ()
  "Display info on how you may redistribute copies of GNU Emacs."
  (interactive)
293
  (view-file (expand-file-name "COPYING" data-directory))
Richard M. Stallman's avatar
Richard M. Stallman committed
294 295
  (goto-char (point-min)))

296 297 298
(defun describe-project ()
  "Display info on the GNU project."
  (interactive)
299
  (view-file (expand-file-name "THE-GNU-PROJECT" data-directory))
300 301
  (goto-char (point-min)))

Richard M. Stallman's avatar
Richard M. Stallman committed
302 303 304 305 306 307 308 309
(defun describe-no-warranty ()
  "Display info on all the kinds of warranty Emacs does NOT have."
  (interactive)
  (describe-copying)
  (let (case-fold-search)
    (search-forward "NO WARRANTY")
    (recenter 0)))

310
(defun describe-prefix-bindings ()
311 312 313
  "Describe the bindings of the prefix used to reach this command.
The prefix described consists of all but the last event
of the key sequence that ran this command."
314
  (interactive)
315 316 317 318 319 320 321 322 323 324
  (let* ((key (this-command-keys)))
    (describe-bindings
     (if (stringp key)
	 (substring key 0 (1- (length key)))
       (let ((prefix (make-vector (1- (length key)) nil))
	     (i 0))
	 (while (< i (length prefix))
	   (aset prefix i (aref key i))
	   (setq i (1+ i)))
	 prefix)))))
325
;; Make C-h after a prefix, when not specifically bound,
326
;; run describe-prefix-bindings.
327 328
(setq prefix-help-command 'describe-prefix-bindings)

329 330
(defun view-emacs-news (&optional arg)
  "Display info on recent changes to Emacs.
331
With argument, display info only for the selected version."
332
  (interactive "P")
333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385
  (if (not arg)
      (view-file (expand-file-name "NEWS" data-directory))
    (let* ((map (sort
                 (delete-dups
                  (apply
                   'nconc
                   (mapcar
                    (lambda (file)
                      (with-temp-buffer
                        (insert-file-contents
                         (expand-file-name file data-directory))
                        (let (res)
                          (while (re-search-forward
                                  (if (string-match "^ONEWS\\.[0-9]+$" file)
                                      "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
                                    "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)
                            (setq res (cons (list (match-string-no-properties 1)
                                                  file) res)))
                          res)))
                    (append '("NEWS" "ONEWS")
                            (directory-files data-directory nil
                                             "^ONEWS\\.[0-9]+$" nil)))))
                 (lambda (a b)
                   (string< (car b) (car a)))))
           (current (caar map))
           (version (completing-read
                     (format "Read NEWS for the version (default %s): " current)
                     (mapcar 'car map) nil nil nil nil current))
           (file (cadr (assoc version map)))
           res)
      (if (not file)
          (error "No news is good news")
        (view-file (expand-file-name file data-directory))
        (widen)
        (goto-char (point-min))
        (when (re-search-forward
               (concat (if (string-match "^ONEWS\\.[0-9]+$" file)
                           "Changes in \\(?:Emacs\\|version\\)?[ \t]*"
                         "^\* [^0-9\n]*") version)
               nil t)
          (beginning-of-line)
          (narrow-to-region
           (point)
           (save-excursion
             (while (and (setq res
                               (re-search-forward
                                (if (string-match "^ONEWS\\.[0-9]+$" file)
                                    "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
                                  "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t))
                         (equal (match-string-no-properties 1) version)))
             (or res (goto-char (point-max)))
             (beginning-of-line)
             (point))))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
386

387 388 389 390 391
(defun view-todo (&optional arg)
  "Display the Emacs TODO list."
  (interactive "P")
  (view-file (expand-file-name "TODO" data-directory)))

392 393 394 395 396 397 398
(defun view-echo-area-messages ()
  "View the log of recent echo-area messages: the `*Messages*' buffer.
The number of messages retained in that buffer
is specified by the variable `message-log-max'."
  (interactive)
  (switch-to-buffer (get-buffer-create "*Messages*")))

399 400 401
(defun view-order-manuals ()
  "Display the Emacs ORDERS file."
  (interactive)
402
  (view-file (expand-file-name "ORDERS" data-directory))
403
  (goto-address))
404

405 406 407
(defun view-emacs-FAQ ()
  "Display the Emacs Frequently Asked Questions (FAQ) file."
  (interactive)
408
  ;; (find-file-read-only (expand-file-name "FAQ" data-directory))
409
  (info "(efaq)"))
410

411 412 413 414 415
(defun view-emacs-problems ()
  "Display info on known problems with Emacs and possible workarounds."
  (interactive)
  (view-file (expand-file-name "PROBLEMS" data-directory)))

Richard M. Stallman's avatar
Richard M. Stallman committed
416
(defun view-lossage ()
417 418 419
  "Display last 100 input keystrokes.

To record all your input on a file, use `open-dribble-file'."
Richard M. Stallman's avatar
Richard M. Stallman committed
420
  (interactive)
421 422
  (help-setup-xref (list #'view-lossage) (interactive-p))
  (with-output-to-temp-buffer (help-buffer)
423 424 425 426
    (princ (mapconcat (lambda (key)
			(if (or (integerp key) (symbolp key) (listp key))
			    (single-key-description key)
			  (prin1-to-string key nil)))
427 428
		      (recent-keys)
		      " "))
429
    (with-current-buffer standard-output
Richard M. Stallman's avatar
Richard M. Stallman committed
430 431 432
      (goto-char (point-min))
      (while (progn (move-to-column 50) (not (eobp)))
	(search-forward " " nil t)
433
	(insert "\n")))
Richard M. Stallman's avatar
Richard M. Stallman committed
434 435
    (print-help-return-message)))

436 437

;; Key bindings
Richard M. Stallman's avatar
Richard M. Stallman committed
438

439
(defun describe-bindings (&optional prefix buffer)
440 441 442 443
  "Show a list of all defined keys, and their definitions.
We put that list in a buffer, and display the buffer.

The optional argument PREFIX, if non-nil, should be a key sequence;
444 445
then we display only bindings that start with that prefix.
The optional argument BUFFER specifies which buffer's bindings
Luc Teirlinck's avatar
Luc Teirlinck committed
446 447
to display (default, the current buffer).  BUFFER can be a buffer
or a buffer name."
448
  (interactive)
449
  (or buffer (setq buffer (current-buffer)))
450
  (help-setup-xref (list #'describe-bindings prefix buffer) (interactive-p))
451
  (with-current-buffer buffer
452
    (describe-bindings-internal nil prefix)))
453

454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
;; This function used to be in keymap.c.
(defun describe-bindings-internal (&optional menus prefix)
  "Show a list of all defined keys, and their definitions.
We put that list in a buffer, and display the buffer.

The optional argument MENUS, if non-nil, says to mention menu bindings.
\(Ordinarily these are omitted from the output.)
The optional argument PREFIX, if non-nil, should be a key sequence;
then we display only bindings that start with that prefix."
  (interactive)
  (let ((buf (current-buffer)))
    (with-output-to-temp-buffer "*Help*"
      (with-current-buffer standard-output
	(describe-buffer-bindings buf prefix menus)))))

469
(defun where-is (definition &optional insert)
470
  "Print message listing key sequences that invoke the command DEFINITION.
471 472
Argument is a command definition, usually a symbol with a function definition.
If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
473 474
  (interactive
   (let ((fn (function-called-at-point))
475
	 (enable-recursive-minibuffers t)
476
	 val)
477 478 479 480 481 482
     (setq val (completing-read
		(if fn
		    (format "Where is command (default %s): " fn)
		  "Where is command: ")
		obarray 'commandp t))
     (list (if (equal val "") fn (intern val)) current-prefix-arg)))
483
  (let ((func (indirect-function definition))
484
        (defs nil)
485
        (standard-output (if insert (current-buffer) t)))
486
    ;; In DEFS, find all symbols that are aliases for DEFINITION.
487 488 489
    (mapatoms (lambda (symbol)
		(and (fboundp symbol)
		     (not (eq symbol definition))
490 491 492
		     (eq func (condition-case ()
				  (indirect-function symbol)
				(error symbol)))
493
		     (push symbol defs))))
494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524
    ;; Look at all the symbols--first DEFINITION,
    ;; then its aliases.
    (dolist (symbol (cons definition defs))
      (let* ((remapped (command-remapping symbol))
	     (keys (where-is-internal
		    symbol overriding-local-map nil nil remapped))
	     (keys (mapconcat 'key-description keys ", "))
	     string)
	(setq string
	      (if insert
		  (if (> (length keys) 0)
		      (if remapped
			  (format "%s (%s) (remapped from %s)"
				  keys remapped symbol)
			(format "%s (%s)" keys symbol))
		    (format "M-x %s RET" symbol))
		(if (> (length keys) 0)
		    (if remapped
			(format "%s is remapped to %s which is on %s"
				definition symbol keys)
		      (format "%s is on %s" symbol keys))
		  ;; If this is the command the user asked about,
		  ;; and it is not on any key, say so.
		  ;; For other symbols, its aliases, say nothing
		  ;; about them unless they are on keys.
		  (if (eq symbol definition)
		      (format "%s is not on any key" symbol)))))
	(when string
	  (unless (eq symbol definition)
	    (princ ";\n its alias "))
	  (princ string)))))
525 526
  nil)

527 528 529 530 531 532
(defun string-key-binding (key)
  "Value is the binding of KEY in a string.
If KEY is an event on a string, and that string has a `local-map'
or `keymap' property, return the binding of KEY in the string's keymap."
  (let* ((defn nil)
	 (start (when (vectorp key)
533 534
		  (if (memq (aref key 0)
			    '(mode-line header-line left-margin right-margin))
535 536 537 538 539 540 541
		      (event-start (aref key 1))
		    (and (consp (aref key 0))
			 (event-start (aref key 0))))))
	 (string-info (and (consp start) (nth 4 start))))
    (when string-info
      (let* ((string (car string-info))
	     (pos (cdr string-info))
542
	     (local-map (and (>= pos 0)
543 544 545 546 547
			     (< pos (length string))
			     (or (get-text-property pos 'local-map string)
				 (get-text-property pos 'keymap string)))))
	(setq defn (and local-map (lookup-key local-map key)))))
    defn))
Eric S. Raymond's avatar
Eric S. Raymond committed
548

549 550
(defun help-key-description (key untranslated)
  (let ((string (key-description key)))
551 552
    (if (or (not untranslated)
	    (and (eq (aref untranslated 0) ?\e) (not (eq (aref key 0) ?\e))))
553 554 555 556 557
	string
      (let ((otherstring (key-description untranslated)))
	(if (equal string otherstring)
	    string
	  (format "%s (translated from %s)" string otherstring))))))
558

559
(defun describe-key-briefly (key &optional insert untranslated)
560
  "Print the name of the function KEY invokes.  KEY is a string.
561 562 563 564 565 566 567
If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
If non-nil UNTRANSLATED is a vector of the untranslated events.
It can also be a number in which case the untranslated events from
the last key hit are used."
  (interactive "kDescribe key briefly: \nP\np")
  (if (numberp untranslated)
      (setq untranslated (this-single-command-raw-keys)))
568
  (save-excursion
569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584
    (let ((modifiers (event-modifiers (aref key 0)))
	  (standard-output (if insert (current-buffer) t))
	  window position)
      ;; For a mouse button event, go to the button it applies to
      ;; to get the right key bindings.  And go to the right place
      ;; in case the keymap depends on where you clicked.
      (if (or (memq 'click modifiers) (memq 'down modifiers)
	      (memq 'drag modifiers))
	  (setq window (posn-window (event-start (aref key 0)))
		position (posn-point (event-start (aref key 0)))))
      (if (windowp window)
	  (progn
	    (set-buffer (window-buffer window))
	    (goto-char position)))
      ;; Ok, now look up the key and name the command.
      (let ((defn (or (string-key-binding key)
585
		      (key-binding key t)))
586 587 588 589
	    key-desc)
	;; Don't bother user with strings from (e.g.) the select-paste menu.
	(if (stringp (aref key (1- (length key))))
	    (aset key (1- (length key)) "(any string)"))
590 591
	(if (and (> (length untranslated) 0)
		 (stringp (aref untranslated (1- (length untranslated)))))
592 593 594 595
	    (aset untranslated (1- (length untranslated))
		  "(any string)"))
	;; Now describe the key, perhaps as changed.
	(setq key-desc (help-key-description key untranslated))
596
	(if (or (null defn) (integerp defn) (equal defn 'undefined))
597
	    (princ (format "%s is undefined" key-desc))
598 599 600
	  (princ (format (if (windowp window)
			     "%s at that spot runs the command %s"
			   "%s runs the command %s")
601 602
			 key-desc
			 (if (symbolp defn) defn (prin1-to-string defn)))))))))
603

604
(defun describe-key (key &optional untranslated up-event)
Richard M. Stallman's avatar
Richard M. Stallman committed
605
  "Display documentation of the function invoked by KEY.
606 607 608 609
KEY can be any kind of a key sequence; it can include keyboard events,
mouse events, and/or menu events.  When calling from a program,
pass KEY as a string or a vector.

Chong Yidong's avatar
Typo.  
Chong Yidong committed
610
If non-nil, UNTRANSLATED is a vector of the corresponding untranslated events.
611 612
It can also be a number, in which case the untranslated events from
the last key sequence entered are used."
613
  ;; UP-EVENT is the up-event that was discarded by reading KEY, or nil.
614
  (interactive "kDescribe key (or click or menu item): \np\nU")
615 616
  (if (numberp untranslated)
      (setq untranslated (this-single-command-raw-keys)))
617 618 619 620 621 622 623 624 625 626
  (save-excursion
    (let ((modifiers (event-modifiers (aref key 0)))
	  window position)
      ;; For a mouse button event, go to the button it applies to
      ;; to get the right key bindings.  And go to the right place
      ;; in case the keymap depends on where you clicked.
      (if (or (memq 'click modifiers) (memq 'down modifiers)
	      (memq 'drag modifiers))
	  (setq window (posn-window (event-start (aref key 0)))
		position (posn-point (event-start (aref key 0)))))
627
      (when (windowp window)
628
	    (set-buffer (window-buffer window))
629
	(goto-char position))
630
      (let ((defn (or (string-key-binding key) (key-binding key t))))
631
	(if (or (null defn) (integerp defn) (equal defn 'undefined))
632
	    (message "%s is undefined" (help-key-description key untranslated))
633
	  (help-setup-xref (list #'describe-function defn) (interactive-p))
634 635 636
	  ;; Don't bother user with strings from (e.g.) the select-paste menu.
	  (if (stringp (aref key (1- (length key))))
	      (aset key (1- (length key)) "(any string)"))
637 638
	  (if (and untranslated
		   (stringp (aref untranslated (1- (length untranslated)))))
639 640
	      (aset untranslated (1- (length untranslated))
		    "(any string)"))
641
	  (with-output-to-temp-buffer (help-buffer)
642
	    (princ (help-key-description key untranslated))
643 644 645 646 647
	    (if (windowp window)
		(princ " at that spot"))
	    (princ " runs the command ")
	    (prin1 defn)
	    (princ "\n   which is ")
648
	    (describe-function-1 defn)
649
	    (when up-event
650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667
	      (let ((ev (aref up-event 0))
		    (descr (key-description up-event))
		    (hdr "\n\n-------------- up event ---------------\n\n")
		    defn
		    mouse-1-tricky mouse-1-remapped)
		(when (and (consp ev)
			   (eq (car ev) 'mouse-1)
			   (windowp window)
			   mouse-1-click-follows-link
			   (not (eq mouse-1-click-follows-link 'double))
			   (with-current-buffer (window-buffer window)
			     (mouse-on-link-p (posn-point (event-start ev)))))
		  (setq mouse-1-tricky (integerp mouse-1-click-follows-link)
			mouse-1-remapped (or (not mouse-1-tricky)
					     (> mouse-1-click-follows-link 0)))
		  (if mouse-1-remapped
		      (setcar ev 'mouse-2)))
		(setq defn (or (string-key-binding up-event) (key-binding up-event)))
668
		(unless (or (null defn) (integerp defn) (equal defn 'undefined))
669 670 671 672 673
		  (princ (if mouse-1-tricky
			     "\n\n----------------- up-event (short click) ----------------\n\n"
			   hdr))
		  (setq hdr nil)
		  (princ descr)
674 675
		  (if (windowp window)
		      (princ " at that spot"))
676 677
		  (if mouse-1-remapped
		      (princ " is remapped to <mouse-2>\n  which" ))
678 679 680
		  (princ " runs the command ")
		  (prin1 defn)
		  (princ "\n   which is ")
681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699
		  (describe-function-1 defn))
		(when mouse-1-tricky
		  (setcar ev
			  (if (> mouse-1-click-follows-link 0) 'mouse-1 'mouse-2))
		  (setq defn (or (string-key-binding up-event) (key-binding up-event)))
		  (unless (or (null defn) (integerp defn) (equal defn 'undefined))
		    (princ (or hdr
			       "\n\n----------------- up-event (long click) ----------------\n\n"))
		    (princ "Pressing ")
		    (princ descr)
		    (if (windowp window)
			(princ " at that spot"))
		    (princ (format " for longer than %d milli-seconds\n"
				   (abs mouse-1-click-follows-link)))
		    (if (not mouse-1-remapped)
			(princ " remaps it to <mouse-2> which" ))
		    (princ " runs the command ")
		    (prin1 defn)
		    (princ "\n   which is ")
700 701
		    (describe-function-1 defn)))))
	    (print-help-return-message)))))))
702 703


704 705
(defun describe-mode (&optional buffer)
  "Display documentation of current major mode and minor modes.
706 707 708 709 710 711 712
A brief summary of the minor modes comes first, followed by the
major mode description.  This is followed by detailed
descriptions of the minor modes, each on a separate page.

For this to work correctly for a minor mode, the mode's indicator
variable \(listed in `minor-mode-alist') must also be a function
whose documentation describes the minor mode."
713
  (interactive)
714 715
  (unless buffer (setq buffer (current-buffer)))
  (help-setup-xref (list #'describe-mode buffer)
716 717 718
		   (interactive-p))
  ;; For the sake of help-do-xref and help-xref-go-back,
  ;; don't switch buffers before calling `help-buffer'.
719
  (with-output-to-temp-buffer (help-buffer)
720
    (with-current-buffer buffer
721
      (let (minor-modes)
722 723 724 725 726 727
	;; Older packages do not register in minor-mode-list but only in
	;; minor-mode-alist.
	(dolist (x minor-mode-alist)
	  (setq x (car x))
	  (unless (memq x minor-mode-list)
	    (push x minor-mode-list)))
728 729 730 731
	;; Find enabled minor mode we will want to mention.
	(dolist (mode minor-mode-list)
	  ;; Document a minor mode if it is listed in minor-mode-alist,
	  ;; non-nil, and has a function definition.
732 733 734 735 736 737 738 739 740 741 742 743 744
	  (let ((fmode (or (get mode :minor-mode-function) mode)))
	    (and (boundp mode) (symbol-value mode)
		 (fboundp fmode)
		 (let ((pretty-minor-mode
			(if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
					  (symbol-name fmode))
			    (capitalize
			     (substring (symbol-name fmode)
					0 (match-beginning 0)))
			  fmode)))
		   (push (list fmode pretty-minor-mode
			       (format-mode-line (assq mode minor-mode-alist)))
			 minor-modes)))))
745 746
	(setq minor-modes
	      (sort minor-modes
747
		    (lambda (a b) (string-lessp (cadr a) (cadr b)))))
748 749
	(when minor-modes
	  (princ "Summary of minor modes:\n")
750 751 752
	  (make-local-variable 'help-button-cache)
	  (with-current-buffer standard-output
	    (dolist (mode minor-modes)
753 754
	      (let ((mode-function (nth 0 mode))
		    (pretty-minor-mode (nth 1 mode))
755
		    (indicator (nth 2 mode)))
756 757 758
		(setq indicator (if (zerop (length indicator))
				    "no indicator"
				  (format "indicator%s" indicator)))
759 760 761 762 763 764 765 766
		(add-text-properties 0 (length pretty-minor-mode)
				     '(face bold) pretty-minor-mode)
		(save-excursion
		  (goto-char (point-max))
		  (princ "\n\f\n")
		  (push (point-marker) help-button-cache)
		  ;; Document the minor modes fully.
		  (insert pretty-minor-mode)
767
		  (princ (format " minor mode (%s):\n" indicator))
768 769 770 771
		  (princ (documentation mode-function)))
		(princ "  ")
		(insert-button pretty-minor-mode
			       'action (car help-button-cache)
772
			       'follow-link t
773
			       'help-echo "mouse-2, RET: show full information")
774
		(princ (format " minor mode (%s):\n" indicator)))))
775 776 777
	  (princ "\n(Full information about these minor modes
follows the description of the major mode.)\n\n"))
	;; Document the major mode.
778 779 780 781
	(let ((mode mode-name))
	  (with-current-buffer standard-output
	    (insert mode)
	    (add-text-properties (- (point) (length mode)) (point) '(face bold))))
782
	(princ " mode:\n")
783
	(princ (documentation major-mode)))
784
      (print-help-return-message))))
785

786

787
(defun describe-minor-mode (minor-mode)
788 789 790
  "Display documentation of a minor mode given as MINOR-MODE.
MINOR-MODE can be a minor mode symbol or a minor mode indicator string
appeared on the mode-line."
791
  (interactive (list (completing-read
792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808
		      "Minor mode: "
			      (nconc
			       (describe-minor-mode-completion-table-for-symbol)
			       (describe-minor-mode-completion-table-for-indicator)
			       ))))
  (if (symbolp minor-mode)
      (setq minor-mode (symbol-name minor-mode)))
  (let ((symbols (describe-minor-mode-completion-table-for-symbol))
	(indicators (describe-minor-mode-completion-table-for-indicator)))
    (cond
     ((member minor-mode symbols)
      (describe-minor-mode-from-symbol (intern minor-mode)))
     ((member minor-mode indicators)
      (describe-minor-mode-from-indicator minor-mode))
     (t
      (error "No such minor mode: %s" minor-mode)))))

809
;; symbol
810 811 812 813 814 815
(defun describe-minor-mode-completion-table-for-symbol ()
  ;; In order to list up all minor modes, minor-mode-list
  ;; is used here instead of minor-mode-alist.
  (delq nil (mapcar 'symbol-name minor-mode-list)))
(defun describe-minor-mode-from-symbol (symbol)
  "Display documentation of a minor mode given as a symbol, SYMBOL"
816
  (interactive (list (intern (completing-read
817 818 819 820 821 822 823 824
			      "Minor mode symbol: "
			      (describe-minor-mode-completion-table-for-symbol)))))
  (if (fboundp symbol)
      (describe-function symbol)
    (describe-variable symbol)))

;; indicator
(defun describe-minor-mode-completion-table-for-indicator ()
825
  (delq nil
826 827 828 829 830 831 832 833
	(mapcar (lambda (x)
		  (let ((i (format-mode-line x)))
		    ;; remove first space if existed
		    (cond
		     ((= 0 (length i))
		      nil)
		     ((eq (aref i 0) ?\ )
		      (substring i 1))
834
		     (t
835 836
		      i))))
		minor-mode-alist)))
837
(defun describe-minor-mode-from-indicator (indicator)
838 839 840
  "Display documentation of a minor mode specified by INDICATOR.
If you call this function interactively, you can give indicator which
is currently activated with completion."
841 842
  (interactive (list
		(completing-read
843
		 "Minor mode indicator: "
844
		 (describe-minor-mode-completion-table-for-indicator))))
845 846
  (let ((minor-mode (lookup-minor-mode-from-indicator indicator)))
    (if minor-mode
847
	(describe-minor-mode-from-symbol minor-mode)
848 849 850 851
      (error "Cannot find minor mode for `%s'" indicator))))

(defun lookup-minor-mode-from-indicator (indicator)
  "Return a minor mode symbol from its indicator on the modeline."
852
  ;; remove first space if existed
853
  (if (and (< 0 (length indicator))
854 855
	   (eq (aref indicator 0) ?\ ))
      (setq indicator (substring indicator 1)))
856 857 858 859
  (let ((minor-modes minor-mode-alist)
	result)
    (while minor-modes
      (let* ((minor-mode (car (car minor-modes)))
860
	     (anindicator (format-mode-line
861 862
			   (car (cdr (car minor-modes))))))
	;; remove first space if existed
863
	(if (and (stringp anindicator)
864 865 866 867
		 (> (length anindicator) 0)
		 (eq (aref anindicator 0) ?\ ))
	    (setq anindicator (substring anindicator 1)))
	(if (equal indicator anindicator)
868 869 870 871 872
	    (setq result minor-mode
		  minor-modes nil)
	  (setq minor-modes (cdr minor-modes)))))
    result))

873 874 875

;;; Automatic resizing of temporary buffers.

876
(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2))
877 878 879 880 881 882 883 884 885 886
  "*Maximum height of a window displaying a temporary buffer.
This is the maximum height (in text lines) which `resize-temp-buffer-window'
will give to a window displaying a temporary buffer.
It can also be a function which will be called with the object corresponding
to the buffer to be displayed as argument and should return an integer
positive number."
  :type '(choice integer function)
  :group 'help
  :version "20.4")

887 888
(define-minor-mode temp-buffer-resize-mode
  "Toggle the mode which makes windows smaller for temporary buffers.
889 890
With prefix argument ARG, turn the resizing of windows displaying temporary
buffers on if ARG is positive or off otherwise.
891 892 893
This makes the window the right height for its contents, but never
more than `temp-buffer-max-height' nor less than `window-min-height'.
This applies to `help', `apropos' and `completion' buffers, and some others."
894
  :global t :group 'help
895
  (if temp-buffer-resize-mode
Richard M. Stallman's avatar
Richard M. Stallman committed
896
      ;; `help-make-xrefs' may add a `back' button and thus increase the
897 898
      ;; text size, so `resize-temp-buffer-window' must be run *after* it.
      (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
Stefan Monnier's avatar
Stefan Monnier committed
899
    (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
900 901 902

(defun resize-temp-buffer-window ()
  "Resize the current window to fit its contents.
903
Will not make it higher than `temp-buffer-max-height' nor smaller than
904
`window-min-height'.  Do nothing if it is the only window on its frame, if it
905 906 907 908 909
is not as wide as the frame or if some of the window's contents are scrolled
out of view."
  (unless (or (one-window-p 'nomini)
              (not (pos-visible-in-window-p (point-min)))
              (/=  (frame-width) (window-width)))
910 911 912 913 914
    (fit-window-to-buffer
     (selected-window)
     (if (functionp temp-buffer-max-height)
	 (funcall temp-buffer-max-height (current-buffer))
       temp-buffer-max-height))))
915

916 917 918 919
;; Provide this for the sake of define-minor-mode which generates
;; defcustoms which require 'help'.
(provide 'help)

920
;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423
Eric S. Raymond's avatar
Eric S. Raymond committed
921
;;; help.el ends here