+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
+
+
+(define (doc-markup-function-properties func)
+ (let ((properties (markup-function-properties func))
+ (prop-strings (list)))
+ (for-each (lambda (prop-spec)
+ (set! prop-strings
+ (if (list? prop-spec)
+ ;; either (prop value) or (prop)
+ (cons (if (null? (cdr prop-spec))
+ (format #f "@item @code{~a}\n" (car prop-spec))
+ (format #f "@item @code{~a} (~a)\n"
+ (car prop-spec)
+ (let ((default (cadr prop-spec)))
+ (if (and (list? default)
+ (null? default))
+ "'()"
+ default))))
+ prop-strings)
+ ;; a markup command: get its properties
+ ;; FIXME: avoid cyclical references
+ (append (doc-markup-function-properties prop-spec)
+ prop-strings))))
+ (or properties (list)))
+ prop-strings))
+
+(define (doc-markup-function func-pair)
+ (let* ((f-name (symbol->string (car func-pair)))
+ (func (cdr func-pair))
+ (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))
+ (c-name (regexp-substitute/global #f "-markup(-list)?$" f-name 'pre "" 'post))
+ (sig (markup-command-signature func))
+ (sig-type-names (map type-name sig))
+ (signature-str
+ (string-join
+ (map (lambda (x y)
+ (format #f "@var{~a} (~a)" x y))
+ arg-names sig-type-names)
+ " " )))