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     (string-append
  75      (node (engraver-name name))
  76      (document-engraver 2 description))))
  77
  78 ;; Second level, part of Context description
  79 (define (document-engraver-by-name name)
  80   (let*
  81       (
  82        (eg (assoc (string->symbol name) engraver-description-alist))
  83        )
  84
  85     (if (eq? eg #f)
  86         (string-append "Engraver " name ", not documented.\n")
  87         (document-engraver 3 (cdr eg))
  88         )
  89     ))
  90
  91 (define (context-doc-string context-desc)
  92   (let*
  93       (
  94        (name (cdr (assoc 'type-name context-desc)))
  95        (desc-handle (assoc (string->symbol name) context-description-alist))
  96        (desc (if (pair? desc-handle)  (cdr desc-handle) ""))
  97
  98        (accepts (cdr (assoc 'accepts context-desc)))
  99        (consists (append
 100                   (list (cdr (assoc 'group-type context-desc)))
 101                   (cdr (assoc 'consists context-desc))
 102                   (cdr (assoc 'end-consists  context-desc))
 103                   ))
 104        )
 105
 106     (string-append
 107      desc
 108
 109      (if (null? accepts)
 110          "This context is a `bottom' context; it can not contain other contexts."
 111          (string-append
 112           name " can contain \n"
 113           (human-listify (map reffy (map context-name accepts)))))
 114
 115      "\n\nThis context is built from the following engravers: "
 116      (if no-copies
 117          (human-listify (map reffy (map engraver-name consists)))
 118          (apply string-append
 119                 (map document-engraver-by-name consists))))))
 120
 121
 122 ;; First level Context description
 123 (define (document-context top context-desc)
 124   (let ((name (cdr (assoc 'type-name context-desc)))
 125         (doc (context-doc-string context-desc)))
 126
 127     (string-append
 128      (node (context-name name))
 129      (section 2 (context-name name))
 130       doc)))
 131
 132 (define (document-paper name)
 133   (let* ((paper-alist (My_lily_parser::paper_description))
 134          (names (sort (map car paper-alist) string<?))
 135          (contexts (map cdr paper-alist))
 136          (doc (apply string-append
 137                      (map (lambda (x) (document-context name x)) contexts))))
 138
 139     (string-append
 140      (texi-node-menu name (map (lambda (x) (cons (context-name x) ""))
 141                                names))
 142      doc)))
 143
 144 (define (document-all-engravers name)
 145   (let* ((descs (map cdr engraver-description-alist))
 146          (names (map car engraver-description-alist))
 147          (doc (apply string-append
 148                      (map (lambda (x) (document-separate-engraver name x))
 149                           descs))))
 150
 151     (string-append
 152      (texi-node-menu name (map (lambda (x) (cons (engraver-name x) ""))
 153                                names))
 154      doc)))
 155