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 (scm->texi val)
  62   (let* (; always start on a new line
  63          (open-texi (if (pretty-printable? val)
  64                       "\n@verbatim\n"
  65                       "\n@code{"))
  66          (close-texi (if (pretty-printable? val)
  67                        "@end verbatim"
  68                        "}")))
  69     (string-append open-texi (scm->string val) close-texi)))
  70
  71 (define (texi-section-command level)
  72   (assoc-get level '(
  73                      ;; Hmm, texinfo doesn't have ``part''
  74                      (0 . "@top")
  75                      (1 . "@chapter")
  76                      (2 . "@section")
  77                      (3 . "@subsection")
  78                      (4 . "@unnumberedsubsubsec")
  79                      (5 . "@unnumberedsubsubsec"))))
  80
  81 (define (texi-appendix-section-command level)
  82   (assoc-get level '((0 . "@top")
  83                      (1 . "@appendix")
  84                      (2 . "@appendixsec")
  85                      (3 . "@appendixsubsec")
  86                      (4 . "@appendixsubsubsec")
  87                      (5 . "@appendixsubsubsec"))))
  88
  89 (define (one-item->texi label-desc-pair)
  90   "Document one (LABEL . DESC); return empty string if LABEL is empty string."
  91   (if (eq? (car label-desc-pair) "")
  92       ""
  93       (string-append "\n\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair))))
  94
  95
  96 (define (description-list->texi items-alist quote?)
  97   "Document ITEMS-ALIST in a table; entries contain (item-label .
  98 string-to-use).  If QUOTE? is #t, embed table in a @quotation environment."
  99   (string-append
 100    "\n"
 101    (if quote? "@quotation\n" "")
 102    "@table @asis"
 103    (string-concatenate (map one-item->texi items-alist))
 104    "\n\n"
 105    "@end table\n"
 106    (if quote? "@end quotation\n" "")))
 107
 108 (define (texi-menu items-alist)
 109   "Generate what is between @menu and @end menu."
 110   (let ((maxwid
 111          (apply max (map (lambda (x) (string-length (car x))) items-alist))))
 112
 113     (string-append
 114      "\n@menu"
 115      (string-concatenate
 116       (map (lambda (x)
 117              (string-append
 118               (string-pad-right
 119                (string-append "\n* " (car x) ":: ")
 120                (+ maxwid 8))
 121               (cdr x)))
 122            items-alist))
 123      "\n@end menu\n"
 124      ;; Menus don't appear in html, so we make a list ourselves
 125      "\n@ignore\n"
 126      "\n@ifhtml\n"
 127      (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
 128                                   items-alist)
 129                              #t)
 130      "\n@end ifhtml\n"
 131      "\n@end ignore\n")))
 132
 133 (define (texi-file-head name file-name top)
 134   (string-append
 135    "\\input texinfo @c -*-texinfo-*-"
 136    "\n@setfilename " file-name ".info"
 137    "\n@settitle " name
 138    "\n@dircategory LilyPond"
 139    "\n@direntry"
 140    ;; prepend GNU for dir, must be unique
 141    "\n* GNU " name ": (" file-name ").          " name "."
 142    "\n@end direntry\n"
 143    "@documentlanguage en\n"
 144    "@documentencoding utf-8\n"))
 145
 146 (define (context-name name)
 147   name)
 148
 149 (define (engraver-name name)
 150   name)
 151
 152 (define (grob-name name)
 153   (if (symbol? name)
 154       (symbol->string name)
 155       name))
 156
 157 (define (interface-name name)
 158   name)
 159
 160 (define (ref-ify x)
 161   "Return @ref{X}.  If mapping ref-ify to a list that needs to be sorted,
 162    sort the list first."
 163   (string-append "@ref{" x "}"))
 164
 165 (define (human-listify lst)
 166   "Produce a textual enumeration from LST, a list of strings"
 167
 168   (cond
 169    ((null? lst) "none")
 170    ((null? (cdr lst)) (car lst))
 171    ((null? (cddr lst)) (string-append (car lst) " and " (cadr lst)))
 172    (else (string-append (car lst) ", " (human-listify (cdr lst))))))
 173
 174 (define (writing-wip x)
 175   (ly:message (_ "Writing ~S...") x))
 176
 177 (define (identifier<? a b)
 178   (ly:string-ci<?
 179    (symbol->string (car a))
 180    (symbol->string (car b))))
 181
 182 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 183 ;; property  stuff.
 184
 185 (define (verify-type-name where sym type)
 186   (if (eq? type #f)
 187       (ly:error (_ "cannot find description for property `~S' (~S)")
 188                 sym
 189                 where))
 190   (type-name type))
 191
 192 (define (property->texi where sym . rest)
 193   "Document SYM for WHERE (which can be translation, backend, music),
 194 with init values from ALIST (1st optional argument)
 195 "
 196   (let* ((name (symbol->string sym))
 197          (alist (if (pair? rest) (car rest) '()))
 198          (type?-name (string->symbol
 199                       (string-append (symbol->string where) "-type?")))
 200          (doc-name (string->symbol
 201                     (string-append (symbol->string where) "-doc")))
 202          (type (object-property sym type?-name))
 203          (typename (verify-type-name where sym type))
 204          (desc (object-property sym doc-name))
 205          (init-value (assoc-get sym alist)))
 206
 207     (if (eq? desc #f)
 208         (ly:error (_ "cannot find description for property ~S (~S)") sym where))
 209
 210     (cons
 211      (string-append "@code{" name "} (" typename ")"
 212                     (if init-value
 213                       (string-append ":" (scm->texi init-value) "\n")
 214                       ""))
 215      desc)))