scm/document-markup.scm

   1 ;;;; document-markup.scm -- part of generated backend documentation
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 1998--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
   6 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8
   9 (define (doc-markup-function-properties func)
  10   (let ((properties (hashq-ref markup-functions-properties func))
  11         (prop-strings (list)))
  12     (for-each (lambda (prop-spec)
  13                 (set! prop-strings
  14                       (if (list? prop-spec)
  15                           ;; either (prop value) or (prop)
  16                           (cons (if (null? (cdr prop-spec))
  17                                     (format #f "@item @code{~a}\n" (car prop-spec))
  18                                     (format #f "@item @code{~a} (~a)\n"
  19                                             (car prop-spec)
  20                                             (let ((default (cadr prop-spec)))
  21                                               (if (and (list? default)
  22                                                        (null? default))
  23                                                   "'()"
  24                                                   default))))
  25                                 prop-strings)
  26                           ;; a markup command: get its properties
  27                           ;; FIXME: avoid cyclical references
  28                           (append (doc-markup-function-properties prop-spec)
  29                                   prop-strings))))
  30               (or properties (list)))
  31     prop-strings))
  32
  33 (define (doc-markup-function func)
  34   (let* ((doc-str  (procedure-documentation func))
  35          (f-name (symbol->string (procedure-name  func)))
  36          (c-name (regexp-substitute/global #f "-markup(-list)?$" f-name  'pre "" 'post))
  37          (sig (object-property func 'markup-signature))
  38          (arg-names (let ((arg-list (cadr (procedure-source func))))
  39                       (if (list? arg-list)
  40                           (map symbol->string (cddr arg-list))
  41                           (make-list (length sig) "arg"))))
  42          (sig-type-names (map type-name sig))
  43          (signature-str
  44           (string-join
  45            (map (lambda (x) (string-append
  46                              "@var{" (car x) "} ("  (cadr x) ")" ))
  47                 (zip arg-names  sig-type-names))
  48            " " )))
  49
  50     (string-append
  51      "\n\n@item @code{\\" c-name "} " signature-str
  52      "\n@funindex \\" c-name "\n"
  53      "\n@cindex \\" c-name "\n"
  54      (if (string? doc-str)
  55          doc-str
  56          "")
  57      (let ((prop-strings (doc-markup-function-properties func)))
  58        (if (null? prop-strings)
  59            "\n"
  60            (string-append "\n\n\nUsed properties:\n@itemize\n"
  61                           (apply string-append prop-strings)
  62                           "@end itemize\n"))))))
  63
  64 (define (markup-function<? a b)
  65   (string<? (symbol->string (procedure-name a)) (symbol->string (procedure-name b))))
  66
  67 (define (markup-category-doc-node category)
  68   (let* ((category-string (symbol->string category))
  69          (category-name (string-capitalize (regexp-substitute/global #f
  70                                         "-" category-string 'pre " " 'post)))
  71         (markup-functions (hashq-ref markup-functions-by-category
  72                                           category)))
  73     (make <texi-node>
  74       #:appendix #t
  75       #:name category-name
  76       #:desc ""
  77       #:text (string-append
  78               "@table @asis"
  79               (apply string-append
  80                      (map doc-markup-function
  81                           (sort markup-functions markup-function<?)))
  82               "\n@end table"))))
  83
  84 (define (markup-list-doc-string)
  85   (string-append
  86    "@table @asis"
  87    (apply string-append
  88           (map doc-markup-function
  89                (sort markup-list-function-list markup-function<?)))
  90    "\n@end table"))
  91
  92 (define (markup-doc-node)
  93   (make <texi-node>
  94     #:appendix #t
  95     #:name "Text markup commands"
  96     #:desc ""
  97     #:text "The following commands can all be used inside @code{\\markup @{ @}}."
  98     #:children (let* (;; when a new category is defined, update `ordered-categories'
  99                       (ordered-categories '(font align graphic music instrument-specific-markup other))
 100                       (raw-categories (hash-fold (lambda (category functions categories)
 101                                                    (cons category categories))
 102                                                  (list)
 103                                                  markup-functions-by-category))
 104                       (categories (append ordered-categories
 105                                           (filter (lambda (cat)
 106                                                     (not (memq cat ordered-categories)))
 107                                                   raw-categories))))
 108                  (map markup-category-doc-node categories))))
 109
 110 (define (markup-list-doc-node)
 111   (make <texi-node>
 112     #:appendix #t
 113     #:name "Text markup list commands"
 114     #:desc ""
 115     #:text (string-append
 116             "The following commands can all be used with @code{\\markuplines}.\n"
 117             (markup-list-doc-string))))