/[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.17 by lektu, Mon Jul 15 16:17:01 2002 UTC revision 1.18 by monnier, Tue Jul 16 16:24:59 2002 UTC
# Line 165  and the file name is displayed in the ec Line 165  and the file name is displayed in the ec
165            ;; Return the text we displayed.            ;; Return the text we displayed.
166            (buffer-string))))))            (buffer-string))))))
167    
168    (defun help-split-fundoc (doc &optional def)
169      "Split a function docstring DOC into the actual doc and the usage info.
170    Return (USAGE . DOC) or nil if there's no usage info."
171      ;; Builtins get the calling sequence at the end of the doc string.
172      ;; In cases where `function' has been fset to a subr we can't search for
173      ;; function's name in the doc string.  Kluge round that using the printed
174      ;; representation.  The arg list then shows the wrong function name, but
175      ;; that might be a useful hint.
176      (let* ((rep (prin1-to-string def))
177             (name (if (string-match " \\([^ ]+\\)>$" rep)
178                       (match-string 1 rep) "fun")))
179        (if (string-match (format "^(%s[ )].*\\'" (regexp-quote name)) doc)
180            (cons (match-string 0 doc)
181                  (substring doc 0 (match-beginning 0))))))
182    
183    (defun help-function-arglist (def)
184      (cond
185       ((byte-code-function-p def) (aref def 0))
186       ((eq (car-safe def) 'lambda) (nth 1 def))
187       ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap)))
188        "[Arg list not available until function definition is loaded.]")
189       (t t)))
190    
191    (defun help-make-usage (function arglist)
192      (cons (if (symbolp function) function 'anonymous)
193            (mapcar (lambda (arg)
194                      (if (not (symbolp arg)) arg
195                        (let ((name (symbol-name arg)))
196                          (if (string-match "\\`&" name) arg
197                            (intern (upcase name))))))
198                    arglist)))
199    
200  ;;;###autoload  ;;;###autoload
201  (defun describe-function-1 (function)  (defun describe-function-1 (function)
202    (let* ((def (if (symbolp function)    (let* ((def (if (symbolp function)
# Line 248  and the file name is displayed in the ec Line 280  and the file name is displayed in the ec
280      (when (commandp function)      (when (commandp function)
281        (let* ((remapped (remap-command function))        (let* ((remapped (remap-command function))
282               (keys (where-is-internal               (keys (where-is-internal
283                     (or remapped function) overriding-local-map nil nil)))                      (or remapped function) overriding-local-map nil nil)))
284          (when remapped          (when remapped
285            (princ "It is remapped to `")            (princ "It is remapped to `")
286            (princ (symbol-name remapped))            (princ (symbol-name remapped))
# Line 265  and the file name is displayed in the ec Line 297  and the file name is displayed in the ec
297      ;; If definition is a macro, find the function inside it.      ;; If definition is a macro, find the function inside it.
298      (if (eq (car-safe def) 'macro)      (if (eq (car-safe def) 'macro)
299          (setq def (cdr def)))          (setq def (cdr def)))
300      (let ((arglist (cond ((byte-code-function-p def)      (let* ((arglist (help-function-arglist def))
301                            (car (append def nil)))             (doc (documentation function))
302                           ((eq (car-safe def) 'lambda)             usage)
303                            (nth 1 def))        (princ (cond
304                           ((and (eq (car-safe def) 'autoload)                ((listp arglist) (help-make-usage function arglist))
305                                 (not (eq (nth 4 def) 'keymap)))                ((stringp arglist) arglist)
306                            (concat "[Arg list not available until "                ((and doc (subrp def) (setq usage (help-split-fundoc doc def)))
307                                    "function definition is loaded.]"))                 (setq doc (cdr usage)) (car usage))
308                           (t t))))                (t "[Missing arglist.  Please make a bug report.]")))
309        (cond ((listp arglist)        (terpri)
310               (princ (cons (if (symbolp function) function "anonymous")        (let ((obsolete (get function 'byte-obsolete-info)))
311                            (mapcar (lambda (arg)          (when obsolete
312                                      (if (memq arg '(&optional &rest))            (terpri)
313                                          arg            (princ "This function is obsolete")
314                                        (intern (upcase (symbol-name arg)))))            (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete))))
315                                    arglist)))            (princ ";") (terpri)
316               (terpri))            (princ (if (stringp (car obsolete)) (car obsolete)
317              ((stringp arglist)                     (format "use `%s' instead." (car obsolete))))
318               (princ arglist)            (terpri)))
              (terpri))))  
     (let ((obsolete (get function 'byte-obsolete-info)))  
       (when obsolete  
         (terpri)  
         (princ "This function is obsolete")  
         (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete))))  
         (princ ";") (terpri)  
         (princ (if (stringp (car obsolete)) (car obsolete)  
                  (format "use `%s' instead." (car obsolete))))  
         (terpri)))  
     (let ((doc (documentation function)))  
319        (if doc        (if doc
320            (progn (terpri)            (progn (terpri) (princ doc))
                  (princ doc)  
                  (if (subrp def)  
                      (with-current-buffer standard-output  
                        (beginning-of-line)  
                        ;; Builtins get the calling sequence at the end of  
                        ;; the doc string.  Move it to the same place as  
                        ;; 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)))))  
321          (princ "Not documented.")))))          (princ "Not documented.")))))
322    
323    

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

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