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 (document-element-property property-def element-description only-doc-if-set)
  15   "
  16 "
  17   (let* (
  18         (handle (assoc (car property-def) element-description))
  19         (def-val-str (if (eq? handle #f)
  20                          "not set"
  21                          (scm->texi (cdr handle))))
  22
  23         (name (symbol->string (car property-def)))
  24         (type (type-name (cadr property-def)))
  25         (desc (caddr property-def))
  26         )
  27
  28     (if (and  (eq? handle #f) only-doc-if-set)
  29         '("" . "")
  30         (cons (string-append "@code{" name "} "
  31                        "(" type ")"
  32                        ":" )
  33               (string-append desc
  34                              "\nDefault value: "
  35                              def-val-str))
  36     ))
  37   )
  38
  39 (define (document-interface where interface element-description)
  40   "
  41
  42 "
  43   (let* ((level (if (eq? where 'element) 3 2))
  44          (name (car interface))
  45          (desc (cadr interface))
  46          (props (caddr interface))
  47          (docfun  (lambda (x)
  48                     (document-element-property
  49                      x element-description (eq? where 'element))))
  50          (docs (map docfun props))
  51          )
  52
  53     (string-append
  54      (texi-section level (string-append (interface-name (symbol->string name))) (eq? where 'element)) ;gur.
  55      desc
  56
  57      (description-list->texi docs)
  58      )))
  59
  60 ;; First level Interface description
  61 (define (document-separate-interface interface)
  62   (let ((name (car interface)))
  63     (processing name)
  64     (string-append
  65      (node (interface-name name))
  66      (document-interface 'self interface '()))))
  67
  68 ;; First level element description
  69 (define (document-element iname description)
  70   (processing iname)
  71   (let* ((metah (assoc 'meta description))
  72
  73          (meta (if (pair? metah)
  74                    (cdr metah)
  75                    '((properties . ()) (name . "huh?"))
  76                    ))
  77
  78          (name (cdr (assoc 'name meta)))
  79          (ifaces (cdr (assoc 'interface-descriptions meta)))
  80          (ifacedoc (map (lambda (x) (document-interface 'element x description))
  81                         (reverse ifaces))))
  82
  83     (string-append
  84      (node (element-name name))
  85      (texi-section 2 (element-name name) #f)
  86      "\n"
  87
  88      (let* ((element (string->symbol name))
  89             (engravers
  90              (apply append
  91                     (map (lambda (x)
  92                            (let ((engraver (car x))
  93                                  (objs (cadddr x)))
  94                              (if (member element objs)
  95                                  (list engraver)
  96                                  '())))
  97                          engraver-description-alist))))
  98        (string-append
  99         name " elements are created by: "
 100         (human-listify (map reffy (map engraver-name engravers)))))
 101
 102      (apply string-append ifacedoc))))
 103
 104
 105 (define (document-all-elements name)
 106   (let* ((doc (apply string-append
 107                      (map (lambda (x) (document-element (car x) (cdr x)))
 108                           all-element-descriptions)))
 109          (names (map car all-element-descriptions)))
 110
 111     (string-append
 112      (texi-node-menu name (map (lambda (x) (cons (element-name x) ""))
 113                                names))
 114      doc)))
 115
 116 ;; testin.. -- how to do this
 117 (eval-string (ly-gulp-file "interface.scm"))
 118 (define xinterface-description-alist
 119   `(
 120     (general-element . ,general-element-interface)
 121     (beam . ,beam-interface)
 122     (clef . ,clef-interface)
 123     (slur . ,slur-interface)
 124     ))
 125
 126 ;; burp, need these for running outside of LilyPond
 127 (if #f
 128     (begin
 129
 130       (debug-enable 'backtrace)
 131
 132       (define (number-pair?  x)
 133         (and (pair? x) (number? (car x)) (number? (cdr x))))
 134
 135       (define (ly-gulp-file x) "")
 136       (define (ly-element? x) #f)
 137       (define (ly-input-location? x) #f)
 138       (define (dir? x) #f)
 139       (define (moment? x) #f)
 140       (load "lily.scm")))
 141
 142 (use-modules (ice-9 string-fun))
 143
 144 (define interface-file-str (string-append (ly-gulp-file "interface.scm") "\n(define "))
 145 (define (list-interface-names)
 146   (let* ((text interface-file-str)
 147          (r (make-regexp
 148              "\n[(](define *([a-z-]*-interface)*)*[^\n]*"))
 149          (t (regexp-substitute/global #f r text 2 " " 'post))
 150          (ugh (regexp-substitute/global #f "#f *" t 'pre 'post))
 151          (l (separate-fields-discarding-char #\  ugh list)))
 152     (reverse (cdr (reverse l)))))
 153
 154 (eval (ly-gulp-file "interface.scm"))
 155
 156 (define interface-description-alist
 157   (map (lambda (x) (cons (string->symbol x) (eval-string x)))
 158              (list-interface-names)))
 159
 160 (define (document-all-interfaces name)
 161   (string-append
 162    (texi-node-menu name (map (lambda (x) (cons (interface-name x) ""))
 163                              (map cadr interface-description-alist)))
 164    (apply string-append
 165           (map document-separate-interface
 166                (map cdr interface-description-alist)))))
 167
 168