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 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 (self-evaluating? x)
  17   (or (number? x) (string? x) (procedure? x) (boolean? x)))
  18
  19 (define (texify x)
  20   x)
  21 ;;  (let*
  22 ;;     ((x1 (regexp-substitute/global #f "\([^@]\){" x 'pre "\1@{" 'post))
  23 ;;      ((x2 (regexp-substitute/global #f "\([^@]\){" x 'pre "\1@{" 'post))
  24 ;;      ((x3 (regexp-substitute/global #f "\([^@]\)@" x 'pre "\1@@" 'post))
  25 ;;       )
  26 ;;    x2))
  27
  28 (define (scm->string val)
  29   (string-append
  30    (if (self-evaluating? val) "" "'")
  31    (texify
  32     (call-with-output-string (lambda (port) (display val port))))
  33   ))
  34
  35 (define (node name)
  36   (string-append
  37    "\n@html"
  38    "\n<hr>"
  39    "\n@end html"
  40    "\n@node " name ",,,"))
  41
  42 (define section-alist
  43   '(
  44     ;; Hmm, texinfo doesn't have ``part''
  45     (0 . "@top")
  46     (1 . "@unnumbered")
  47     (2 . "@unnumberedsec")
  48     (3 . "@unnumberedsubsec")
  49     (4 . "@unnumberedsubsubsec")
  50     (5 . "@unnumberedsubsubsec")
  51     ))
  52
  53 (define (section level name)
  54   (string-append "\n" (cdr (assoc level section-alist)) " " name "\n"))
  55
  56 (define (description-list items-alist)
  57   (string-append
  58    "\n@table @samp\n"
  59    (apply string-append
  60           (map (lambda (x) (string-append "\n@item " (car x) "\n" (cdr x)))
  61                items-alist))
  62    "\n@end table\n"))
  63
  64 (define (texi-menu items-alist)
  65   (string-append
  66   "\n@menu"
  67   (apply string-append
  68          (map (lambda (x) (string-append "\n* " (car x) ":: " (cdr x)))
  69               items-alist))
  70   "\n@end menu\n"
  71   ;; Menus don't appear in html, so we make a list ourselves
  72   "\n@ignore\n"
  73   "\n@ifhtml\n"
  74   (description-list (map (lambda (x) (cons (reffy (car x)) (cdr x)))
  75                          items-alist))
  76   "\n@end ifhtml\n"
  77   "\n@end ignore\n"))
  78
  79
  80 (define (texi-node-menu name items-alist)
  81   (string-append
  82    (node name)
  83    (section 1 name)
  84    (texi-menu items-alist)))
  85
  86 (define (texi-file-head name file-name top items-alist)
  87   (string-append
  88    "\\input texinfo @c -*-texinfo-*-"
  89    "\n@setfilename " file-name ".info"
  90    "\n@settitle " name
  91    (node "Top") top
  92    "\n@top"
  93    (section 1 name)
  94    (texi-menu items-alist)
  95    "\n@contents"
  96    ))
  97
  98 (define (context-name name)
  99   (string-append "Context " name))
 100
 101 (define (engraver-name name)
 102   name)
 103
 104 (define (element-name name)
 105   (string-append "Element " name))
 106
 107 (define (interface-name name)
 108   name)
 109
 110 (define (reffy x)
 111   (string-append "@ref{" x "}"))
 112
 113 (define (human-listify l)
 114   (cond
 115    ((null? l) "none")
 116    ((null? (cdr l)) (car l))
 117    ((null? (cddr l)) (string-append (car l) " and " (cadr l)))
 118    (else (string-append (car l) ", " (human-listify (cdr l))))
 119    ))
 120
 121 (define (writing-wip x)
 122   (display (string-append "\nWriting " x " ... ") (current-error-port)))