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