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 sym)
  14    (cons
  15     (string-append
  16      "@code{" (symbol->string sym) "} "
  17      "(" (type-name (object-property sym 'translation-type?)) "):")
  18     (object-property sym 'translation-doc)))
  19
  20 ;; First level Engraver description and
  21 ;; second level Context description
  22 (define (document-engraver where engraver-descr)
  23   (let* (
  24          (level (if (eq? where 'context) 3 2))
  25          (props (car (cdddr engraver-descr)))
  26          (name (car engraver-descr))
  27          (name-sym (string->symbol name))
  28          (desc (cadr engraver-descr))
  29          (objs (map symbol->string (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 grob-name objs)))
  47            " grobs.")
  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-sym 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 (symbol<? l r)
 135   (string<? (symbol->string l) (symbol->string r)))
 136
 137 (define (document-paper name)
 138   (let* ((paper-alist
 139           (sort (My_lily_parser::paper_description)
 140                 (lambda (x y) (symbol<? (car x) (car y)))))
 141          (names (sort (map symbol->string (map car paper-alist)) string<?))
 142          (contexts (map cdr paper-alist))
 143          (doc (apply string-append
 144                      (map (lambda (x) (document-context name x)) contexts))))
 145
 146     (string-append
 147      (texi-node-menu name (map (lambda (x) (cons (context-name x) ""))
 148                                names))
 149      doc)))
 150
 151 (define (document-all-engravers name)
 152   (let* ((descs (map cdr engraver-description-alist))
 153          (names (map symbol->string (map car engraver-description-alist)))
 154          (doc (apply string-append
 155                      (map (lambda (x) (document-separate-engraver name x))
 156                           descs))))
 157     (string-append
 158      (texi-node-menu name (map (lambda (x) (cons (engraver-name x) ""))
 159                                names))
 160      doc)))
 161
 162 (define (document-all-engraver-properties name)
 163   (let* ((ps (sort (map symbol->string all-translation-properties) string<?))
 164          (sortedsyms (map string->symbol ps))
 165          (propdescs (map document-translator-property sortedsyms))
 166          (texi (description-list->texi propdescs)))
 167
 168   (string-append
 169           (node name)
 170           (texi-section 1 name #f)
 171           texi)))