Issue 4121/2: Store markup command argument list names in docstring

For one thing, the doc string does not make a lot of sense without the
argument list and it cannot reliably be deduced from the doc string
itself.

For another, GUILEv2 does not do us the favor of storing the original
argument list anywhere where it could be retrieved with a useful amount
of labor.

While it would be nice to put the types of the arguments into the doc
string as well, the signature's actual predicates are only evaluated
after macro expansion and that is too late for generating the doc
string.

So we just stick the argument list (after uncurrying) as a line at the
top.

diff --git a/scm/document-markup.scm b/scm/document-markup.scm
index 318a26b9e60718108a78cdb4ab4f4ee6106602e8..97809f2a8c41649cd0f5eb01954451f3ae88d7d3 100644 (file)
--- a/scm/document-markup.scm
+++ b/scm/document-markup.scm
@@ -42,19 +42,20 @@
     prop-strings))
 
 (define (doc-markup-function func)
-  (let* ((doc-str  (procedure-documentation func))
+  (let* ((full-doc (procedure-documentation func))
+         (match-args (and full-doc (string-match "^\\([^)]*\\)\n" full-doc)))
+         (arg-names (if match-args
+                        (with-input-from-string (match:string match-args) read)
+                        (circular-list "arg")))
+         (doc-str (if match-args (match:suffix match-args) full-doc))
          (f-name (symbol->string (procedure-name  func)))
          (c-name (regexp-substitute/global #f "-markup(-list)?$" f-name  'pre "" 'post))
          (sig (object-property func 'markup-signature))
-         (arg-names (let ((arg-list (cadr (procedure-source func))))
-                      (if (list? arg-list)
-                          (map symbol->string (cddr arg-list))
-                          (make-list (length sig) "arg"))))
          (sig-type-names (map type-name sig))
          (signature-str
           (string-join
-           (map (lambda (x y) (string-append
-                             "@var{" x "} (" y ")" ))
+           (map (lambda (x y)
+                  (format #f "@var{~a} (~a)" x y))
                 arg-names  sig-type-names)
            " " )))
 

diff --git a/scm/markup-macros.scm b/scm/markup-macros.scm
index 67db7b5e8cead5ba9cc134ea7b4406866b9a6267..5e446d12e805d17c8195024aaf7d347468f1f56c 100644 (file)
--- a/scm/markup-macros.scm
+++ b/scm/markup-macros.scm
@@ -110,14 +110,14 @@ command.  There is no protection against circular definitions.
            (set! body (cddr body)))
     `(begin
        ;; define the COMMAND-markup function
-       ,(let* ((documentation (if (string? (car body))
-                                  (list (car body))
-                                  '()))
-               (real-body (if (or (null? documentation)
+       ,(let* ((documentation
+                (format #f "~a\n~a" (cddr args)
+                        (if (string? (car body)) (car body) "")))
+               (real-body (if (or (not (string? (car body)))
                                   (null? (cdr body)))
                               body (cdr body))))
           `(define-public (,command-name ,@args)
-             ,@documentation
+             ,documentation
              (let ,(map (lambda (prop-spec)
                           (let ((prop (car prop-spec))
                                 (default-value (if (null? (cdr prop-spec))
@@ -168,14 +168,14 @@ interpreted, returns a list of stencils instead of a single one"
            (set! body (cddr body)))
     `(begin
        ;; define the COMMAND-markup-list function
-       ,(let* ((documentation (if (string? (car body))
-                                  (list (car body))
-                                  '()))
-               (real-body (if (or (null? documentation)
+       ,(let* ((documentation
+                (format #f "~a\n~a" (cddr args)
+                        (if (string? (car body)) (car body) "")))
+               (real-body (if (or (not (string? (car body)))
                                   (null? (cdr body)))
                               body (cdr body))))
           `(define-public (,command-name ,@args)
-             ,@documentation
+             ,documentation
              (let ,(map (lambda (prop-spec)
                           (let ((prop (car prop-spec))
                                 (default-value (if (null? (cdr prop-spec))