scm/backend-documentation-lib.scm

   1 ;;; backend-documentation-lib.scm -- Functions for backend documentation
   2 ;;;
   3 ;;; source file of the GNU LilyPond music typesetter
   4 ;;;
   5 ;;; (c) 2000--2001 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   6 ;;; Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8
   9 ;;; This file generates documentation for the backend of lilypond.
  10
  11 ;; alist of property descriptions
  12
  13
  14 (define (backend-property->texi sym)
  15   (let* ((name (symbol->string sym))
  16         (type (object-property sym 'backend-type?))
  17         (typename (type-name type))
  18         (desc (object-property sym 'backend-doc)))
  19
  20     (cons (string-append "@code{" name "} "
  21                        "(" typename ")"
  22                        ": "
  23
  24 ; index gets too messy
  25 ;                      "@vindex " name "\n"
  26
  27
  28                        )
  29           desc)))
  30
  31 (define (document-grob-property sym grob-description )
  32   (let* ((handle (assoc sym grob-description))
  33          (defval (if (eq? handle #f)
  34                      "(unset)"
  35                    (scm->texi (cdr handle))))
  36          (propdoc (backend-property->texi sym)))
  37
  38     (cons (car propdoc) (string-append (cdr propdoc)
  39                                            "\nDefault value: "
  40                                            defval))))
  41
  42 (define (document-interface where interface grob-description)
  43   (let* ((level (if (eq? where 'grob) 3 2))
  44          (name (car interface))
  45          (desc (cadr interface))
  46          (props (caddr interface))
  47          (docfunc (lambda (x)
  48                     (document-grob-property
  49                      x grob-description )))
  50          (docs (map docfunc props)))
  51
  52     (string-append
  53      (texi-section level
  54                    (string-append (interface-name (symbol->string name)))
  55                    (eq? where 'grob)) ;gur.
  56      desc
  57      (description-list->texi docs))))
  58
  59 ;; First level Interface description
  60 (define (document-separate-interface interface)
  61   (let ((name (symbol->string (car interface))))
  62     (processing name)
  63     (string-append
  64      (node (interface-name name))
  65      (document-interface 'self interface '()))))
  66
  67 ;; First level grob description
  68 (define (document-grob iname description)
  69   (processing iname)
  70   (let* ((metah (assoc 'meta description))
  71
  72          (meta (if (pair? metah)
  73                    (cdr metah)
  74                    '((properties . ()) (name . "huh?"))
  75                    ))
  76
  77          (name (cdr (assoc 'name meta)))
  78          (ifaces (cdr (assoc 'interface-descriptions meta)))
  79          (ifacedoc (map (lambda (x)
  80                           (document-interface 'grob x description))
  81                         (reverse ifaces))))
  82
  83     (string-append
  84      (node (grob-name name))
  85      (texi-section 2 (grob-name name) #f)
  86      "\n"
  87
  88      (let* ((grob (string->symbol name))
  89             (engravers
  90              (apply append
  91                     (map (lambda (x)
  92                            (let ((engraver (car x))
  93                                  (objs (cadddr x)))
  94                              (if (member grob objs)
  95                                  (list engraver)
  96                                  '())))
  97                          engraver-description-alist))))
  98        (string-append
  99         name " grobs are created by: "
 100         (human-listify (map ref-ify
 101                             (map engraver-name
 102                                  (map symbol->string engravers))))))
 103
 104      (apply string-append ifacedoc))))
 105
 106
 107 (define (document-all-grobs name)
 108   (let* ((doc (apply string-append
 109                      (map (lambda (x)
 110                             (document-grob (symbol->string (car x)) (cdr x)))
 111                           all-grob-descriptions)))
 112          (names (map symbol->string (map car all-grob-descriptions))))
 113
 114     (string-append
 115      (texi-node-menu name (map (lambda (x) (cons (grob-name x) ""))
 116                                names))
 117      doc)))
 118
 119 ;; ugh, this works standalone, but not anymore with lily
 120 (if (not (defined? 'standalone))
 121     (begin
 122
 123       (debug-enable 'backtrace)
 124
 125       (load "standalone.scm")
 126
 127       (define (number-pair?  x)
 128         (and (pair? x) (number? (car x)) (number? (cdr x))))
 129
 130       (define (ly-grob? x) #f)
 131       (define (ly-input-location? x) #f)
 132       (define (dir? x) #f)
 133       (define (moment? x) #f)
 134       ))
 135
 136 (use-modules (ice-9 string-fun))
 137
 138 (define interface-file-str (string-append (ly-gulp-file "interface-description.scm") "\n(define "))
 139
 140 ;;(define (list-interface-names)
 141 (define (ugh-standalone-list-interface-names)
 142   (let* ((text interface-file-str)
 143          (t1 (regexp-substitute/global #f "\n" text 'pre 'post))
 144          (t (regexp-substitute/global #f "[^\t ]define[ \t]*([a-z-]+interface)"
 145                                       t1 1 " " 'post))
 146          (ugh (regexp-substitute/global #f "  .*" t 'pre 'post))
 147          (l (separate-fields-discarding-char #\  ugh list)))
 148     (reverse (cdr (reverse l)))))
 149
 150 (if standalone
 151   (begin
 152     (display "(define (list-interface-names) '")
 153     (write (ugh-standalone-list-interface-names))
 154     (display ")")
 155     (exit 0)))
 156
 157 ;; Ugh
 158 ;; This list is generated manually, by doing:
 159 ;; guile
 160 ;; guile> (load "backend-documentation-lib.scm")
 161 ;; For some reason, this can't be generated when lilypond is loaded;
 162 ;; the regexp stuff behaves weird.
 163 (define (list-interface-names) '("general-grob-interface" "beam-interface" "clef-interface" "axis-group-interface" "note-column-interface" "stem-interface" "slur-interface" "side-position-interface" "accidentals-interface" "line-of-score-interface" "note-head-interface" "note-name-interface" "rhythmic-head-interface" "rest-interface" "tuplet-bracket-interface" "align-interface" "aligned-interface" "break-aligned-interface" "chord-name-interface" "time-signature-interface" "bar-line-interface" "hairpin-interface" "arpeggio-interface" "note-collision-interface" "custos-interface" "dot-interface" "font-interface" "text-interface" "dot-column-interface" "dynamic-interface" "finger-interface" "separation-spanner-interface" "text-script-interface" "grace-alignment-interface" "hara-kiri-group-interface" "line-spanner-interface" "lyric-hyphen-interface" "key-signature-interface" "lyric-extender-interface" "lyric-syllable-interface" "mark-interface" "multi-measure-rest-interface" "paper-column-interface" "spaceable-element-interface" "rest-collision-interface" "script-interface" "script-column-interface" "spacing-spanner-interface" "staff-symbol-interface" "stem-tremolo-interface" "separation-item-interface" "sustain-pedal-interface" "system-start-delimiter-interface" "text-spanner-interface" "tie-interface" "tie-column-interface" "volta-bracket-interface" "span-bar-interface"))
 164
 165
 166 (eval-string (ly-gulp-file "interface-description.scm"))
 167
 168 (define interface-description-alist
 169   (map (lambda (x) (cons (string->symbol x) (eval-string x)))
 170              (list-interface-names)))
 171
 172 (set! interface-description-alist (sort interface-description-alist alist<?))
 173
 174 (define (document-all-interfaces name)
 175   (string-append
 176    (texi-node-menu name (map (lambda (x)
 177                                (cons (interface-name (symbol->string x)) ""))
 178                              (map cadr interface-description-alist)))
 179    (apply string-append
 180           (map document-separate-interface
 181                (map cdr interface-description-alist)))))
 182
 183 (define (document-all-backend-properties name)
 184   (let*
 185       (
 186        (ps (sort (map symbol->string all-backend-properties) string<?))
 187        (descs (map (lambda (prop)
 188                      (backend-property->texi (string->symbol prop)))
 189                    ps))
 190        (texi (description-list->texi descs))
 191        )
 192
 193     (string-append
 194      (node name)
 195      (texi-section 1 name #f)
 196      texi)
 197   )
 198   )
 199