scm/documentation-lib.scm

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