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      (let* ((grob (string->symbol name))
  88             (engravers (filter-list
  89                         (lambda (x) (engraver-makes-grob? name x)) all-engravers-list))
  90             (engraver-names (map Translator::name engravers))
  91             )
  92
  93        (string-append
  94         name " grobs are created by: "
  95         (human-listify (map ref-ify
  96                             (map engraver-name engraver-names)))))
  97
  98             (apply string-append ifacedoc))))
  99
 100 (define (engraver-makes-grob? name grav)
 101   (memq name (assoc 'grobs-created (Translator::description grav)))
 102   )
 103
 104 (define (document-all-grobs name)
 105   (let* ((doc (apply string-append
 106                      (map (lambda (x)
 107                             (document-grob (symbol->string (car x)) (cdr x)))
 108                           all-grob-descriptions)))
 109          (names (map symbol->string (map car all-grob-descriptions))))
 110
 111     (string-append
 112      (texi-node-menu name (map (lambda (x) (cons (grob-name x) ""))
 113                                names))
 114      doc)))
 115
 116 ;; ugh, this works standalone, but not anymore with lily
 117 (if (not (defined? 'standalone))
 118     (begin
 119
 120       (debug-enable 'backtrace)
 121
 122       (load "standalone.scm")
 123
 124       (define (number-pair?  x)
 125         (and (pair? x) (number? (car x)) (number? (cdr x))))
 126
 127       (define (ly-grob? x) #f)
 128       (define (ly-input-location? x) #f)
 129       (define (dir? x) #f)
 130       (define (moment? x) #f)
 131       ))
 132
 133 (use-modules (ice-9 string-fun))
 134
 135 (if standalone
 136   (begin
 137     (display "(define (list-interface-names) '")
 138     (write (ugh-standalone-list-interface-names))
 139     (display ")")
 140     (exit 0)))
 141
 142
 143 (define interface-description-alist
 144   (map (lambda (x) (cons (string->symbol x) (eval-string x)))
 145              (interface-names)))
 146
 147 (set! interface-description-alist (sort interface-description-alist alist<?))
 148
 149 (define (document-all-interfaces name)
 150   (string-append
 151    (texi-node-menu name (map (lambda (x)
 152                                (cons (interface-name (symbol->string x)) ""))
 153                              (map cadr interface-description-alist)))
 154    (apply string-append
 155           (map document-separate-interface
 156                (map cdr interface-description-alist)))))
 157
 158 (define (document-all-backend-properties name)
 159   (let*
 160       (
 161        (ps (sort (map symbol->string all-backend-properties) string<?))
 162        (descs (map (lambda (prop)
 163                      (backend-property->texi (string->symbol prop)))
 164                    ps))
 165        (texi (description-list->texi descs))
 166        )
 167
 168     (string-append
 169      (node name)
 170      (texi-section 1 name #f)
 171      texi)
 172   )
 173   )
 174