scm/generate-documentation.scm

   1
   2
   3 (define (uniqued-alist  alist acc)
   4   (if (null? alist) acc
   5       (if (assoc (caar alist) acc)
   6           (uniqued-alist (cdr alist) acc)
   7           (uniqued-alist (cdr alist) (cons (car alist) acc)
   8   ))))
   9
  10
  11 ;;; TODO
  12
  13 (define (wordwrap string)
  14   ""
  15   )
  16
  17
  18 (define (self-evaluating? x)
  19   (or (number? x) (string? x))
  20   )
  21
  22 (define (type-name  predicate)
  23   (cond
  24    ((eq? predicate dir?) "direction")
  25    ((eq? predicate ly-element?) "graphic element")
  26    ((eq? predicate pair?) "pair")
  27    ((eq? predicate integer?) "integer")
  28    ((eq? predicate list?) "list")
  29    ((eq? predicate symbol?) "symbol")
  30    ((eq? predicate string?) "string")
  31    ((eq? predicate boolean?) "string")
  32    ((eq? predicate number?) "number")
  33    ((eq? predicate procedure?) "procedure")
  34    (else "(unknown)")
  35   ))
  36
  37 (define (scm->string val)
  38   (string-append
  39    (if (self-evaluating? val) "" "'")
  40    (call-with-output-string (lambda (port) (display val port)))
  41   ))
  42
  43 (define (document-property prop desc)
  44   (let ((handle (assoc (car prop) desc)))
  45     (string-append
  46      "\n" (symbol->string (car prop)) " (" (type-name (cadr prop)) ") -- "
  47      (caddr prop)
  48      "\ndefault value:  "
  49      (if (pair? handle)
  50          (scm->string (cdr handle))
  51          "not set"
  52          )
  53      "\n"
  54   )
  55   ))
  56
  57 ;;
  58 ;; todo: setup ifaces differently.
  59 ;;
  60 (define (document-element description)
  61   (let* ((metah (assoc 'meta description))
  62          (meta (if (pair? metah)
  63                    (cdr metah)
  64                    '((properties . ()) (name . "huh?"))
  65                    ))
  66
  67          (name (cdr (assoc 'name meta)))
  68 ;        (iface-descs (cdr (assoc 'interface-descriptions meta)))
  69          (propdesc (cdr (assoc 'properties meta)))
  70          (docs (map (lambda (x) (document-property x description))
  71                     (uniqued-alist propdesc '())))
  72          )
  73
  74     (string-append
  75      "\n-------------------------\n"
  76      name "\n"
  77      "-------------------------\n"
  78      "INTERFACES\n"
  79      "(todo)\n"
  80      ; (apply string-append iface-descs)
  81      "-------------------------\n"
  82      "PROPERTIES:\n"
  83      (apply string-append docs)
  84     )
  85   ))
  86
  87
  88 (define (document-elements elts)
  89   (string-append
  90    (map (lambda (x) (display (car x)) (document-element (cdr x)))
  91         elts
  92         )
  93    ))
  94
  95 (define (test-module )
  96   (display
  97    (list
  98   (scm->string '(1 2 abc))
  99   (scm->string +)
 100   (type-name number?)
 101   (uniqued-alist '((a . 1 ) (a . 1)) '() )
 102   )))
 103
 104
 105 ; (define b (cdr (assoc 'Beam all-element-descriptions)))
 106 ;(display b)
 107
 108 ; (display (document-element  b))
 109
 110 (display (document-elements all-element-descriptions))
 111