scm/document-markup.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 1998--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
   4 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
   5 ;;;;
   6 ;;;; LilyPond is free software: you can redistribute it and/or modify
   7 ;;;; it under the terms of the GNU General Public License as published by
   8 ;;;; the Free Software Foundation, either version 3 of the License, or
   9 ;;;; (at your option) any later version.
  10 ;;;;
  11 ;;;; LilyPond is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;;; GNU General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU General Public License
  17 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18
  19
  20 (define (doc-markup-function-properties func)
  21   (let ((properties (hashq-ref markup-functions-properties func))
  22         (prop-strings (list)))
  23     (for-each (lambda (prop-spec)
  24                 (set! prop-strings
  25                       (if (list? prop-spec)
  26                           ;; either (prop value) or (prop)
  27                           (cons (if (null? (cdr prop-spec))
  28                                     (format #f "@item @code{~a}\n" (car prop-spec))
  29                                     (format #f "@item @code{~a} (~a)\n"
  30                                             (car prop-spec)
  31                                             (let ((default (cadr prop-spec)))
  32                                               (if (and (list? default)
  33                                                        (null? default))
  34                                                   "'()"
  35                                                   default))))
  36                                 prop-strings)
  37                           ;; a markup command: get its properties
  38                           ;; FIXME: avoid cyclical references
  39                           (append (doc-markup-function-properties prop-spec)
  40                                   prop-strings))))
  41               (or properties (list)))
  42     prop-strings))
  43
  44 (define (doc-markup-function func)
  45   (let* ((doc-str  (procedure-documentation func))
  46          (f-name (symbol->string (procedure-name  func)))
  47          (c-name (regexp-substitute/global #f "-markup(-list)?$" f-name  'pre "" 'post))
  48          (sig (object-property func 'markup-signature))
  49          (arg-names (let ((arg-list (cadr (procedure-source func))))
  50                       (if (list? arg-list)
  51                           (map symbol->string (cddr arg-list))
  52                           (make-list (length sig) "arg"))))
  53          (sig-type-names (map type-name sig))
  54          (signature-str
  55           (string-join
  56            (map (lambda (x) (string-append
  57                              "@var{" (car x) "} ("  (cadr x) ")" ))
  58                 (zip arg-names  sig-type-names))
  59            " " )))
  60
  61     (string-append
  62      "\n\n@item @code{\\" c-name "} " signature-str
  63      "\n@funindex \\" c-name "\n"
  64      "\n@cindex \\" c-name "\n"
  65      (if (string? doc-str)
  66          doc-str
  67          "")
  68      (let ((prop-strings (doc-markup-function-properties func)))
  69        (if (null? prop-strings)
  70            "\n"
  71            (string-append "\n\n\nUsed properties:\n@itemize\n"
  72                           (apply string-append prop-strings)
  73                           "@end itemize\n"))))))
  74
  75 (define (markup-function<? a b)
  76   (ly:string-ci<? (symbol->string (procedure-name a)) (symbol->string (procedure-name b))))
  77
  78 (define (markup-category-doc-node category)
  79   (let* ((category-string (symbol->string category))
  80          (category-name (string-capitalize (regexp-substitute/global #f
  81                                         "-" category-string 'pre " " 'post)))
  82         (markup-functions (hashq-ref markup-functions-by-category
  83                                           category)))
  84     (make <texi-node>
  85       #:appendix #t
  86       #:name category-name
  87       #:desc ""
  88       #:text (string-append
  89               "@table @asis"
  90               (apply string-append
  91                      (map doc-markup-function
  92                           (sort markup-functions markup-function<?)))
  93               "\n@end table"))))
  94
  95 (define (markup-list-doc-string)
  96   (string-append
  97    "@table @asis"
  98    (apply string-append
  99           (map doc-markup-function
 100                (sort markup-list-function-list markup-function<?)))
 101    "\n@end table"))
 102
 103 (define (markup-doc-node)
 104   (make <texi-node>
 105     #:appendix #t
 106     #:name "Text markup commands"
 107     #:desc ""
 108     #:text "The following commands can all be used inside @code{\\markup @{ @}}."
 109     #:children (let* (;; when a new category is defined, update `ordered-categories'
 110                       (ordered-categories '(font align graphic music instrument-specific-markup other))
 111                       (raw-categories (hash-fold (lambda (category functions categories)
 112                                                    (cons category categories))
 113                                                  (list)
 114                                                  markup-functions-by-category))
 115                       (categories (append ordered-categories
 116                                           (filter (lambda (cat)
 117                                                     (not (memq cat ordered-categories)))
 118                                                   raw-categories))))
 119                  (map markup-category-doc-node categories))))
 120
 121 (define (markup-list-doc-node)
 122   (make <texi-node>
 123     #:appendix #t
 124     #:name "Text markup list commands"
 125     #:desc ""
 126     #:text (string-append
 127             "The following commands can all be used with @code{\\markuplines}.\n"
 128             (markup-list-doc-string))))