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 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* (
  16         (name (symbol->string sym))
  17         (type (object-property sym 'backend-type?))
  18         (typename (type-name type))
  19         (desc (object-property sym 'backend-doc))
  20         )
  21
  22     (cons (string-append "@code{" name "} "
  23                        "(" typename ")"
  24                        ":" )
  25           desc)
  26     ))
  27
  28 (define (document-grob-property sym grob-description only-doc-if-set)
  29   (let*
  30       (
  31        (handle (assoc sym grob-description))
  32        (defval (if (eq? handle #f)
  33                    ""
  34                    (scm->texi (cdr handle))
  35                    ))
  36        (propdoc (backend-property->texi sym))
  37        )
  38
  39     (if (and only-doc-if-set  (eq? handle #f) )
  40         '("" . "")
  41         (cons (car propdoc) (string-append (cdr propdoc)
  42                                            "\nDefault value: "
  43                                            defval)))
  44     ))
  45
  46 (define (document-interface where interface grob-description)
  47   "
  48
  49 "
  50   (let* ((level (if (eq? where 'grob) 3 2))
  51          (name (car interface))
  52          (desc (cadr interface))
  53          (props (caddr interface))
  54          (docfunc  (lambda (x)
  55                     (document-grob-property
  56                      x grob-description (eq? where 'grob))))
  57          (docs (map docfunc props))
  58          )
  59
  60     (string-append
  61      (texi-section level (string-append (interface-name (symbol->string name))) (eq? where 'grob)) ;gur.
  62      desc
  63
  64      (description-list->texi docs)
  65      )))
  66
  67 ;; First level Interface description
  68 (define (document-separate-interface interface)
  69   (let ((name (car interface)))
  70     (processing name)
  71     (string-append
  72      (node (interface-name name))
  73      (document-interface 'self interface '()))))
  74
  75 ;; First level grob description
  76 (define (document-grob iname description)
  77   (processing iname)
  78   (let* ((metah (assoc 'meta description))
  79
  80          (meta (if (pair? metah)
  81                    (cdr metah)
  82                    '((properties . ()) (name . "huh?"))
  83                    ))
  84
  85          (name (cdr (assoc 'name meta)))
  86          (ifaces (cdr (assoc 'interface-descriptions meta)))
  87          (ifacedoc (map (lambda (x) (document-interface 'grob x description))
  88                         (reverse ifaces))))
  89
  90     (string-append
  91      (node (grob-name name))
  92      (texi-section 2 (grob-name name) #f)
  93      "\n"
  94
  95      (let* ((grob (string->symbol name))
  96             (engravers
  97              (apply append
  98                     (map (lambda (x)
  99                            (let ((engraver (car x))
 100                                  (objs (cadddr x)))
 101                              (if (member grob objs)
 102                                  (list engraver)
 103                                  '())))
 104                          engraver-description-alist))))
 105        (string-append
 106         name " grobs are created by: "
 107         (human-listify (map reffy (map engraver-name engravers)))))
 108
 109      (apply string-append ifacedoc))))
 110
 111
 112 (define (document-all-grobs name)
 113   (let* ((doc (apply string-append
 114                      (map (lambda (x) (document-grob (car x) (cdr x)))
 115                           all-grob-descriptions)))
 116          (names (map car all-grob-descriptions)))
 117
 118     (string-append
 119      (texi-node-menu name (map (lambda (x) (cons (grob-name x) ""))
 120                                names))
 121      doc)))
 122
 123 ;; ugh, this works standalone, but not anymore with lily
 124 (if (not (defined? 'standalone))
 125     (begin
 126
 127       (debug-enable 'backtrace)
 128
 129       (load "standalone.scm")
 130
 131       (define (number-pair?  x)
 132         (and (pair? x) (number? (car x)) (number? (cdr x))))
 133
 134       (define (ly-grob? x) #f)
 135       (define (ly-input-location? x) #f)
 136       (define (dir? x) #f)
 137       (define (moment? x) #f)
 138       ))
 139
 140 (use-modules (ice-9 string-fun))
 141
 142 (define interface-file-str (string-append (ly-gulp-file "interface-description.scm") "\n(define "))
 143
 144 ;;(define (list-interface-names)
 145 (define (ugh-standalone-list-interface-names)
 146   (let* ((text interface-file-str)
 147          (t1 (regexp-substitute/global #f "\n" text 'pre 'post))
 148          (t (regexp-substitute/global #f "[^\t ]*[ \t]([a-z-]+interface)"
 149                                       t1 1 " " 'post))
 150          (ugh (regexp-substitute/global #f "  .*" t 'pre 'post))
 151          (l (separate-fields-discarding-char #\  ugh list)))
 152     (reverse (cdr (reverse l)))))
 153
 154 (if standalone
 155   (begin
 156     (display "(define (list-interface-names) '")
 157     (write (ugh-standalone-list-interface-names))
 158     (display ")")
 159     (exit 0)))
 160
 161 ;; Ugh
 162 ;; This list is generated manually, by doing:
 163 ;; guile
 164 ;; guile> (load "backend-documentation-lib.scm")
 165 ;; For some reason, this can't be generated when lilypond is loaded;
 166 ;; the regexp stuff behaves weird.
 167 (define (list-interface-names) '("general-grob-interface" "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" "align-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" "font-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"))
 168
 169 (eval-string (ly-gulp-file "interface-description.scm"))
 170
 171 (define interface-description-alist
 172   (map (lambda (x) (cons (string->symbol x) (eval-string x)))
 173              (list-interface-names)))
 174
 175 (set! interface-description-alist (sort interface-description-alist alist<?))
 176
 177 (define (document-all-interfaces name)
 178   (string-append
 179    (texi-node-menu name (map (lambda (x) (cons (interface-name x) ""))
 180                              (map cadr interface-description-alist)))
 181    (apply string-append
 182           (map document-separate-interface
 183                (map cdr interface-description-alist)))))
 184
 185 (define (document-all-backend-properties name)
 186   (let*
 187       (
 188        (ps (sort (map symbol->string all-backend-properties) string<?))
 189        (descs (map (lambda (prop)
 190                      (backend-property->texi (string->symbol prop)))
 191                    ps))
 192        (texi (description-list->texi descs))
 193        )
 194
 195     (string-append
 196      (node name)
 197      (texi-section 1 name #f)
 198      texi)
 199   )
 200   )
 201