# HG changeset patch # User Juanma Barranquero # Date 1083630000 0 # Node ID 07c85e772ee2e7bff902317fee50c5733fca1be3 # Parent c8a5d5bfeeff6d70b59222e991750e420c6e4243 (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 -r c8a5d5bfeeff -r 07c85e772ee2 lisp/help-fns.el --- 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