Commit | Line | Data |
---|---|---|
1a06eabd ER |
1 | ;;; help.el --- help commands for Emacs |
2 | ||
754084bb GM |
3 | ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001 |
4 | ;; Free Software Foundation, Inc. | |
3a801d0c | 5 | |
e5167999 | 6 | ;; Maintainer: FSF |
fd7fa35a | 7 | ;; Keywords: help, internal |
e5167999 | 8 | |
433ae6f6 RS |
9 | ;; This file is part of GNU Emacs. |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
433ae6f6 RS |
14 | ;; any later version. |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 | ;; Boston, MA 02111-1307, USA. | |
433ae6f6 | 25 | |
d9ecc911 ER |
26 | ;;; Commentary: |
27 | ||
a1c9f209 | 28 | ;; This code implements GNU Emacs' on-line help system, the one invoked by |
95ac0a6f | 29 | ;; `M-x help-for-help'. |
d9ecc911 | 30 | |
e5167999 ER |
31 | ;;; Code: |
32 | ||
8aa3a187 RS |
33 | ;; Get the macro make-help-screen when this is compiled, |
34 | ;; or run interpreted, but not when the compiled code is loaded. | |
b1fe9304 | 35 | (eval-when-compile (require 'help-macro)) |
4a8adb0b | 36 | (eval-when-compile (require 'view)) |
41b8542b | 37 | |
433ae6f6 RS |
38 | (defvar help-map (make-sparse-keymap) |
39 | "Keymap for characters following the Help key.") | |
40 | ||
afaa65e4 KH |
41 | (defvar help-mode-map (make-sparse-keymap) |
42 | "Keymap for help mode.") | |
43 | ||
0cf0d828 MB |
44 | (set-keymap-parent help-mode-map button-buffer-map) |
45 | ||
e17d2fd1 | 46 | (define-key global-map (char-to-string help-char) 'help-command) |
0af3df1c RS |
47 | (define-key global-map [help] 'help-command) |
48 | (define-key global-map [f1] 'help-command) | |
433ae6f6 RS |
49 | (fset 'help-command help-map) |
50 | ||
e17d2fd1 | 51 | (define-key help-map (char-to-string help-char) 'help-for-help) |
0af3df1c RS |
52 | (define-key help-map [help] 'help-for-help) |
53 | (define-key help-map [f1] 'help-for-help) | |
433ae6f6 RS |
54 | (define-key help-map "?" 'help-for-help) |
55 | ||
56 | (define-key help-map "\C-c" 'describe-copying) | |
57 | (define-key help-map "\C-d" 'describe-distribution) | |
58 | (define-key help-map "\C-w" 'describe-no-warranty) | |
76766f2d | 59 | (define-key help-map "\C-p" 'describe-project) |
122955bf | 60 | (define-key help-map "a" 'apropos-command) |
433ae6f6 RS |
61 | |
62 | (define-key help-map "b" 'describe-bindings) | |
63 | ||
64 | (define-key help-map "c" 'describe-key-briefly) | |
65 | (define-key help-map "k" 'describe-key) | |
66 | ||
67 | (define-key help-map "d" 'describe-function) | |
68 | (define-key help-map "f" 'describe-function) | |
69 | ||
7ee71cf1 RS |
70 | (define-key help-map "F" 'view-emacs-FAQ) |
71 | ||
433ae6f6 | 72 | (define-key help-map "i" 'info) |
4b08b7ed | 73 | (define-key help-map "4i" 'info-other-window) |
e5d77022 JB |
74 | (define-key help-map "\C-f" 'Info-goto-emacs-command-node) |
75 | (define-key help-map "\C-k" 'Info-goto-emacs-key-command-node) | |
32884eab | 76 | (define-key help-map "\C-i" 'info-lookup-symbol) |
433ae6f6 RS |
77 | |
78 | (define-key help-map "l" 'view-lossage) | |
79 | ||
80 | (define-key help-map "m" 'describe-mode) | |
754084bb | 81 | (define-key help-map "\C-m" 'view-order-manuals) |
433ae6f6 RS |
82 | |
83 | (define-key help-map "\C-n" 'view-emacs-news) | |
84 | (define-key help-map "n" 'view-emacs-news) | |
85 | ||
06b98c51 | 86 | (define-key help-map "p" 'finder-by-keyword) |
3e9c095d RS |
87 | (autoload 'finder-by-keyword "finder" |
88 | "Find packages matching a given keyword." t) | |
06b98c51 | 89 | |
4cbff657 DL |
90 | (define-key help-map "P" 'view-emacs-problems) |
91 | ||
433ae6f6 RS |
92 | (define-key help-map "s" 'describe-syntax) |
93 | ||
94 | (define-key help-map "t" 'help-with-tutorial) | |
95 | ||
96 | (define-key help-map "w" 'where-is) | |
97 | ||
98 | (define-key help-map "v" 'describe-variable) | |
99 | ||
2fc9d9f4 RS |
100 | (define-key help-map "q" 'help-quit) |
101 | ||
400a1b1f RS |
102 | (define-key help-mode-map "\C-c\C-b" 'help-go-back) |
103 | (define-key help-mode-map "\C-c\C-c" 'help-follow) | |
400a1b1f RS |
104 | ;; Documentation only, since we use minor-mode-overriding-map-alist. |
105 | (define-key help-mode-map "\r" 'help-follow) | |
106 | ||
400a1b1f RS |
107 | (defvar help-xref-stack nil |
108 | "A stack of ways by which to return to help buffers after following xrefs. | |
4c45295b | 109 | Used by `help-follow' and `help-xref-go-back'. |
376b2a24 DL |
110 | An element looks like (POSITION FUNCTION ARGS...), where POSITION is |
111 | `(POINT . BUFFER-NAME)'. | |
112 | To use the element, do (apply FUNCTION ARGS) then goto the point in | |
113 | the named buffer.") | |
400a1b1f RS |
114 | (put 'help-xref-stack 'permanent-local t) |
115 | ||
116 | (defvar help-xref-stack-item nil | |
4c45295b KH |
117 | "An item for `help-follow' in this buffer to push onto `help-xref-stack'. |
118 | The format is (FUNCTION ARGS...).") | |
400a1b1f RS |
119 | (put 'help-xref-stack-item 'permanent-local t) |
120 | ||
121 | (setq-default help-xref-stack nil help-xref-stack-item nil) | |
507fb916 | 122 | |
73ea6d94 DL |
123 | (defcustom help-mode-hook nil |
124 | "Hook run by `help-mode'." | |
125 | :type 'hook | |
126 | :group 'help) | |
127 | ||
0cf0d828 MB |
128 | \f |
129 | ;; Button types used by help | |
130 | ||
131 | ;; Make some button types that all use the same naming conventions | |
132 | (dolist (help-type '("function" "variable" "face" | |
133 | "coding-system" "input-method" "character-set")) | |
134 | (define-button-type (intern (purecopy (concat "help-" help-type))) | |
135 | 'help-function (intern (concat "describe-" help-type)) | |
136 | 'help-echo (purecopy (concat "mouse-2, RET: describe this " help-type)) | |
137 | 'action #'help-button-action)) | |
138 | ||
139 | ;; make some more ideosyncratic button types | |
140 | ||
141 | (define-button-type 'help-symbol | |
142 | 'help-function #'help-xref-interned | |
143 | 'help-echo (purecopy "mouse-2, RET: describe this symbol") | |
144 | 'action #'help-button-action) | |
145 | ||
146 | (define-button-type 'help-back | |
147 | 'help-function #'help-xref-go-back | |
148 | 'help-echo (purecopy "mouse-2, RET: go back to previous help buffer") | |
149 | 'action #'help-button-action) | |
150 | ||
151 | (define-button-type 'help-info | |
152 | 'help-function #'info | |
153 | 'help-echo (purecopy"mouse-2, RET: read this Info node") | |
154 | 'action #'help-button-action) | |
155 | ||
156 | (define-button-type 'help-customize-variable | |
157 | 'help-function (lambda (v) | |
158 | (if help-xref-stack | |
159 | (pop help-xref-stack)) | |
160 | (customize-variable v)) | |
161 | 'help-echo (purecopy "mouse-2, RET: customize variable") | |
162 | 'action #'help-button-action) | |
163 | ||
164 | (define-button-type 'help-function-def | |
165 | 'help-function (lambda (fun file) | |
166 | (require 'find-func) | |
167 | ;; Don't use find-function-noselect because it follows | |
168 | ;; aliases (which fails for built-in functions). | |
169 | (let* ((location (find-function-search-for-symbol | |
170 | fun nil file))) | |
171 | (pop-to-buffer (car location)) | |
172 | (goto-char (cdr location)))) | |
173 | 'help-echo (purecopy "mouse-2, RET: find function's definition") | |
174 | 'action #'help-button-action) | |
175 | ||
176 | (define-button-type 'help-variable-def | |
177 | 'help-function (lambda (arg) | |
178 | (let ((location | |
179 | (find-variable-noselect arg))) | |
180 | (pop-to-buffer (car location)) | |
181 | (goto-char (cdr location)))) | |
182 | 'help-echo (purecopy"mouse-2, RET: find variable's definition") | |
183 | 'action #'help-button-action) | |
184 | ||
185 | (defun help-button-action (button) | |
186 | "Call this button's help function." | |
187 | (help-do-xref (button-start button) | |
188 | (button-get button 'help-function) | |
189 | (button-get button 'help-args))) | |
190 | ||
191 | \f | |
afaa65e4 | 192 | (defun help-mode () |
400a1b1f | 193 | "Major mode for viewing help text and navigating references in it. |
afaa65e4 KH |
194 | Entry to this mode runs the normal hook `help-mode-hook'. |
195 | Commands: | |
196 | \\{help-mode-map}" | |
197 | (interactive) | |
198 | (kill-all-local-variables) | |
199 | (use-local-map help-mode-map) | |
200 | (setq mode-name "Help") | |
201 | (setq major-mode 'help-mode) | |
507fb916 | 202 | (make-local-variable 'font-lock-defaults) |
400a1b1f | 203 | (setq font-lock-defaults nil) ; font-lock would defeat xref |
42499979 | 204 | (view-mode) |
f90b6922 RS |
205 | (make-local-variable 'view-no-disable-on-exit) |
206 | (setq view-no-disable-on-exit t) | |
afaa65e4 KH |
207 | (run-hooks 'help-mode-hook)) |
208 | ||
e48143f0 RS |
209 | (defun help-mode-setup () |
210 | (help-mode) | |
211 | (setq buffer-read-only nil)) | |
212 | ||
3d02beed | 213 | (add-hook 'temp-buffer-setup-hook 'help-mode-setup) |
e48143f0 RS |
214 | |
215 | (defun help-mode-finish () | |
4e1ede6c | 216 | (when (eq major-mode 'help-mode) |
400a1b1f RS |
217 | ;; View mode's read-only status of existing *Help* buffer is lost |
218 | ;; by with-output-to-temp-buffer. | |
219 | (toggle-read-only 1) | |
220 | (help-make-xrefs (current-buffer))) | |
01364a75 RS |
221 | (setq view-return-to-alist |
222 | (list (cons (selected-window) help-return-method)))) | |
21de5941 | 223 | |
3d02beed | 224 | (add-hook 'temp-buffer-show-hook 'help-mode-finish) |
21de5941 | 225 | |
2fc9d9f4 | 226 | (defun help-quit () |
3120a677 | 227 | "Just exit from the Help command's command loop." |
2fc9d9f4 RS |
228 | (interactive) |
229 | nil) | |
230 | ||
0634ea78 KH |
231 | (defun help-with-tutorial (&optional arg) |
232 | "Select the Emacs learn-by-doing tutorial. | |
da412772 | 233 | If there is a tutorial version written in the language |
71e9bd71 | 234 | of the selected language environment, that version is used. |
da412772 | 235 | If there's no tutorial in that language, `TUTORIAL' is selected. |
c822b44b | 236 | With arg, you are asked to choose which language." |
0634ea78 | 237 | (interactive "P") |
3060bf83 KH |
238 | (let ((lang (if arg |
239 | (read-language-name 'tutorial "Language: " "English") | |
240 | (if (get-language-info current-language-environment 'tutorial) | |
241 | current-language-environment | |
ad21fa07 RS |
242 | "English"))) |
243 | file filename) | |
3060bf83 | 244 | (setq filename (get-language-info lang 'tutorial)) |
7c9b148e | 245 | (setq file (expand-file-name (concat "~/" filename))) |
433ae6f6 RS |
246 | (delete-other-windows) |
247 | (if (get-file-buffer file) | |
248 | (switch-to-buffer (get-file-buffer file)) | |
249 | (switch-to-buffer (create-file-buffer file)) | |
250 | (setq buffer-file-name file) | |
251 | (setq default-directory (expand-file-name "~/")) | |
79058860 | 252 | (setq buffer-auto-save-file-name nil) |
0634ea78 | 253 | (insert-file-contents (expand-file-name filename data-directory)) |
433ae6f6 RS |
254 | (goto-char (point-min)) |
255 | (search-forward "\n<<") | |
256 | (beginning-of-line) | |
257 | (delete-region (point) (progn (end-of-line) (point))) | |
857a1de6 | 258 | (let ((n (- (window-height (selected-window)) |
433ae6f6 | 259 | (count-lines (point-min) (point)) |
857a1de6 | 260 | 6))) |
d0da2301 | 261 | (if (< n 12) |
857a1de6 KH |
262 | (newline n) |
263 | ;; Some people get confused by the large gap. | |
264 | (newline (/ n 2)) | |
265 | (insert "[Middle of page left blank for didactic purposes. " | |
266 | "Text continues below]") | |
267 | (newline (- n (/ n 2))))) | |
433ae6f6 RS |
268 | (goto-char (point-min)) |
269 | (set-buffer-modified-p nil)))) | |
270 | ||
c085b77c GM |
271 | (defun string-key-binding (key) |
272 | "Value is the binding of KEY in a string. | |
273 | If KEY is an event on a string, and that string has a `local-map' | |
274 | or `keymap' property, return the binding of KEY in the string's keymap." | |
275 | (let* ((defn nil) | |
276 | (start (when (vectorp key) | |
277 | (if (memq (aref key 0) '(mode-line header-line)) | |
278 | (event-start (aref key 1)) | |
4b29c200 GM |
279 | (and (consp (aref key 0)) |
280 | (event-start (aref key 0)))))) | |
c085b77c GM |
281 | (string-info (and (consp start) (nth 4 start)))) |
282 | (when string-info | |
283 | (let* ((string (car string-info)) | |
284 | (pos (cdr string-info)) | |
285 | (local-map (and (> pos 0) | |
286 | (< pos (length string)) | |
287 | (or (get-text-property pos 'local-map string) | |
288 | (get-text-property pos 'keymap string))))) | |
289 | (setq defn (and local-map (lookup-key local-map key))))) | |
35831732 GM |
290 | defn)) |
291 | ||
e88a2c59 RS |
292 | (defun describe-key-briefly (key &optional insert) |
293 | "Print the name of the function KEY invokes. KEY is a string. | |
294 | If INSERT (the prefix arg) is non-nil, insert the message in the buffer." | |
295 | (interactive "kDescribe key briefly: \nP") | |
fc558e4d RS |
296 | (save-excursion |
297 | (let ((modifiers (event-modifiers (aref key 0))) | |
e88a2c59 | 298 | (standard-output (if insert (current-buffer) t)) |
fc558e4d RS |
299 | window position) |
300 | ;; For a mouse button event, go to the button it applies to | |
301 | ;; to get the right key bindings. And go to the right place | |
302 | ;; in case the keymap depends on where you clicked. | |
303 | (if (or (memq 'click modifiers) (memq 'down modifiers) | |
304 | (memq 'drag modifiers)) | |
305 | (setq window (posn-window (event-start (aref key 0))) | |
306 | position (posn-point (event-start (aref key 0))))) | |
307 | (if (windowp window) | |
308 | (progn | |
309 | (set-buffer (window-buffer window)) | |
310 | (goto-char position))) | |
311 | ;; Ok, now look up the key and name the command. | |
c085b77c | 312 | (let ((defn (or (string-key-binding key) |
35831732 | 313 | (key-binding key))) |
e88a2c59 | 314 | (key-desc (key-description key))) |
fc558e4d | 315 | (if (or (null defn) (integerp defn)) |
e88a2c59 RS |
316 | (princ (format "%s is undefined" key-desc)) |
317 | (princ (format (if insert | |
0f2aa0e1 | 318 | "`%s' (`%s')" |
e88a2c59 RS |
319 | (if (windowp window) |
320 | "%s at that spot runs the command %s" | |
321 | "%s runs the command %s")) | |
322 | key-desc | |
323 | (if (symbolp defn) defn (prin1-to-string defn))))))))) | |
433ae6f6 | 324 | |
01364a75 RS |
325 | (defvar help-return-method nil |
326 | "What to do to \"exit\" the help buffer. | |
327 | This is a list | |
328 | (WINDOW . t) delete the selected window, go to WINDOW. | |
329 | (WINDOW . quit-window) do quit-window, then select WINDOW. | |
330 | (WINDOW BUF START POINT) display BUF at START, POINT, then select WINDOW.") | |
331 | ||
433ae6f6 RS |
332 | (defun print-help-return-message (&optional function) |
333 | "Display or return message saying how to restore windows after help command. | |
334 | Computes a message and applies the optional argument FUNCTION to it. | |
335 | If FUNCTION is nil, applies `message' to it, thus printing it." | |
336 | (and (not (get-buffer-window standard-output)) | |
d536293f | 337 | (let ((first-message |
a1c9f209 | 338 | (cond ((special-display-p (buffer-name standard-output)) |
01364a75 | 339 | (setq help-return-method (cons (selected-window) t)) |
d536293f RS |
340 | ;; If the help output buffer is a special display buffer, |
341 | ;; don't say anything about how to get rid of it. | |
342 | ;; First of all, the user will do that with the window | |
343 | ;; manager, not with Emacs. | |
344 | ;; Secondly, the buffer has not been displayed yet, | |
345 | ;; so we don't know whether its frame will be selected. | |
d536293f | 346 | nil) |
f3ad2fc8 GM |
347 | (display-buffer-reuse-frames |
348 | (setq help-return-method (cons (selected-window) | |
349 | 'quit-window)) | |
350 | nil) | |
d536293f | 351 | ((not (one-window-p t)) |
01364a75 RS |
352 | (setq help-return-method |
353 | (cons (selected-window) 'quit-window)) | |
d536293f RS |
354 | "Type \\[switch-to-buffer-other-window] RET to restore the other window.") |
355 | (pop-up-windows | |
01364a75 | 356 | (setq help-return-method (cons (selected-window) t)) |
d536293f RS |
357 | "Type \\[delete-other-windows] to remove help window.") |
358 | (t | |
01364a75 RS |
359 | (setq help-return-method |
360 | (list (selected-window) (window-buffer) | |
361 | (window-start) (window-point))) | |
d536293f RS |
362 | "Type \\[switch-to-buffer] RET to remove help window.")))) |
363 | (funcall (or function 'message) | |
364 | (concat | |
365 | (if first-message | |
376b2a24 DL |
366 | (substitute-command-keys first-message)) |
367 | (if first-message " ") | |
125a8d70 RS |
368 | ;; If the help buffer will go in a separate frame, |
369 | ;; it's no use mentioning a command to scroll, so don't. | |
a1c9f209 | 370 | (if (special-display-p (buffer-name standard-output)) |
125a8d70 | 371 | nil |
a1c9f209 | 372 | (if (same-window-p (buffer-name standard-output)) |
125a8d70 RS |
373 | ;; Say how to scroll this window. |
374 | (substitute-command-keys | |
375 | "\\[scroll-up] to scroll the help.") | |
376 | ;; Say how to scroll some other window. | |
6e7f5182 | 377 | (substitute-command-keys |
125a8d70 | 378 | "\\[scroll-other-window] to scroll the help.")))))))) |
433ae6f6 RS |
379 | |
380 | (defun describe-key (key) | |
381 | "Display documentation of the function invoked by KEY. KEY is a string." | |
382 | (interactive "kDescribe key: ") | |
fc558e4d RS |
383 | (save-excursion |
384 | (let ((modifiers (event-modifiers (aref key 0))) | |
385 | window position) | |
386 | ;; For a mouse button event, go to the button it applies to | |
387 | ;; to get the right key bindings. And go to the right place | |
388 | ;; in case the keymap depends on where you clicked. | |
389 | (if (or (memq 'click modifiers) (memq 'down modifiers) | |
390 | (memq 'drag modifiers)) | |
391 | (setq window (posn-window (event-start (aref key 0))) | |
392 | position (posn-point (event-start (aref key 0))))) | |
393 | (if (windowp window) | |
394 | (progn | |
395 | (set-buffer (window-buffer window)) | |
396 | (goto-char position))) | |
c085b77c | 397 | (let ((defn (or (string-key-binding key) (key-binding key)))) |
fc558e4d RS |
398 | (if (or (null defn) (integerp defn)) |
399 | (message "%s is undefined" (key-description key)) | |
400 | (with-output-to-temp-buffer "*Help*" | |
401 | (princ (key-description key)) | |
402 | (if (windowp window) | |
403 | (princ " at that spot")) | |
404 | (princ " runs the command ") | |
405 | (prin1 defn) | |
05f6170c | 406 | (princ "\n which is ") |
0ab0e672 | 407 | (describe-function-1 defn nil (interactive-p)) |
fc558e4d | 408 | (print-help-return-message))))))) |
433ae6f6 | 409 | |
ad023904 RS |
410 | (defun describe-mode () |
411 | "Display documentation of current major mode and minor modes. | |
40b3bdc1 RS |
412 | The major mode description comes first, followed by the minor modes, |
413 | each on a separate page. | |
414 | ||
433ae6f6 | 415 | For this to work correctly for a minor mode, the mode's indicator variable |
61c6b658 | 416 | \(listed in `minor-mode-alist') must also be a function whose documentation |
433ae6f6 | 417 | describes the minor mode." |
7192540b | 418 | (interactive) |
433ae6f6 | 419 | (with-output-to-temp-buffer "*Help*" |
40b3bdc1 RS |
420 | (when minor-mode-alist |
421 | (princ "The major mode is described first. | |
422 | For minor modes, see following pages.\n\n")) | |
423 | (princ mode-name) | |
424 | (princ " mode:\n") | |
425 | (princ (documentation major-mode)) | |
426 | (help-setup-xref (list #'help-xref-mode (current-buffer)) (interactive-p)) | |
427 | (let ((minor-modes minor-mode-alist)) | |
7192540b RS |
428 | (while minor-modes |
429 | (let* ((minor-mode (car (car minor-modes))) | |
ddbe99e0 | 430 | (indicator (car (cdr (car minor-modes))))) |
7192540b RS |
431 | ;; Document a minor mode if it is listed in minor-mode-alist, |
432 | ;; bound locally in this buffer, non-nil, and has a function | |
433 | ;; definition. | |
4675e266 GM |
434 | (if (and (boundp minor-mode) |
435 | (symbol-value minor-mode) | |
7192540b RS |
436 | (fboundp minor-mode)) |
437 | (let ((pretty-minor-mode minor-mode)) | |
438 | (if (string-match "-mode$" (symbol-name minor-mode)) | |
439 | (setq pretty-minor-mode | |
440 | (capitalize | |
441 | (substring (symbol-name minor-mode) | |
442 | 0 (match-beginning 0))))) | |
e95419a6 RS |
443 | (while (and indicator (symbolp indicator) |
444 | (boundp indicator) | |
445 | (not (eq indicator (symbol-value indicator)))) | |
7192540b | 446 | (setq indicator (symbol-value indicator))) |
40b3bdc1 | 447 | (princ "\n\f\n") |
2ef581f3 RS |
448 | (princ (format "%s minor mode (%s):\n" |
449 | pretty-minor-mode | |
450 | (if indicator | |
451 | (format "indicator%s" indicator) | |
452 | "no indicator"))) | |
40b3bdc1 | 453 | (princ (documentation minor-mode))))) |
7192540b | 454 | (setq minor-modes (cdr minor-modes)))) |
433ae6f6 RS |
455 | (print-help-return-message))) |
456 | ||
457 | ;; So keyboard macro definitions are documented correctly | |
458 | (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) | |
459 | ||
460 | (defun describe-distribution () | |
461 | "Display info on how to obtain the latest version of GNU Emacs." | |
462 | (interactive) | |
463 | (find-file-read-only | |
1e6dacf6 | 464 | (expand-file-name "DISTRIB" data-directory))) |
433ae6f6 RS |
465 | |
466 | (defun describe-copying () | |
467 | "Display info on how you may redistribute copies of GNU Emacs." | |
468 | (interactive) | |
469 | (find-file-read-only | |
1e6dacf6 | 470 | (expand-file-name "COPYING" data-directory)) |
433ae6f6 RS |
471 | (goto-char (point-min))) |
472 | ||
76766f2d RS |
473 | (defun describe-project () |
474 | "Display info on the GNU project." | |
475 | (interactive) | |
476 | (find-file-read-only | |
869e248d | 477 | (expand-file-name "THE-GNU-PROJECT" data-directory)) |
76766f2d RS |
478 | (goto-char (point-min))) |
479 | ||
433ae6f6 RS |
480 | (defun describe-no-warranty () |
481 | "Display info on all the kinds of warranty Emacs does NOT have." | |
482 | (interactive) | |
483 | (describe-copying) | |
484 | (let (case-fold-search) | |
485 | (search-forward "NO WARRANTY") | |
486 | (recenter 0))) | |
487 | ||
61c6b658 | 488 | (defun describe-prefix-bindings () |
c7cba9cb RS |
489 | "Describe the bindings of the prefix used to reach this command. |
490 | The prefix described consists of all but the last event | |
491 | of the key sequence that ran this command." | |
61c6b658 | 492 | (interactive) |
ccc06dcc KH |
493 | (let* ((key (this-command-keys))) |
494 | (describe-bindings | |
495 | (if (stringp key) | |
496 | (substring key 0 (1- (length key))) | |
497 | (let ((prefix (make-vector (1- (length key)) nil)) | |
498 | (i 0)) | |
499 | (while (< i (length prefix)) | |
500 | (aset prefix i (aref key i)) | |
501 | (setq i (1+ i))) | |
502 | prefix))))) | |
c7cba9cb RS |
503 | ;; Make C-h after a prefix, when not specifically bound, |
504 | ;; run describe-prefix-bindings. | |
61c6b658 RS |
505 | (setq prefix-help-command 'describe-prefix-bindings) |
506 | ||
382d018a RS |
507 | (defun view-emacs-news (&optional arg) |
508 | "Display info on recent changes to Emacs. | |
f0753a5f | 509 | With numeric argument, display information on correspondingly older changes." |
382d018a | 510 | (interactive "P") |
f0753a5f GM |
511 | (let* ((arg (if arg (prefix-numeric-value arg) 0)) |
512 | (file (cond ((eq arg 0) "NEWS") | |
513 | ((eq arg 1) "ONEWS") | |
514 | (t | |
515 | (nth (- arg 2) | |
516 | (nreverse (directory-files data-directory | |
975f82c9 | 517 | nil "^ONEWS\\.[0-9]+$" |
f0753a5f GM |
518 | nil))))))) |
519 | (if file | |
520 | (find-file-read-only (expand-file-name file data-directory)) | |
521 | (error "No such old news")))) | |
433ae6f6 | 522 | |
754084bb GM |
523 | (defun view-order-manuals () |
524 | "Display the Emacs ORDERS file." | |
525 | (interactive) | |
38790755 GM |
526 | (find-file-read-only (expand-file-name "ORDERS" data-directory)) |
527 | (goto-address)) | |
754084bb | 528 | |
7ee71cf1 RS |
529 | (defun view-emacs-FAQ () |
530 | "Display the Emacs Frequently Asked Questions (FAQ) file." | |
531 | (interactive) | |
4a8adb0b | 532 | ;;; (find-file-read-only (expand-file-name "FAQ" data-directory)) |
279b772d | 533 | (info "(efaq)")) |
7ee71cf1 | 534 | |
4cbff657 DL |
535 | (defun view-emacs-problems () |
536 | "Display info on known problems with Emacs and possible workarounds." | |
537 | (interactive) | |
538 | (view-file (expand-file-name "PROBLEMS" data-directory))) | |
539 | ||
433ae6f6 | 540 | (defun view-lossage () |
50b57199 EZ |
541 | "Display last 100 input keystrokes. |
542 | ||
543 | To record all your input on a file, use `open-dribble-file'." | |
433ae6f6 RS |
544 | (interactive) |
545 | (with-output-to-temp-buffer "*Help*" | |
298a7c8c RS |
546 | (princ (mapconcat (function (lambda (key) |
547 | (if (or (integerp key) | |
548 | (symbolp key) | |
549 | (listp key)) | |
550 | (single-key-description key) | |
551 | (prin1-to-string key nil)))) | |
552 | (recent-keys) | |
553 | " ")) | |
433ae6f6 RS |
554 | (save-excursion |
555 | (set-buffer standard-output) | |
556 | (goto-char (point-min)) | |
557 | (while (progn (move-to-column 50) (not (eobp))) | |
558 | (search-forward " " nil t) | |
613a39b9 RS |
559 | (insert "\n")) |
560 | (setq help-xref-stack nil | |
561 | help-xref-stack-item nil)) | |
433ae6f6 RS |
562 | (print-help-return-message))) |
563 | ||
2fc9d9f4 | 564 | (defalias 'help 'help-for-help) |
41b8542b | 565 | (make-help-screen help-for-help |
a30a106b | 566 | "a b c C f F C-f i I k C-k l L m n p s t v w C-c C-d C-n C-p C-w; ? for help:" |
a82e9c01 | 567 | "You have typed %THIS-KEY%, the help character. Type a Help option: |
efcce2d2 | 568 | \(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.) |
433ae6f6 | 569 | |
21ee8c42 RM |
570 | a command-apropos. Give a substring, and see a list of commands |
571 | (functions interactively callable) that contain | |
572 | that substring. See also the apropos command. | |
af6a9de9 RS |
573 | b describe-bindings. Display table of all key bindings. |
574 | c describe-key-briefly. Type a command key sequence; | |
21ee8c42 | 575 | it prints the function name that sequence runs. |
a30a106b RS |
576 | C describe-coding-system. This describes either a specific coding system |
577 | (if you type its name) or the coding systems currently in use | |
578 | (if you type just RET). | |
af6a9de9 | 579 | f describe-function. Type a function name and get documentation of it. |
21ee8c42 RM |
580 | C-f Info-goto-emacs-command-node. Type a function name; |
581 | it takes you to the Info node for that command. | |
af6a9de9 | 582 | i info. The info documentation reader. |
a30a106b RS |
583 | I describe-input-method. Describe a specific input method (if you type |
584 | its name) or the current input method (if you type just RET). | |
90a56040 KH |
585 | C-i info-lookup-symbol. Display the definition of a specific symbol |
586 | as found in the manual for the language this buffer is written in. | |
af6a9de9 | 587 | k describe-key. Type a command key sequence; |
21ee8c42 RM |
588 | it displays the full documentation. |
589 | C-k Info-goto-emacs-key-command-node. Type a command key sequence; | |
590 | it takes you to the Info node for the command bound to that key. | |
90a56040 | 591 | l view-lossage. Show last 100 characters you typed. |
5760471f | 592 | L describe-language-environment. This describes either a |
a30a106b RS |
593 | specific language environment (if you type its name) |
594 | or the current language environment (if you type just RET). | |
ed13681f KH |
595 | m describe-mode. Print documentation of current minor modes, |
596 | and the current major mode, including their special commands. | |
90a56040 | 597 | n view-emacs-news. Display news of recent Emacs changes. |
af6a9de9 | 598 | p finder-by-keyword. Find packages matching a given topic keyword. |
e0c21266 | 599 | s describe-syntax. Display contents of syntax table, plus explanations. |
af6a9de9 RS |
600 | t help-with-tutorial. Select the Emacs learn-by-doing tutorial. |
601 | v describe-variable. Type name of a variable; | |
21ee8c42 | 602 | it displays the variable's documentation and value. |
af6a9de9 | 603 | w where-is. Type command name; it prints which keystrokes |
21ee8c42 | 604 | invoke that command. |
a30a106b RS |
605 | |
606 | F Display the frequently asked questions file. | |
607 | h Display the HELLO file which illustrates various scripts. | |
608 | C-c Display Emacs copying permission (General Public License). | |
609 | C-d Display Emacs ordering information. | |
610 | C-n Display news of recent Emacs changes. | |
611 | C-p Display information about the GNU project. | |
612 | C-w Display information on absence of warranty for GNU Emacs." | |
41b8542b | 613 | help-map) |
433ae6f6 | 614 | |
433ae6f6 | 615 | (defun function-called-at-point () |
b2c85790 DL |
616 | "Return a function around point or else called by the list containing point. |
617 | If that doesn't give a function, return nil." | |
9a200f68 DL |
618 | (with-syntax-table emacs-lisp-mode-syntax-table |
619 | (or (condition-case () | |
620 | (save-excursion | |
621 | (or (not (zerop (skip-syntax-backward "_w"))) | |
622 | (eq (char-syntax (following-char)) ?w) | |
623 | (eq (char-syntax (following-char)) ?_) | |
624 | (forward-sexp -1)) | |
625 | (skip-chars-forward "'") | |
626 | (let ((obj (read (current-buffer)))) | |
627 | (and (symbolp obj) (fboundp obj) obj))) | |
628 | (error nil)) | |
629 | (condition-case () | |
630 | (save-excursion | |
631 | (save-restriction | |
632 | (narrow-to-region (max (point-min) | |
633 | (- (point) 1000)) (point-max)) | |
634 | ;; Move up to surrounding paren, then after the open. | |
635 | (backward-up-list 1) | |
636 | (forward-char 1) | |
637 | ;; If there is space here, this is probably something | |
638 | ;; other than a real Lisp function call, so ignore it. | |
639 | (if (looking-at "[ \t]") | |
640 | (error "Probably not a Lisp function call")) | |
641 | (let ((obj (read (current-buffer)))) | |
642 | (and (symbolp obj) (fboundp obj) obj)))) | |
643 | (error nil))))) | |
433ae6f6 | 644 | |
0f619a41 KH |
645 | (defvar symbol-file-load-history-loaded nil |
646 | "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'. | |
647 | That file records the part of `load-history' for preloaded files, | |
648 | which is cleared out before dumping to make Emacs smaller.") | |
649 | ||
50ca4be0 GM |
650 | (defun load-symbol-file-load-history () |
651 | "Load the file `fns-VERSION.el' in `exec-directory' if not already done. | |
652 | That file records the part of `load-history' for preloaded files, | |
653 | which is cleared out before dumping to make Emacs smaller." | |
0f619a41 KH |
654 | (unless symbol-file-load-history-loaded |
655 | (load (expand-file-name | |
656 | ;; fns-XX.YY.ZZ.el does not work on DOS filesystem. | |
657 | (if (eq system-type 'ms-dos) | |
658 | "fns.el" | |
659 | (format "fns-%s.el" emacs-version)) | |
660 | exec-directory) | |
661 | ;; The file name fns-%s.el already has a .el extension. | |
662 | nil nil t) | |
50ca4be0 GM |
663 | (setq symbol-file-load-history-loaded t))) |
664 | ||
665 | (defun symbol-file (function) | |
666 | "Return the input source from which FUNCTION was loaded. | |
667 | The value is normally a string that was passed to `load': | |
668 | either an absolute file name, or a library name | |
669 | \(with no directory name and no `.el' or `.elc' at the end). | |
670 | It can also be nil, if the definition is not associated with any file." | |
671 | (load-symbol-file-load-history) | |
ca5ed196 RS |
672 | (let ((files load-history) |
673 | file functions) | |
674 | (while files | |
675 | (if (memq function (cdr (car files))) | |
676 | (setq file (car (car files)) files nil)) | |
677 | (setq files (cdr files))) | |
678 | file)) | |
679 | ||
433ae6f6 RS |
680 | (defun describe-function (function) |
681 | "Display the full documentation of FUNCTION (a symbol)." | |
682 | (interactive | |
683 | (let ((fn (function-called-at-point)) | |
684 | (enable-recursive-minibuffers t) | |
685 | val) | |
686 | (setq val (completing-read (if fn | |
687 | (format "Describe function (default %s): " fn) | |
688 | "Describe function: ") | |
1bacc93e | 689 | obarray 'fboundp t nil nil (symbol-name fn))) |
433ae6f6 RS |
690 | (list (if (equal val "") |
691 | fn (intern val))))) | |
00d3de8e RS |
692 | (if function |
693 | (with-output-to-temp-buffer "*Help*" | |
694 | (prin1 function) | |
eea844b2 RS |
695 | ;; Use " is " instead of a colon so that |
696 | ;; it is easier to get out the function name using forward-sexp. | |
697 | (princ " is ") | |
0ab0e672 | 698 | (describe-function-1 function nil (interactive-p)) |
00d3de8e RS |
699 | (print-help-return-message) |
700 | (save-excursion | |
701 | (set-buffer standard-output) | |
00d3de8e RS |
702 | ;; Return the text we displayed. |
703 | (buffer-string))) | |
704 | (message "You didn't specify a function"))) | |
705 | ||
0ab0e672 | 706 | (defun describe-function-1 (function parens interactive-p) |
6016b6e4 RS |
707 | (let* ((def (if (symbolp function) |
708 | (symbol-function function) | |
709 | function)) | |
05f6170c KH |
710 | file-name string need-close |
711 | (beg (if (commandp def) "an interactive " "a "))) | |
712 | (setq string | |
713 | (cond ((or (stringp def) | |
714 | (vectorp def)) | |
715 | "a keyboard macro") | |
716 | ((subrp def) | |
d16296bb DL |
717 | (if (eq 'unevalled (cdr (subr-arity def))) |
718 | (concat beg "special form") | |
719 | (concat beg "built-in function"))) | |
05f6170c KH |
720 | ((byte-code-function-p def) |
721 | (concat beg "compiled Lisp function")) | |
722 | ((symbolp def) | |
3f8309db RS |
723 | (while (symbolp (symbol-function def)) |
724 | (setq def (symbol-function def))) | |
213f4eae | 725 | (format "an alias for `%s'" def)) |
05f6170c KH |
726 | ((eq (car-safe def) 'lambda) |
727 | (concat beg "Lisp function")) | |
728 | ((eq (car-safe def) 'macro) | |
729 | "a Lisp macro") | |
730 | ((eq (car-safe def) 'mocklisp) | |
731 | "a mocklisp function") | |
732 | ((eq (car-safe def) 'autoload) | |
733 | (setq file-name (nth 1 def)) | |
aed2b2cd | 734 | (format "%s autoloaded %s" |
05f6170c | 735 | (if (commandp def) "an interactive" "an") |
aed2b2cd AS |
736 | (if (eq (nth 4 def) 'keymap) "keymap" |
737 | (if (nth 4 def) "Lisp macro" "Lisp function")) | |
05f6170c | 738 | )) |
b89d72a1 RS |
739 | ;; perhaps use keymapp here instead |
740 | ((eq (car-safe def) 'keymap) | |
741 | (let ((is-full nil) | |
742 | (elts (cdr-safe def))) | |
743 | (while elts | |
744 | (if (char-table-p (car-safe elts)) | |
745 | (setq is-full t | |
746 | elts nil)) | |
747 | (setq elts (cdr-safe elts))) | |
748 | (if is-full | |
749 | "a full keymap" | |
750 | "a sparse keymap"))) | |
05f6170c KH |
751 | (t ""))) |
752 | (when (and parens (not (equal string ""))) | |
753 | (setq need-close t) | |
754 | (princ "(")) | |
755 | (princ string) | |
b2c85790 DL |
756 | (with-current-buffer "*Help*" |
757 | (save-excursion | |
758 | (save-match-data | |
759 | (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) | |
0cf0d828 | 760 | (help-xref-button 1 'help-function def))))) |
05f6170c | 761 | (or file-name |
0f619a41 | 762 | (setq file-name (symbol-file function))) |
05f6170c KH |
763 | (if file-name |
764 | (progn | |
765 | (princ " in `") | |
766 | ;; We used to add .el to the file name, | |
767 | ;; but that's completely wrong when the user used load-file. | |
768 | (princ file-name) | |
2676e099 DL |
769 | (princ "'") |
770 | ;; Make a hyperlink to the library. | |
771 | (with-current-buffer "*Help*" | |
772 | (save-excursion | |
773 | (re-search-backward "`\\([^`']+\\)'" nil t) | |
0cf0d828 | 774 | (help-xref-button 1 'help-function-def function file-name))))) |
05f6170c KH |
775 | (if need-close (princ ")")) |
776 | (princ ".") | |
777 | (terpri) | |
3f8309db RS |
778 | ;; Handle symbols aliased to other symbols. |
779 | (setq def (indirect-function def)) | |
780 | ;; If definition is a macro, find the function inside it. | |
781 | (if (eq (car-safe def) 'macro) | |
782 | (setq def (cdr def))) | |
783 | (let ((arglist (cond ((byte-code-function-p def) | |
784 | (car (append def nil))) | |
785 | ((eq (car-safe def) 'lambda) | |
786 | (nth 1 def)) | |
f0d0fb19 DL |
787 | ((and (eq (car-safe def) 'autoload) |
788 | (not (eq (nth 4 def) 'keymap))) | |
789 | (concat "[Arg list not available until " | |
790 | "function definition is loaded.]")) | |
3f8309db | 791 | (t t)))) |
f0d0fb19 DL |
792 | (cond ((listp arglist) |
793 | (princ (cons (if (symbolp function) function "anonymous") | |
794 | (mapcar (lambda (arg) | |
795 | (if (memq arg '(&optional &rest)) | |
796 | arg | |
797 | (intern (upcase (symbol-name arg))))) | |
798 | arglist))) | |
799 | (terpri)) | |
800 | ((stringp arglist) | |
801 | (princ arglist) | |
802 | (terpri)))) | |
05f6170c KH |
803 | (let ((doc (documentation function))) |
804 | (if doc | |
805 | (progn (terpri) | |
806 | (princ doc) | |
6ce5615d | 807 | (if (subrp def) |
d16296bb DL |
808 | (with-current-buffer standard-output |
809 | (beginning-of-line) | |
810 | ;; Builtins get the calling sequence at the end of | |
811 | ;; the doc string. Move it to the same place as | |
812 | ;; for other functions. | |
9c50afce DL |
813 | |
814 | ;; In cases where `function' has been fset to a | |
815 | ;; subr we can't search for function's name in | |
816 | ;; the doc string. Kluge round that using the | |
817 | ;; printed representation. The arg list then | |
818 | ;; shows the wrong function name, but that | |
819 | ;; might be a useful hint. | |
820 | (let* ((rep (prin1-to-string def)) | |
821 | (name (progn | |
822 | (string-match " \\([^ ]+\\)>$" rep) | |
823 | (match-string 1 rep)))) | |
0383ed60 | 824 | (if (looking-at (format "(%s[ )]" (regexp-quote name))) |
9c50afce DL |
825 | (let ((start (point-marker))) |
826 | (goto-char (point-min)) | |
827 | (forward-paragraph) | |
828 | (insert-buffer-substring (current-buffer) start) | |
829 | (insert ?\n) | |
830 | (delete-region (1- start) (point-max))) | |
831 | (goto-char (point-min)) | |
832 | (forward-paragraph) | |
833 | (insert | |
834 | "[Missing arglist. Please make a bug report.]\n"))) | |
d16296bb | 835 | (goto-char (point-max)))) |
f0d0fb19 DL |
836 | (help-setup-xref (list #'describe-function function) |
837 | interactive-p)) | |
05f6170c KH |
838 | (princ "not documented"))))) |
839 | ||
433ae6f6 | 840 | (defun variable-at-point () |
b2c85790 DL |
841 | "Return the bound variable symbol found around point. |
842 | Return 0 if there is no such symbol." | |
433ae6f6 | 843 | (condition-case () |
9a200f68 DL |
844 | (with-syntax-table emacs-lisp-mode-syntax-table |
845 | (save-excursion | |
846 | (or (not (zerop (skip-syntax-backward "_w"))) | |
847 | (eq (char-syntax (following-char)) ?w) | |
848 | (eq (char-syntax (following-char)) ?_) | |
849 | (forward-sexp -1)) | |
850 | (skip-chars-forward "'") | |
851 | (let ((obj (read (current-buffer)))) | |
852 | (or (and (symbolp obj) (boundp obj) obj) | |
853 | 0)))) | |
00d3de8e | 854 | (error 0))) |
433ae6f6 | 855 | |
2e48ba18 GM |
856 | (defun help-xref-on-pp (from to) |
857 | "Add xrefs for symbols in `pp's output between FROM and TO." | |
858 | (let ((ost (syntax-table))) | |
859 | (unwind-protect | |
860 | (save-excursion | |
861 | (save-restriction | |
862 | (set-syntax-table emacs-lisp-mode-syntax-table) | |
863 | (narrow-to-region from to) | |
864 | (goto-char (point-min)) | |
865 | (while (not (eobp)) | |
866 | (cond | |
867 | ((looking-at "\"") (forward-sexp 1)) | |
868 | ((looking-at "#<") (search-forward ">" nil 'move)) | |
869 | ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)") | |
4e1ede6c | 870 | (let* ((sym (intern-soft (match-string 1))) |
0cf0d828 | 871 | (type (cond ((fboundp sym) 'help-function) |
820ad5e7 DL |
872 | ((or (memq sym '(t nil)) |
873 | (keywordp sym)) | |
874 | nil) | |
875 | ((and sym (boundp sym)) | |
0cf0d828 MB |
876 | 'help-variable)))) |
877 | (when type (help-xref-button 1 type sym))) | |
2e48ba18 GM |
878 | (goto-char (match-end 1))) |
879 | (t (forward-char 1)))))) | |
880 | (set-syntax-table ost)))) | |
881 | ||
4e1ede6c | 882 | (defun describe-variable (variable &optional buffer) |
433ae6f6 | 883 | "Display the full documentation of VARIABLE (a symbol). |
4e1ede6c SM |
884 | Returns the documentation as a string, also. |
885 | If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), | |
886 | it is displayed along with the global value." | |
887 | (interactive | |
433ae6f6 RS |
888 | (let ((v (variable-at-point)) |
889 | (enable-recursive-minibuffers t) | |
890 | val) | |
00d3de8e | 891 | (setq val (completing-read (if (symbolp v) |
820ad5e7 DL |
892 | (format |
893 | "Describe variable (default %s): " v) | |
433ae6f6 | 894 | "Describe variable: ") |
d5645846 KH |
895 | obarray 'boundp t nil nil |
896 | (if (symbolp v) (symbol-name v)))) | |
433ae6f6 RS |
897 | (list (if (equal val "") |
898 | v (intern val))))) | |
4e1ede6c SM |
899 | (unless (bufferp buffer) (setq buffer (current-buffer))) |
900 | (if (not (symbolp variable)) | |
901 | (message "You did not specify a variable") | |
902 | (let (valvoid) | |
903 | (with-current-buffer buffer | |
9a656d19 RS |
904 | (with-output-to-temp-buffer "*Help*" |
905 | (prin1 variable) | |
906 | (if (not (boundp variable)) | |
907 | (progn | |
908 | (princ " is void") | |
9a656d19 | 909 | (setq valvoid t)) |
2e48ba18 GM |
910 | (let ((val (symbol-value variable))) |
911 | (with-current-buffer standard-output | |
912 | (princ "'s value is ") | |
913 | (terpri) | |
914 | (let ((from (point))) | |
915 | (pp val) | |
7727f3c0 RS |
916 | (help-xref-on-pp from (point)) |
917 | (if (< (point) (+ from 20)) | |
918 | (save-excursion | |
919 | (goto-char from) | |
920 | (delete-char -1))))))) | |
2e48ba18 | 921 | (terpri) |
9a656d19 RS |
922 | (if (local-variable-p variable) |
923 | (progn | |
924 | (princ (format "Local in buffer %s; " (buffer-name))) | |
925 | (if (not (default-boundp variable)) | |
926 | (princ "globally void") | |
2e48ba18 GM |
927 | (let ((val (default-value variable))) |
928 | (with-current-buffer standard-output | |
929 | (princ "global value is ") | |
930 | (terpri) | |
9a200f68 DL |
931 | ;; Fixme: pp can take an age if you happen to |
932 | ;; ask for a very large expression. We should | |
933 | ;; probably print it raw once and check it's a | |
934 | ;; sensible size before prettyprinting. -- fx | |
2e48ba18 GM |
935 | (let ((from (point))) |
936 | (pp val) | |
7727f3c0 RS |
937 | (help-xref-on-pp from (point)) |
938 | (if (< (point) (+ from 20)) | |
939 | (save-excursion | |
940 | (goto-char from) | |
941 | (delete-char -1))))))) | |
9a656d19 RS |
942 | (terpri))) |
943 | (terpri) | |
4e1ede6c | 944 | (with-current-buffer standard-output |
9a656d19 RS |
945 | (if (> (count-lines (point-min) (point-max)) 10) |
946 | (progn | |
d365421f GM |
947 | ;; Note that setting the syntax table like below |
948 | ;; makes forward-sexp move over a `'s' at the end | |
949 | ;; of a symbol. | |
14cc00ad | 950 | (set-syntax-table emacs-lisp-mode-syntax-table) |
9a656d19 RS |
951 | (goto-char (point-min)) |
952 | (if valvoid | |
953 | (forward-line 1) | |
954 | (forward-sexp 1) | |
955 | (delete-region (point) (progn (end-of-line) (point))) | |
d365421f | 956 | (insert " value is shown below.\n\n") |
9a656d19 RS |
957 | (save-excursion |
958 | (insert "\n\nValue:")))))) | |
959 | (princ "Documentation:") | |
960 | (terpri) | |
961 | (let ((doc (documentation-property variable 'variable-documentation))) | |
962 | (princ (or doc "not documented as a variable."))) | |
4e1ede6c SM |
963 | (help-setup-xref (list #'describe-variable variable (current-buffer)) |
964 | (interactive-p)) | |
965 | ||
7e824765 | 966 | ;; Make a link to customize if this variable can be customized. |
be66e132 | 967 | ;; Note, it is not reliable to test only for a custom-type property |
4f103eaa RS |
968 | ;; because those are only present after the var's definition |
969 | ;; has been loaded. | |
96757035 DL |
970 | (if (or (get variable 'custom-type) ; after defcustom |
971 | (get variable 'custom-loads) ; from loaddefs.el | |
972 | (get variable 'standard-value)) ; from cus-start.el | |
7e824765 RS |
973 | (let ((customize-label "customize")) |
974 | (terpri) | |
975 | (terpri) | |
976 | (princ (concat "You can " customize-label " this variable.")) | |
977 | (with-current-buffer "*Help*" | |
978 | (save-excursion | |
4e1ede6c | 979 | (re-search-backward |
7e824765 | 980 | (concat "\\(" customize-label "\\)") nil t) |
0cf0d828 | 981 | (help-xref-button 1 'help-customize-variable variable))))) |
3476e159 DL |
982 | ;; Make a hyperlink to the library if appropriate. (Don't |
983 | ;; change the format of the buffer's initial line in case | |
984 | ;; anything expects the current format.) | |
0f619a41 | 985 | (let ((file-name (symbol-file variable))) |
3476e159 | 986 | (when file-name |
5f373960 | 987 | (princ "\n\nDefined in `") |
3476e159 | 988 | (princ file-name) |
5f373960 | 989 | (princ "'.") |
3476e159 DL |
990 | (with-current-buffer "*Help*" |
991 | (save-excursion | |
5f373960 | 992 | (re-search-backward "`\\([^`']+\\)'" nil t) |
0cf0d828 | 993 | (help-xref-button 1 'help-variable-def variable))))) |
7e824765 | 994 | |
9a656d19 RS |
995 | (print-help-return-message) |
996 | (save-excursion | |
997 | (set-buffer standard-output) | |
9a656d19 | 998 | ;; Return the text we displayed. |
4e1ede6c | 999 | (buffer-string))))))) |
433ae6f6 | 1000 | |
4c45295b | 1001 | (defun describe-bindings (&optional prefix buffer) |
a8ad43aa RS |
1002 | "Show a list of all defined keys, and their definitions. |
1003 | We put that list in a buffer, and display the buffer. | |
1004 | ||
1005 | The optional argument PREFIX, if non-nil, should be a key sequence; | |
4c45295b KH |
1006 | then we display only bindings that start with that prefix. |
1007 | The optional argument BUFFER specifies which buffer's bindings | |
1008 | to display (default, the current buffer)." | |
a249d3a0 | 1009 | (interactive "P") |
4c45295b KH |
1010 | (or buffer (setq buffer (current-buffer))) |
1011 | (with-current-buffer buffer | |
1012 | (describe-bindings-internal nil prefix)) | |
613a39b9 | 1013 | (with-current-buffer "*Help*" |
4c45295b KH |
1014 | (help-setup-xref (list #'describe-bindings prefix buffer) |
1015 | (interactive-p)))) | |
a8ad43aa | 1016 | |
e88a2c59 | 1017 | (defun where-is (definition &optional insert) |
b2c85790 | 1018 | "Print message listing key sequences that invoke the command DEFINITION. |
e88a2c59 RS |
1019 | Argument is a command definition, usually a symbol with a function definition. |
1020 | If INSERT (the prefix arg) is non-nil, insert the message in the buffer." | |
54c0b967 RS |
1021 | (interactive |
1022 | (let ((fn (function-called-at-point)) | |
1023 | (enable-recursive-minibuffers t) | |
1024 | val) | |
1025 | (setq val (completing-read (if fn | |
1026 | (format "Where is command (default %s): " fn) | |
1027 | "Where is command: ") | |
d5f65532 | 1028 | obarray 'commandp t)) |
54c0b967 | 1029 | (list (if (equal val "") |
e88a2c59 RS |
1030 | fn (intern val)) |
1031 | current-prefix-arg))) | |
54c0b967 | 1032 | (let* ((keys (where-is-internal definition overriding-local-map nil nil)) |
e88a2c59 RS |
1033 | (keys1 (mapconcat 'key-description keys ", ")) |
1034 | (standard-output (if insert (current-buffer) t))) | |
1035 | (if insert | |
1036 | (if (> (length keys1) 0) | |
1037 | (princ (format "%s (%s)" keys1 definition)) | |
1038 | (princ (format "M-x %s RET" definition))) | |
1039 | (if (> (length keys1) 0) | |
1040 | (princ (format "%s is on %s" definition keys1)) | |
1041 | (princ (format "%s is not on any key" definition))))) | |
54c0b967 RS |
1042 | nil) |
1043 | ||
a130d829 | 1044 | (defun locate-library (library &optional nosuffix path interactive-call) |
2747503c | 1045 | "Show the precise file name of Emacs library LIBRARY. |
433ae6f6 RS |
1046 | This command searches the directories in `load-path' like `M-x load-library' |
1047 | to find the file that `M-x load-library RET LIBRARY RET' would load. | |
1048 | Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' | |
9dc176a0 RS |
1049 | to the specified name LIBRARY. |
1050 | ||
1051 | If the optional third arg PATH is specified, that list of directories | |
b2c85790 DL |
1052 | is used instead of `load-path'. |
1053 | ||
1054 | When called from a program, the file name is normaly returned as a | |
1055 | string. When run interactively, the argument INTERACTIVE-CALL is t, | |
1056 | and the file name is displayed in the echo area." | |
a130d829 RS |
1057 | (interactive (list (read-string "Locate library: ") |
1058 | nil nil | |
1059 | t)) | |
dd557bb8 | 1060 | (let (result) |
a130d829 | 1061 | (catch 'answer |
e3e36d74 | 1062 | (mapc |
a1c9f209 | 1063 | (lambda (dir) |
e3e36d74 | 1064 | (mapc |
a1c9f209 EN |
1065 | (lambda (suf) |
1066 | (let ((try (expand-file-name (concat library suf) dir))) | |
1067 | (and (file-readable-p try) | |
1068 | (null (file-directory-p try)) | |
1069 | (progn | |
1070 | (setq result try) | |
1071 | (throw 'answer try))))) | |
1072 | (if nosuffix | |
1073 | '("") | |
dd557bb8 | 1074 | '(".elc" ".el" "") |
f1c53471 EZ |
1075 | (let ((basic '(".elc" ".el" "")) |
1076 | (compressed '(".Z" ".gz" ""))) | |
1077 | ;; If autocompression mode is on, | |
1078 | ;; consider all combinations of library suffixes | |
1079 | ;; and compression suffixes. | |
1080 | (if (rassq 'jka-compr-handler file-name-handler-alist) | |
1081 | (apply 'nconc | |
1082 | (mapcar (lambda (compelt) | |
1083 | (mapcar (lambda (baselt) | |
1084 | (concat baselt compelt)) | |
1085 | basic)) | |
1086 | compressed)) | |
1087 | basic))))) | |
a130d829 RS |
1088 | (or path load-path))) |
1089 | (and interactive-call | |
1090 | (if result | |
1091 | (message "Library is file %s" result) | |
1092 | (message "No library %s in search path" library))) | |
1093 | result)) | |
1a06eabd | 1094 | |
400a1b1f RS |
1095 | \f |
1096 | ;;; Grokking cross-reference information in doc strings and | |
1097 | ;;; hyperlinking it. | |
1098 | ||
1099 | ;; This may have some scope for extension and the same or something | |
1100 | ;; similar should be done for widget doc strings, which currently use | |
1101 | ;; another mechanism. | |
1102 | ||
1103 | (defcustom help-highlight-p t | |
1104 | "*If non-nil, `help-make-xrefs' highlight cross-references. | |
1105 | Under a window system it highlights them with face defined by | |
510df933 | 1106 | `help-highlight-face'." |
400a1b1f RS |
1107 | :group 'help |
1108 | :version "20.3" | |
1109 | :type 'boolean) | |
1110 | ||
1111 | (defcustom help-highlight-face 'underline | |
1112 | "Face used by `help-make-xrefs' to highlight cross-references. | |
1113 | Must be previously-defined." | |
1114 | :group 'help | |
1115 | :version "20.3" | |
7f082394 | 1116 | :type 'face) |
400a1b1f | 1117 | |
4607e12b | 1118 | (defvar help-back-label (purecopy "[back]") |
400a1b1f RS |
1119 | "Label to use by `help-make-xrefs' for the go-back reference.") |
1120 | ||
4607e12b DL |
1121 | (defconst help-xref-symbol-regexp |
1122 | (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|" | |
1123 | "\\(function\\|command\\)\\|" | |
950cf06f | 1124 | "\\(face\\)\\|" |
9bc4554a RS |
1125 | "\\(symbol\\)\\|" |
1126 | "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)\\s-+\\)?" | |
4607e12b DL |
1127 | ;; Note starting with word-syntax character: |
1128 | "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")) | |
400a1b1f RS |
1129 | "Regexp matching doc string references to symbols. |
1130 | ||
1131 | The words preceding the quoted symbol can be used in doc strings to | |
1132 | distinguish references to variables, functions and symbols.") | |
1133 | ||
cba62b78 | 1134 | (defconst help-xref-mule-regexp nil |
5b7a8c46 | 1135 | "Regexp matching doc string references to MULE-related keywords. |
cba62b78 | 1136 | |
5b7a8c46 EZ |
1137 | It is usually nil, and is temporarily bound to an appropriate regexp |
1138 | when help commands related to multilingual environment (e.g., | |
1139 | `describe-coding-system') are invoked.") | |
cba62b78 KH |
1140 | |
1141 | ||
4607e12b DL |
1142 | (defconst help-xref-info-regexp |
1143 | (purecopy "\\<[Ii]nfo[ \t\n]+node[ \t\n]+`\\([^']+\\)'") | |
400a1b1f RS |
1144 | "Regexp matching doc string references to an Info node.") |
1145 | ||
1146 | (defun help-setup-xref (item interactive-p) | |
1147 | "Invoked from commands using the \"*Help*\" buffer to install some xref info. | |
1148 | ||
4c45295b | 1149 | ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help |
400a1b1f RS |
1150 | buffer after following a reference. INTERACTIVE-P is non-nil if the |
1151 | calling command was invoked interactively. In this case the stack of | |
1152 | items for help buffer \"back\" buttons is cleared." | |
1153 | (if interactive-p | |
1154 | (setq help-xref-stack nil)) | |
1155 | (setq help-xref-stack-item item)) | |
1156 | ||
376b2a24 DL |
1157 | (defvar help-xref-following nil |
1158 | "Non-nil when following a help cross-reference.") | |
1159 | ||
400a1b1f RS |
1160 | (defun help-make-xrefs (&optional buffer) |
1161 | "Parse and hyperlink documentation cross-references in the given BUFFER. | |
1162 | ||
1163 | Find cross-reference information in a buffer and, if | |
1164 | `help-highlight-p' is non-nil, highlight it with face defined by | |
1165 | `help-highlight-face'; activate such cross references for selection | |
1166 | with `help-follow'. Cross-references have the canonical form `...' | |
1167 | and the type of reference may be disambiguated by the preceding | |
1168 | word(s) used in `help-xref-symbol-regexp'. | |
1169 | ||
cba62b78 | 1170 | If the variable `help-xref-mule-regexp' is non-nil, find also |
5b7a8c46 EZ |
1171 | cross-reference information related to multilingual environment |
1172 | \(e.g., coding-systems). This variable is also used to disambiguate | |
1173 | the type of reference as the same way as `help-xref-symbol-regexp'. | |
cba62b78 | 1174 | |
400a1b1f RS |
1175 | A special reference `back' is made to return back through a stack of |
1176 | help buffers. Variable `help-back-label' specifies the text for | |
1177 | that." | |
1178 | (interactive "b") | |
1179 | (save-excursion | |
1180 | (set-buffer (or buffer (current-buffer))) | |
1181 | (goto-char (point-min)) | |
1182 | ;; Skip the header-type info, though it might be useful to parse | |
1183 | ;; it at some stage (e.g. "function in `library'"). | |
1184 | (forward-paragraph) | |
1185 | (let ((old-modified (buffer-modified-p))) | |
1186 | (let ((stab (syntax-table)) | |
1187 | (case-fold-search t) | |
1188 | (inhibit-read-only t)) | |
1189 | (set-syntax-table emacs-lisp-mode-syntax-table) | |
1190 | ;; The following should probably be abstracted out. | |
1191 | (unwind-protect | |
1192 | (progn | |
f58790da RS |
1193 | ;; Info references |
1194 | (save-excursion | |
1195 | (while (re-search-forward help-xref-info-regexp nil t) | |
1196 | (let ((data (match-string 1))) | |
1197 | (save-match-data | |
1198 | (unless (string-match "^([^)]+)" data) | |
1199 | (setq data (concat "(emacs)" data)))) | |
0cf0d828 | 1200 | (help-xref-button 1 'help-info data)))) |
cba62b78 KH |
1201 | ;; Mule related keywords. Do this before trying |
1202 | ;; `help-xref-symbol-regexp' because some of Mule | |
1203 | ;; keywords have variable or function definitions. | |
1204 | (if help-xref-mule-regexp | |
1205 | (save-excursion | |
1206 | (while (re-search-forward help-xref-mule-regexp nil t) | |
96ede6b2 | 1207 | (let* ((data (match-string 7)) |
cba62b78 KH |
1208 | (sym (intern-soft data))) |
1209 | (cond | |
1210 | ((match-string 3) ; coding system | |
880c345e | 1211 | (and sym (coding-system-p sym) |
0cf0d828 | 1212 | (help-xref-button 6 'help-coding-system sym))) |
cba62b78 KH |
1213 | ((match-string 4) ; input method |
1214 | (and (assoc data input-method-alist) | |
0cf0d828 | 1215 | (help-xref-button 7 'help-input-method data))) |
96ede6b2 KH |
1216 | ((or (match-string 5) (match-string 6)) ; charset |
1217 | (and sym (charsetp sym) | |
0cf0d828 | 1218 | (help-xref-button 7 'help-character-set sym))) |
96ede6b2 | 1219 | ((assoc data input-method-alist) |
0cf0d828 | 1220 | (help-xref-button 7 'help-character-set data)) |
880c345e | 1221 | ((and sym (coding-system-p sym)) |
0cf0d828 | 1222 | (help-xref-button 7 'help-coding-system sym)) |
96ede6b2 | 1223 | ((and sym (charsetp sym)) |
0cf0d828 | 1224 | (help-xref-button 7 'help-character-set sym))))))) |
400a1b1f RS |
1225 | ;; Quoted symbols |
1226 | (save-excursion | |
1227 | (while (re-search-forward help-xref-symbol-regexp nil t) | |
9bc4554a | 1228 | (let* ((data (match-string 8)) |
400a1b1f RS |
1229 | (sym (intern-soft data))) |
1230 | (if sym | |
1231 | (cond | |
1232 | ((match-string 3) ; `variable' &c | |
1233 | (and (boundp sym) ; `variable' doesn't ensure | |
1234 | ; it's actually bound | |
0cf0d828 | 1235 | (help-xref-button 8 'help-variable sym))) |
400a1b1f RS |
1236 | ((match-string 4) ; `function' &c |
1237 | (and (fboundp sym) ; similarly | |
0cf0d828 | 1238 | (help-xref-button 8 'help-function sym))) |
950cf06f DL |
1239 | ((match-string 5) ; `face' |
1240 | (and (facep sym) | |
0cf0d828 | 1241 | (help-xref-button 8 'help-face sym))) |
9bc4554a RS |
1242 | ((match-string 6)) ; nothing for `symbol' |
1243 | ((match-string 7) | |
0cf0d828 MB |
1244 | ;; this used: |
1245 | ;; #'(lambda (arg) | |
1246 | ;; (let ((location | |
1247 | ;; (find-function-noselect arg))) | |
1248 | ;; (pop-to-buffer (car location)) | |
1249 | ;; (goto-char (cdr location)))) | |
1250 | (help-xref-button 8 'help-function-def sym)) | |
d77dae5c | 1251 | ((and (boundp sym) (fboundp sym)) |
400a1b1f RS |
1252 | ;; We can't intuit whether to use the |
1253 | ;; variable or function doc -- supply both. | |
0cf0d828 | 1254 | (help-xref-button 8 'help-symbol sym)) |
d77dae5c | 1255 | ((boundp sym) |
0cf0d828 | 1256 | (help-xref-button 8 'help-variable sym)) |
d77dae5c | 1257 | ((fboundp sym) |
0cf0d828 | 1258 | (help-xref-button 8 'help-function sym)) |
950cf06f | 1259 | ((facep sym) |
0cf0d828 | 1260 | (help-xref-button 8 'help-face sym))))))) |
400a1b1f | 1261 | ;; An obvious case of a key substitution: |
4e1ede6c | 1262 | (save-excursion |
b2c85790 DL |
1263 | (while (re-search-forward |
1264 | ;; Assume command name is only word characters | |
1265 | ;; and dashes to get things like `use M-x foo.'. | |
1266 | "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t) | |
400a1b1f RS |
1267 | (let ((sym (intern-soft (match-string 1)))) |
1268 | (if (fboundp sym) | |
0cf0d828 | 1269 | (help-xref-button 1 'help-function sym))))) |
ff3453e4 DL |
1270 | ;; Look for commands in whole keymap substitutions: |
1271 | (save-excursion | |
9b49f910 RS |
1272 | ;; Make sure to find the first keymap. |
1273 | (goto-char (point-min)) | |
ff3453e4 DL |
1274 | ;; Find a header and the column at which the command |
1275 | ;; name will be found. | |
4e1ede6c | 1276 | (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" |
ff3453e4 DL |
1277 | nil t) |
1278 | (let ((col (- (match-end 1) (match-beginning 1)))) | |
1279 | (while | |
1280 | ;; Ignore single blank lines in table, but not | |
1281 | ;; double ones, which should terminate it. | |
95ac0a6f | 1282 | (and (not (looking-at "\n\\s-*\n")) |
ff3453e4 | 1283 | (progn |
657cca97 AS |
1284 | (and (eolp) (forward-line)) |
1285 | (end-of-line) | |
1286 | (skip-chars-backward "^\t\n") | |
1287 | (if (and (>= (current-column) col) | |
377d15d9 | 1288 | (looking-at "\\(\\sw\\|-\\)+$")) |
ff3453e4 DL |
1289 | (let ((sym (intern-soft (match-string 0)))) |
1290 | (if (fboundp sym) | |
0cf0d828 | 1291 | (help-xref-button 0 'help-function sym)))) |
657cca97 | 1292 | (zerop (forward-line))))))))) |
400a1b1f | 1293 | (set-syntax-table stab)) |
a2e6f426 MB |
1294 | ;; Delete extraneous newlines at the end of the docstring |
1295 | (goto-char (point-max)) | |
1296 | (while (and (not (bobp)) (bolp)) | |
1297 | (delete-char -1)) | |
400a1b1f | 1298 | ;; Make a back-reference in this buffer if appropriate. |
376b2a24 | 1299 | (when (and help-xref-following help-xref-stack) |
0cf0d828 MB |
1300 | (insert "\n\n") |
1301 | (help-insert-xref-button help-back-label 'help-back | |
1302 | (current-buffer)))) | |
400a1b1f RS |
1303 | ;; View mode steals RET from us. |
1304 | (set (make-local-variable 'minor-mode-overriding-map-alist) | |
1305 | (list (cons 'view-mode | |
1306 | (let ((map (make-sparse-keymap))) | |
ff3453e4 | 1307 | (set-keymap-parent map view-mode-map) |
400a1b1f RS |
1308 | (define-key map "\r" 'help-follow) |
1309 | map)))) | |
1310 | (set-buffer-modified-p old-modified)))) | |
1311 | ||
0cf0d828 | 1312 | (defun help-xref-button (match-number type &rest args) |
400a1b1f | 1313 | "Make a hyperlink for cross-reference text previously matched. |
400a1b1f | 1314 | MATCH-NUMBER is the subexpression of interest in the last matched |
0cf0d828 MB |
1315 | regexp. TYPE is the type of button to use. Any remaining arguments are |
1316 | passed to the button's help-function when it is invoked. | |
1317 | See `help-make-xrefs'." | |
5f373960 | 1318 | ;; Don't mung properties we've added specially in some instances. |
0cf0d828 MB |
1319 | (unless (button-at (match-beginning match-number)) |
1320 | (make-text-button (match-beginning match-number) | |
1321 | (match-end match-number) | |
1322 | 'type type 'help-args args))) | |
96ede6b2 | 1323 | |
0cf0d828 MB |
1324 | (defun help-insert-xref-button (string type &rest args) |
1325 | "Insert STRING and make a hyperlink from cross-reference text on it. | |
1326 | TYPE is the type of button to use. Any remaining arguments are passed | |
1327 | to the button's help-function when it is invoked. | |
1328 | See `help-make-xrefs'." | |
1329 | (unless (button-at (point)) | |
1330 | (insert-text-button string 'type type 'help-args args))) | |
96ede6b2 | 1331 | |
400a1b1f RS |
1332 | \f |
1333 | ;; Additional functions for (re-)creating types of help buffers. | |
1334 | (defun help-xref-interned (symbol) | |
1335 | "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. | |
1336 | ||
1337 | Both variable and function documentation are extracted into a single | |
1338 | help buffer." | |
950cf06f DL |
1339 | (let ((fdoc (when (fboundp symbol) (describe-function symbol))) |
1340 | (facedoc (when (facep symbol) (describe-face symbol)))) | |
accd1266 SM |
1341 | (when (or (boundp symbol) (not fdoc)) |
1342 | (describe-variable symbol) | |
1343 | ;; We now have a help buffer on the variable. Insert the function | |
1344 | ;; text before it. | |
950cf06f | 1345 | (when (or fdoc facedoc) |
accd1266 SM |
1346 | (with-current-buffer "*Help*" |
1347 | (goto-char (point-min)) | |
1348 | (let ((inhibit-read-only t)) | |
950cf06f DL |
1349 | (when fdoc |
1350 | (insert fdoc "\n\n")) | |
1351 | (when facedoc | |
1352 | (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) | |
1353 | " is also a " "face." "\n\n" facedoc "\n\n")) | |
1354 | (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) | |
1355 | " is also a " "variable." "\n\n")) | |
accd1266 | 1356 | (help-setup-xref (list #'help-xref-interned symbol) nil)))))) |
400a1b1f RS |
1357 | |
1358 | (defun help-xref-mode (buffer) | |
1359 | "Do a `describe-mode' for the specified BUFFER." | |
1360 | (save-excursion | |
1361 | (set-buffer buffer) | |
1362 | (describe-mode))) | |
0cf0d828 | 1363 | |
400a1b1f RS |
1364 | \f |
1365 | ;;; Navigation/hyperlinking with xrefs | |
1366 | ||
613a39b9 | 1367 | (defun help-xref-go-back (buffer) |
b2c85790 | 1368 | "From BUFFER, go back to previous help buffer text using `help-xref-stack'." |
4c45295b | 1369 | (let (item position method args) |
613a39b9 RS |
1370 | (with-current-buffer buffer |
1371 | (when help-xref-stack | |
1372 | (setq help-xref-stack (cdr help-xref-stack)) ; due to help-follow | |
376b2a24 | 1373 | (setq item (pop help-xref-stack) |
4c45295b KH |
1374 | position (car item) |
1375 | method (cadr item) | |
376b2a24 | 1376 | args (cddr item)))) |
4c45295b | 1377 | (apply method args) |
376b2a24 DL |
1378 | ;; We assume that the buffer we just recreated has the saved name, |
1379 | ;; which might not always be true. | |
1380 | (when (get-buffer (cdr position)) | |
1381 | (with-current-buffer (cdr position) | |
1382 | (goto-char (car position)))))) | |
400a1b1f RS |
1383 | |
1384 | (defun help-go-back () | |
b2c85790 | 1385 | "Invoke the [back] button (if any) in the Help mode buffer." |
400a1b1f | 1386 | (interactive) |
0cf0d828 MB |
1387 | (let ((back-button (button-at (1- (point-max))))) |
1388 | (if back-button | |
1389 | (button-activate back-button) | |
1390 | (error "No [back] button")))) | |
1391 | ||
1392 | (defun help-do-xref (pos function args) | |
1393 | "Call the help cross-reference function FUNCTION with args ARGS. | |
1394 | Things are set up properly so that the resulting help-buffer has | |
1395 | a proper [back] button." | |
1396 | (setq help-xref-stack (cons (cons (cons pos (buffer-name)) | |
1397 | help-xref-stack-item) | |
1398 | help-xref-stack)) | |
1399 | (setq help-xref-stack-item nil) | |
1400 | ;; There is a reference at point. Follow it. | |
1401 | (let ((help-xref-following t)) | |
1402 | (apply function args))) | |
400a1b1f | 1403 | |
400c12fd | 1404 | (defun help-follow (&optional pos) |
400a1b1f RS |
1405 | "Follow cross-reference at POS, defaulting to point. |
1406 | ||
1407 | For the cross-reference format, see `help-make-xrefs'." | |
1408 | (interactive "d") | |
400c12fd DL |
1409 | (unless pos |
1410 | (setq pos (point))) | |
0cf0d828 MB |
1411 | (unless (push-button pos) |
1412 | ;; check if the symbol under point is a function or variable | |
1413 | (let ((sym | |
1414 | (intern | |
1415 | (save-excursion | |
1416 | (goto-char pos) (skip-syntax-backward "w_") | |
1417 | (buffer-substring (point) | |
1418 | (progn (skip-syntax-forward "w_") | |
1419 | (point))))))) | |
1420 | (when (or (boundp sym) (fboundp sym)) | |
1421 | (help-do-xref pos #'help-xref-interned (list sym)))))) | |
400a1b1f | 1422 | |
48ce3c22 RS |
1423 | \f |
1424 | ;;; Automatic resizing of temporary buffers. | |
1425 | ||
4483ddc5 | 1426 | (defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) |
48ce3c22 RS |
1427 | "*Maximum height of a window displaying a temporary buffer. |
1428 | This is the maximum height (in text lines) which `resize-temp-buffer-window' | |
1429 | will give to a window displaying a temporary buffer. | |
1430 | It can also be a function which will be called with the object corresponding | |
1431 | to the buffer to be displayed as argument and should return an integer | |
1432 | positive number." | |
1433 | :type '(choice integer function) | |
1434 | :group 'help | |
1435 | :version "20.4") | |
1436 | ||
4e1ede6c SM |
1437 | (define-minor-mode temp-buffer-resize-mode |
1438 | "Toggle the mode which makes windows smaller for temporary buffers. | |
48ce3c22 RS |
1439 | With prefix argument ARG, turn the resizing of windows displaying temporary |
1440 | buffers on if ARG is positive or off otherwise. | |
4e1ede6c SM |
1441 | This makes the window the right height for its contents, but never |
1442 | more than `temp-buffer-max-height' nor less than `window-min-height'. | |
1443 | This applies to `help', `apropos' and `completion' buffers, and some others." | |
1444 | nil nil nil :global t :group 'help | |
1445 | (if temp-buffer-resize-mode | |
57f43907 | 1446 | ;; `help-make-xrefs' may add a `back' button and thus increase the |
4e1ede6c SM |
1447 | ;; text size, so `resize-temp-buffer-window' must be run *after* it. |
1448 | (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) | |
8304a3bb | 1449 | (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window))) |
48ce3c22 RS |
1450 | |
1451 | (defun resize-temp-buffer-window () | |
1452 | "Resize the current window to fit its contents. | |
4483ddc5 | 1453 | Will not make it higher than `temp-buffer-max-height' nor smaller than |
b2c85790 | 1454 | `window-min-height'. Do nothing if it is the only window on its frame, if it |
48ce3c22 RS |
1455 | is not as wide as the frame or if some of the window's contents are scrolled |
1456 | out of view." | |
1457 | (unless (or (one-window-p 'nomini) | |
1458 | (not (pos-visible-in-window-p (point-min))) | |
1459 | (/= (frame-width) (window-width))) | |
d9c30bdf MB |
1460 | (fit-window-to-buffer |
1461 | (selected-window) | |
1462 | (if (functionp temp-buffer-max-height) | |
1463 | (funcall temp-buffer-max-height (current-buffer)) | |
1464 | temp-buffer-max-height)))) | |
48ce3c22 | 1465 | |
f0d0fb19 DL |
1466 | ;; `help-manyarg-func-alist' is defined primitively (in doc.c). |
1467 | ;; New primitives with `MANY' or `UNEVALLED' arglists should be added | |
1468 | ;; to this alist. | |
1469 | ;; The parens and function name are redundant, but it's messy to add | |
1470 | ;; them in `documentation'. | |
3b4429b4 DL |
1471 | |
1472 | ;; This will find any missing items: | |
1473 | ;; (let (l) | |
1474 | ;; (mapatoms (lambda (x) | |
1475 | ;; (if (and (fboundp x) | |
1476 | ;; (subrp (symbol-function x)) | |
1477 | ;; (not (numberp (cdr (subr-arity (symbol-function x))))) | |
1478 | ;; (not (assq x help-manyarg-func-alist))) | |
1479 | ;; (push x l)))) | |
1480 | ;; l) | |
f0d0fb19 DL |
1481 | (defconst help-manyarg-func-alist |
1482 | (purecopy | |
1483 | '((list . "(list &rest OBJECTS)") | |
1484 | (vector . "(vector &rest OBJECTS)") | |
1485 | (make-byte-code . "(make-byte-code &rest ELEMENTS)") | |
1486 | (call-process | |
1487 | . "(call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)") | |
e3e36d74 DL |
1488 | (call-process-region |
1489 | . "(call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS)") | |
f0d0fb19 DL |
1490 | (string . "(string &rest CHARACTERS)") |
1491 | (+ . "(+ &rest NUMBERS-OR-MARKERS)") | |
1492 | (- . "(- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS)") | |
1493 | (* . "(* &rest NUMBERS-OR-MARKERS)") | |
1494 | (/ . "(/ DIVIDEND DIVISOR &rest DIVISORS)") | |
1495 | (max . "(max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)") | |
1496 | (min . "(min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)") | |
1497 | (logand . "(logand &rest INTS-OR-MARKERS)") | |
1498 | (logior . "(logior &rest INTS-OR-MARKERS)") | |
1499 | (logxor . "(logxor &rest INTS-OR-MARKERS)") | |
1500 | (encode-time | |
1501 | . "(encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)") | |
1502 | (insert . "(insert &rest ARGS)") | |
9a200f68 | 1503 | (insert-and-inherit . "(insert-and-inherit &rest ARGS)") |
f0d0fb19 DL |
1504 | (insert-before-markers . "(insert-before-markers &rest ARGS)") |
1505 | (message . "(message STRING &rest ARGUMENTS)") | |
1506 | (message-box . "(message-box STRING &rest ARGUMENTS)") | |
1507 | (message-or-box . "(message-or-box STRING &rest ARGUMENTS)") | |
1508 | (propertize . "(propertize STRING &rest PROPERTIES)") | |
1509 | (format . "(format STRING &rest OBJECTS)") | |
1510 | (apply . "(apply FUNCTION &rest ARGUMENTS)") | |
1511 | (run-hooks . "(run-hooks &rest HOOKS)") | |
2de47765 DL |
1512 | (run-hook-with-args . "(run-hook-with-args HOOK &rest ARGS)") |
1513 | (run-hook-with-args-until-failure | |
1514 | . "(run-hook-with-args-until-failure HOOK &rest ARGS)") | |
1515 | (run-hook-with-args-until-success | |
1516 | . "(run-hook-with-args-until-success HOOK &rest ARGS)") | |
f0d0fb19 DL |
1517 | (funcall . "(funcall FUNCTION &rest ARGUMENTS)") |
1518 | (append . "(append &rest SEQUENCES)") | |
1519 | (concat . "(concat &rest SEQUENCES)") | |
46c56972 | 1520 | (vconcat . "(vconcat &rest SEQUENCES)") |
f0d0fb19 DL |
1521 | (nconc . "(nconc &rest LISTS)") |
1522 | (widget-apply . "(widget-apply WIDGET PROPERTY &rest ARGS)") | |
1523 | (make-hash-table . "(make-hash-table &rest KEYWORD-ARGS)") | |
1524 | (insert-string . "(insert-string &rest ARGS)") | |
1525 | (start-process . "(start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)") | |
1526 | (setq-default . "(setq-default SYMBOL VALUE [SYMBOL VALUE...])") | |
1527 | (save-excursion . "(save-excursion &rest BODY)") | |
1528 | (save-current-buffer . "(save-current-buffer &rest BODY)") | |
1529 | (save-restriction . "(save-restriction &rest BODY)") | |
1530 | (or . "(or CONDITIONS ...)") | |
1531 | (and . "(and CONDITIONS ...)") | |
1532 | (if . "(if COND THEN ELSE...)") | |
1533 | (cond . "(cond CLAUSES...)") | |
1534 | (progn . "(progn BODY ...)") | |
1535 | (prog1 . "(prog1 FIRST BODY...)") | |
1536 | (prog2 . "(prog2 X Y BODY...)") | |
1537 | (setq . "(setq SYM VAL SYM VAL ...)") | |
1538 | (quote . "(quote ARG)") | |
1539 | (function . "(function ARG)") | |
1540 | (defun . "(defun NAME ARGLIST [DOCSTRING] BODY...)") | |
1541 | (defmacro . "(defmacro NAME ARGLIST [DOCSTRING] BODY...)") | |
1542 | (defvar . "(defvar SYMBOL [INITVALUE DOCSTRING])") | |
1543 | (defconst . "(defconst SYMBOL INITVALUE [DOCSTRING])") | |
1544 | (let* . "(let* VARLIST BODY...)") | |
1545 | (let . "(let VARLIST BODY...)") | |
1546 | (while . "(while TEST BODY...)") | |
1547 | (catch . "(catch TAG BODY...)") | |
1548 | (unwind-protect . "(unwind-protect BODYFORM UNWINDFORMS...)") | |
1549 | (condition-case . "(condition-case VAR BODYFORM HANDLERS...)") | |
194959c7 | 1550 | (track-mouse . "(track-mouse BODY ...)") |
2de47765 DL |
1551 | (ml-if . "(ml-if COND THEN ELSE...)") |
1552 | (ml-provide-prefix-argument . "(ml-provide-prefix-argument ARG1 ARG2)") | |
3b4429b4 | 1553 | (ml-prefix-argument-loop . "(ml-prefix-argument-loop ...)") |
2de47765 DL |
1554 | (with-output-to-temp-buffer |
1555 | . "(with-output-to-temp-buffer BUFFNAME BODY ...)") | |
caf047ec DL |
1556 | (save-window-excursion . "(save-window-excursion BODY ...)") |
1557 | (find-operation-coding-system | |
3b4429b4 DL |
1558 | . "(find-operation-coding-system OPERATION ARGUMENTS ...)") |
1559 | (insert-before-markers-and-inherit | |
1560 | . "(insert-before-markers-and-inherit &rest ARGS)")))) | |
f0d0fb19 | 1561 | |
5fbeea74 GM |
1562 | ;; Provide this for the sake of define-minor-mode which generates |
1563 | ;; defcustoms which require 'help'. | |
1564 | ||
1565 | (provide 'help) | |
1566 | ||
1a06eabd | 1567 | ;;; help.el ends here |