scm/engraver-documentation-lib.scm

   1
   2 ;;; engraver-documentation-lib.scm -- Functions for engraver 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
  10 (eval-string (ly-gulp-file "translator-description.scm"))
  11
  12 ;; alist of translater descriptions
  13 (define (document-translator-property prop-desc)
  14    (cons
  15     (string-append
  16      "@code{" (car prop-desc) "} "
  17      "(" (type-name (cadr prop-desc)) "):")
  18     (caddr prop-desc)))
  19
  20 ;; First level Engraver description and
  21 ;; second level Context description
  22 (define (document-engraver level engraver-descr)
  23
  24   (let* (
  25          (props (car (cdddr engraver-descr)))
  26          (name (car engraver-descr))
  27          (desc (cadr engraver-descr))
  28          (objs (caddr engraver-descr))
  29          )
  30
  31     (string-append
  32      (section level (engraver-name name))
  33      desc
  34      "\n\n"
  35      (if (null? props)
  36          ""
  37          (string-append
  38           (section (+ level 1) "Properties")
  39           (description-list
  40            (map (lambda (x) (document-translator-property x)) props))))
  41      (if  (null? objs)
  42           ""
  43           (string-append
  44            "This engraver creates \n "
  45            (human-listify (map reffy (map element-name objs)))
  46            " elements.")
  47           )
  48
  49      "\n\n"
  50
  51      (let* ((paper-alist (My_lily_parser::paper_description))
  52             (context-description-alist (map cdr paper-alist))
  53             (contexts
  54              (apply append
  55                     (map (lambda (x)
  56                            (let ((context (cdr (assoc 'type-name x)))
  57                                  (consists (append
  58                                             (list (cdr (assoc 'group-type x)))
  59                                             (cdr (assoc 'consists x))
  60                                             (cdr (assoc 'end-consists x)))))
  61
  62                              (if (member name consists)
  63                                  (list context)
  64                                  '())))
  65                          context-description-alist))))
  66        (string-append
  67         name " is part of contexts: "
  68         (human-listify (map reffy (map context-name contexts))))))))
  69
  70
  71 ;; First level Engraver description
  72 (define (document-separate-engraver top description)
  73   (let ((name (car description)))
  74     (processing name)
  75     (string-append
  76      (node (engraver-name name))
  77      (document-engraver 2 description))))
  78
  79 ;; Second level, part of Context description
  80 (define (document-engraver-by-name name)
  81   (let*
  82       (
  83        (eg (assoc (string->symbol name) engraver-description-alist))
  84        )
  85
  86     (if (eq? eg #f)
  87         (string-append "Engraver " name ", not documented.\n")
  88         (document-engraver 3 (cdr eg))
  89         )
  90     ))
  91
  92 (define (context-doc-string context-desc)
  93   (let*
  94       (
  95        (name (cdr (assoc 'type-name context-desc)))
  96        (desc-handle (assoc (string->symbol name) context-description-alist))
  97        (desc (if (pair? desc-handle)  (cdr desc-handle) ""))
  98
  99        (accepts (cdr (assoc 'accepts context-desc)))
 100        (consists (append
 101                   (list (cdr (assoc 'group-type context-desc)))
 102                   (cdr (assoc 'consists context-desc))
 103                   (cdr (assoc 'end-consists  context-desc))
 104                   ))
 105        )
 106
 107     (string-append
 108      desc
 109
 110      (if (null? accepts)
 111          "This context is a `bottom' context; it can not contain other contexts."
 112          (string-append
 113           name " can contain \n"
 114           (human-listify (map reffy (map context-name accepts)))))
 115
 116      "\n\nThis context is built from the following engravers: "
 117      (if no-copies
 118          (human-listify (map reffy (map engraver-name consists)))
 119          (apply string-append
 120                 (map document-engraver-by-name consists))))))
 121
 122
 123 ;; First level Context description
 124 (define (document-context top context-desc)
 125   (let ((name (cdr (assoc 'type-name context-desc)))
 126         (doc (context-doc-string context-desc)))
 127     (processing name)
 128     (string-append
 129      (node (context-name name))
 130      (section 2 (context-name name))
 131       doc)))
 132
 133 (define (document-paper name)
 134   (let* ((paper-alist (My_lily_parser::paper_description))
 135          (names (sort (map car paper-alist) string<?))
 136          (contexts (map cdr paper-alist))
 137          (doc (apply string-append
 138                      (map (lambda (x) (document-context name x)) contexts))))
 139
 140     (string-append
 141      (texi-node-menu name (map (lambda (x) (cons (context-name x) ""))
 142                                names))
 143      doc)))
 144
 145 (define (document-all-engravers name)
 146   (let* ((descs (map cdr engraver-description-alist))
 147          (names (map car engraver-description-alist))
 148          (doc (apply string-append
 149                      (map (lambda (x) (document-separate-engraver name x))
 150                           descs))))
 151
 152     (string-append
 153      (texi-node-menu name (map (lambda (x) (cons (engraver-name x) ""))
 154                                names))
 155      doc)))
 156