1 |
;;; help-fns.el --- Complex help functions |
;;; help-fns.el --- Complex help functions |
2 |
|
|
3 |
;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002 |
;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Maintainer: FSF |
;; Maintainer: FSF |
42 |
If there is a tutorial version written in the language |
If there is a tutorial version written in the language |
43 |
of the selected language environment, that version is used. |
of the selected language environment, that version is used. |
44 |
If there's no tutorial in that language, `TUTORIAL' is selected. |
If there's no tutorial in that language, `TUTORIAL' is selected. |
45 |
With arg, you are asked to choose which language." |
With ARG, you are asked to choose which language." |
46 |
(interactive "P") |
(interactive "P") |
47 |
(let ((lang (if arg |
(let ((lang (if arg |
48 |
(read-language-name 'tutorial "Language: " "English") |
(let ((minibuffer-setup-hook minibuffer-setup-hook)) |
49 |
|
(add-hook 'minibuffer-setup-hook |
50 |
|
'minibuffer-completion-help) |
51 |
|
(read-language-name 'tutorial "Language: " "English")) |
52 |
(if (get-language-info current-language-environment 'tutorial) |
(if (get-language-info current-language-environment 'tutorial) |
53 |
current-language-environment |
current-language-environment |
54 |
"English"))) |
"English"))) |
91 |
(newline n)) |
(newline n)) |
92 |
;; Some people get confused by the large gap. |
;; Some people get confused by the large gap. |
93 |
(newline (/ n 2)) |
(newline (/ n 2)) |
94 |
|
|
95 |
;; Skip the [...] line (don't delete it). |
;; Skip the [...] line (don't delete it). |
96 |
(forward-line 1) |
(forward-line 1) |
97 |
(newline (- n (/ n 2))))) |
(newline (- n (/ n 2))))) |
101 |
;;;###autoload |
;;;###autoload |
102 |
(defun locate-library (library &optional nosuffix path interactive-call) |
(defun locate-library (library &optional nosuffix path interactive-call) |
103 |
"Show the precise file name of Emacs library LIBRARY. |
"Show the precise file name of Emacs library LIBRARY. |
104 |
This command searches the directories in `load-path' like `M-x load-library' |
This command searches the directories in `load-path' like `\\[load-library]' |
105 |
to find the file that `M-x load-library RET LIBRARY RET' would load. |
to find the file that `\\[load-library] RET LIBRARY RET' would load. |
106 |
Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' |
Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' |
107 |
to the specified name LIBRARY. |
to the specified name LIBRARY. |
108 |
|
|
112 |
When called from a program, the file name is normaly returned as a |
When called from a program, the file name is normaly returned as a |
113 |
string. When run interactively, the argument INTERACTIVE-CALL is t, |
string. When run interactively, the argument INTERACTIVE-CALL is t, |
114 |
and the file name is displayed in the echo area." |
and the file name is displayed in the echo area." |
115 |
(interactive (list (read-string "Locate library: ") |
(interactive (list (completing-read "Locate library: " |
116 |
|
'locate-file-completion |
117 |
|
(cons load-path load-suffixes)) |
118 |
nil nil |
nil nil |
119 |
t)) |
t)) |
120 |
(catch 'answer |
(let ((file (locate-file library |
121 |
(dolist (dir (or path load-path)) |
(or path load-path) |
122 |
(dolist (suf (append (unless nosuffix load-suffixes) '(""))) |
(append (unless nosuffix load-suffixes) '(""))))) |
|
(let ((try (expand-file-name (concat library suf) dir))) |
|
|
(and (file-readable-p try) |
|
|
(null (file-directory-p try)) |
|
|
(progn |
|
|
(if interactive-call |
|
|
(message "Library is file %s" (abbreviate-file-name try))) |
|
|
(throw 'answer try)))))) |
|
123 |
(if interactive-call |
(if interactive-call |
124 |
(message "No library %s in search path" library)) |
(if file |
125 |
nil)) |
(message "Library is file %s" (abbreviate-file-name file)) |
126 |
|
(message "No library %s in search path" library))) |
127 |
|
file)) |
128 |
|
|
129 |
|
|
130 |
;; Functions |
;; Functions |
157 |
;; Return the text we displayed. |
;; Return the text we displayed. |
158 |
(buffer-string)))))) |
(buffer-string)))))) |
159 |
|
|
160 |
|
(defun help-split-fundoc (doc def) |
161 |
|
"Split a function docstring DOC into the actual doc and the usage info. |
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. |
165 |
|
;; In cases where `function' has been fset to a subr we can't search for |
166 |
|
;; function's name in the doc string so we use `fn' as the anonymous |
167 |
|
;; function name instead. |
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. |
178 |
|
The usage info is built from ARGLIST. DOC can be nil." |
179 |
|
(unless (stringp doc) (setq doc "Not documented")) |
180 |
|
(if (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) |
181 |
|
doc |
182 |
|
(format "%s%s%s" doc |
183 |
|
(if (string-match "\n?\n\\'" doc) |
184 |
|
(if (< (- (match-end 0) (match-beginning 0)) 2) "\n") |
185 |
|
"\n\n") |
186 |
|
(help-make-usage 'fn arglist)))) |
187 |
|
|
188 |
|
(defun help-function-arglist (def) |
189 |
|
;; Handle symbols aliased to other symbols. |
190 |
|
(if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) |
191 |
|
;; If definition is a macro, find the function inside it. |
192 |
|
(if (eq (car-safe def) 'macro) (setq def (cdr def))) |
193 |
|
;; and do the same for interpreted closures |
194 |
|
(if (eq (car-safe def) 'closure) (setq def (cddr def))) |
195 |
|
(cond |
196 |
|
((byte-code-function-p def) (aref def 0)) |
197 |
|
((eq (car-safe def) 'lambda) (nth 1 def)) |
198 |
|
((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) |
199 |
|
"[Arg list not available until function definition is loaded.]") |
200 |
|
(t t))) |
201 |
|
|
202 |
|
(defun help-make-usage (function arglist) |
203 |
|
(cons (if (symbolp function) function 'anonymous) |
204 |
|
(mapcar (lambda (arg) |
205 |
|
(if (not (symbolp arg)) |
206 |
|
(if (and (consp arg) (symbolp (car arg))) |
207 |
|
;; CL style default values for optional args. |
208 |
|
(cons (intern (upcase (symbol-name (car arg)))) |
209 |
|
(cdr arg)) |
210 |
|
arg) |
211 |
|
(let ((name (symbol-name arg))) |
212 |
|
(if (string-match "\\`&" name) arg |
213 |
|
(intern (upcase name)))))) |
214 |
|
arglist))) |
215 |
|
|
216 |
;;;###autoload |
;;;###autoload |
217 |
(defun describe-function-1 (function) |
(defun describe-function-1 (function) |
218 |
(let* ((def (if (symbolp function) |
(let* ((def (if (symbolp function) |
246 |
(if (eq (nth 4 def) 'keymap) "keymap" |
(if (eq (nth 4 def) 'keymap) "keymap" |
247 |
(if (nth 4 def) "Lisp macro" "Lisp function")) |
(if (nth 4 def) "Lisp macro" "Lisp function")) |
248 |
)) |
)) |
249 |
;; perhaps use keymapp here instead |
((keymapp def) |
|
((eq (car-safe def) 'keymap) |
|
250 |
(let ((is-full nil) |
(let ((is-full nil) |
251 |
(elts (cdr-safe def))) |
(elts (cdr-safe def))) |
252 |
(while elts |
(while elts |
271 |
;; This is necessary only for defaliases. |
;; This is necessary only for defaliases. |
272 |
(let ((location |
(let ((location |
273 |
(condition-case nil |
(condition-case nil |
274 |
(find-function-search-for-symbol function nil "loaddefs.el") |
(find-function-search-for-symbol function nil "loaddefs.el") |
275 |
(error nil)))) |
(error nil)))) |
276 |
(when location |
(when location |
277 |
(with-current-buffer (car location) |
(with-current-buffer (car location) |
294 |
(princ ".") |
(princ ".") |
295 |
(terpri) |
(terpri) |
296 |
(when (commandp function) |
(when (commandp function) |
297 |
(let* ((remapped (remap-command function)) |
(let* ((remapped (command-remapping function)) |
298 |
(keys (where-is-internal |
(keys (where-is-internal |
299 |
(or remapped function) overriding-local-map nil nil))) |
(or remapped function) overriding-local-map nil nil))) |
300 |
(when remapped |
(when remapped |
301 |
(princ "It is remapped to `") |
(princ "It is remapped to `") |
302 |
(princ (symbol-name remapped)) |
(princ (symbol-name remapped)) |
308 |
(when (or remapped keys) |
(when (or remapped keys) |
309 |
(princ ".") |
(princ ".") |
310 |
(terpri)))) |
(terpri)))) |
311 |
;; Handle symbols aliased to other symbols. |
(let* ((arglist (help-function-arglist def)) |
312 |
(setq def (indirect-function def)) |
(doc (documentation function)) |
313 |
;; If definition is a macro, find the function inside it. |
(usage (help-split-fundoc doc function))) |
314 |
(if (eq (car-safe def) 'macro) |
;; If definition is a keymap, skip arglist note. |
315 |
(setq def (cdr def))) |
(unless (keymapp def) |
316 |
;; and do the same for interpreted closures |
(princ (cond |
317 |
(if (eq (car-safe def) 'closure) |
(usage (setq doc (cdr usage)) (car usage)) |
318 |
(setq def (cddr def))) |
((listp arglist) (help-make-usage function arglist)) |
319 |
(let ((arglist (cond ((byte-code-function-p def) |
((stringp arglist) arglist) |
320 |
(car (append def nil))) |
;; Maybe the arglist is in the docstring of the alias. |
321 |
((eq (car-safe def) 'lambda) |
((let ((fun function)) |
322 |
(nth 1 def)) |
(while (and (symbolp fun) |
323 |
((and (eq (car-safe def) 'autoload) |
(setq fun (symbol-function fun)) |
324 |
(not (eq (nth 4 def) 'keymap))) |
(not (setq usage (help-split-fundoc |
325 |
(concat "[Arg list not available until " |
(documentation fun) |
326 |
"function definition is loaded.]")) |
function))))) |
327 |
(t t)))) |
usage) |
328 |
(cond ((listp arglist) |
(car usage)) |
329 |
(princ (cons (if (symbolp function) function "anonymous") |
((or (stringp def) |
330 |
(mapcar (lambda (arg) |
(vectorp def)) |
331 |
(if (memq arg '(&optional &rest)) |
(format "\nMacro: %s" (format-kbd-macro def))) |
332 |
arg |
(t "[Missing arglist. Please make a bug report.]"))) |
333 |
(intern (upcase (symbol-name arg))))) |
(terpri)) |
334 |
arglist))) |
(let ((obsolete (and |
335 |
(terpri)) |
;; function might be a lambda construct. |
336 |
((stringp arglist) |
(symbolp function) |
337 |
(princ arglist) |
(get function 'byte-obsolete-info)))) |
338 |
(terpri)))) |
(when obsolete |
339 |
(let ((doc (documentation function))) |
(terpri) |
340 |
(if doc |
(princ "This function is obsolete") |
341 |
(progn (terpri) |
(if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete)))) |
342 |
(princ doc) |
(princ ";") (terpri) |
343 |
(if (subrp def) |
(princ (if (stringp (car obsolete)) (car obsolete) |
344 |
(with-current-buffer standard-output |
(format "use `%s' instead." (car obsolete)))) |
345 |
(beginning-of-line) |
(terpri))) |
346 |
;; Builtins get the calling sequence at the end of |
(terpri) |
347 |
;; the doc string. Move it to the same place as |
(princ (or doc "Not documented."))))) |
|
;; for other functions. |
|
|
|
|
|
;; In cases where `function' has been fset to a |
|
|
;; subr we can't search for function's name in |
|
|
;; the doc string. Kluge round that using the |
|
|
;; printed representation. The arg list then |
|
|
;; shows the wrong function name, but that |
|
|
;; might be a useful hint. |
|
|
(let* ((rep (prin1-to-string def)) |
|
|
(name (progn |
|
|
(string-match " \\([^ ]+\\)>$" rep) |
|
|
(match-string 1 rep)))) |
|
|
(if (looking-at (format "(%s[ )]" (regexp-quote name))) |
|
|
(let ((start (point-marker))) |
|
|
(goto-char (point-min)) |
|
|
(forward-paragraph) |
|
|
(insert-buffer-substring (current-buffer) start) |
|
|
(insert ?\n) |
|
|
(delete-region (1- start) (point-max))) |
|
|
(goto-char (point-min)) |
|
|
(forward-paragraph) |
|
|
(insert |
|
|
"[Missing arglist. Please make a bug report.]\n"))) |
|
|
(goto-char (point-max))))) |
|
|
(princ "not documented"))))) |
|
348 |
|
|
349 |
|
|
350 |
;; Variables |
;; Variables |
384 |
(if (symbolp v) (symbol-name v)))) |
(if (symbolp v) (symbol-name v)))) |
385 |
(list (if (equal val "") |
(list (if (equal val "") |
386 |
v (intern val))))) |
v (intern val))))) |
387 |
(unless (bufferp buffer) (setq buffer (current-buffer))) |
(unless (buffer-live-p buffer) (setq buffer (current-buffer))) |
388 |
(if (not (symbolp variable)) |
(if (not (symbolp variable)) |
389 |
(message "You did not specify a variable") |
(message "You did not specify a variable") |
390 |
(save-excursion |
(save-excursion |
391 |
(let (valvoid) |
(let* ((valvoid (not (with-current-buffer buffer (boundp variable)))) |
392 |
|
;; Extract the value before setting up the output buffer, |
393 |
|
;; in case `buffer' *is* the output buffer. |
394 |
|
(val (unless valvoid (buffer-local-value variable buffer)))) |
395 |
(help-setup-xref (list #'describe-variable variable buffer) |
(help-setup-xref (list #'describe-variable variable buffer) |
396 |
(interactive-p)) |
(interactive-p)) |
397 |
(with-output-to-temp-buffer (help-buffer) |
(with-output-to-temp-buffer (help-buffer) |
398 |
(with-current-buffer buffer |
(with-current-buffer buffer |
399 |
(prin1 variable) |
(prin1 variable) |
400 |
(if (not (boundp variable)) |
(if valvoid |
401 |
(progn |
(princ " is void") |
402 |
(princ " is void") |
(with-current-buffer standard-output |
403 |
(setq valvoid t)) |
(princ "'s value is ") |
404 |
(let ((val (symbol-value variable))) |
(terpri) |
405 |
(with-current-buffer standard-output |
(let ((from (point))) |
406 |
(princ "'s value is ") |
(pp val) |
407 |
(terpri) |
(help-xref-on-pp from (point)) |
408 |
(let ((from (point))) |
(if (< (point) (+ from 20)) |
409 |
(pp val) |
(delete-region (1- from) from))))) |
|
(help-xref-on-pp from (point)) |
|
|
(if (< (point) (+ from 20)) |
|
|
(save-excursion |
|
|
(goto-char from) |
|
|
(delete-char -1))))))) |
|
410 |
(terpri) |
(terpri) |
411 |
(when (local-variable-p variable) |
(when (local-variable-p variable) |
412 |
(princ (format "Local in buffer %s; " (buffer-name))) |
(princ (format "Local in buffer %s; " (buffer-name))) |
424 |
(pp val) |
(pp val) |
425 |
(help-xref-on-pp from (point)) |
(help-xref-on-pp from (point)) |
426 |
(if (< (point) (+ from 20)) |
(if (< (point) (+ from 20)) |
427 |
(save-excursion |
(delete-region (1- from) from)))))) |
|
(goto-char from) |
|
|
(delete-char -1))))))) |
|
428 |
(terpri)) |
(terpri)) |
429 |
(terpri) |
(terpri) |
430 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
449 |
(save-excursion |
(save-excursion |
450 |
(forward-line -1) |
(forward-line -1) |
451 |
(insert "Automatically becomes buffer-local when set in any fashion.\n")))) |
(insert "Automatically becomes buffer-local when set in any fashion.\n")))) |
452 |
(princ "Documentation:") |
;; Mention if it's an alias |
453 |
(terpri) |
(let* ((alias (condition-case nil |
454 |
(let ((doc (documentation-property variable 'variable-documentation))) |
(indirect-variable variable) |
455 |
(princ (or doc "not documented as a variable."))) |
(error variable))) |
456 |
|
(obsolete (get variable 'byte-obsolete-variable)) |
457 |
|
(doc (or (documentation-property variable 'variable-documentation) |
458 |
|
(documentation-property alias 'variable-documentation)))) |
459 |
|
(unless (eq alias variable) |
460 |
|
(princ (format "This variable is an alias for `%s'." alias)) |
461 |
|
(terpri) |
462 |
|
(terpri)) |
463 |
|
(when obsolete |
464 |
|
(princ "This variable is obsolete") |
465 |
|
(if (cdr obsolete) (princ (format " since %s" (cdr obsolete)))) |
466 |
|
(princ ";") (terpri) |
467 |
|
(princ (if (stringp (car obsolete)) (car obsolete) |
468 |
|
(format "use `%s' instead." (car obsolete)))) |
469 |
|
(terpri) |
470 |
|
(terpri)) |
471 |
|
(princ (or doc "Not documented as a variable."))) |
472 |
;; Make a link to customize if this variable can be customized. |
;; Make a link to customize if this variable can be customized. |
473 |
;; Note, it is not reliable to test only for a custom-type property |
(if (custom-variable-p variable) |
|
;; because those are only present after the var's definition |
|
|
;; has been loaded. |
|
|
(if (or (get variable 'custom-type) ; after defcustom |
|
|
(get variable 'custom-loads) ; from loaddefs.el |
|
|
(get variable 'standard-value)) ; from cus-start.el |
|
474 |
(let ((customize-label "customize")) |
(let ((customize-label "customize")) |
475 |
(terpri) |
(terpri) |
476 |
(terpri) |
(terpri) |
483 |
;; Make a hyperlink to the library if appropriate. (Don't |
;; Make a hyperlink to the library if appropriate. (Don't |
484 |
;; change the format of the buffer's initial line in case |
;; change the format of the buffer's initial line in case |
485 |
;; anything expects the current format.) |
;; anything expects the current format.) |
486 |
(let ((file-name (symbol-file variable))) |
(let ((file-name (symbol-file (cons 'defvar variable)))) |
487 |
(when (equal file-name "loaddefs.el") |
(when (equal file-name "loaddefs.el") |
488 |
;; Find the real def site of the preloaded variable. |
;; Find the real def site of the preloaded variable. |
489 |
(let ((location |
(let ((location |