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