scm/documentation-lib.scm

   1 ;;;;
   2 ;;;; documentation-lib.scm -- Assorted Functions for generated documentation
   3 ;;;;
   4 ;;;; source file of the GNU LilyPond music typesetter
   5 ;;;;
   6 ;;;; (c) 2000--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
   7 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
   8
   9 (use-modules (oop goops)
  10              (srfi srfi-13)
  11              (srfi srfi-1))
  12
  13 (define-class <texi-node> ()
  14   (appendix #:init-value #f #:accessor appendix? #:init-keyword #:appendix)
  15   (children #:init-value '() #:accessor node-children #:init-keyword #:children)
  16   (text #:init-value "" #:accessor node-text #:init-keyword #:text)
  17   (name #:init-value "" #:accessor node-name #:init-keyword #:name)
  18   (description #:init-value "" #:accessor node-desc #:init-keyword #:desc))
  19
  20 (define (menu-entry x)
  21   (cons
  22    (node-name x)
  23    (node-desc x)))
  24
  25 (define* (dump-node node port level)
  26   (display
  27    (string-append
  28     "\n@node "
  29     (if (= level 0) "Top" (node-name node))
  30     "\n"
  31     (if (appendix? node)
  32         (texi-appendix-section-command level)
  33         (texi-section-command level))
  34     " "
  35     (node-name node)
  36     "\n\n"
  37     (node-text node)
  38     "\n\n"
  39     (if (pair? (node-children node))
  40         (texi-menu
  41          (map (lambda (x) (menu-entry x))
  42               (node-children node)))
  43         ""))
  44    port)
  45   (map (lambda (x) (dump-node x port (+ 1 level)))
  46        (node-children node)))
  47
  48 (define (processing name)
  49   (ly:message (_ "Processing ~S...") name))
  50
  51 (define (self-evaluating? x)
  52   (or (number? x) (string? x) (procedure? x) (boolean? x)))
  53
  54 (define (texify x)
  55   x)
  56
  57 (define (scm->texi x)
  58   (string-append "@code{" (texify (scm->string x)) "}"))
  59
  60
  61
  62 (define (texi-section-command level)
  63   (assoc-get level '(
  64                      ;; Hmm, texinfo doesn't have ``part''
  65                      (0 . "@top")
  66                      (1 . "@chapter")
  67                      (2 . "@section")
  68                      (3 . "@subsection")
  69                      (4 . "@unnumberedsubsubsec")
  70                      (5 . "@unnumberedsubsubsec"))))
  71
  72 (define (texi-appendix-section-command level)
  73   (assoc-get level '((0 . "@top")
  74                      (1 . "@appendix")
  75                      (2 . "@appendixsec")
  76                      (3 . "@appendixsubsec")
  77                      (4 . "@appendixsubsubsec")
  78                      (5 . "@appendixsubsubsec"))))
  79
  80 (define (one-item->texi label-desc-pair)
  81   "Document one (LABEL . DESC); return empty string if LABEL is empty string."
  82   (if (eq? (car label-desc-pair) "")
  83       ""
  84       (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair))))
  85
  86
  87 (define (description-list->texi items-alist quote?)
  88   "Document ITEMS-ALIST in a table; entries contain (item-label .
  89 string-to-use).  If QUOTE? is #t, embed table in a @quotation environment."
  90   (string-append
  91    "\n"
  92    (if quote? "@quotation\n" "")
  93    "@table @asis\n"
  94    (apply string-append (map one-item->texi items-alist))
  95    "\n"
  96    "@end table\n"
  97    (if quote? "@end quotation\n" "")))
  98
  99 (define (texi-menu items-alist)
 100   "Generate what is between @menu and @end menu."
 101   (let ((maxwid
 102          (apply max (map (lambda (x) (string-length (car x))) items-alist))))
 103
 104     (string-append
 105      "\n@menu"
 106      (apply string-append
 107             (map (lambda (x)
 108                    (string-append
 109                     (string-pad-right
 110                      (string-append "\n* " (car x) ":: ")
 111                      (+ maxwid 8))
 112                     (cdr x)))
 113                  items-alist))
 114      "\n@end menu\n"
 115      ;; Menus don't appear in html, so we make a list ourselves
 116      "\n@ignore\n"
 117      "\n@ifhtml\n"
 118      (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
 119                                   items-alist)
 120                              #t)
 121      "\n@end ifhtml\n"
 122      "\n@end ignore\n")))
 123
 124 (define (texi-file-head name file-name top)
 125   (string-append
 126    "\\input texinfo @c -*-texinfo-*-"
 127    "\n@setfilename " file-name ".info"
 128    "\n@settitle " name
 129    "\n@dircategory LilyPond"
 130    "\n@direntry"
 131    ;; prepend GNU for dir, must be unique
 132    "\n* GNU " name ": (" file-name ").          " name "."
 133    "\n@end direntry\n"
 134    "@documentlanguage en\n"
 135    "@documentencoding utf-8\n"))
 136
 137 (define (context-name name)
 138   name)
 139
 140 (define (engraver-name name)
 141   name)
 142
 143 (define (grob-name name)
 144   (if (symbol? name)
 145       (symbol->string name)
 146       name))
 147
 148 (define (interface-name name)
 149   name)
 150
 151 (define (ref-ify x)
 152   "Return @ref{X}. If mapping ref-ify to a list that needs to be sorted,
 153    sort the list first."
 154   (string-append "@ref{" x "}"))
 155
 156 (define (human-listify lst)
 157   "Produce a textual enumeration from LST, a list of strings"
 158
 159   (cond
 160    ((null? lst) "none")
 161    ((null? (cdr lst)) (car lst))
 162    ((null? (cddr lst)) (string-append (car lst) " and " (cadr lst)))
 163    (else (string-append (car lst) ", " (human-listify (cdr lst))))))
 164
 165 (define (writing-wip x)
 166   (ly:message (_ "Writing ~S...") x))
 167
 168
 169 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 170 ;; property  stuff.
 171
 172 (define (property->texi where sym . rest)
 173   "Document SYM for WHERE (which can be translation, backend, music),
 174 with init values from ALIST (1st optional argument)
 175 "
 176   (let* ((name (symbol->string sym))
 177          (alist (if (pair? rest) (car rest) '()))
 178          (type?-name (string->symbol
 179                       (string-append (symbol->string where) "-type?")))
 180          (doc-name (string->symbol
 181                     (string-append (symbol->string where) "-doc")))
 182          (type (object-property sym type?-name))
 183          (typename (type-name type))
 184          (desc (object-property sym doc-name))
 185          (init-value (assoc-get sym alist)))
 186
 187     (if (eq? desc #f)
 188         (ly:error (_ "cannot find description for property ~S (~S)") sym where))
 189
 190     (cons
 191      (string-append "@code{" name "} "
 192                     "(" typename ")"
 193                     (if init-value
 194                         (string-append
 195                          ":\n\n"
 196                          (scm->texi init-value)
 197                          "\n\n")
 198                         ""))
 199      desc)))
 200