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