scm/documentation-lib.scm

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