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 ;;;;;; TODO: sort out symbol vs. string stuff.
  15 ;;;;;; TODO: use flatten write iso. string-append; might be possible to fold
  16 ;;;;;; in symbol->string integrally.
  17
  18 (define (backend-property->texi sym)
  19   (let* ((name (symbol->string sym))
  20         (type (object-property sym 'backend-type?))
  21         (typename (type-name type))
  22         (desc (object-property sym 'backend-doc)))
  23
  24
  25     (if (equal? desc #f)
  26         (error "Unknown property " sym)
  27
  28         (cons (string-append "@code{" name "} "
  29                        "(" typename ")"
  30                        ": "
  31
  32 ; index gets too messy
  33 ;                      "@vindex " name "\n"
  34                        )
  35           desc))))
  36
  37 (define (document-grob-property sym grob-description )
  38   "Document SYM, filling in default values."
  39   (let* ((handle (assoc sym grob-description))
  40          (defval (if (eq? handle #f)
  41                      "(unset)"
  42                    (scm->texi (cdr handle))))
  43          (propdoc (backend-property->texi sym)))
  44
  45     (cons (car propdoc) (string-append (cdr propdoc)
  46                                            "\nDefault value: "
  47                                            defval)))
  48   )
  49
  50 (define (document-interface where interface grob-description)
  51
  52   (let* ((level (if (eq? where 'grob) 3 2))
  53          (name (car interface))
  54          (desc (cadr interface))
  55          (props (sort (caddr interface) symbol<?))
  56          (docfunc (lambda (pr)
  57                     (document-grob-property
  58                      pr grob-description )))
  59          (docs (map docfunc props)))
  60
  61     (string-append
  62      (texi-section level
  63                    (string-append (interface-name (symbol->string name)))
  64                    (eq? where 'grob)) ;gur.
  65      desc
  66      (description-list->texi docs))))
  67
  68 ;; First level Interface description
  69 (define (document-separate-interface interface)
  70   (let ((name (symbol->string (car interface))))
  71     (processing name)
  72     (string-append
  73      (node (interface-name name))
  74      (document-interface 'self interface '()))))
  75
  76
  77 ;; First level grob description
  78 (define (document-grob iname description)
  79   (processing iname)
  80   (let* ((metah (assoc 'meta description))
  81
  82          (meta (cdr metah))
  83          (name (cdr (assoc 'name meta)))
  84          (ifaces (map lookup-interface (cdr (assoc 'interfaces meta))))
  85          (ifacedoc (map (lambda (iface)
  86                           (document-interface 'grob iface description))
  87                         (reverse ifaces)))
  88          )
  89
  90
  91     (string-append
  92      (node (grob-name name))
  93      (texi-section 2 (grob-name name) #f)
  94      "\n"
  95      (let* ((grob name)
  96             (engravers (filter-list
  97                         (lambda (x) (engraver-makes-grob? name x)) all-engravers-list))
  98             (engraver-names (map Translator::name engravers))
  99             )
 100
 101        (string-append
 102         (symbol->string name) " grobs are created by: "
 103         (human-listify (map ref-ify
 104                             (map engraver-name engraver-names)))))
 105
 106             (apply string-append ifacedoc))))
 107
 108
 109
 110 (define (engraver-makes-grob? name-symbol grav)
 111   (memq name-symbol (assoc 'grobs-created (Translator::description grav)))
 112   )
 113
 114 (define (document-all-grobs name)
 115   (let* ((doc (apply string-append
 116                      (map (lambda (x)
 117                             (document-grob (symbol->string (car x)) (cdr x)))
 118                           all-grob-descriptions)))
 119          (names (map symbol->string (map car all-grob-descriptions))))
 120
 121     (string-append
 122      (texi-node-menu name (map (lambda (x) (cons (grob-name x) ""))
 123                                names))
 124      doc)))
 125
 126 ;; ugh, this works standalone, but not anymore with lily
 127 (if (not (defined? 'standalone))
 128     (begin
 129
 130 ;      (debug-enable 'backtrace)
 131
 132       (load "standalone.scm")
 133
 134       (define (number-pair?  x)
 135         (and (pair? x) (number? (car x)) (number? (cdr x))))
 136       (define (ly-grob? x) #f)
 137       (define (ly-input-location? x) #f)
 138       (define (dir? x) #f)
 139       (define (moment? x) #f)
 140       ))
 141
 142 (use-modules (ice-9 string-fun))
 143
 144 (if standalone
 145   (begin
 146     (display "(define (list-interface-names) '")
 147     (write (ugh-standalone-list-interface-names))
 148     (display ")")
 149     (exit 0)))
 150
 151
 152 (define interface-description-alist
 153   (hash-fold
 154    (lambda (key val prior)
 155      (cons (cons key val)  prior)
 156      )
 157    '() (ly-all-grob-interfaces)))
 158
 159 (set! interface-description-alist (sort interface-description-alist alist<?))
 160
 161
 162 ;;;;;;;;;; check for dangling backend properties.
 163 (define (mark-interface-properties entry)
 164   (map (lambda (x) (set-object-property! x  'iface-marked #t)) (caddr (cdr entry)))
 165   )
 166
 167 (map mark-interface-properties interface-description-alist)
 168
 169 (define (check-dangling-properties prop)
 170   (if (not (object-property prop 'iface-marked))
 171       (error  "\nDangling property: "  prop))
 172   )
 173
 174 (map check-dangling-properties all-backend-properties)
 175
 176 ;;;;;;;;;;;;;;;;
 177
 178 (define (lookup-interface name)
 179   (let*  (
 180           (entry  (hashq-ref (ly-all-grob-interfaces) name #f))
 181           )
 182
 183     (if (equal? entry #f)
 184         (error "Unknown interface" name))
 185
 186     entry
 187 ))
 188
 189 ;(write  (map car  interface-description-alist) (current-error-port))
 190 ;(display  (lookup-interface 'accidental-placement-interface))
 191 ;(display  (document-all-grobs "OO" ))
 192
 193 (define (document-all-interfaces name)
 194   (string-append
 195    (texi-node-menu name (map (lambda (x)
 196                                (cons (interface-name (symbol->string x)) ""))
 197                              (map cadr interface-description-alist)))
 198    (apply string-append
 199           (map document-separate-interface
 200                (map cdr interface-description-alist)))))
 201
 202 (define (document-all-backend-properties name)
 203   (let*
 204       (
 205        (ps (sort (map symbol->string all-backend-properties) string<?))
 206        (descs (map (lambda (prop)
 207                      (backend-property->texi (string->symbol prop)))
 208                    ps))
 209        (texi (description-list->texi descs))
 210        )
 211
 212     (string-append
 213      (node name)
 214      (texi-section 1 name #f)
 215      texi)
 216   )
 217   )
 218
 219 ;;;;;;;;;;;;;;;;
 220