Re: Improved help from minibuffer prompts

[Juanma Barranquero <lektu@mi.madritel.es>]

On 01 May 2004 16:23:07 -0400, Stefan Monnier <monnier@iro.umontreal.ca> wrote:

> Yes.  I'd just call it ugly.

:)

> Yup and there's only one place where this happens, so despite the ugly
> control flow there's clearly just one place where you can insert a call to
> your function, knowing that the arglist has just been inserted at point.

Aha! Now I understand you. I don't know why I was looping over the idea
of getting hold of (usage . doc) at the point the docstring was splitted,
instead of at the point where usage is inserted...

Please try this (hopefully near-to-last) patch, and let's see what do
you think of it.

The change seems bigger than it is because I've opted to change all
`princ's and `terpri's of the last section of `describe-function-1' to
`insert's inside a big (with-current-buffer standard-output ...). It
seems cleaner than having

 (with-current-buffer standard-output
   (insert usage)
    ...))
 (princ ...)
 (terpri)
 (princ ...)
 (terpri)
 ...
 (terpri)
 (with-current-buffer standard-output
   (insert (or doc "No documentation available.")))

I'll be happy to do a refactoring of describe-function-1 some day,
splitting it into manageable chunks and doing all output through insert
(instead of the current mix insert/princ), but I don't think this is an
appropriate time, with the proposed freeze, etc.

Supposing help-highlight-arguments is accepted, I think the only things
left to do are deciding which face to use (I'm using a new
help-argument-name face which inherits from font-lock-variable-face, but
I have no real preference), and whether the argument highlighting should
be always on, or user-configurable. Again, no preference.

                                                           /L/e/k/t/u



Index: help-fns.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/help-fns.el,v
retrieving revision 1.41
diff -u -2 -r1.41 help-fns.el
--- help-fns.el	1 May 2004 13:52:53 -0000	1.41
+++ help-fns.el	2 May 2004 01:39:22 -0000
@@ -238,5 +238,42 @@
 	  file)))))
 
-;;;###autoload
+(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)
@@ -354,38 +391,42 @@
 	   (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