Commit | Line | Data |
---|---|---|
125eb411 | 1 | ;;; help-fns.el --- Complex help functions |
44e75f50 | 2 | |
b0622c6d | 3 | ;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003 |
44e75f50 MB |
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 | ;; This file contains those help commands which are complicated, and | |
29 | ;; which may not be used in every session. For example | |
30 | ;; `describe-function' will probably be heavily used when doing elisp | |
31 | ;; programming, but not if just editing C files. Simpler help commands | |
32 | ;; are in help.el | |
33 | ||
34 | ;;; Code: | |
35 | ||
8422a3b8 SM |
36 | (require 'help-mode) |
37 | ||
38 | ||
44e75f50 MB |
39 | ;;;###autoload |
40 | (defun help-with-tutorial (&optional arg) | |
41 | "Select the Emacs learn-by-doing tutorial. | |
42 | If there is a tutorial version written in the language | |
43 | of the selected language environment, that version is used. | |
44 | If there's no tutorial in that language, `TUTORIAL' is selected. | |
bbb7041a | 45 | With ARG, you are asked to choose which language." |
44e75f50 MB |
46 | (interactive "P") |
47 | (let ((lang (if arg | |
e06d1742 RS |
48 | (let ((minibuffer-setup-hook minibuffer-setup-hook)) |
49 | (add-hook 'minibuffer-setup-hook | |
bbb7041a SM |
50 | 'minibuffer-completion-help) |
51 | (read-language-name 'tutorial "Language: " "English")) | |
44e75f50 MB |
52 | (if (get-language-info current-language-environment 'tutorial) |
53 | current-language-environment | |
54 | "English"))) | |
55 | file filename) | |
56 | (setq filename (get-language-info lang 'tutorial)) | |
57 | (setq file (expand-file-name (concat "~/" filename))) | |
58 | (delete-other-windows) | |
59 | (if (get-file-buffer file) | |
60 | (switch-to-buffer (get-file-buffer file)) | |
61 | (switch-to-buffer (create-file-buffer file)) | |
62 | (setq buffer-file-name file) | |
63 | (setq default-directory (expand-file-name "~/")) | |
64 | (setq buffer-auto-save-file-name nil) | |
65 | (insert-file-contents (expand-file-name filename data-directory)) | |
66 | (goto-char (point-min)) | |
67 | (search-forward "\n<<") | |
68 | (beginning-of-line) | |
7dd3ed35 RS |
69 | ;; Convert the <<...>> line to the proper [...] line, |
70 | ;; or just delete the <<...>> line if a [...] line follows. | |
71 | (cond ((save-excursion | |
72 | (forward-line 1) | |
73 | (looking-at "\\[")) | |
74 | (delete-region (point) (progn (forward-line 1) (point)))) | |
75 | ((looking-at "<<Blank lines inserted.*>>") | |
76 | (replace-match "[Middle of page left blank for didactic purposes. Text continues below]")) | |
77 | (t | |
78 | (looking-at "<<") | |
79 | (replace-match "[") | |
80 | (search-forward ">>") | |
81 | (replace-match "]"))) | |
82 | (beginning-of-line) | |
44e75f50 MB |
83 | (let ((n (- (window-height (selected-window)) |
84 | (count-lines (point-min) (point)) | |
85 | 6))) | |
7dd3ed35 RS |
86 | (if (< n 8) |
87 | (progn | |
88 | ;; For a short gap, we don't need the [...] line, | |
89 | ;; so delete it. | |
90 | (delete-region (point) (progn (end-of-line) (point))) | |
91 | (newline n)) | |
44e75f50 MB |
92 | ;; Some people get confused by the large gap. |
93 | (newline (/ n 2)) | |
71296446 | 94 | |
7dd3ed35 RS |
95 | ;; Skip the [...] line (don't delete it). |
96 | (forward-line 1) | |
44e75f50 MB |
97 | (newline (- n (/ n 2))))) |
98 | (goto-char (point-min)) | |
99 | (set-buffer-modified-p nil)))) | |
100 | ||
101 | ;;;###autoload | |
102 | (defun locate-library (library &optional nosuffix path interactive-call) | |
103 | "Show the precise file name of Emacs library LIBRARY. | |
26f19477 SM |
104 | This command searches the directories in `load-path' like `\\[load-library]' |
105 | to find the file that `\\[load-library] RET LIBRARY RET' would load. | |
be5fc59b | 106 | Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' |
44e75f50 MB |
107 | to the specified name LIBRARY. |
108 | ||
109 | If the optional third arg PATH is specified, that list of directories | |
110 | is used instead of `load-path'. | |
111 | ||
112 | When called from a program, the file name is normaly returned as a | |
113 | string. When run interactively, the argument INTERACTIVE-CALL is t, | |
114 | and the file name is displayed in the echo area." | |
26f19477 SM |
115 | (interactive (list (completing-read "Locate library: " |
116 | 'locate-file-completion | |
117 | (cons load-path load-suffixes)) | |
44e75f50 MB |
118 | nil nil |
119 | t)) | |
26f19477 SM |
120 | (let ((file (locate-file library |
121 | (or path load-path) | |
122 | (append (unless nosuffix load-suffixes) '(""))))) | |
be5fc59b | 123 | (if interactive-call |
26f19477 SM |
124 | (if file |
125 | (message "Library is file %s" (abbreviate-file-name file)) | |
126 | (message "No library %s in search path" library))) | |
127 | file)) | |
44e75f50 MB |
128 | |
129 | \f | |
130 | ;; Functions | |
131 | ||
132 | ;;;###autoload | |
133 | (defun describe-function (function) | |
134 | "Display the full documentation of FUNCTION (a symbol)." | |
135 | (interactive | |
136 | (let ((fn (function-called-at-point)) | |
137 | (enable-recursive-minibuffers t) | |
138 | val) | |
139 | (setq val (completing-read (if fn | |
140 | (format "Describe function (default %s): " fn) | |
141 | "Describe function: ") | |
142 | obarray 'fboundp t nil nil (symbol-name fn))) | |
143 | (list (if (equal val "") | |
144 | fn (intern val))))) | |
145 | (if (null function) | |
146 | (message "You didn't specify a function") | |
8422a3b8 | 147 | (help-setup-xref (list #'describe-function function) (interactive-p)) |
5a6a8d3b RS |
148 | (save-excursion |
149 | (with-output-to-temp-buffer (help-buffer) | |
150 | (prin1 function) | |
151 | ;; Use " is " instead of a colon so that | |
152 | ;; it is easier to get out the function name using forward-sexp. | |
153 | (princ " is ") | |
154 | (describe-function-1 function) | |
155 | (print-help-return-message) | |
156 | (with-current-buffer standard-output | |
157 | ;; Return the text we displayed. | |
158 | (buffer-string)))))) | |
44e75f50 | 159 | |
f63f0981 | 160 | (defun help-split-fundoc (doc def) |
2dbbed9e | 161 | "Split a function docstring DOC into the actual doc and the usage info. |
f63f0981 SM |
162 | Return (USAGE . DOC) or nil if there's no usage info. |
163 | DEF is the function whose usage we're looking for in DOC." | |
164 | ;; Functions can get the calling sequence at the end of the doc string. | |
2dbbed9e | 165 | ;; In cases where `function' has been fset to a subr we can't search for |
f63f0981 SM |
166 | ;; function's name in the doc string so we use `fn' as the anonymous |
167 | ;; function name instead. | |
bbb7041a SM |
168 | (when (and doc (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc)) |
169 | (cons (format "(%s%s" | |
170 | ;; Replace `fn' with the actual function name. | |
171 | (if (consp def) "anonymous" def) | |
172 | (match-string 1 doc)) | |
173 | (substring doc 0 (match-beginning 0))))) | |
174 | ||
175 | (defun help-add-fundoc-usage (doc arglist) | |
176 | "Add the usage info to the docstring DOC. | |
177 | If DOC already has a usage info, then just return DOC unchanged. | |
95734598 | 178 | The usage info is built from ARGLIST. DOC can be nil. |
f8daddcf | 179 | ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"." |
bbb7041a | 180 | (unless (stringp doc) (setq doc "Not documented")) |
f8daddcf | 181 | (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) (eq arglist t)) |
bbb7041a SM |
182 | doc |
183 | (format "%s%s%s" doc | |
184 | (if (string-match "\n?\n\\'" doc) | |
88ff724b | 185 | (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "") |
bbb7041a | 186 | "\n\n") |
95734598 SM |
187 | (if (and (stringp arglist) |
188 | (string-match "\\`([^ ]+\\(.*\\))\\'" arglist)) | |
189 | (concat "(fn" (match-string 1 arglist) ")") | |
190 | (help-make-usage 'fn arglist))))) | |
2dbbed9e SM |
191 | |
192 | (defun help-function-arglist (def) | |
26f19477 SM |
193 | ;; Handle symbols aliased to other symbols. |
194 | (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) | |
195 | ;; If definition is a macro, find the function inside it. | |
196 | (if (eq (car-safe def) 'macro) (setq def (cdr def))) | |
2dbbed9e SM |
197 | (cond |
198 | ((byte-code-function-p def) (aref def 0)) | |
199 | ((eq (car-safe def) 'lambda) (nth 1 def)) | |
200 | ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) | |
201 | "[Arg list not available until function definition is loaded.]") | |
202 | (t t))) | |
203 | ||
204 | (defun help-make-usage (function arglist) | |
205 | (cons (if (symbolp function) function 'anonymous) | |
206 | (mapcar (lambda (arg) | |
f63f0981 SM |
207 | (if (not (symbolp arg)) |
208 | (if (and (consp arg) (symbolp (car arg))) | |
209 | ;; CL style default values for optional args. | |
210 | (cons (intern (upcase (symbol-name (car arg)))) | |
211 | (cdr arg)) | |
212 | arg) | |
2dbbed9e SM |
213 | (let ((name (symbol-name arg))) |
214 | (if (string-match "\\`&" name) arg | |
215 | (intern (upcase name)))))) | |
216 | arglist))) | |
217 | ||
8422a3b8 SM |
218 | ;;;###autoload |
219 | (defun describe-function-1 (function) | |
44e75f50 MB |
220 | (let* ((def (if (symbolp function) |
221 | (symbol-function function) | |
222 | function)) | |
8422a3b8 | 223 | file-name string |
44e75f50 MB |
224 | (beg (if (commandp def) "an interactive " "a "))) |
225 | (setq string | |
226 | (cond ((or (stringp def) | |
227 | (vectorp def)) | |
228 | "a keyboard macro") | |
229 | ((subrp def) | |
230 | (if (eq 'unevalled (cdr (subr-arity def))) | |
231 | (concat beg "special form") | |
232 | (concat beg "built-in function"))) | |
233 | ((byte-code-function-p def) | |
234 | (concat beg "compiled Lisp function")) | |
235 | ((symbolp def) | |
236 | (while (symbolp (symbol-function def)) | |
237 | (setq def (symbol-function def))) | |
238 | (format "an alias for `%s'" def)) | |
239 | ((eq (car-safe def) 'lambda) | |
240 | (concat beg "Lisp function")) | |
241 | ((eq (car-safe def) 'macro) | |
242 | "a Lisp macro") | |
44e75f50 MB |
243 | ((eq (car-safe def) 'autoload) |
244 | (setq file-name (nth 1 def)) | |
245 | (format "%s autoloaded %s" | |
246 | (if (commandp def) "an interactive" "an") | |
247 | (if (eq (nth 4 def) 'keymap) "keymap" | |
248 | (if (nth 4 def) "Lisp macro" "Lisp function")) | |
249 | )) | |
26f19477 | 250 | ((keymapp def) |
44e75f50 MB |
251 | (let ((is-full nil) |
252 | (elts (cdr-safe def))) | |
253 | (while elts | |
254 | (if (char-table-p (car-safe elts)) | |
255 | (setq is-full t | |
256 | elts nil)) | |
257 | (setq elts (cdr-safe elts))) | |
258 | (if is-full | |
259 | "a full keymap" | |
260 | "a sparse keymap"))) | |
261 | (t ""))) | |
44e75f50 | 262 | (princ string) |
8422a3b8 | 263 | (with-current-buffer standard-output |
44e75f50 MB |
264 | (save-excursion |
265 | (save-match-data | |
266 | (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) | |
267 | (help-xref-button 1 'help-function def))))) | |
268 | (or file-name | |
269 | (setq file-name (symbol-file function))) | |
35679c3f MR |
270 | (when (equal file-name "loaddefs.el") |
271 | ;; Find the real def site of the preloaded function. | |
272 | ;; This is necessary only for defaliases. | |
273 | (let ((location | |
274 | (condition-case nil | |
d24c52bb | 275 | (find-function-search-for-symbol function nil "loaddefs.el") |
35679c3f MR |
276 | (error nil)))) |
277 | (when location | |
278 | (with-current-buffer (car location) | |
279 | (goto-char (cdr location)) | |
280 | (when (re-search-backward | |
281 | "^;;; Generated autoloads from \\(.*\\)" nil t) | |
282 | (setq file-name (match-string 1))))))) | |
8422a3b8 SM |
283 | (cond |
284 | (file-name | |
5a6a8d3b RS |
285 | (princ " in `") |
286 | ;; We used to add .el to the file name, | |
287 | ;; but that's completely wrong when the user used load-file. | |
288 | (princ file-name) | |
289 | (princ "'") | |
290 | ;; Make a hyperlink to the library. | |
8422a3b8 | 291 | (with-current-buffer standard-output |
5a6a8d3b RS |
292 | (save-excursion |
293 | (re-search-backward "`\\([^`']+\\)'" nil t) | |
8422a3b8 | 294 | (help-xref-button 1 'help-function-def function file-name))))) |
44e75f50 MB |
295 | (princ ".") |
296 | (terpri) | |
297 | (when (commandp function) | |
023b93f6 | 298 | (let* ((remapped (command-remapping function)) |
d2ab11c5 | 299 | (keys (where-is-internal |
023b93f6 | 300 | (or remapped function) overriding-local-map nil nil))) |
d2ab11c5 KS |
301 | (when remapped |
302 | (princ "It is remapped to `") | |
303 | (princ (symbol-name remapped)) | |
304 | (princ "'")) | |
44e75f50 | 305 | (when keys |
d2ab11c5 | 306 | (princ (if remapped " which is bound to " "It is bound to ")) |
44e75f50 | 307 | ;; FIXME: This list can be very long (f.ex. for self-insert-command). |
d2ab11c5 KS |
308 | (princ (mapconcat 'key-description keys ", "))) |
309 | (when (or remapped keys) | |
44e75f50 MB |
310 | (princ ".") |
311 | (terpri)))) | |
2dbbed9e SM |
312 | (let* ((arglist (help-function-arglist def)) |
313 | (doc (documentation function)) | |
f63f0981 | 314 | (usage (help-split-fundoc doc function))) |
dd66897f JPW |
315 | ;; If definition is a keymap, skip arglist note. |
316 | (unless (keymapp def) | |
317 | (princ (cond | |
26f19477 | 318 | (usage (setq doc (cdr usage)) (car usage)) |
dd66897f JPW |
319 | ((listp arglist) (help-make-usage function arglist)) |
320 | ((stringp arglist) arglist) | |
26f19477 SM |
321 | ;; Maybe the arglist is in the docstring of the alias. |
322 | ((let ((fun function)) | |
323 | (while (and (symbolp fun) | |
324 | (setq fun (symbol-function fun)) | |
325 | (not (setq usage (help-split-fundoc | |
326 | (documentation fun) | |
f63f0981 | 327 | function))))) |
26f19477 SM |
328 | usage) |
329 | (car usage)) | |
a01ba4f1 JB |
330 | ((or (stringp def) |
331 | (vectorp def)) | |
332 | (format "\nMacro: %s" (format-kbd-macro def))) | |
dd66897f JPW |
333 | (t "[Missing arglist. Please make a bug report.]"))) |
334 | (terpri)) | |
32d9a725 MR |
335 | (let ((obsolete (and |
336 | ;; function might be a lambda construct. | |
337 | (symbolp function) | |
338 | (get function 'byte-obsolete-info)))) | |
2dbbed9e SM |
339 | (when obsolete |
340 | (terpri) | |
341 | (princ "This function is obsolete") | |
342 | (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete)))) | |
343 | (princ ";") (terpri) | |
344 | (princ (if (stringp (car obsolete)) (car obsolete) | |
345 | (format "use `%s' instead." (car obsolete)))) | |
346 | (terpri))) | |
3b622b44 JB |
347 | (terpri) |
348 | (princ (or doc "Not documented."))))) | |
44e75f50 MB |
349 | |
350 | \f | |
351 | ;; Variables | |
352 | ||
353 | ;;;###autoload | |
354 | (defun variable-at-point () | |
355 | "Return the bound variable symbol found around point. | |
356 | Return 0 if there is no such symbol." | |
357 | (condition-case () | |
358 | (with-syntax-table emacs-lisp-mode-syntax-table | |
359 | (save-excursion | |
360 | (or (not (zerop (skip-syntax-backward "_w"))) | |
361 | (eq (char-syntax (following-char)) ?w) | |
362 | (eq (char-syntax (following-char)) ?_) | |
363 | (forward-sexp -1)) | |
364 | (skip-chars-forward "'") | |
365 | (let ((obj (read (current-buffer)))) | |
366 | (or (and (symbolp obj) (boundp obj) obj) | |
367 | 0)))) | |
368 | (error 0))) | |
369 | ||
370 | ;;;###autoload | |
371 | (defun describe-variable (variable &optional buffer) | |
372 | "Display the full documentation of VARIABLE (a symbol). | |
373 | Returns the documentation as a string, also. | |
374 | If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), | |
375 | it is displayed along with the global value." | |
376 | (interactive | |
377 | (let ((v (variable-at-point)) | |
378 | (enable-recursive-minibuffers t) | |
379 | val) | |
380 | (setq val (completing-read (if (symbolp v) | |
381 | (format | |
382 | "Describe variable (default %s): " v) | |
383 | "Describe variable: ") | |
384 | obarray 'boundp t nil nil | |
385 | (if (symbolp v) (symbol-name v)))) | |
386 | (list (if (equal val "") | |
387 | v (intern val))))) | |
d24c52bb | 388 | (unless (buffer-live-p buffer) (setq buffer (current-buffer))) |
44e75f50 MB |
389 | (if (not (symbolp variable)) |
390 | (message "You did not specify a variable") | |
5a6a8d3b | 391 | (save-excursion |
26f19477 SM |
392 | (let* ((valvoid (not (with-current-buffer buffer (boundp variable)))) |
393 | ;; Extract the value before setting up the output buffer, | |
394 | ;; in case `buffer' *is* the output buffer. | |
395 | (val (unless valvoid (buffer-local-value variable buffer)))) | |
5a6a8d3b RS |
396 | (help-setup-xref (list #'describe-variable variable buffer) |
397 | (interactive-p)) | |
398 | (with-output-to-temp-buffer (help-buffer) | |
399 | (with-current-buffer buffer | |
400 | (prin1 variable) | |
26f19477 SM |
401 | (if valvoid |
402 | (princ " is void") | |
403 | (with-current-buffer standard-output | |
404 | (princ "'s value is ") | |
405 | (terpri) | |
406 | (let ((from (point))) | |
407 | (pp val) | |
408 | (help-xref-on-pp from (point)) | |
409 | (if (< (point) (+ from 20)) | |
f63f0981 | 410 | (delete-region (1- from) from))))) |
5a6a8d3b RS |
411 | (terpri) |
412 | (when (local-variable-p variable) | |
b0622c6d SM |
413 | (princ (format "%socal in buffer %s; " |
414 | (if (get variable 'permanent-local) | |
415 | "Permanently l" "L") | |
416 | (buffer-name))) | |
5a6a8d3b RS |
417 | (if (not (default-boundp variable)) |
418 | (princ "globally void") | |
419 | (let ((val (default-value variable))) | |
420 | (with-current-buffer standard-output | |
421 | (princ "global value is ") | |
422 | (terpri) | |
423 | ;; Fixme: pp can take an age if you happen to | |
424 | ;; ask for a very large expression. We should | |
425 | ;; probably print it raw once and check it's a | |
426 | ;; sensible size before prettyprinting. -- fx | |
427 | (let ((from (point))) | |
428 | (pp val) | |
429 | (help-xref-on-pp from (point)) | |
430 | (if (< (point) (+ from 20)) | |
d24c52bb | 431 | (delete-region (1- from) from)))))) |
5a6a8d3b RS |
432 | (terpri)) |
433 | (terpri) | |
434 | (with-current-buffer standard-output | |
435 | (when (> (count-lines (point-min) (point-max)) 10) | |
436 | ;; Note that setting the syntax table like below | |
437 | ;; makes forward-sexp move over a `'s' at the end | |
438 | ;; of a symbol. | |
439 | (set-syntax-table emacs-lisp-mode-syntax-table) | |
440 | (goto-char (point-min)) | |
441 | (if valvoid | |
442 | (forward-line 1) | |
443 | (forward-sexp 1) | |
444 | (delete-region (point) (progn (end-of-line) (point))) | |
445 | (insert " value is shown below.\n\n") | |
446 | (save-excursion | |
447 | (insert "\n\nValue:")))) | |
448 | ;; Add a note for variables that have been make-var-buffer-local. | |
449 | (when (and (local-variable-if-set-p variable) | |
450 | (or (not (local-variable-p variable)) | |
451 | (with-temp-buffer | |
452 | (local-variable-if-set-p variable)))) | |
44e75f50 | 453 | (save-excursion |
5a6a8d3b RS |
454 | (forward-line -1) |
455 | (insert "Automatically becomes buffer-local when set in any fashion.\n")))) | |
d00a3408 | 456 | ;; Mention if it's an alias |
50a2c5f9 | 457 | (let* ((alias (condition-case nil |
d00a3408 | 458 | (indirect-variable variable) |
50a2c5f9 JB |
459 | (error variable))) |
460 | (obsolete (get variable 'byte-obsolete-variable)) | |
461 | (doc (or (documentation-property variable 'variable-documentation) | |
462 | (documentation-property alias 'variable-documentation)))) | |
d00a3408 JB |
463 | (unless (eq alias variable) |
464 | (princ (format "This variable is an alias for `%s'." alias)) | |
465 | (terpri) | |
50a2c5f9 JB |
466 | (terpri)) |
467 | (when obsolete | |
468 | (princ "This variable is obsolete") | |
469 | (if (cdr obsolete) (princ (format " since %s" (cdr obsolete)))) | |
c72fcfc3 | 470 | (princ ";") (terpri) |
50a2c5f9 JB |
471 | (princ (if (stringp (car obsolete)) (car obsolete) |
472 | (format "use `%s' instead." (car obsolete)))) | |
473 | (terpri) | |
474 | (terpri)) | |
475 | (princ (or doc "Not documented as a variable."))) | |
5a6a8d3b | 476 | ;; Make a link to customize if this variable can be customized. |
13eb72d2 | 477 | (if (custom-variable-p variable) |
5a6a8d3b RS |
478 | (let ((customize-label "customize")) |
479 | (terpri) | |
480 | (terpri) | |
481 | (princ (concat "You can " customize-label " this variable.")) | |
482 | (with-current-buffer standard-output | |
483 | (save-excursion | |
484 | (re-search-backward | |
485 | (concat "\\(" customize-label "\\)") nil t) | |
486 | (help-xref-button 1 'help-customize-variable variable))))) | |
487 | ;; Make a hyperlink to the library if appropriate. (Don't | |
488 | ;; change the format of the buffer's initial line in case | |
489 | ;; anything expects the current format.) | |
dcae291f | 490 | (let ((file-name (symbol-file (cons 'defvar variable)))) |
5a6a8d3b RS |
491 | (when (equal file-name "loaddefs.el") |
492 | ;; Find the real def site of the preloaded variable. | |
493 | (let ((location | |
494 | (condition-case nil | |
495 | (find-variable-noselect variable file-name) | |
496 | (error nil)))) | |
497 | (when location | |
498 | (with-current-buffer (car location) | |
499 | (goto-char (cdr location)) | |
500 | (when (re-search-backward | |
501 | "^;;; Generated autoloads from \\(.*\\)" nil t) | |
502 | (setq file-name (match-string 1))))))) | |
503 | (when file-name | |
504 | (princ "\n\nDefined in `") | |
505 | (princ file-name) | |
506 | (princ "'.") | |
44e75f50 MB |
507 | (with-current-buffer standard-output |
508 | (save-excursion | |
5a6a8d3b RS |
509 | (re-search-backward "`\\([^`']+\\)'" nil t) |
510 | (help-xref-button 1 'help-variable-def | |
511 | variable file-name))))) | |
44e75f50 | 512 | |
5a6a8d3b RS |
513 | (print-help-return-message) |
514 | (save-excursion | |
515 | (set-buffer standard-output) | |
516 | ;; Return the text we displayed. | |
517 | (buffer-string)))))))) | |
44e75f50 | 518 | |
44e75f50 | 519 | |
c477f688 SM |
520 | ;;;###autoload |
521 | (defun describe-syntax (&optional buffer) | |
c477f688 SM |
522 | "Describe the syntax specifications in the syntax table of BUFFER. |
523 | The descriptions are inserted in a help buffer, which is then displayed. | |
524 | BUFFER defaults to the current buffer." | |
240cbfca | 525 | (interactive) |
c477f688 SM |
526 | (setq buffer (or buffer (current-buffer))) |
527 | (help-setup-xref (list #'describe-syntax buffer) (interactive-p)) | |
528 | (with-output-to-temp-buffer (help-buffer) | |
529 | (let ((table (with-current-buffer buffer (syntax-table)))) | |
530 | (with-current-buffer standard-output | |
531 | (describe-vector table 'internal-describe-syntax-value) | |
532 | (while (setq table (char-table-parent table)) | |
533 | (insert "\nThe parent syntax table is:") | |
534 | (describe-vector table 'internal-describe-syntax-value)))))) | |
535 | ||
861d9ef6 SM |
536 | (defun help-describe-category-set (value) |
537 | (insert (cond | |
538 | ((null value) "default") | |
539 | ((char-table-p value) "deeper char-table ...") | |
540 | (t (condition-case err | |
541 | (category-set-mnemonics value) | |
542 | (error "invalid")))))) | |
543 | ||
544 | ;;;###autoload | |
545 | (defun describe-categories (&optional buffer) | |
546 | "Describe the category specifications in the current category table. | |
547 | The descriptions are inserted in a buffer, which is then displayed." | |
548 | (interactive) | |
549 | (setq buffer (or buffer (current-buffer))) | |
550 | (help-setup-xref (list #'describe-categories buffer) (interactive-p)) | |
551 | (with-output-to-temp-buffer (help-buffer) | |
552 | (let ((table (with-current-buffer buffer (category-table)))) | |
553 | (with-current-buffer standard-output | |
554 | (describe-vector table 'help-describe-category-set) | |
555 | (let ((docs (char-table-extra-slot table 0))) | |
556 | (if (or (not (vectorp docs)) (/= (length docs) 95)) | |
557 | (insert "Invalid first extra slot in this char table\n") | |
558 | (insert "Meanings of mnemonic characters are:\n") | |
559 | (dotimes (i 95) | |
560 | (let ((elt (aref docs i))) | |
561 | (when elt | |
562 | (insert (+ i ?\ ) ": " elt "\n")))) | |
563 | (while (setq table (char-table-parent table)) | |
564 | (insert "\nThe parent category table is:") | |
565 | (describe-vector table 'help-describe-category-set)))))))) | |
566 | ||
125eb411 | 567 | (provide 'help-fns) |
44e75f50 | 568 | |
ab5796a9 | 569 | ;;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3 |
125eb411 | 570 | ;;; help-fns.el ends here |