X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scm%2Fdocument-markup.scm;h=8761deb83db17b031f0d65f12f1d7e9ef7395053;hb=17098f34eace028d047ee7f9cd6f81a84e0e7537;hp=77c5d5228a2d1414d3eb75b327bfa18ce4b99fdc;hpb=12186b6828aee7aa298076d684835d629b757f2a;p=lilypond.git diff --git a/scm/document-markup.scm b/scm/document-markup.scm index 77c5d5228a..8761deb83d 100644 --- a/scm/document-markup.scm +++ b/scm/document-markup.scm @@ -2,59 +2,65 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2004 Han-Wen Nienhuys +;;;; (c) 1998--2007 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen (define (doc-markup-function func) - (let* - ( - (doc-str (procedure-documentation func) ) - (f-name (symbol->string (procedure-name func))) - (c-name (regexp-substitute/global #f "-markup$" f-name 'pre "" 'post)) - (sig (object-property func 'markup-signature)) - (arg-names - (map symbol->string - (cddr (cadr (procedure-source func))))) - - (sig-type-names (map type-name sig)) - (signature (zip arg-names sig-type-names)) - (signature-str - (string-join - (map (lambda (x) (string-append - "@var{" (car x) "} (" (cadr x) ")" )) - (zip arg-names sig-type-names)) - " " ))) + (let* ((doc-str (procedure-documentation func)) + (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) (string-append + "@var{" (car x) "} (" (cadr x) ")" )) + (zip arg-names sig-type-names)) + " " ))) - - - (string-append - "\n\n@item @code{\\" c-name "} " signature-str - - "\n@findex " f-name "\n" - "\n@cindex " c-name "\n" - - (if (string? doc-str) - doc-str - "") - ))) + (string-append + "\n\n@item @code{\\" c-name "} " signature-str + + "\n@findex " f-name "\n" + "\n@cindex @code{" c-name "}\n" + + (if (string? doc-str) + doc-str + "")))) (define (markup-functionstring (procedure-name a)) (symbol->string (procedure-name b)))) (define (markup-doc-string) (string-append - - "@table @asis" - (apply string-append - - (map doc-markup-function - (sort markup-function-list markup-function #:name "Markup functions" #:desc "Definitions of the markup functions." #:text (markup-doc-string))) + +(define (markup-list-doc-node) + (make + #:name "Markup list functions" + #:desc "Definitions of the markup list functions." + #:text (markup-list-doc-string)))