/[emacs]/emacs/lisp/help-fns.el
ViewVC logotype

Diff of /emacs/lisp/help-fns.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9.2.1 by miles, Wed Jun 12 01:53:06 2002 UTC revision 1.9.2.2 by miles, Fri Apr 4 06:20:06 2003 UTC
# Line 1  Line 1 
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
# Line 42  Line 42 
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")))
# Line 88  With arg, you are asked to choose which Line 91  With arg, you are asked to choose which
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)))))
# Line 98  With arg, you are asked to choose which Line 101  With arg, you are asked to choose which
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    
# Line 109  is used instead of `load-path'. Line 112  is used instead of `load-path'.
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
# Line 157  and the file name is displayed in the ec Line 157  and the file name is displayed in the ec
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)
# Line 190  and the file name is displayed in the ec Line 246  and the file name is displayed in the ec
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
# Line 216  and the file name is displayed in the ec Line 271  and the file name is displayed in the ec
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)
# Line 239  and the file name is displayed in the ec Line 294  and the file name is displayed in the ec
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))
# Line 253  and the file name is displayed in the ec Line 308  and the file name is displayed in the ec
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
# Line 354  it is displayed along with the global va Line 384  it is displayed along with the global va
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)))
# Line 396  it is displayed along with the global va Line 424  it is displayed along with the global va
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
# Line 423  it is displayed along with the global va Line 449  it is displayed along with the global va
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)
# Line 447  it is displayed along with the global va Line 483  it is displayed along with the global va
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

Legend:
Removed from v.1.9.2.1  
changed lines
  Added in v.1.9.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26