scm/backend-documentation-lib.scm

   1
   2 ;;; backend-documentation-lib.scm -- Functions for backend documentation
   3 ;;;
   4 ;;; source file of the GNU LilyPond music typesetter
   5 ;;;
   6 ;;; (c) 2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7 ;;; Jan Nieuwenhuizen <janneke@gnu.org>
   8
   9
  10 ;;; This file generates documentation for the backend of lilypond.
  11
  12 ;; alist of property descriptions
  13 ;; when called by First level Interface description, desc == '()
  14 ;; CDR "not set" is only used for Second level Element description
  15 (define (document-element-property prop desc)
  16   (let ((handle (assoc (car prop) desc)))
  17     (cons
  18      (string-append "@code{" (symbol->string (car prop)) "} "
  19                     "(" (type-name (cadr prop)) ")"
  20                     (if (equal? desc '()) "" ":"))
  21      (string-append (if (equal? desc '())
  22                         (caddr prop)
  23                         (if (pair? handle)
  24                             (string-append (caddr prop)
  25                                            "\ndefault value: @code{"
  26                                            (scm->string (cdr handle))
  27                                            "}")
  28                             "not set"))))))
  29
  30 ;; First level Interface description
  31 ;; Second level, part of element description
  32 (define (document-interface level interface element-description)
  33   (let* ((name (car interface))
  34          (desc (cadr interface))
  35          (props (caddr interface))
  36          (docs (map (lambda (x)
  37                       (document-element-property x element-description))
  38                     props)))
  39
  40     (string-append
  41      (section level (string-append (interface-name (symbol->string name))))
  42      desc
  43
  44      (description-list
  45       ;; filter-out entries with CDR "not set"
  46       (apply append
  47              (map (lambda  (x)
  48                     (if (string-match "not set" (cdr x)) '() (list x)))
  49                   docs))))))
  50
  51 ;; First level Interface description
  52 (define (document-separate-interface interface)
  53   (let ((name (car interface)))
  54     (processing name)
  55     (string-append
  56      (node (interface-name name))
  57      (document-interface 2 interface '()))))
  58
  59 ;; First level element description
  60 (define (document-element iname description)
  61   (processing iname)
  62   (let* ((metah (assoc 'meta description))
  63
  64          (meta (if (pair? metah)
  65                    (cdr metah)
  66                    '((properties . ()) (name . "huh?"))
  67                    ))
  68
  69          (name (cdr (assoc 'name meta)))
  70          (ifaces (cdr (assoc 'interface-descriptions meta)))
  71          (ifacedoc (map (lambda (x) (document-interface 3 x description))
  72                         (reverse ifaces))))
  73
  74     (string-append
  75      (node (element-name name))
  76      (section 2 (element-name name))
  77      "\n"
  78
  79      (let* ((element (string->symbol name))
  80             (engravers
  81              (apply append
  82                     (map (lambda (x)
  83                            (let ((engraver (car x))
  84                                  (objs (cadddr x)))
  85                              (if (member element objs)
  86                                  (list engraver)
  87                                  '())))
  88                          engraver-description-alist))))
  89        (string-append
  90         name " elements are created by: "
  91         (human-listify (map reffy (map engraver-name engravers)))))
  92
  93      (apply string-append ifacedoc))))
  94
  95
  96 (define (document-all-elements name)
  97   (let* ((doc (apply string-append
  98                      (map (lambda (x) (document-element (car x) (cdr x)))
  99                           all-element-descriptions)))
 100          (names (map car all-element-descriptions)))
 101
 102     (string-append
 103      (texi-node-menu name (map (lambda (x) (cons (element-name x) ""))
 104                                names))
 105      doc)))
 106
 107 ;; testin.. -- how to do this
 108 (eval-string (ly-gulp-file "interface.scm"))
 109 (define xinterface-description-alist
 110   `(
 111     (general-element . ,general-element-interface)
 112     (beam . ,beam-interface)
 113     (clef . ,clef-interface)
 114     (slur . ,slur-interface)
 115     ))
 116
 117 ;; burp, need these for running outside of LilyPond
 118 (if #f
 119     (begin
 120
 121       (debug-enable 'backtrace)
 122
 123       (define (number-pair?  x)
 124         (and (pair? x) (number? (car x)) (number? (cdr x))))
 125
 126       (define (ly-gulp-file x) "")
 127       (define (ly-element? x) #f)
 128       (define (ly-input-location? x) #f)
 129       (define (dir? x) #f)
 130       (define (moment? x) #f)
 131       (load "lily.scm")))
 132
 133 (use-modules (ice-9 string-fun))
 134 (define (list-interface-names)
 135   (let* ((text (string-append (ly-gulp-file "interface.scm") "\n(define "))
 136          (r (make-regexp
 137              "\n[(](define *([a-z-]*-interface)*)*[^\n]*"))
 138          (t (regexp-substitute/global #f r text 2 " " 'post))
 139          (ugh (regexp-substitute/global #f "#f *" t 'pre 'post))
 140          (l (separate-fields-discarding-char #\  ugh list)))
 141     (reverse (cdr (reverse l)))))
 142
 143 (eval (ly-gulp-file "interface.scm"))
 144
 145 (define interface-description-alist
 146   (map (lambda (x) (cons (string->symbol x) (eval-string x)))
 147              (list-interface-names)))
 148
 149 (define (document-all-interfaces name)
 150   (string-append
 151    (texi-node-menu name (map (lambda (x) (cons (interface-name x) ""))
 152                              (map cadr interface-description-alist)))
 153    (apply string-append
 154           (map document-separate-interface
 155                (map cdr interface-description-alist)))))
 156
 157