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