Line data Source code
1 : ;;; help-mode.el --- `help-mode' used by *Help* buffers
2 :
3 : ;; Copyright (C) 1985-1986, 1993-1994, 1998-2017 Free Software
4 : ;; Foundation, Inc.
5 :
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: help, internal
8 : ;; Package: emacs
9 :
10 : ;; This file is part of GNU Emacs.
11 :
12 : ;; GNU Emacs is free software: you can redistribute it and/or modify
13 : ;; it under the terms of the GNU General Public License as published by
14 : ;; the Free Software Foundation, either version 3 of the License, or
15 : ;; (at your option) any later version.
16 :
17 : ;; GNU Emacs is distributed in the hope that it will be useful,
18 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 : ;; GNU General Public License for more details.
21 :
22 : ;; You should have received a copy of the GNU General Public License
23 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 :
25 : ;;; Commentary:
26 :
27 : ;; Defines `help-mode', which is the mode used by *Help* buffers, and
28 : ;; associated support machinery, such as adding hyperlinks, etc.,
29 :
30 : ;;; Code:
31 :
32 : (require 'button)
33 : (require 'cl-lib)
34 : (eval-when-compile (require 'easymenu))
35 :
36 : (defvar help-mode-map
37 : (let ((map (make-sparse-keymap)))
38 : (set-keymap-parent map (make-composed-keymap button-buffer-map
39 : special-mode-map))
40 : (define-key map [mouse-2] 'help-follow-mouse)
41 : (define-key map "l" 'help-go-back)
42 : (define-key map "r" 'help-go-forward)
43 : (define-key map "\C-c\C-b" 'help-go-back)
44 : (define-key map "\C-c\C-f" 'help-go-forward)
45 : (define-key map [XF86Back] 'help-go-back)
46 : (define-key map [XF86Forward] 'help-go-forward)
47 : (define-key map "\C-c\C-c" 'help-follow-symbol)
48 : (define-key map "\r" 'help-follow)
49 : map)
50 : "Keymap for help mode.")
51 :
52 : (easy-menu-define help-mode-menu help-mode-map
53 : "Menu for Help Mode."
54 : '("Help-Mode"
55 : ["Show Help for Symbol" help-follow-symbol
56 : :help "Show the docs for the symbol at point"]
57 : ["Previous Topic" help-go-back
58 : :help "Go back to previous topic in this help buffer"]
59 : ["Next Topic" help-go-forward
60 : :help "Go back to next topic in this help buffer"]
61 : ["Move to Previous Button" backward-button
62 : :help "Move to the Next Button in the help buffer"]
63 : ["Move to Next Button" forward-button
64 : :help "Move to the Next Button in the help buffer"]))
65 :
66 : (defvar help-xref-stack nil
67 : "A stack of ways by which to return to help buffers after following xrefs.
68 : Used by `help-follow' and `help-xref-go-back'.
69 : An element looks like (POSITION FUNCTION ARGS...).
70 : To use the element, do (apply FUNCTION ARGS) then goto the point.")
71 : (put 'help-xref-stack 'permanent-local t)
72 : (make-variable-buffer-local 'help-xref-stack)
73 :
74 : (defvar help-xref-forward-stack nil
75 : "A stack used to navigate help forwards after using the back button.
76 : Used by `help-follow' and `help-xref-go-forward'.
77 : An element looks like (POSITION FUNCTION ARGS...).
78 : To use the element, do (apply FUNCTION ARGS) then goto the point.")
79 : (put 'help-xref-forward-stack 'permanent-local t)
80 : (make-variable-buffer-local 'help-xref-forward-stack)
81 :
82 : (defvar help-xref-stack-item nil
83 : "An item for `help-follow' in this buffer to push onto `help-xref-stack'.
84 : The format is (FUNCTION ARGS...).")
85 : (put 'help-xref-stack-item 'permanent-local t)
86 : (make-variable-buffer-local 'help-xref-stack-item)
87 :
88 : (defvar help-xref-stack-forward-item nil
89 : "An item for `help-go-back' to push onto `help-xref-forward-stack'.
90 : The format is (FUNCTION ARGS...).")
91 : (put 'help-xref-stack-forward-item 'permanent-local t)
92 : (make-variable-buffer-local 'help-xref-stack-forward-item)
93 :
94 : (setq-default help-xref-stack nil help-xref-stack-item nil)
95 : (setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil)
96 :
97 : (defcustom help-mode-hook nil
98 : "Hook run by `help-mode'."
99 : :type 'hook
100 : :group 'help)
101 :
102 : ;; Button types used by help
103 :
104 : (define-button-type 'help-xref
105 : 'follow-link t
106 : 'action #'help-button-action)
107 :
108 : (defun help-button-action (button)
109 : "Call BUTTON's help function."
110 0 : (help-do-xref nil
111 0 : (button-get button 'help-function)
112 0 : (button-get button 'help-args)))
113 :
114 : ;; These 6 calls to define-button-type were generated in a dolist
115 : ;; loop, but that is bad because it means these button types don't
116 : ;; have an easily found definition.
117 :
118 : (define-button-type 'help-function
119 : :supertype 'help-xref
120 : 'help-function 'describe-function
121 : 'help-echo (purecopy "mouse-2, RET: describe this function"))
122 :
123 : (define-button-type 'help-variable
124 : :supertype 'help-xref
125 : 'help-function 'describe-variable
126 : 'help-echo (purecopy "mouse-2, RET: describe this variable"))
127 :
128 : (define-button-type 'help-face
129 : :supertype 'help-xref
130 : 'help-function 'describe-face
131 : 'help-echo (purecopy "mouse-2, RET: describe this face"))
132 :
133 : (define-button-type 'help-coding-system
134 : :supertype 'help-xref
135 : 'help-function 'describe-coding-system
136 : 'help-echo (purecopy "mouse-2, RET: describe this coding system"))
137 :
138 : (define-button-type 'help-input-method
139 : :supertype 'help-xref
140 : 'help-function 'describe-input-method
141 : 'help-echo (purecopy "mouse-2, RET: describe this input method"))
142 :
143 : (define-button-type 'help-character-set
144 : :supertype 'help-xref
145 : 'help-function 'describe-character-set
146 : 'help-echo (purecopy "mouse-2, RET: describe this character set"))
147 :
148 : ;; Make some more idiosyncratic button types.
149 :
150 : (define-button-type 'help-symbol
151 : :supertype 'help-xref
152 : 'help-function #'describe-symbol
153 : 'help-echo (purecopy "mouse-2, RET: describe this symbol"))
154 :
155 : (define-button-type 'help-back
156 : :supertype 'help-xref
157 : 'help-function #'help-xref-go-back
158 : 'help-echo (purecopy "mouse-2, RET: go back to previous help buffer"))
159 :
160 : (define-button-type 'help-forward
161 : :supertype 'help-xref
162 : 'help-function #'help-xref-go-forward
163 : 'help-echo (purecopy "mouse-2, RET: move forward to next help buffer"))
164 :
165 : (define-button-type 'help-info-variable
166 : :supertype 'help-xref
167 : ;; the name of the variable is put before the argument to Info
168 : 'help-function (lambda (_a v) (info v))
169 : 'help-echo (purecopy "mouse-2, RET: read this Info node"))
170 :
171 : (define-button-type 'help-info
172 : :supertype 'help-xref
173 : 'help-function #'info
174 : 'help-echo (purecopy "mouse-2, RET: read this Info node"))
175 :
176 : (define-button-type 'help-url
177 : :supertype 'help-xref
178 : 'help-function #'browse-url
179 : 'help-echo (purecopy "mouse-2, RET: view this URL in a browser"))
180 :
181 : (define-button-type 'help-customize-variable
182 : :supertype 'help-xref
183 : 'help-function (lambda (v)
184 : (customize-variable v))
185 : 'help-echo (purecopy "mouse-2, RET: customize variable"))
186 :
187 : (define-button-type 'help-customize-face
188 : :supertype 'help-xref
189 : 'help-function (lambda (v)
190 : (customize-face v))
191 : 'help-echo (purecopy "mouse-2, RET: customize face"))
192 :
193 : (define-button-type 'help-function-def
194 : :supertype 'help-xref
195 : 'help-function (lambda (fun file &optional type)
196 : (require 'find-func)
197 : (when (eq file 'C-source)
198 : (setq file
199 : (help-C-file-name (indirect-function fun) 'fun)))
200 : ;; Don't use find-function-noselect because it follows
201 : ;; aliases (which fails for built-in functions).
202 : (let ((location
203 : (find-function-search-for-symbol fun type file)))
204 : (pop-to-buffer (car location))
205 : (run-hooks 'find-function-after-hook)
206 : (if (cdr location)
207 : (goto-char (cdr location))
208 : (message "Unable to find location in file"))))
209 : 'help-echo (purecopy "mouse-2, RET: find function's definition"))
210 :
211 : (define-button-type 'help-function-cmacro ; FIXME: Obsolete since 24.4.
212 : :supertype 'help-xref
213 : 'help-function (lambda (fun file)
214 : (setq file (locate-library file t))
215 : (if (and file (file-readable-p file))
216 : (progn
217 : (pop-to-buffer (find-file-noselect file))
218 : (goto-char (point-min))
219 : (if (re-search-forward
220 : (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s"
221 : (regexp-quote (symbol-name fun)))
222 : nil t)
223 : (forward-line 0)
224 : (message "Unable to find location in file")))
225 : (message "Unable to find file")))
226 : 'help-echo (purecopy "mouse-2, RET: find function's compiler macro"))
227 :
228 : (define-button-type 'help-variable-def
229 : :supertype 'help-xref
230 : 'help-function (lambda (var &optional file)
231 : (when (eq file 'C-source)
232 : (setq file (help-C-file-name var 'var)))
233 : (let ((location (find-variable-noselect var file)))
234 : (pop-to-buffer (car location))
235 : (run-hooks 'find-function-after-hook)
236 : (if (cdr location)
237 : (goto-char (cdr location))
238 : (message "Unable to find location in file"))))
239 : 'help-echo (purecopy "mouse-2, RET: find variable's definition"))
240 :
241 : (define-button-type 'help-face-def
242 : :supertype 'help-xref
243 : 'help-function (lambda (fun file)
244 : (require 'find-func)
245 : ;; Don't use find-function-noselect because it follows
246 : ;; aliases (which fails for built-in functions).
247 : (let ((location
248 : (find-function-search-for-symbol fun 'defface file)))
249 : (pop-to-buffer (car location))
250 : (if (cdr location)
251 : (goto-char (cdr location))
252 : (message "Unable to find location in file"))))
253 : 'help-echo (purecopy "mouse-2, RET: find face's definition"))
254 :
255 : (define-button-type 'help-package
256 : :supertype 'help-xref
257 : 'help-function 'describe-package
258 : 'help-echo (purecopy "mouse-2, RET: Describe package"))
259 :
260 : (define-button-type 'help-package-def
261 : :supertype 'help-xref
262 : 'help-function (lambda (file) (dired file))
263 : 'help-echo (purecopy "mouse-2, RET: visit package directory"))
264 :
265 : (define-button-type 'help-theme-def
266 : :supertype 'help-xref
267 : 'help-function 'find-file
268 : 'help-echo (purecopy "mouse-2, RET: visit theme file"))
269 :
270 : (define-button-type 'help-theme-edit
271 : :supertype 'help-xref
272 : 'help-function 'customize-create-theme
273 : 'help-echo (purecopy "mouse-2, RET: edit this theme file"))
274 :
275 : (define-button-type 'help-dir-local-var-def
276 : :supertype 'help-xref
277 : 'help-function (lambda (_var &optional file)
278 : ;; FIXME: this should go to the point where the
279 : ;; local variable was defined.
280 : (find-file file))
281 : 'help-echo (purecopy "mouse-2, RET: open directory-local variables file"))
282 :
283 :
284 : (defvar bookmark-make-record-function)
285 :
286 : ;;;###autoload
287 : (define-derived-mode help-mode special-mode "Help"
288 : "Major mode for viewing help text and navigating references in it.
289 : Entry to this mode runs the normal hook `help-mode-hook'.
290 : Commands:
291 : \\{help-mode-map}"
292 0 : (set (make-local-variable 'revert-buffer-function)
293 0 : 'help-mode-revert-buffer)
294 0 : (set (make-local-variable 'bookmark-make-record-function)
295 0 : 'help-bookmark-make-record))
296 :
297 : ;;;###autoload
298 : (defun help-mode-setup ()
299 : "Enter Help Mode in the current buffer."
300 0 : (help-mode)
301 0 : (setq buffer-read-only nil))
302 :
303 : ;;;###autoload
304 : (defun help-mode-finish ()
305 : "Finalize Help Mode setup in current buffer."
306 0 : (when (derived-mode-p 'help-mode)
307 0 : (setq buffer-read-only t)
308 0 : (help-make-xrefs (current-buffer))))
309 :
310 : ;; Grokking cross-reference information in doc strings and
311 : ;; hyperlinking it.
312 :
313 : ;; This may have some scope for extension and the same or something
314 : ;; similar should be done for widget doc strings, which currently use
315 : ;; another mechanism.
316 :
317 : (defvar help-back-label (purecopy "[back]")
318 : "Label to use by `help-make-xrefs' for the go-back reference.")
319 :
320 : (defvar help-forward-label (purecopy "[forward]")
321 : "Label to use by `help-make-xrefs' for the go-forward reference.")
322 :
323 : (defconst help-xref-symbol-regexp
324 : (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|" ; Link to var
325 : "\\(function\\|command\\|call\\)\\|" ; Link to function
326 : "\\(face\\)\\|" ; Link to face
327 : "\\(symbol\\|program\\|property\\)\\|" ; Don't link
328 : "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
329 : "[ \t\n]+\\)?"
330 : ;; Note starting with word-syntax character:
331 : "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]"))
332 : "Regexp matching doc string references to symbols.
333 :
334 : The words preceding the quoted symbol can be used in doc strings to
335 : distinguish references to variables, functions and symbols.")
336 :
337 : (defvar help-xref-mule-regexp nil
338 : "Regexp matching doc string references to MULE-related keywords.
339 :
340 : It is usually nil, and is temporarily bound to an appropriate regexp
341 : when help commands related to multilingual environment (e.g.,
342 : `describe-coding-system') are invoked.")
343 :
344 :
345 : (defconst help-xref-info-regexp
346 : (purecopy
347 : "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+['`‘]\\([^'’]+\\)['’]")
348 : "Regexp matching doc string references to an Info node.")
349 :
350 : (defconst help-xref-url-regexp
351 : (purecopy "\\<[Uu][Rr][Ll][ \t\n]+['`‘]\\([^'’]+\\)['’]")
352 : "Regexp matching doc string references to a URL.")
353 :
354 : ;;;###autoload
355 : (defun help-setup-xref (item interactive-p)
356 : "Invoked from commands using the \"*Help*\" buffer to install some xref info.
357 :
358 : ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help
359 : buffer after following a reference. INTERACTIVE-P is non-nil if the
360 : calling command was invoked interactively. In this case the stack of
361 : items for help buffer \"back\" buttons is cleared.
362 :
363 : This should be called very early, before the output buffer is cleared,
364 : because we want to record the \"previous\" position of point so we can
365 : restore it properly when going back."
366 0 : (with-current-buffer (help-buffer)
367 0 : (when help-xref-stack-item
368 0 : (push (cons (point) help-xref-stack-item) help-xref-stack)
369 0 : (setq help-xref-forward-stack nil))
370 0 : (when interactive-p
371 0 : (let ((tail (nthcdr 10 help-xref-stack)))
372 : ;; Truncate the stack.
373 0 : (if tail (setcdr tail nil))))
374 0 : (setq help-xref-stack-item item)))
375 :
376 : (defvar help-xref-following nil
377 : "Non-nil when following a help cross-reference.")
378 :
379 : ;;;###autoload
380 : (defun help-buffer ()
381 : "Return the name of a buffer for inserting help.
382 : If `help-xref-following' is non-nil, this is the name of the
383 : current buffer. Signal an error if this buffer is not derived
384 : from `help-mode'.
385 : Otherwise, return \"*Help*\", creating a buffer with that name if
386 : it does not already exist."
387 0 : (buffer-name ;for with-output-to-temp-buffer
388 0 : (if (not help-xref-following)
389 0 : (get-buffer-create "*Help*")
390 0 : (unless (derived-mode-p 'help-mode)
391 0 : (error "Current buffer is not in Help mode"))
392 0 : (current-buffer))))
393 :
394 : (defvar describe-symbol-backends
395 : `((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
396 : (nil
397 : ,(lambda (symbol)
398 : (or (and (boundp symbol) (not (keywordp symbol)))
399 : (get symbol 'variable-documentation)))
400 : ,#'describe-variable)
401 : ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))))
402 :
403 : ;;;###autoload
404 : (defun help-make-xrefs (&optional buffer)
405 : "Parse and hyperlink documentation cross-references in the given BUFFER.
406 :
407 : Find cross-reference information in a buffer and activate such cross
408 : references for selection with `help-follow'. Cross-references have
409 : the canonical form `...' and the type of reference may be
410 : disambiguated by the preceding word(s) used in
411 : `help-xref-symbol-regexp'. Faces only get cross-referenced if
412 : preceded or followed by the word `face'. Variables without
413 : variable documentation do not get cross-referenced, unless
414 : preceded by the word `variable' or `option'.
415 :
416 : If the variable `help-xref-mule-regexp' is non-nil, find also
417 : cross-reference information related to multilingual environment
418 : \(e.g., coding-systems). This variable is also used to disambiguate
419 : the type of reference as the same way as `help-xref-symbol-regexp'.
420 :
421 : A special reference `back' is made to return back through a stack of
422 : help buffers. Variable `help-back-label' specifies the text for
423 : that."
424 : (interactive "b")
425 0 : (with-current-buffer (or buffer (current-buffer))
426 0 : (save-excursion
427 0 : (goto-char (point-min))
428 : ;; Skip the header-type info, though it might be useful to parse
429 : ;; it at some stage (e.g. "function in `library'").
430 0 : (forward-paragraph)
431 0 : (let ((old-modified (buffer-modified-p)))
432 0 : (let ((stab (syntax-table))
433 : (case-fold-search t)
434 : (inhibit-read-only t))
435 0 : (set-syntax-table emacs-lisp-mode-syntax-table)
436 : ;; The following should probably be abstracted out.
437 0 : (unwind-protect
438 0 : (progn
439 : ;; Info references
440 0 : (save-excursion
441 0 : (while (re-search-forward help-xref-info-regexp nil t)
442 0 : (let ((data (match-string 2)))
443 0 : (save-match-data
444 0 : (unless (string-match "^([^)]+)" data)
445 0 : (setq data (concat "(emacs)" data)))
446 0 : (setq data ;; possible newlines if para filled
447 0 : (replace-regexp-in-string "[ \t\n]+" " " data t t)))
448 0 : (help-xref-button 2 'help-info data))))
449 : ;; URLs
450 0 : (save-excursion
451 0 : (while (re-search-forward help-xref-url-regexp nil t)
452 0 : (let ((data (match-string 1)))
453 0 : (help-xref-button 1 'help-url data))))
454 : ;; Mule related keywords. Do this before trying
455 : ;; `help-xref-symbol-regexp' because some of Mule
456 : ;; keywords have variable or function definitions.
457 0 : (if help-xref-mule-regexp
458 0 : (save-excursion
459 0 : (while (re-search-forward help-xref-mule-regexp nil t)
460 0 : (let* ((data (match-string 7))
461 0 : (sym (intern-soft data)))
462 0 : (cond
463 0 : ((match-string 3) ; coding system
464 0 : (and sym (coding-system-p sym)
465 0 : (help-xref-button 6 'help-coding-system sym)))
466 0 : ((match-string 4) ; input method
467 0 : (and (assoc data input-method-alist)
468 0 : (help-xref-button 7 'help-input-method data)))
469 0 : ((or (match-string 5) (match-string 6)) ; charset
470 0 : (and sym (charsetp sym)
471 0 : (help-xref-button 7 'help-character-set sym)))
472 0 : ((assoc data input-method-alist)
473 0 : (help-xref-button 7 'help-character-set data))
474 0 : ((and sym (coding-system-p sym))
475 0 : (help-xref-button 7 'help-coding-system sym))
476 0 : ((and sym (charsetp sym))
477 0 : (help-xref-button 7 'help-character-set sym)))))))
478 : ;; Quoted symbols
479 0 : (save-excursion
480 0 : (while (re-search-forward help-xref-symbol-regexp nil t)
481 0 : (let* ((data (match-string 8))
482 0 : (sym (intern-soft data)))
483 0 : (if sym
484 0 : (cond
485 0 : ((match-string 3) ; `variable' &c
486 0 : (and (or (boundp sym) ; `variable' doesn't ensure
487 : ; it's actually bound
488 0 : (get sym 'variable-documentation))
489 0 : (help-xref-button 8 'help-variable sym)))
490 0 : ((match-string 4) ; `function' &c
491 0 : (and (fboundp sym) ; similarly
492 0 : (help-xref-button 8 'help-function sym)))
493 0 : ((match-string 5) ; `face'
494 0 : (and (facep sym)
495 0 : (help-xref-button 8 'help-face sym)))
496 0 : ((match-string 6)) ; nothing for `symbol'
497 0 : ((match-string 7)
498 : ;; this used:
499 : ;; #'(lambda (arg)
500 : ;; (let ((location
501 : ;; (find-function-noselect arg)))
502 : ;; (pop-to-buffer (car location))
503 : ;; (goto-char (cdr location))))
504 0 : (help-xref-button 8 'help-function-def sym))
505 0 : ((cl-some (lambda (x) (funcall (nth 1 x) sym))
506 0 : describe-symbol-backends)
507 0 : (help-xref-button 8 'help-symbol sym)))))))
508 : ;; An obvious case of a key substitution:
509 0 : (save-excursion
510 0 : (while (re-search-forward
511 : ;; Assume command name is only word and symbol
512 : ;; characters to get things like `use M-x foo->bar'.
513 : ;; Command required to end with word constituent
514 : ;; to avoid `.' at end of a sentence.
515 0 : "\\<M-x\\s-+\\(\\sw\\(\\sw\\|\\s_\\)*\\sw\\)" nil t)
516 0 : (let ((sym (intern-soft (match-string 1))))
517 0 : (if (fboundp sym)
518 0 : (help-xref-button 1 'help-function sym)))))
519 : ;; Look for commands in whole keymap substitutions:
520 0 : (save-excursion
521 : ;; Make sure to find the first keymap.
522 0 : (goto-char (point-min))
523 : ;; Find a header and the column at which the command
524 : ;; name will be found.
525 :
526 : ;; If the keymap substitution isn't the last thing in
527 : ;; the doc string, and if there is anything on the same
528 : ;; line after it, this code won't recognize the end of it.
529 0 : (while (re-search-forward "^key +binding\n\\(-+ +\\)-+\n\n"
530 0 : nil t)
531 0 : (let ((col (- (match-end 1) (match-beginning 1))))
532 0 : (while
533 0 : (and (not (eobp))
534 : ;; Stop at a pair of blank lines.
535 0 : (not (looking-at-p "\n\\s-*\n")))
536 : ;; Skip a single blank line.
537 0 : (and (eolp) (forward-line))
538 0 : (end-of-line)
539 0 : (skip-chars-backward "^ \t\n")
540 0 : (if (and (>= (current-column) col)
541 0 : (looking-at "\\(\\sw\\|\\s_\\)+$"))
542 0 : (let ((sym (intern-soft (match-string 0))))
543 0 : (if (fboundp sym)
544 0 : (help-xref-button 0 'help-function sym))))
545 0 : (forward-line))))))
546 0 : (set-syntax-table stab))
547 : ;; Delete extraneous newlines at the end of the docstring
548 0 : (goto-char (point-max))
549 0 : (while (and (not (bobp)) (bolp))
550 0 : (delete-char -1))
551 0 : (insert "\n")
552 0 : (when (or help-xref-stack help-xref-forward-stack)
553 0 : (insert "\n"))
554 : ;; Make a back-reference in this buffer if appropriate.
555 0 : (when help-xref-stack
556 0 : (help-insert-xref-button help-back-label 'help-back
557 0 : (current-buffer)))
558 : ;; Make a forward-reference in this buffer if appropriate.
559 0 : (when help-xref-forward-stack
560 0 : (when help-xref-stack
561 0 : (insert "\t"))
562 0 : (help-insert-xref-button help-forward-label 'help-forward
563 0 : (current-buffer)))
564 0 : (when (or help-xref-stack help-xref-forward-stack)
565 0 : (insert "\n")))
566 0 : (set-buffer-modified-p old-modified)))))
567 :
568 : ;;;###autoload
569 : (defun help-xref-button (match-number type &rest args)
570 : "Make a hyperlink for cross-reference text previously matched.
571 : MATCH-NUMBER is the subexpression of interest in the last matched
572 : regexp. TYPE is the type of button to use. Any remaining arguments are
573 : passed to the button's help-function when it is invoked.
574 : See `help-make-xrefs'."
575 : ;; Don't mung properties we've added specially in some instances.
576 0 : (unless (button-at (match-beginning match-number))
577 0 : (make-text-button (match-beginning match-number)
578 0 : (match-end match-number)
579 0 : 'type type 'help-args args)))
580 :
581 : ;;;###autoload
582 : (defun help-insert-xref-button (string type &rest args)
583 : "Insert STRING and make a hyperlink from cross-reference text on it.
584 : TYPE is the type of button to use. Any remaining arguments are passed
585 : to the button's help-function when it is invoked.
586 : See `help-make-xrefs'."
587 0 : (unless (button-at (point))
588 0 : (insert-text-button string 'type type 'help-args args)))
589 :
590 : ;;;###autoload
591 : (defun help-xref-on-pp (from to)
592 : "Add xrefs for symbols in `pp's output between FROM and TO."
593 0 : (if (> (- to from) 5000) nil
594 0 : (with-syntax-table emacs-lisp-mode-syntax-table
595 0 : (save-excursion
596 0 : (save-restriction
597 0 : (narrow-to-region from to)
598 0 : (goto-char (point-min))
599 0 : (ignore-errors
600 0 : (while (not (eobp))
601 0 : (cond
602 0 : ((looking-at-p "\"") (forward-sexp 1))
603 0 : ((looking-at-p "#<") (search-forward ">" nil 'move))
604 0 : ((looking-at "\\(\\(\\sw\\|\\s_\\)+\\)")
605 0 : (let* ((sym (intern-soft (match-string 1)))
606 0 : (type (cond ((fboundp sym) 'help-function)
607 0 : ((or (memq sym '(t nil))
608 0 : (keywordp sym))
609 : nil)
610 0 : ((and sym
611 0 : (or (boundp sym)
612 0 : (get sym
613 0 : 'variable-documentation)))
614 0 : 'help-variable))))
615 0 : (when type (help-xref-button 1 type sym)))
616 0 : (goto-char (match-end 1)))
617 0 : (t (forward-char 1))))))))))
618 :
619 :
620 : ;; Additional functions for (re-)creating types of help buffers.
621 :
622 : ;;;###autoload
623 : (define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1")
624 :
625 :
626 : ;; Navigation/hyperlinking with xrefs
627 :
628 : (defun help-xref-go-back (buffer)
629 : "From BUFFER, go back to previous help buffer text using `help-xref-stack'."
630 0 : (let (item position method args)
631 0 : (with-current-buffer buffer
632 0 : (push (cons (point) help-xref-stack-item) help-xref-forward-stack)
633 0 : (when help-xref-stack
634 0 : (setq item (pop help-xref-stack)
635 : ;; Clear the current item so that it won't get pushed
636 : ;; by the function we're about to call. TODO: We could also
637 : ;; push it onto a "forward" stack and add a `forw' button.
638 : help-xref-stack-item nil
639 0 : position (car item)
640 0 : method (cadr item)
641 0 : args (cddr item))))
642 0 : (apply method args)
643 0 : (with-current-buffer buffer
644 0 : (if (get-buffer-window buffer)
645 0 : (set-window-point (get-buffer-window buffer) position)
646 0 : (goto-char position)))))
647 :
648 : (defun help-xref-go-forward (buffer)
649 : "From BUFFER, go forward to next help buffer."
650 0 : (let (item position method args)
651 0 : (with-current-buffer buffer
652 0 : (push (cons (point) help-xref-stack-item) help-xref-stack)
653 0 : (when help-xref-forward-stack
654 0 : (setq item (pop help-xref-forward-stack)
655 : ;; Clear the current item so that it won't get pushed
656 : ;; by the function we're about to call. TODO: We could also
657 : ;; push it onto a "forward" stack and add a `forw' button.
658 : help-xref-stack-item nil
659 0 : position (car item)
660 0 : method (cadr item)
661 0 : args (cddr item))))
662 0 : (apply method args)
663 0 : (with-current-buffer buffer
664 0 : (if (get-buffer-window buffer)
665 0 : (set-window-point (get-buffer-window buffer) position)
666 0 : (goto-char position)))))
667 :
668 : (defun help-go-back ()
669 : "Go back to previous topic in this help buffer."
670 : (interactive)
671 0 : (if help-xref-stack
672 0 : (help-xref-go-back (current-buffer))
673 0 : (user-error "No previous help buffer")))
674 :
675 : (defun help-go-forward ()
676 : "Go to the next topic in this help buffer."
677 : (interactive)
678 0 : (if help-xref-forward-stack
679 0 : (help-xref-go-forward (current-buffer))
680 0 : (user-error "No next help buffer")))
681 :
682 : (defun help-do-xref (_pos function args)
683 : "Call the help cross-reference function FUNCTION with args ARGS.
684 : Things are set up properly so that the resulting help-buffer has
685 : a proper [back] button."
686 : ;; There is a reference at point. Follow it.
687 0 : (let ((help-xref-following t))
688 0 : (apply function (if (eq function 'info)
689 0 : (append args (list (generate-new-buffer-name "*info*"))) args))))
690 :
691 : ;; The doc string is meant to explain what buttons do.
692 : (defun help-follow-mouse ()
693 : "Follow the cross-reference that you click on."
694 : (interactive)
695 0 : (error "No cross-reference here"))
696 :
697 : ;; The doc string is meant to explain what buttons do.
698 : (defun help-follow ()
699 : "Follow cross-reference at point.
700 :
701 : For the cross-reference format, see `help-make-xrefs'."
702 : (interactive)
703 0 : (user-error "No cross-reference here"))
704 :
705 : (defun help-follow-symbol (&optional pos)
706 : "In help buffer, show docs for symbol at POS, defaulting to point.
707 : Show all docs for that symbol as either a variable, function or face."
708 : (interactive "d")
709 0 : (unless pos
710 0 : (setq pos (point)))
711 : ;; check if the symbol under point is a function, variable or face
712 0 : (let ((sym
713 0 : (intern
714 0 : (save-excursion
715 0 : (goto-char pos) (skip-syntax-backward "w_")
716 0 : (buffer-substring (point)
717 0 : (progn (skip-syntax-forward "w_")
718 0 : (point)))))))
719 0 : (when (or (boundp sym)
720 0 : (get sym 'variable-documentation)
721 0 : (fboundp sym) (facep sym))
722 0 : (help-do-xref pos #'describe-symbol (list sym)))))
723 :
724 : (defun help-mode-revert-buffer (_ignore-auto noconfirm)
725 0 : (when (or noconfirm (yes-or-no-p "Revert help buffer? "))
726 0 : (let ((pos (point))
727 0 : (item help-xref-stack-item)
728 : ;; Pretend there is no current item to add to the history.
729 : (help-xref-stack-item nil)
730 : ;; Use the current buffer.
731 : (help-xref-following t))
732 0 : (apply (car item) (cdr item))
733 0 : (goto-char pos))))
734 :
735 : (defun help-insert-string (string)
736 : "Insert STRING to the help buffer and install xref info for it.
737 : This function can be used to restore the old contents of the help buffer
738 : when going back to the previous topic in the xref stack. It is needed
739 : in case when it is impossible to recompute the old contents of the
740 : help buffer by other means."
741 0 : (setq help-xref-stack-item (list #'help-insert-string string))
742 0 : (with-output-to-temp-buffer (help-buffer)
743 0 : (insert string)))
744 :
745 :
746 : ;; Bookmark support
747 :
748 : (declare-function bookmark-prop-get "bookmark" (bookmark prop))
749 : (declare-function bookmark-make-record-default "bookmark"
750 : (&optional no-file no-context posn))
751 :
752 : (defun help-bookmark-make-record ()
753 : "Create and return a help-mode bookmark record.
754 : Implements `bookmark-make-record-function' for help-mode buffers."
755 0 : (unless (car help-xref-stack-item)
756 0 : (error "Cannot create bookmark - help command not known"))
757 0 : `(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
758 0 : (help-fn . ,(car help-xref-stack-item))
759 0 : (help-args . ,(cdr help-xref-stack-item))
760 0 : (position . ,(point))
761 0 : (handler . help-bookmark-jump)))
762 :
763 : ;;;###autoload
764 : (defun help-bookmark-jump (bookmark)
765 : "Jump to help-mode bookmark BOOKMARK.
766 : Handler function for record returned by `help-bookmark-make-record'.
767 : BOOKMARK is a bookmark name or a bookmark record."
768 0 : (let ((help-fn (bookmark-prop-get bookmark 'help-fn))
769 0 : (help-args (bookmark-prop-get bookmark 'help-args))
770 0 : (position (bookmark-prop-get bookmark 'position)))
771 0 : (apply help-fn help-args)
772 0 : (pop-to-buffer "*Help*")
773 0 : (goto-char position)))
774 :
775 :
776 : (provide 'help-mode)
777 :
778 : ;;; help-mode.el ends here
|