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