(help-argument-name): New face, inheriting from

font-lock-variable-name-face, to highlight function arguments in
`describe-function' and `describe-key'.
(help-do-arg-highlight): Auxiliary function to highlight a given list of
arguments in a string.
(help-highlight-arguments): Highlight the function arguments and all uses
of them in the docstring.
(describe-function-1): Use it. Do docstring output via `insert', not
'princ', so text attributes are preserved.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c05df552aa52ac0339bcaf54234069bbe46f3af5..5dc4c7cfaaff641c3c40601de92638f1124422ed 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,15 @@
 2004-05-04  Juanma Barranquero  <lektu@terra.es>
 
+       * help-fns.el (help-argument-name): New face, inheriting from
+       font-lock-variable-name-face, to highlight function arguments in
+       `describe-function' and `describe-key'.
+       (help-do-arg-highlight): Auxiliary function to highlight a given
+       list of arguments in a string.
+       (help-highlight-arguments): Highlight the function arguments and
+       all uses of them in the docstring.
+       (describe-function-1): Use it. Do docstring output via `insert',
+       not 'princ', so text attributes are preserved.
+
        * winner.el (winner-mode-map): Move winner-undo and winner-redo to
        C-c <left> and C-c <right>, respectively (the previous bindings
        conflict with prev-buffer, next-buffer).

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 467ab0eba17557de623f0b19452bbbf7794503de..d4c0997bdf72eb3bf2e808828075f283e91b5d91 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -237,6 +237,43 @@ KIND should be `var' for a variable or `subr' for a subroutine."
            (concat "src/" file)
          file)))))
 
+(defface help-argument-name '((t (:inherit font-lock-variable-name-face)))
+  "Face to highlight function arguments in docstrings.")
+
+(defun help-do-arg-highlight (doc args)
+  (while args
+    (let ((arg (prog1 (car args) (setq args (cdr args)))))
+      (setq doc (replace-regexp-in-string
+                 (concat "\\<\\(" arg "\\)\\(?:es\\|s\\)?\\>")
+                 (propertize arg 'face 'help-argument-name)
+                 doc t t 1))))
+  doc)
+
+(defun help-highlight-arguments (usage doc &rest args)
+  (when usage
+    (let ((case-fold-search nil)
+          (next (not args)))
+      ;; Make a list of all arguments
+      (with-temp-buffer
+        (insert usage)
+        (goto-char (point-min))
+        ;; Make a list of all arguments
+        (while next
+          (if (not (re-search-forward " \\([\\[(]?\\)\\([^] &)\.]+\\)" nil t))
+              (setq next nil)
+            (setq args (cons (match-string 2) args))
+            (when (string= (match-string 1) "(")
+              ;; A pesky CL-style optional argument with default value,
+              ;; so let's skip over it
+              (search-backward "(")
+              (goto-char (scan-sexps (point) 1)))))
+        ;; Highlight aguments in the USAGE string
+        (setq usage (help-do-arg-highlight (buffer-string) args)))
+      ;; Highlight arguments in the DOC string
+      (setq doc (and doc (help-do-arg-highlight doc args)))
+      ;; Return value is like the one from help-split-fundoc, but highlighted
+      (cons usage doc))))
+
 ;;;###autoload
 (defun describe-function-1 (function)
   (let* ((def (if (symbolp function)
@@ -353,40 +390,44 @@ KIND should be `var' for a variable or `subr' for a subroutine."
     (let* ((arglist (help-function-arglist def))
           (doc (documentation function))
           (usage (help-split-fundoc doc function)))
-      ;; If definition is a keymap, skip arglist note.
-      (unless (keymapp def)
-       (princ (cond
-               (usage (setq doc (cdr usage)) (car usage))
-               ((listp arglist) (help-make-usage function arglist))
-               ((stringp arglist) arglist)
-               ;; Maybe the arglist is in the docstring of the alias.
-               ((let ((fun function))
-                  (while (and (symbolp fun)
-                              (setq fun (symbol-function fun))
-                              (not (setq usage (help-split-fundoc
-                                                (documentation fun)
-                                                function)))))
-                  usage)
-                (car usage))
-               ((or (stringp def)
-                    (vectorp def))
-                (format "\nMacro: %s" (format-kbd-macro def)))
-               (t "[Missing arglist.  Please make a bug report.]")))
-       (terpri))
-      (let ((obsolete (and
-                      ;; function might be a lambda construct.
-                      (symbolp function)
-                      (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)))
-      (terpri)
-      (princ (or doc "Not documented.")))))
+      (with-current-buffer standard-output
+        ;; If definition is a keymap, skip arglist note.
+        (unless (keymapp def)
+          (let* ((use (cond
+                        (usage (setq doc (cdr usage)) (car usage))
+                        ((listp arglist)
+                         (format "%S" (help-make-usage function arglist)))
+                        ((stringp arglist) arglist)
+                        ;; Maybe the arglist is in the docstring of the alias.
+                        ((let ((fun function))
+                           (while (and (symbolp fun)
+                                       (setq fun (symbol-function fun))
+                                       (not (setq usage (help-split-fundoc
+                                                         (documentation fun)
+                                                         function)))))
+                           usage)
+                         (car usage))
+                        ((or (stringp def)
+                             (vectorp def))
+                         (format "\nMacro: %s" (format-kbd-macro def)))
+                        (t "[Missing arglist.  Please make a bug report.]")))
+                 (high (help-highlight-arguments use doc)))
+            (insert (car high) "\n")
+            (setq doc (cdr high))))
+        (let ((obsolete (and
+                         ;; function might be a lambda construct.
+                         (symbolp function)
+                         (get function 'byte-obsolete-info))))
+          (when obsolete
+            (princ "\nThis function is obsolete")
+            (when (nth 2 obsolete)
+              (insert (format " since %s" (nth 2 obsolete))))
+            (insert ";\n"
+                    (if (stringp (car obsolete)) (car obsolete)
+                      (format "use `%s' instead." (car obsolete)))
+                    "\n"))
+          (insert "\n"
+                  (or doc "Not documented.")))))))
 
 \f
 ;; Variables