scm/engraver-documentation-lib.scm

   1
   2 ;;; engraver-doumentation-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
  11 ;; alist of translater descriptions
  12 (define (document-translator-property sym)
  13    (cons
  14     (string-append
  15      "@code{" (symbol->string sym) "} "
  16      "(" (type-name (object-property sym 'translation-type?)) "):")
  17     (object-property sym 'translation-doc)))
  18
  19 ;; First level Engraver description and
  20 ;; second level Context description
  21 (define (document-engraver where engraver)
  22
  23   (let* (
  24          (level (if (eq? where 'context) 3 2))
  25          (propsr (cdr (assoc 'properties-read (Translator::description engraver))))
  26          (propsw (cdr (assoc 'properties-written (Translator::description engraver))))
  27          (name (Translator::name engraver))
  28          (name-sym (string->symbol name))
  29          (desc (cdr (assoc 'description (Translator::description engraver))))
  30          (grobs (engraver-grobs engraver))
  31          )
  32
  33     (string-append
  34      (texi-section level (engraver-name name) (eq? where 'context))
  35      desc
  36      "\n\n"
  37      (if (null? propsr)
  38          ""
  39          (string-append
  40           (texi-section (+ level 1) "Properties (read)" #f)
  41           (description-list->texi
  42            (map (lambda (x) (document-translator-property x)) propsr))))
  43      (if (null? propsw)
  44          ""
  45          (string-append
  46           (texi-section (+ level 1) "Properties (write)" #f)
  47           (description-list->texi
  48            (map (lambda (x) (document-translator-property x)) propsw))))
  49      (if  (null? grobs)
  50           ""
  51           (string-append
  52            "This engraver creates the following grobs: \n "
  53            (human-listify (map ref-ify (uniq-list (sort  grobs string<? ))))
  54            ".")
  55           )
  56
  57      "\n\n"
  58
  59      (let* ((paper-alist (My_lily_parser::paper_description))
  60             (context-description-alist (map cdr paper-alist))
  61             (contexts
  62              (apply append
  63                     (map (lambda (x)
  64                            (let ((context (cdr (assoc 'type-name x)))
  65                                  (consists (append
  66                                             (list (cdr (assoc 'group-type x)))
  67                                             (cdr (assoc 'consists x))
  68                                             (cdr (assoc 'end-consists x)))))
  69
  70                              (if (member name consists)
  71                                  (list context)
  72                                  '())))
  73                          context-description-alist))))
  74        (string-append
  75         name " is part of contexts: "
  76         (human-listify (map ref-ify (map context-name contexts))))))))
  77
  78
  79 ;; First level Engraver description
  80 (define (document-separate-engraver top grav)
  81   (let ((name (Translator::name grav)))
  82     (processing name)
  83     (string-append
  84      (node (engraver-name name))
  85      (document-engraver 'self grav))))
  86
  87 ;; Second level, part of Context description
  88 (define (find-engraver-by-name name list)
  89   (if (null? list)
  90       #f
  91       (if (equal? name (Translator::name (car list)))
  92           (car list)
  93           (find-engraver-by-name name (cdr list)))))
  94
  95 (define (document-engraver-by-name name)
  96   (let*
  97       (
  98        (eg (find-engraver-by-name name all-engravers-list))
  99        )
 100
 101     (if (eq? eg #f)
 102         (string-append "Engraver " name ", not documented.\n")
 103         (document-engraver 'context eg)
 104         )
 105     ))
 106
 107 (define (context-doc-string context-desc)
 108   (let*
 109       (
 110        (name (cdr (assoc 'type-name context-desc)))
 111        (desc-handle (assoc (string->symbol name) context-description-alist))
 112        (desc (if (pair? desc-handle)  (cdr desc-handle) ""))
 113
 114        (accepts (cdr (assoc 'accepts context-desc)))
 115        (consists (append
 116                   (list (cdr (assoc 'group-type context-desc)))
 117                   (cdr (assoc 'consists context-desc))
 118                   (cdr (assoc 'end-consists  context-desc))
 119                   ))
 120        (grobs  (context-grobs context-desc))
 121        (grob-refs (map (lambda (x) (ref-ify x)) grobs))
 122        )
 123
 124     (string-append
 125      desc
 126      "\n\nThis context creates the following grobs: \n\n"
 127      (human-listify (uniq-list (sort grob-refs string<? )))
 128      "."
 129
 130      (if (null? accepts)
 131          "This context is a `bottom' context; it can not contain other contexts."
 132          (string-append
 133           "\n\nContext "
 134           name " can contain \n"
 135           (human-listify (map ref-ify (map context-name accepts)))))
 136
 137      "\n\nThis context is built from the following engravers: "
 138      (if no-copies
 139          (human-listify (map ref-ify (map engraver-name consists)))
 140          (apply string-append
 141                 (map document-engraver-by-name consists))))))
 142
 143 (define (engraver-grobs  grav)
 144   (let* (
 145          (eg (if (string? grav)
 146                  (find-engraver-by-name grav all-engravers-list)
 147                  grav))
 148
 149              )
 150
 151     (if (eq? eg #f)
 152         '()
 153         (map symbol->string (cdr (assoc 'grobs-created (Translator::description eg))))
 154         )
 155   ))
 156
 157 (define (context-grobs context-desc)
 158   (let* (
 159          (consists (append
 160                     (list (cdr (assoc 'group-type context-desc)))
 161                     (cdr (assoc 'consists context-desc))
 162                     (cdr (assoc 'end-consists  context-desc))
 163                     ))
 164          (grobs  (apply append
 165                   (map engraver-grobs consists))
 166          )
 167          )
 168     grobs
 169     ))
 170
 171
 172 ;; First level Context description
 173 (define (document-context top context-desc)
 174   (let ((name (cdr (assoc 'type-name context-desc)))
 175         (doc (context-doc-string context-desc)))
 176     (processing name)
 177     (string-append
 178      (node (context-name name))
 179      (texi-section 2 (context-name name) #f)
 180       doc)))
 181
 182 (define (symbol<? l r)
 183   (string<? (symbol->string l) (symbol->string r)))
 184
 185 (define (document-paper name)
 186   (let* ((paper-alist
 187           (sort (My_lily_parser::paper_description)
 188                 (lambda (x y) (symbol<? (car x) (car y)))))
 189          (names (sort (map symbol->string (map car paper-alist)) string<?))
 190          (contexts (map cdr paper-alist))
 191          (doc (apply string-append
 192                      (map (lambda (x) (document-context name x)) contexts))))
 193
 194     (string-append
 195      (texi-node-menu name (map (lambda (x) (cons (context-name x) ""))
 196                                names))
 197      doc)))
 198
 199 (define all-engravers-list  (ly-get-all-translators))
 200 (define (document-all-engravers name)
 201   (let* ((gravs all-engravers-list)
 202          (names (map Translator::name gravs))
 203          (doc (apply string-append
 204                      (map (lambda (x) (document-separate-engraver name x))
 205                           gravs))))
 206     (string-append
 207      (texi-node-menu name (map (lambda (x) (cons (engraver-name x) ""))
 208                                names))
 209      doc)))
 210
 211 (define (document-all-engraver-properties name)
 212   (let* ((ps (sort (map symbol->string all-translation-properties) string<?))
 213          (sortedsyms (map string->symbol ps))
 214          (propdescs (map document-translator-property sortedsyms))
 215          (texi (description-list->texi propdescs)))
 216
 217   (string-append
 218           (node name)
 219           (texi-section 1 name #f)
 220           texi)))