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 ;; testin.. -- how to do this
 124 (eval-string (ly-gulp-file "interface-description.scm"))
 125 (define xinterface-description-alist
 126       `(
 127         (general-grob . ,general-grob-interface)
 128         (beam . ,beam-interface)
 129         (clef . ,clef-interface)
 130         (slur . ,slur-interface)
 131         ))
 132
 133 ;; burp, need these for running outside of LilyPond
 134 (if #f
 135     (begin
 136
 137       (debug-enable 'backtrace)
 138
 139       (define (number-pair?  x)
 140         (and (pair? x) (number? (car x)) (number? (cdr x))))
 141
 142       (define (ly-gulp-file x) "")
 143       (define (ly-grob? x) #f)
 144       (define (ly-input-location? x) #f)
 145       (define (dir? x) #f)
 146       (define (moment? x) #f)
 147       (load "lily.scm")))
 148
 149 (use-modules (ice-9 string-fun))
 150
 151 (define interface-file-str (string-append (ly-gulp-file "interface-description.scm") "\n(define "))
 152
 153 (define (list-interface-names)
 154   (let* ((text interface-file-str)
 155          (r (make-regexp
 156              "\n[(](define *([a-z-]*-interface)*)*[^\n]*"))
 157          (t (regexp-substitute/global #f r text 2 " " 'post))
 158          (ugh (regexp-substitute/global #f "#f *" t 'pre 'post))
 159          (l (separate-fields-discarding-char #\  ugh list)))
 160     (reverse (cdr (reverse l)))))
 161
 162
 163
 164
 165 (eval (ly-gulp-file "interface-description.scm"))
 166
 167 (define interface-description-alist
 168   (map (lambda (x) (cons (string->symbol x) (eval-string x)))
 169              (list-interface-names)))
 170
 171 (set! interface-description-alist (sort interface-description-alist alist<?))
 172
 173 (define (document-all-interfaces name)
 174   (string-append
 175    (texi-node-menu name (map (lambda (x) (cons (interface-name x) ""))
 176                              (map cadr interface-description-alist)))
 177    (apply string-append
 178           (map document-separate-interface
 179                (map cdr interface-description-alist)))))
 180
 181 (define (document-all-backend-properties name)
 182   (let*
 183       (
 184        (ps (sort (map symbol->string all-backend-properties) string<?))
 185        (descs (map (lambda (prop)
 186                      (backend-property->texi (string->symbol prop)))
 187                    ps))
 188        (texi (description-list->texi descs))
 189        )
 190
 191     (string-append
 192      (node name)
 193      (texi-section 1 name #f)
 194      texi)
 195   )
 196   )
 197