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