Mercurial > emacs
comparison lisp/help-mode.el @ 39727:3806fe844742
New file, contents mostly from `help.el'.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Tue, 09 Oct 2001 11:16:25 +0000 |
parents | |
children | b44e34df3fa2 |
comparison
equal
deleted
inserted
replaced
39726:19d78cd38271 | 39727:3806fe844742 |
---|---|
1 ;;; help-mode.el --- `help-mode' used by *Help* buffers | |
2 | |
3 ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001 | |
4 ;; Free Software Foundation, Inc. | |
5 | |
6 ;; Maintainer: FSF | |
7 ;; Keywords: help, internal | |
8 | |
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 | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
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 | |
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. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; Defines `help-mode', which is the mode used by *Help* buffers, and | |
29 ;; associated support machinery, such as adding hyperlinks, etc., | |
30 | |
31 ;;; Code: | |
32 | |
33 (require 'button) | |
34 (eval-when-compile (require 'view)) | |
35 | |
36 (defvar help-mode-map (make-sparse-keymap) | |
37 "Keymap for help mode.") | |
38 | |
39 (set-keymap-parent help-mode-map button-buffer-map) | |
40 | |
41 (define-key help-mode-map "\C-c\C-b" 'help-go-back) | |
42 (define-key help-mode-map "\C-c\C-c" 'help-follow) | |
43 ;; Documentation only, since we use minor-mode-overriding-map-alist. | |
44 (define-key help-mode-map "\r" 'help-follow) | |
45 | |
46 (defvar help-xref-stack nil | |
47 "A stack of ways by which to return to help buffers after following xrefs. | |
48 Used by `help-follow' and `help-xref-go-back'. | |
49 An element looks like (POSITION FUNCTION ARGS...), where POSITION is | |
50 `(POINT . BUFFER-NAME)'. | |
51 To use the element, do (apply FUNCTION ARGS) then goto the point in | |
52 the named buffer.") | |
53 (put 'help-xref-stack 'permanent-local t) | |
54 | |
55 (defvar help-xref-stack-item nil | |
56 "An item for `help-follow' in this buffer to push onto `help-xref-stack'. | |
57 The format is (FUNCTION ARGS...).") | |
58 (put 'help-xref-stack-item 'permanent-local t) | |
59 | |
60 (setq-default help-xref-stack nil help-xref-stack-item nil) | |
61 | |
62 | |
63 | |
64 ;; Button types used by help | |
65 | |
66 ;; Make some button types that all use the same naming conventions | |
67 (dolist (help-type '("function" "variable" "face" | |
68 "coding-system" "input-method" "character-set")) | |
69 (define-button-type (intern (purecopy (concat "help-" help-type))) | |
70 'help-function (intern (concat "describe-" help-type)) | |
71 'help-echo (purecopy (concat "mouse-2, RET: describe this " help-type)) | |
72 'action #'help-button-action)) | |
73 | |
74 ;; make some more ideosyncratic button types | |
75 | |
76 (define-button-type 'help-symbol | |
77 'help-function #'help-xref-interned | |
78 'help-echo (purecopy "mouse-2, RET: describe this symbol") | |
79 'action #'help-button-action) | |
80 | |
81 (define-button-type 'help-back | |
82 'help-function #'help-xref-go-back | |
83 'help-echo (purecopy "mouse-2, RET: go back to previous help buffer") | |
84 'action #'help-button-action) | |
85 | |
86 (define-button-type 'help-info | |
87 'help-function #'info | |
88 'help-echo (purecopy"mouse-2, RET: read this Info node") | |
89 'action #'help-button-action) | |
90 | |
91 (define-button-type 'help-customize-variable | |
92 'help-function (lambda (v) | |
93 (if help-xref-stack | |
94 (pop help-xref-stack)) | |
95 (customize-variable v)) | |
96 'help-echo (purecopy "mouse-2, RET: customize variable") | |
97 'action #'help-button-action) | |
98 | |
99 (define-button-type 'help-function-def | |
100 'help-function (lambda (fun file) | |
101 (require 'find-func) | |
102 ;; Don't use find-function-noselect because it follows | |
103 ;; aliases (which fails for built-in functions). | |
104 (let* ((location (find-function-search-for-symbol | |
105 fun nil file))) | |
106 (pop-to-buffer (car location)) | |
107 (goto-char (cdr location)))) | |
108 'help-echo (purecopy "mouse-2, RET: find function's definition") | |
109 'action #'help-button-action) | |
110 | |
111 (define-button-type 'help-variable-def | |
112 'help-function (lambda (var &optional file) | |
113 (let ((location | |
114 (find-variable-noselect var file))) | |
115 (pop-to-buffer (car location)) | |
116 (goto-char (cdr location)))) | |
117 'help-echo (purecopy"mouse-2, RET: find variable's definition") | |
118 'action #'help-button-action) | |
119 | |
120 (defun help-button-action (button) | |
121 "Call BUTTON's help function." | |
122 (help-do-xref (button-start button) | |
123 (button-get button 'help-function) | |
124 (button-get button 'help-args))) | |
125 | |
126 | |
127 ;;;###autoload | |
128 (define-derived-mode help-mode nil "Help" | |
129 "Major mode for viewing help text and navigating references in it. | |
130 Entry to this mode runs the normal hook `help-mode-hook'. | |
131 Commands: | |
132 \\{help-mode-map}" | |
133 (setq font-lock-defaults nil) ; font-lock would defeat xref | |
134 (view-mode) | |
135 (make-local-variable 'view-no-disable-on-exit) | |
136 (setq view-no-disable-on-exit t)) | |
137 | |
138 ;;;###autoload | |
139 (defun help-mode-setup () | |
140 (help-mode) | |
141 (setq buffer-read-only nil)) | |
142 | |
143 ;;;###autoload | |
144 (defun help-mode-finish () | |
145 (when (eq major-mode 'help-mode) | |
146 ;; View mode's read-only status of existing *Help* buffer is lost | |
147 ;; by with-output-to-temp-buffer. | |
148 (toggle-read-only 1) | |
149 (help-make-xrefs (current-buffer))) | |
150 (setq view-return-to-alist | |
151 (list (cons (selected-window) help-return-method)))) | |
152 | |
153 | |
154 ;;; Grokking cross-reference information in doc strings and | |
155 ;;; hyperlinking it. | |
156 | |
157 ;; This may have some scope for extension and the same or something | |
158 ;; similar should be done for widget doc strings, which currently use | |
159 ;; another mechanism. | |
160 | |
161 (defcustom help-highlight-p t | |
162 "*If non-nil, `help-make-xrefs' highlight cross-references. | |
163 Under a window system it highlights them with face defined by | |
164 `help-highlight-face'." | |
165 :group 'help | |
166 :version "20.3" | |
167 :type 'boolean) | |
168 | |
169 (defcustom help-highlight-face 'underline | |
170 "Face used by `help-make-xrefs' to highlight cross-references. | |
171 Must be previously-defined." | |
172 :group 'help | |
173 :version "20.3" | |
174 :type 'face) | |
175 | |
176 (defvar help-back-label (purecopy "[back]") | |
177 "Label to use by `help-make-xrefs' for the go-back reference.") | |
178 | |
179 (defconst help-xref-symbol-regexp | |
180 (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|" | |
181 "\\(function\\|command\\)\\|" | |
182 "\\(face\\)\\|" | |
183 "\\(symbol\\)\\|" | |
184 "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)\\s-+\\)?" | |
185 ;; Note starting with word-syntax character: | |
186 "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")) | |
187 "Regexp matching doc string references to symbols. | |
188 | |
189 The words preceding the quoted symbol can be used in doc strings to | |
190 distinguish references to variables, functions and symbols.") | |
191 | |
192 (defconst help-xref-mule-regexp nil | |
193 "Regexp matching doc string references to MULE-related keywords. | |
194 | |
195 It is usually nil, and is temporarily bound to an appropriate regexp | |
196 when help commands related to multilingual environment (e.g., | |
197 `describe-coding-system') are invoked.") | |
198 | |
199 | |
200 (defconst help-xref-info-regexp | |
201 (purecopy "\\<[Ii]nfo[ \t\n]+node[ \t\n]+`\\([^']+\\)'") | |
202 "Regexp matching doc string references to an Info node.") | |
203 | |
204 ;;;###autoload | |
205 (defun help-setup-xref (item interactive-p) | |
206 "Invoked from commands using the \"*Help*\" buffer to install some xref info. | |
207 | |
208 ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help | |
209 buffer after following a reference. INTERACTIVE-P is non-nil if the | |
210 calling command was invoked interactively. In this case the stack of | |
211 items for help buffer \"back\" buttons is cleared." | |
212 (if interactive-p | |
213 (setq help-xref-stack nil)) | |
214 (setq help-xref-stack-item item)) | |
215 | |
216 (defvar help-xref-following nil | |
217 "Non-nil when following a help cross-reference.") | |
218 | |
219 ;;;###autoload | |
220 (defun help-make-xrefs (&optional buffer) | |
221 "Parse and hyperlink documentation cross-references in the given BUFFER. | |
222 | |
223 Find cross-reference information in a buffer and, if | |
224 `help-highlight-p' is non-nil, highlight it with face defined by | |
225 `help-highlight-face'; activate such cross references for selection | |
226 with `help-follow'. Cross-references have the canonical form `...' | |
227 and the type of reference may be disambiguated by the preceding | |
228 word(s) used in `help-xref-symbol-regexp'. | |
229 | |
230 If the variable `help-xref-mule-regexp' is non-nil, find also | |
231 cross-reference information related to multilingual environment | |
232 \(e.g., coding-systems). This variable is also used to disambiguate | |
233 the type of reference as the same way as `help-xref-symbol-regexp'. | |
234 | |
235 A special reference `back' is made to return back through a stack of | |
236 help buffers. Variable `help-back-label' specifies the text for | |
237 that." | |
238 (interactive "b") | |
239 (save-excursion | |
240 (set-buffer (or buffer (current-buffer))) | |
241 (goto-char (point-min)) | |
242 ;; Skip the header-type info, though it might be useful to parse | |
243 ;; it at some stage (e.g. "function in `library'"). | |
244 (forward-paragraph) | |
245 (let ((old-modified (buffer-modified-p))) | |
246 (let ((stab (syntax-table)) | |
247 (case-fold-search t) | |
248 (inhibit-read-only t)) | |
249 (set-syntax-table emacs-lisp-mode-syntax-table) | |
250 ;; The following should probably be abstracted out. | |
251 (unwind-protect | |
252 (progn | |
253 ;; Info references | |
254 (save-excursion | |
255 (while (re-search-forward help-xref-info-regexp nil t) | |
256 (let ((data (match-string 1))) | |
257 (save-match-data | |
258 (unless (string-match "^([^)]+)" data) | |
259 (setq data (concat "(emacs)" data)))) | |
260 (help-xref-button 1 'help-info data)))) | |
261 ;; Mule related keywords. Do this before trying | |
262 ;; `help-xref-symbol-regexp' because some of Mule | |
263 ;; keywords have variable or function definitions. | |
264 (if help-xref-mule-regexp | |
265 (save-excursion | |
266 (while (re-search-forward help-xref-mule-regexp nil t) | |
267 (let* ((data (match-string 7)) | |
268 (sym (intern-soft data))) | |
269 (cond | |
270 ((match-string 3) ; coding system | |
271 (and sym (coding-system-p sym) | |
272 (help-xref-button 6 'help-coding-system sym))) | |
273 ((match-string 4) ; input method | |
274 (and (assoc data input-method-alist) | |
275 (help-xref-button 7 'help-input-method data))) | |
276 ((or (match-string 5) (match-string 6)) ; charset | |
277 (and sym (charsetp sym) | |
278 (help-xref-button 7 'help-character-set sym))) | |
279 ((assoc data input-method-alist) | |
280 (help-xref-button 7 'help-character-set data)) | |
281 ((and sym (coding-system-p sym)) | |
282 (help-xref-button 7 'help-coding-system sym)) | |
283 ((and sym (charsetp sym)) | |
284 (help-xref-button 7 'help-character-set sym))))))) | |
285 ;; Quoted symbols | |
286 (save-excursion | |
287 (while (re-search-forward help-xref-symbol-regexp nil t) | |
288 (let* ((data (match-string 8)) | |
289 (sym (intern-soft data))) | |
290 (if sym | |
291 (cond | |
292 ((match-string 3) ; `variable' &c | |
293 (and (boundp sym) ; `variable' doesn't ensure | |
294 ; it's actually bound | |
295 (help-xref-button 8 'help-variable sym))) | |
296 ((match-string 4) ; `function' &c | |
297 (and (fboundp sym) ; similarly | |
298 (help-xref-button 8 'help-function sym))) | |
299 ((match-string 5) ; `face' | |
300 (and (facep sym) | |
301 (help-xref-button 8 'help-face sym))) | |
302 ((match-string 6)) ; nothing for `symbol' | |
303 ((match-string 7) | |
304 ;; this used: | |
305 ;; #'(lambda (arg) | |
306 ;; (let ((location | |
307 ;; (find-function-noselect arg))) | |
308 ;; (pop-to-buffer (car location)) | |
309 ;; (goto-char (cdr location)))) | |
310 (help-xref-button 8 'help-function-def sym)) | |
311 ((and (boundp sym) (fboundp sym)) | |
312 ;; We can't intuit whether to use the | |
313 ;; variable or function doc -- supply both. | |
314 (help-xref-button 8 'help-symbol sym)) | |
315 ((boundp sym) | |
316 (help-xref-button 8 'help-variable sym)) | |
317 ((fboundp sym) | |
318 (help-xref-button 8 'help-function sym)) | |
319 ((facep sym) | |
320 (help-xref-button 8 'help-face sym))))))) | |
321 ;; An obvious case of a key substitution: | |
322 (save-excursion | |
323 (while (re-search-forward | |
324 ;; Assume command name is only word characters | |
325 ;; and dashes to get things like `use M-x foo.'. | |
326 "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t) | |
327 (let ((sym (intern-soft (match-string 1)))) | |
328 (if (fboundp sym) | |
329 (help-xref-button 1 'help-function sym))))) | |
330 ;; Look for commands in whole keymap substitutions: | |
331 (save-excursion | |
332 ;; Make sure to find the first keymap. | |
333 (goto-char (point-min)) | |
334 ;; Find a header and the column at which the command | |
335 ;; name will be found. | |
336 (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n" | |
337 nil t) | |
338 (let ((col (- (match-end 1) (match-beginning 1)))) | |
339 (while | |
340 ;; Ignore single blank lines in table, but not | |
341 ;; double ones, which should terminate it. | |
342 (and (not (looking-at "\n\\s-*\n")) | |
343 (progn | |
344 (and (eolp) (forward-line)) | |
345 (end-of-line) | |
346 (skip-chars-backward "^\t\n") | |
347 (if (and (>= (current-column) col) | |
348 (looking-at "\\(\\sw\\|-\\)+$")) | |
349 (let ((sym (intern-soft (match-string 0)))) | |
350 (if (fboundp sym) | |
351 (help-xref-button 0 'help-function sym)))) | |
352 (zerop (forward-line))))))))) | |
353 (set-syntax-table stab)) | |
354 ;; Delete extraneous newlines at the end of the docstring | |
355 (goto-char (point-max)) | |
356 (while (and (not (bobp)) (bolp)) | |
357 (delete-char -1)) | |
358 ;; Make a back-reference in this buffer if appropriate. | |
359 (when (and help-xref-following help-xref-stack) | |
360 (insert "\n\n") | |
361 (help-insert-xref-button help-back-label 'help-back | |
362 (current-buffer)))) | |
363 ;; View mode steals RET from us. | |
364 (set (make-local-variable 'minor-mode-overriding-map-alist) | |
365 (list (cons 'view-mode | |
366 (let ((map (make-sparse-keymap))) | |
367 (set-keymap-parent map view-mode-map) | |
368 (define-key map "\r" 'help-follow) | |
369 map)))) | |
370 (set-buffer-modified-p old-modified)))) | |
371 | |
372 ;;;###autoload | |
373 (defun help-xref-button (match-number type &rest args) | |
374 "Make a hyperlink for cross-reference text previously matched. | |
375 MATCH-NUMBER is the subexpression of interest in the last matched | |
376 regexp. TYPE is the type of button to use. Any remaining arguments are | |
377 passed to the button's help-function when it is invoked. | |
378 See `help-make-xrefs'." | |
379 ;; Don't mung properties we've added specially in some instances. | |
380 (unless (button-at (match-beginning match-number)) | |
381 (make-text-button (match-beginning match-number) | |
382 (match-end match-number) | |
383 'type type 'help-args args))) | |
384 | |
385 ;;;###autoload | |
386 (defun help-insert-xref-button (string type &rest args) | |
387 "Insert STRING and make a hyperlink from cross-reference text on it. | |
388 TYPE is the type of button to use. Any remaining arguments are passed | |
389 to the button's help-function when it is invoked. | |
390 See `help-make-xrefs'." | |
391 (unless (button-at (point)) | |
392 (insert-text-button string 'type type 'help-args args))) | |
393 | |
394 ;;;###autoload | |
395 (defun help-xref-on-pp (from to) | |
396 "Add xrefs for symbols in `pp's output between FROM and TO." | |
397 (let ((ost (syntax-table))) | |
398 (unwind-protect | |
399 (save-excursion | |
400 (save-restriction | |
401 (set-syntax-table emacs-lisp-mode-syntax-table) | |
402 (narrow-to-region from to) | |
403 (goto-char (point-min)) | |
404 (while (not (eobp)) | |
405 (cond | |
406 ((looking-at "\"") (forward-sexp 1)) | |
407 ((looking-at "#<") (search-forward ">" nil 'move)) | |
408 ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)") | |
409 (let* ((sym (intern-soft (match-string 1))) | |
410 (type (cond ((fboundp sym) 'help-function) | |
411 ((or (memq sym '(t nil)) | |
412 (keywordp sym)) | |
413 nil) | |
414 ((and sym (boundp sym)) | |
415 'help-variable)))) | |
416 (when type (help-xref-button 1 type sym))) | |
417 (goto-char (match-end 1))) | |
418 (t (forward-char 1)))))) | |
419 (set-syntax-table ost)))) | |
420 | |
421 | |
422 ;; Additional functions for (re-)creating types of help buffers. | |
423 (defun help-xref-interned (symbol) | |
424 "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL. | |
425 | |
426 Both variable and function documentation are extracted into a single | |
427 help buffer." | |
428 (let ((fdoc (when (fboundp symbol) (describe-function symbol))) | |
429 (facedoc (when (facep symbol) (describe-face symbol)))) | |
430 (when (or (boundp symbol) (not fdoc)) | |
431 (describe-variable symbol) | |
432 ;; We now have a help buffer on the variable. Insert the function | |
433 ;; text before it. | |
434 (when (or fdoc facedoc) | |
435 (with-current-buffer "*Help*" | |
436 (goto-char (point-min)) | |
437 (let ((inhibit-read-only t)) | |
438 (when fdoc | |
439 (insert fdoc "\n\n")) | |
440 (when facedoc | |
441 (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) | |
442 " is also a " "face." "\n\n" facedoc "\n\n")) | |
443 (insert (make-string 30 ?-) "\n\n" (symbol-name symbol) | |
444 " is also a " "variable." "\n\n")) | |
445 (help-setup-xref (list #'help-xref-interned symbol) nil)))))) | |
446 | |
447 | |
448 ;;; Navigation/hyperlinking with xrefs | |
449 | |
450 (defun help-xref-go-back (buffer) | |
451 "From BUFFER, go back to previous help buffer text using `help-xref-stack'." | |
452 (let (item position method args) | |
453 (with-current-buffer buffer | |
454 (when help-xref-stack | |
455 (setq help-xref-stack (cdr help-xref-stack)) ; due to help-follow | |
456 (setq item (pop help-xref-stack) | |
457 position (car item) | |
458 method (cadr item) | |
459 args (cddr item)))) | |
460 (apply method args) | |
461 ;; We assume that the buffer we just recreated has the saved name, | |
462 ;; which might not always be true. | |
463 (when (get-buffer (cdr position)) | |
464 (with-current-buffer (cdr position) | |
465 (goto-char (car position)))))) | |
466 | |
467 (defun help-go-back () | |
468 "Invoke the [back] button (if any) in the Help mode buffer." | |
469 (interactive) | |
470 (let ((back-button (button-at (1- (point-max))))) | |
471 (if back-button | |
472 (button-activate back-button) | |
473 (error "No [back] button")))) | |
474 | |
475 (defun help-do-xref (pos function args) | |
476 "Call the help cross-reference function FUNCTION with args ARGS. | |
477 Things are set up properly so that the resulting help-buffer has | |
478 a proper [back] button." | |
479 (setq help-xref-stack (cons (cons (cons pos (buffer-name)) | |
480 help-xref-stack-item) | |
481 help-xref-stack)) | |
482 (setq help-xref-stack-item nil) | |
483 ;; There is a reference at point. Follow it. | |
484 (let ((help-xref-following t)) | |
485 (apply function args))) | |
486 | |
487 (defun help-follow (&optional pos) | |
488 "Follow cross-reference at POS, defaulting to point. | |
489 | |
490 For the cross-reference format, see `help-make-xrefs'." | |
491 (interactive "d") | |
492 (unless pos | |
493 (setq pos (point))) | |
494 (unless (push-button pos) | |
495 ;; check if the symbol under point is a function or variable | |
496 (let ((sym | |
497 (intern | |
498 (save-excursion | |
499 (goto-char pos) (skip-syntax-backward "w_") | |
500 (buffer-substring (point) | |
501 (progn (skip-syntax-forward "w_") | |
502 (point))))))) | |
503 (when (or (boundp sym) (fboundp sym)) | |
504 (help-do-xref pos #'help-xref-interned (list sym)))))) | |
505 | |
506 | |
507 (provide 'help-mode) | |
508 | |
509 ;;; help-mode.el ends here | |
510 | |
511 |