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