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--2001 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 the following grobs: \n "
  46            (human-listify (map ref-ify (uniq-list (sort  objs string<? ))))
  47            ".")
  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 ref-ify (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        (grobs  (context-grobs context-desc))
 107        (grob-refs (map (lambda (x) (ref-ify x)) grobs))
 108        )
 109
 110     (string-append
 111      desc
 112      "\n\nThis context creates the following grobs: \n\n"
 113      (human-listify (uniq-list (sort grob-refs string<? )))
 114      "."
 115
 116      (if (null? accepts)
 117          "This context is a `bottom' context; it can not contain other contexts."
 118          (string-append
 119           "\n\nContext "
 120           name " can contain \n"
 121           (human-listify (map ref-ify (map context-name accepts)))))
 122
 123      "\n\nThis context is built from the following engravers: "
 124      (if no-copies
 125          (human-listify (map ref-ify (map engraver-name consists)))
 126          (apply string-append
 127                 (map document-engraver-by-name consists))))))
 128
 129 (define (engraver-grobs  name)
 130   (let* (
 131          (eg (assoc (string->symbol name) engraver-description-alist))
 132       )
 133
 134     (if (eq? eg #f)
 135         '()
 136         (map symbol->string (caddr (cdr eg)))
 137         )
 138   ))
 139
 140 (define (context-grobs context-desc)
 141   (let* (
 142          (consists (append
 143                     (list (cdr (assoc 'group-type context-desc)))
 144                     (cdr (assoc 'consists context-desc))
 145                     (cdr (assoc 'end-consists  context-desc))
 146                     ))
 147          (grobs  (apply append
 148                   (map engraver-grobs consists))
 149          )
 150          )
 151     grobs
 152     ))
 153
 154
 155 ;; First level Context description
 156 (define (document-context top context-desc)
 157   (let ((name (cdr (assoc 'type-name context-desc)))
 158         (doc (context-doc-string context-desc)))
 159     (processing name)
 160     (string-append
 161      (node (context-name name))
 162      (texi-section 2 (context-name name) #f)
 163       doc)))
 164
 165 (define (symbol<? l r)
 166   (string<? (symbol->string l) (symbol->string r)))
 167
 168 (define (document-paper name)
 169   (let* ((paper-alist
 170           (sort (My_lily_parser::paper_description)
 171                 (lambda (x y) (symbol<? (car x) (car y)))))
 172          (names (sort (map symbol->string (map car paper-alist)) string<?))
 173          (contexts (map cdr paper-alist))
 174          (doc (apply string-append
 175                      (map (lambda (x) (document-context name x)) contexts))))
 176
 177     (string-append
 178      (texi-node-menu name (map (lambda (x) (cons (context-name x) ""))
 179                                names))
 180      doc)))
 181
 182 (define (document-all-engravers name)
 183   (let* ((descs (map cdr engraver-description-alist))
 184          (names (map symbol->string (map car engraver-description-alist)))
 185          (doc (apply string-append
 186                      (map (lambda (x) (document-separate-engraver name x))
 187                           descs))))
 188     (string-append
 189      (texi-node-menu name (map (lambda (x) (cons (engraver-name x) ""))
 190                                names))
 191      doc)))
 192
 193 (define (document-all-engraver-properties name)
 194   (let* ((ps (sort (map symbol->string all-translation-properties) string<?))
 195          (sortedsyms (map string->symbol ps))
 196          (propdescs (map document-translator-property sortedsyms))
 197          (texi (description-list->texi propdescs)))
 198
 199   (string-append
 200           (node name)
 201           (texi-section 1 name #f)
 202           texi)))