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--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 ;;; Jan Nieuwenhuizen <janneke@gnu.org>
   8
   9 (define (processing name)
  10   (display (string-append "\nProcessing " name " ... ") (current-error-port)))
  11
  12 (define (self-evaluating? x)
  13   (or (number? x) (string? x) (procedure? x) (boolean? x)))
  14
  15 (define (texify x)
  16   x)
  17 ;;  (let*
  18 ;;     ((x1 (regexp-substitute/global #f "\([^@]\){" x 'pre "\1@{" 'post))
  19 ;;      ((x2 (regexp-substitute/global #f "\([^@]\){" x 'pre "\1@{" 'post))
  20 ;;      ((x3 (regexp-substitute/global #f "\([^@]\)@" x 'pre "\1@@" 'post))
  21 ;;       )
  22 ;;    x2))
  23
  24
  25
  26 (define (scm->texi x)
  27   (string-append "@code{" (texify (scm->string x)) "}")
  28   )
  29
  30 (define (scm->string val)
  31   (string-append
  32    (if (self-evaluating? val) "" "'")
  33    (call-with-output-string (lambda (port) (display val port)))
  34   ))
  35
  36 (define (node name)
  37   (string-append
  38    "\n@html"
  39    "\n<hr>"
  40    "\n@end html"
  41    "\n@node " name))
  42
  43 (define texi-section-alist
  44   '(
  45     ;; Hmm, texinfo doesn't have ``part''
  46     (0 . "@top")
  47     (1 . "@unnumbered")
  48     (2 . "@unnumberedsec")
  49     (3 . "@unnumberedsubsec")
  50     (4 . "@unnumberedsubsubsec")
  51     (5 . "@unnumberedsubsubsec")
  52     ))
  53
  54 (define (texi-section level name ref)
  55   "texi sectioning command (lower LEVEL means more significant).
  56 Add a ref if REF is set
  57 "
  58
  59   (string-append
  60    "\n" (cdr (assoc level texi-section-alist)) " "
  61    (if ref
  62        (ref-ify name)
  63        name)
  64    "\n"))
  65
  66
  67 (define (one-item->texi label-desc-pair)
  68   "Document one (LABEL . DESC); return empty string if LABEL is empty string.
  69 "
  70   (if (eq? (car label-desc-pair) "")
  71       ""
  72       (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair))
  73   ))
  74
  75
  76 (define (description-list->texi items-alist)
  77   "Document ITEMS-ALIST in a table. entries contain (item-label . string-to-use)
  78 "
  79   (string-append
  80    "\n@table @samp\n"
  81    (apply string-append (map one-item->texi items-alist))
  82    "\n@end table\n"))
  83
  84 (define (texi-menu items-alist)
  85   (string-append
  86   "\n@menu"
  87   (apply string-append
  88          (map (lambda (x) (string-append "\n* " (car x) ":: " (cdr x)))
  89               items-alist))
  90   "\n@end menu\n"
  91   ;; Menus don't appear in html, so we make a list ourselves
  92   "\n@ignore\n"
  93   "\n@ifhtml\n"
  94   (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
  95                          items-alist))
  96   "\n@end ifhtml\n"
  97   "\n@end ignore\n"))
  98
  99
 100 (define (texi-node-menu name items-alist)
 101   (string-append
 102    (node name)
 103    (texi-section 1 name #f)
 104    (texi-menu items-alist)))
 105
 106 (define (texi-file-head name file-name top items-alist)
 107   (string-append
 108    "\\input texinfo @c -*-texinfo-*-"
 109    "\n@setfilename " file-name ".info"
 110    "\n@settitle " name
 111    "\n@dircategory GNU music project"
 112    "\n@direntry"
 113    ;; prepend GNU for dir, must be unique
 114    "\n* GNU " name ": (" file-name ").          " name "."
 115    "\n@end direntry"
 116    ;; ugh, prev and next should be settable, of course
 117    (node "Top") ",(lilypond)Index,(lilypond)Full Grob interface list," top
 118    "\n@top"
 119    (texi-section 1 name #f)
 120    (texi-menu items-alist)
 121    "\n@contents"
 122    ))
 123
 124 (define (itexi-file-head name file-name top items-alist)
 125   (string-append
 126    "@c -*-texinfo-*-"
 127    (node name) ",,," top
 128    (texi-section 1 name #f)
 129    (texi-menu items-alist)
 130    "\n@contents"
 131    ))
 132
 133 (define (context-name name)
 134   name)
 135
 136 (define (engraver-name name)
 137   name)
 138
 139 (define (grob-name name)
 140   name)
 141
 142 (define (interface-name name)
 143   name)
 144
 145 (define (ref-ify x)
 146   (string-append "@ref{" x "}"))
 147
 148 (define (human-listify l)
 149   "Produce a textual enumeration from L, a list of strings"
 150
 151   (cond
 152    ((null? l) "none")
 153    ((null? (cdr l)) (car l))
 154    ((null? (cddr l)) (string-append (car l) " and " (cadr l)))
 155    (else (string-append (car l) ", " (human-listify (cdr l))))
 156    ))
 157
 158 (define (writing-wip x)
 159   (display (string-append "\nWriting " x " ... ") (current-error-port)))