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