changeset 55351:07c85e772ee2

(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.

--- a/lisp/help-fns.el	Mon May 03 23:17:41 2004 +0000
+++ b/lisp/help-fns.el	Tue May 04 00:20:00 2004 +0000
@@ -237,6 +237,43 @@
 	    (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 @@
     (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.")))))))
 
 
 ;; Variables