Commit | Line | Data |
---|---|---|
125eb411 | 1 | ;;; help-fns.el --- Complex help functions |
44e75f50 | 2 | |
6b61353c | 3 | ;; Copyright (C) 1985, 86, 93, 94, 98, 1999, 2000, 01, 02, 03, 2004 |
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 | ||
6b61353c KH |
218 | (defvar help-C-source-directory |
219 | (let ((dir (expand-file-name "src" source-directory))) | |
220 | (when (and (file-directory-p dir) (file-readable-p dir)) | |
221 | dir)) | |
222 | "Directory where the C source files of Emacs can be found. | |
223 | If nil, do not try to find the source code of functions and variables | |
224 | defined in C.") | |
225 | ||
226 | (defun help-subr-name (subr) | |
227 | (let ((name (prin1-to-string subr))) | |
228 | (if (string-match "\\`#<subr \\(.*\\)>\\'" name) | |
229 | (match-string 1 name) | |
230 | (error "Unexpected subroutine print name: %s" name)))) | |
231 | ||
232 | (defun help-C-file-name (subr-or-var kind) | |
233 | "Return the name of the C file where SUBR-OR-VAR is defined. | |
234 | KIND should be `var' for a variable or `subr' for a subroutine." | |
235 | (let ((docbuf (get-buffer-create " *DOC*")) | |
236 | (name (if (eq 'var kind) | |
237 | (concat "V" (symbol-name subr-or-var)) | |
238 | (concat "F" (help-subr-name subr-or-var))))) | |
239 | (with-current-buffer docbuf | |
240 | (goto-char (point-min)) | |
241 | (if (eobp) | |
242 | (insert-file-contents-literally | |
243 | (expand-file-name internal-doc-file-name doc-directory))) | |
244 | (search-forward (concat "\1f" name "\n")) | |
245 | (re-search-backward "\1fS\\(.*\\)") | |
246 | (let ((file (match-string 1))) | |
247 | (if (string-match "\\.\\(o\\|obj\\)\\'" file) | |
248 | (replace-match ".c" t t file) | |
249 | file))))) | |
250 | ||
251 | (defun help-find-C-source (fun-or-var file kind) | |
252 | "Find the source location where SUBR-OR-VAR is defined in FILE. | |
253 | KIND should be `var' for a variable or `subr' for a subroutine." | |
254 | (setq file (expand-file-name file help-C-source-directory)) | |
255 | (unless (file-readable-p file) | |
256 | (error "The C source file %s is not available" | |
257 | (file-name-nondirectory file))) | |
258 | (if (eq 'fun kind) | |
259 | (setq fun-or-var (indirect-function fun-or-var))) | |
260 | (with-current-buffer (find-file-noselect file) | |
261 | (goto-char (point-min)) | |
262 | (unless (re-search-forward | |
263 | (if (eq 'fun kind) | |
264 | (concat "DEFUN[ \t\n]*([ \t\n]*\"" | |
265 | (regexp-quote (help-subr-name fun-or-var)) | |
266 | "\"") | |
267 | (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\"" | |
268 | (regexp-quote (symbol-name fun-or-var)))) | |
269 | nil t) | |
270 | (error "Can't find source for %s" fun)) | |
271 | (cons (current-buffer) (match-beginning 0)))) | |
272 | ||
8422a3b8 SM |
273 | ;;;###autoload |
274 | (defun describe-function-1 (function) | |
44e75f50 MB |
275 | (let* ((def (if (symbolp function) |
276 | (symbol-function function) | |
277 | function)) | |
8422a3b8 | 278 | file-name string |
44e75f50 MB |
279 | (beg (if (commandp def) "an interactive " "a "))) |
280 | (setq string | |
281 | (cond ((or (stringp def) | |
282 | (vectorp def)) | |
283 | "a keyboard macro") | |
284 | ((subrp def) | |
285 | (if (eq 'unevalled (cdr (subr-arity def))) | |
286 | (concat beg "special form") | |
287 | (concat beg "built-in function"))) | |
288 | ((byte-code-function-p def) | |
289 | (concat beg "compiled Lisp function")) | |
290 | ((symbolp def) | |
291 | (while (symbolp (symbol-function def)) | |
292 | (setq def (symbol-function def))) | |
293 | (format "an alias for `%s'" def)) | |
294 | ((eq (car-safe def) 'lambda) | |
295 | (concat beg "Lisp function")) | |
296 | ((eq (car-safe def) 'macro) | |
297 | "a Lisp macro") | |
44e75f50 MB |
298 | ((eq (car-safe def) 'autoload) |
299 | (setq file-name (nth 1 def)) | |
300 | (format "%s autoloaded %s" | |
301 | (if (commandp def) "an interactive" "an") | |
302 | (if (eq (nth 4 def) 'keymap) "keymap" | |
303 | (if (nth 4 def) "Lisp macro" "Lisp function")) | |
304 | )) | |
26f19477 | 305 | ((keymapp def) |
44e75f50 MB |
306 | (let ((is-full nil) |
307 | (elts (cdr-safe def))) | |
308 | (while elts | |
309 | (if (char-table-p (car-safe elts)) | |
310 | (setq is-full t | |
311 | elts nil)) | |
312 | (setq elts (cdr-safe elts))) | |
313 | (if is-full | |
314 | "a full keymap" | |
315 | "a sparse keymap"))) | |
316 | (t ""))) | |
44e75f50 | 317 | (princ string) |
8422a3b8 | 318 | (with-current-buffer standard-output |
44e75f50 MB |
319 | (save-excursion |
320 | (save-match-data | |
321 | (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) | |
322 | (help-xref-button 1 'help-function def))))) | |
323 | (or file-name | |
324 | (setq file-name (symbol-file function))) | |
35679c3f MR |
325 | (when (equal file-name "loaddefs.el") |
326 | ;; Find the real def site of the preloaded function. | |
327 | ;; This is necessary only for defaliases. | |
328 | (let ((location | |
329 | (condition-case nil | |
d24c52bb | 330 | (find-function-search-for-symbol function nil "loaddefs.el") |
35679c3f MR |
331 | (error nil)))) |
332 | (when location | |
333 | (with-current-buffer (car location) | |
334 | (goto-char (cdr location)) | |
335 | (when (re-search-backward | |
336 | "^;;; Generated autoloads from \\(.*\\)" nil t) | |
337 | (setq file-name (match-string 1))))))) | |
6b61353c KH |
338 | (when (and (null file-name) (subrp def) help-C-source-directory) |
339 | ;; Find the C source file name. | |
340 | (setq file-name (concat "src/" (help-C-file-name def 'subr)))) | |
341 | (when file-name | |
5a6a8d3b RS |
342 | (princ " in `") |
343 | ;; We used to add .el to the file name, | |
344 | ;; but that's completely wrong when the user used load-file. | |
345 | (princ file-name) | |
346 | (princ "'") | |
347 | ;; Make a hyperlink to the library. | |
8422a3b8 | 348 | (with-current-buffer standard-output |
6b61353c | 349 | (save-excursion |
5a6a8d3b | 350 | (re-search-backward "`\\([^`']+\\)'" nil t) |
6b61353c | 351 | (help-xref-button 1 'help-function-def function file-name)))) |
44e75f50 MB |
352 | (princ ".") |
353 | (terpri) | |
354 | (when (commandp function) | |
023b93f6 | 355 | (let* ((remapped (command-remapping function)) |
d2ab11c5 | 356 | (keys (where-is-internal |
023b93f6 | 357 | (or remapped function) overriding-local-map nil nil))) |
d2ab11c5 KS |
358 | (when remapped |
359 | (princ "It is remapped to `") | |
360 | (princ (symbol-name remapped)) | |
361 | (princ "'")) | |
44e75f50 | 362 | (when keys |
d2ab11c5 | 363 | (princ (if remapped " which is bound to " "It is bound to ")) |
44e75f50 | 364 | ;; FIXME: This list can be very long (f.ex. for self-insert-command). |
d2ab11c5 KS |
365 | (princ (mapconcat 'key-description keys ", "))) |
366 | (when (or remapped keys) | |
44e75f50 MB |
367 | (princ ".") |
368 | (terpri)))) | |
2dbbed9e SM |
369 | (let* ((arglist (help-function-arglist def)) |
370 | (doc (documentation function)) | |
f63f0981 | 371 | (usage (help-split-fundoc doc function))) |
dd66897f JPW |
372 | ;; If definition is a keymap, skip arglist note. |
373 | (unless (keymapp def) | |
374 | (princ (cond | |
26f19477 | 375 | (usage (setq doc (cdr usage)) (car usage)) |
dd66897f JPW |
376 | ((listp arglist) (help-make-usage function arglist)) |
377 | ((stringp arglist) arglist) | |
26f19477 SM |
378 | ;; Maybe the arglist is in the docstring of the alias. |
379 | ((let ((fun function)) | |
380 | (while (and (symbolp fun) | |
381 | (setq fun (symbol-function fun)) | |
382 | (not (setq usage (help-split-fundoc | |
383 | (documentation fun) | |
f63f0981 | 384 | function))))) |
26f19477 SM |
385 | usage) |
386 | (car usage)) | |
a01ba4f1 JB |
387 | ((or (stringp def) |
388 | (vectorp def)) | |
389 | (format "\nMacro: %s" (format-kbd-macro def))) | |
dd66897f JPW |
390 | (t "[Missing arglist. Please make a bug report.]"))) |
391 | (terpri)) | |
32d9a725 MR |
392 | (let ((obsolete (and |
393 | ;; function might be a lambda construct. | |
394 | (symbolp function) | |
395 | (get function 'byte-obsolete-info)))) | |
2dbbed9e SM |
396 | (when obsolete |
397 | (terpri) | |
398 | (princ "This function is obsolete") | |
399 | (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete)))) | |
400 | (princ ";") (terpri) | |
401 | (princ (if (stringp (car obsolete)) (car obsolete) | |
402 | (format "use `%s' instead." (car obsolete)))) | |
403 | (terpri))) | |
3b622b44 JB |
404 | (terpri) |
405 | (princ (or doc "Not documented."))))) | |
44e75f50 MB |
406 | |
407 | \f | |
408 | ;; Variables | |
409 | ||
410 | ;;;###autoload | |
411 | (defun variable-at-point () | |
412 | "Return the bound variable symbol found around point. | |
413 | Return 0 if there is no such symbol." | |
414 | (condition-case () | |
415 | (with-syntax-table emacs-lisp-mode-syntax-table | |
416 | (save-excursion | |
417 | (or (not (zerop (skip-syntax-backward "_w"))) | |
418 | (eq (char-syntax (following-char)) ?w) | |
419 | (eq (char-syntax (following-char)) ?_) | |
420 | (forward-sexp -1)) | |
421 | (skip-chars-forward "'") | |
422 | (let ((obj (read (current-buffer)))) | |
423 | (or (and (symbolp obj) (boundp obj) obj) | |
424 | 0)))) | |
425 | (error 0))) | |
426 | ||
427 | ;;;###autoload | |
428 | (defun describe-variable (variable &optional buffer) | |
429 | "Display the full documentation of VARIABLE (a symbol). | |
430 | Returns the documentation as a string, also. | |
431 | If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), | |
432 | it is displayed along with the global value." | |
433 | (interactive | |
434 | (let ((v (variable-at-point)) | |
435 | (enable-recursive-minibuffers t) | |
436 | val) | |
437 | (setq val (completing-read (if (symbolp v) | |
438 | (format | |
439 | "Describe variable (default %s): " v) | |
440 | "Describe variable: ") | |
441 | obarray 'boundp t nil nil | |
442 | (if (symbolp v) (symbol-name v)))) | |
443 | (list (if (equal val "") | |
444 | v (intern val))))) | |
d24c52bb | 445 | (unless (buffer-live-p buffer) (setq buffer (current-buffer))) |
44e75f50 MB |
446 | (if (not (symbolp variable)) |
447 | (message "You did not specify a variable") | |
5a6a8d3b | 448 | (save-excursion |
26f19477 SM |
449 | (let* ((valvoid (not (with-current-buffer buffer (boundp variable)))) |
450 | ;; Extract the value before setting up the output buffer, | |
451 | ;; in case `buffer' *is* the output buffer. | |
452 | (val (unless valvoid (buffer-local-value variable buffer)))) | |
5a6a8d3b RS |
453 | (help-setup-xref (list #'describe-variable variable buffer) |
454 | (interactive-p)) | |
455 | (with-output-to-temp-buffer (help-buffer) | |
456 | (with-current-buffer buffer | |
457 | (prin1 variable) | |
26f19477 SM |
458 | (if valvoid |
459 | (princ " is void") | |
460 | (with-current-buffer standard-output | |
461 | (princ "'s value is ") | |
462 | (terpri) | |
463 | (let ((from (point))) | |
464 | (pp val) | |
465 | (help-xref-on-pp from (point)) | |
466 | (if (< (point) (+ from 20)) | |
f63f0981 | 467 | (delete-region (1- from) from))))) |
5a6a8d3b RS |
468 | (terpri) |
469 | (when (local-variable-p variable) | |
b0622c6d SM |
470 | (princ (format "%socal in buffer %s; " |
471 | (if (get variable 'permanent-local) | |
472 | "Permanently l" "L") | |
473 | (buffer-name))) | |
5a6a8d3b RS |
474 | (if (not (default-boundp variable)) |
475 | (princ "globally void") | |
476 | (let ((val (default-value variable))) | |
477 | (with-current-buffer standard-output | |
478 | (princ "global value is ") | |
479 | (terpri) | |
480 | ;; Fixme: pp can take an age if you happen to | |
481 | ;; ask for a very large expression. We should | |
482 | ;; probably print it raw once and check it's a | |
483 | ;; sensible size before prettyprinting. -- fx | |
484 | (let ((from (point))) | |
485 | (pp val) | |
486 | (help-xref-on-pp from (point)) | |
487 | (if (< (point) (+ from 20)) | |
d24c52bb | 488 | (delete-region (1- from) from)))))) |
5a6a8d3b RS |
489 | (terpri)) |
490 | (terpri) | |
491 | (with-current-buffer standard-output | |
492 | (when (> (count-lines (point-min) (point-max)) 10) | |
493 | ;; Note that setting the syntax table like below | |
494 | ;; makes forward-sexp move over a `'s' at the end | |
495 | ;; of a symbol. | |
496 | (set-syntax-table emacs-lisp-mode-syntax-table) | |
497 | (goto-char (point-min)) | |
498 | (if valvoid | |
499 | (forward-line 1) | |
500 | (forward-sexp 1) | |
501 | (delete-region (point) (progn (end-of-line) (point))) | |
502 | (insert " value is shown below.\n\n") | |
503 | (save-excursion | |
504 | (insert "\n\nValue:")))) | |
505 | ;; Add a note for variables that have been make-var-buffer-local. | |
506 | (when (and (local-variable-if-set-p variable) | |
507 | (or (not (local-variable-p variable)) | |
508 | (with-temp-buffer | |
509 | (local-variable-if-set-p variable)))) | |
44e75f50 | 510 | (save-excursion |
5a6a8d3b RS |
511 | (forward-line -1) |
512 | (insert "Automatically becomes buffer-local when set in any fashion.\n")))) | |
d00a3408 | 513 | ;; Mention if it's an alias |
50a2c5f9 | 514 | (let* ((alias (condition-case nil |
d00a3408 | 515 | (indirect-variable variable) |
50a2c5f9 JB |
516 | (error variable))) |
517 | (obsolete (get variable 'byte-obsolete-variable)) | |
518 | (doc (or (documentation-property variable 'variable-documentation) | |
519 | (documentation-property alias 'variable-documentation)))) | |
d00a3408 JB |
520 | (unless (eq alias variable) |
521 | (princ (format "This variable is an alias for `%s'." alias)) | |
522 | (terpri) | |
50a2c5f9 JB |
523 | (terpri)) |
524 | (when obsolete | |
525 | (princ "This variable is obsolete") | |
526 | (if (cdr obsolete) (princ (format " since %s" (cdr obsolete)))) | |
c72fcfc3 | 527 | (princ ";") (terpri) |
50a2c5f9 JB |
528 | (princ (if (stringp (car obsolete)) (car obsolete) |
529 | (format "use `%s' instead." (car obsolete)))) | |
530 | (terpri) | |
531 | (terpri)) | |
532 | (princ (or doc "Not documented as a variable."))) | |
5a6a8d3b | 533 | ;; Make a link to customize if this variable can be customized. |
13eb72d2 | 534 | (if (custom-variable-p variable) |
5a6a8d3b RS |
535 | (let ((customize-label "customize")) |
536 | (terpri) | |
537 | (terpri) | |
538 | (princ (concat "You can " customize-label " this variable.")) | |
539 | (with-current-buffer standard-output | |
540 | (save-excursion | |
541 | (re-search-backward | |
542 | (concat "\\(" customize-label "\\)") nil t) | |
543 | (help-xref-button 1 'help-customize-variable variable))))) | |
544 | ;; Make a hyperlink to the library if appropriate. (Don't | |
545 | ;; change the format of the buffer's initial line in case | |
546 | ;; anything expects the current format.) | |
dcae291f | 547 | (let ((file-name (symbol-file (cons 'defvar variable)))) |
5a6a8d3b RS |
548 | (when (equal file-name "loaddefs.el") |
549 | ;; Find the real def site of the preloaded variable. | |
550 | (let ((location | |
551 | (condition-case nil | |
552 | (find-variable-noselect variable file-name) | |
553 | (error nil)))) | |
554 | (when location | |
555 | (with-current-buffer (car location) | |
556 | (goto-char (cdr location)) | |
557 | (when (re-search-backward | |
558 | "^;;; Generated autoloads from \\(.*\\)" nil t) | |
559 | (setq file-name (match-string 1))))))) | |
6b61353c KH |
560 | (when (and (null file-name) |
561 | (integerp (get variable 'variable-documentation))) | |
562 | ;; It's a variable not defined in Elisp but in C. | |
563 | (if help-C-source-directory | |
564 | (setq file-name | |
565 | (concat "src/" (help-C-file-name variable 'var))) | |
566 | (princ "\n\nDefined in core C code."))) | |
5a6a8d3b RS |
567 | (when file-name |
568 | (princ "\n\nDefined in `") | |
569 | (princ file-name) | |
570 | (princ "'.") | |
44e75f50 MB |
571 | (with-current-buffer standard-output |
572 | (save-excursion | |
5a6a8d3b RS |
573 | (re-search-backward "`\\([^`']+\\)'" nil t) |
574 | (help-xref-button 1 'help-variable-def | |
575 | variable file-name))))) | |
44e75f50 | 576 | |
5a6a8d3b RS |
577 | (print-help-return-message) |
578 | (save-excursion | |
579 | (set-buffer standard-output) | |
580 | ;; Return the text we displayed. | |
581 | (buffer-string)))))))) | |
44e75f50 | 582 | |
44e75f50 | 583 | |
c477f688 SM |
584 | ;;;###autoload |
585 | (defun describe-syntax (&optional buffer) | |
c477f688 SM |
586 | "Describe the syntax specifications in the syntax table of BUFFER. |
587 | The descriptions are inserted in a help buffer, which is then displayed. | |
588 | BUFFER defaults to the current buffer." | |
240cbfca | 589 | (interactive) |
c477f688 SM |
590 | (setq buffer (or buffer (current-buffer))) |
591 | (help-setup-xref (list #'describe-syntax buffer) (interactive-p)) | |
592 | (with-output-to-temp-buffer (help-buffer) | |
593 | (let ((table (with-current-buffer buffer (syntax-table)))) | |
594 | (with-current-buffer standard-output | |
595 | (describe-vector table 'internal-describe-syntax-value) | |
596 | (while (setq table (char-table-parent table)) | |
597 | (insert "\nThe parent syntax table is:") | |
598 | (describe-vector table 'internal-describe-syntax-value)))))) | |
599 | ||
861d9ef6 SM |
600 | (defun help-describe-category-set (value) |
601 | (insert (cond | |
602 | ((null value) "default") | |
603 | ((char-table-p value) "deeper char-table ...") | |
604 | (t (condition-case err | |
605 | (category-set-mnemonics value) | |
606 | (error "invalid")))))) | |
607 | ||
608 | ;;;###autoload | |
609 | (defun describe-categories (&optional buffer) | |
610 | "Describe the category specifications in the current category table. | |
6b61353c KH |
611 | The descriptions are inserted in a buffer, which is then displayed. |
612 | If BUFFER is non-nil, then describe BUFFER's category table instead. | |
613 | BUFFER should be a buffer or a buffer name." | |
861d9ef6 SM |
614 | (interactive) |
615 | (setq buffer (or buffer (current-buffer))) | |
616 | (help-setup-xref (list #'describe-categories buffer) (interactive-p)) | |
617 | (with-output-to-temp-buffer (help-buffer) | |
618 | (let ((table (with-current-buffer buffer (category-table)))) | |
619 | (with-current-buffer standard-output | |
620 | (describe-vector table 'help-describe-category-set) | |
621 | (let ((docs (char-table-extra-slot table 0))) | |
622 | (if (or (not (vectorp docs)) (/= (length docs) 95)) | |
623 | (insert "Invalid first extra slot in this char table\n") | |
624 | (insert "Meanings of mnemonic characters are:\n") | |
625 | (dotimes (i 95) | |
626 | (let ((elt (aref docs i))) | |
627 | (when elt | |
628 | (insert (+ i ?\ ) ": " elt "\n")))) | |
629 | (while (setq table (char-table-parent table)) | |
630 | (insert "\nThe parent category table is:") | |
631 | (describe-vector table 'help-describe-category-set)))))))) | |
632 | ||
125eb411 | 633 | (provide 'help-fns) |
44e75f50 | 634 | |
6b61353c | 635 | ;;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3 |
125eb411 | 636 | ;;; help-fns.el ends here |