From 26628a62149a950cc102a620d41cb43ddbe74038 Mon Sep 17 00:00:00 2001 From: Martin Baulig Date: Fri, 22 May 1998 23:22:03 +0000 Subject: [PATCH] New file. Uses the guile interface of libgtop to create docbook * guile/make-docbook.scm: New file. Uses the guile interface of libgtop to create docbook documentation for all functions. --- guile/make-docbook.scm | 266 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 266 insertions(+) create mode 100644 guile/make-docbook.scm diff --git a/guile/make-docbook.scm b/guile/make-docbook.scm new file mode 100644 index 00000000..b993db92 --- /dev/null +++ b/guile/make-docbook.scm @@ -0,0 +1,266 @@ +;; $Id$ + +(define sysdeps-list '()) + +(define make-sysdeps-list + (lambda () + (letrec ((names (glibtop-names-sysdeps)) + (labels (glibtop-labels-sysdeps)) + (descriptions (glibtop-descriptions-sysdeps)) + ) + (for-each (lambda (feature) + (let* ((label (car labels)) + (description (car descriptions)) + (list '()) + ) + (set! labels (cdr labels)) + (set! descriptions (cdr descriptions)) + (set! list (assoc-set! list 'name feature)) + (set! list (assoc-set! list 'label label)) + (set! list (assoc-set! list 'description description)) + (set! sysdeps-list (assoc-set! sysdeps-list feature list)) + ) + ) + names) + ) + ) + ) + +(define make-docbook + (lambda (feature) + (let* ((names (eval-string (string "(glibtop-names-" feature ")"))) + (types (eval-string (string "(glibtop-types-" feature ")"))) + (labels (eval-string (string "(glibtop-labels-" feature ")"))) + (sysdeps (assoc-ref sysdeps-list feature)) (retval "void") + (name (assoc-ref sysdeps 'name)) + (label (assoc-ref sysdeps 'label)) + (description (assoc-ref sysdeps 'description)) + (descriptions (eval-string (string "(glibtop-descriptions-" feature ")"))) + (decl-list '()) (field-list '()) + + (synopsis-start-string + (string "Automatically generated function synopsis:\n\n")) + + (section-string + (string "\n" + "<function>glibtop_get_" feature "()</function> - " + label "\n\n") + ) + + (description-string + (string "\nAutomatically generated description:\n\n" + "
\n\n" + description "\n" + "\n
\n\n") + ) + + (definition-start-string + (string "Automatically generated declaration of " + "_glibtop_" feature ":\n\n") + ) + + (funcsynopsisinfo-string + (string "\n" + "#include <glibtop.h>\n" + "#include <glibtop/" feature ".h>" + "") + ) + + (funcdef-string + (string "" retval " " + "glibtop_get_" feature "__r" + "\n") + ) + + (paramdef-string + (string "glibtop *server, " + "glibtop_" feature " *" feature "\n" + "") + ) + + (funcdef-noserver-string + (string "" retval " " + "glibtop_get_" feature "" + "\n") + ) + + (paramdef-noserver-string + (string "glibtop_" feature " *" + "" feature "\n" + "") + ) + + (field-name-constant + (lambda (name field) + (string "GLIBTOP_" + (string-upcase! (string name)) + "_" + (string-upcase! (string field))) + ) + ) + + (make-struct-name + (lambda (type) + (string "glibtop_" (assoc-ref type "name")) + ) + ) + + (tab-pad-string + (lambda (string tabs) + (let* ((slength (string-length string)) + (tlength (* tabs 8))) + (string-append string + (make-string + (if (> tlength slength) + (- tlength slength) + 1 + ) + #\space)) + ) + ) + ) + + (make-field-list + (lambda (name type fields) + (let* ((output (string)) (pos 1)) + (map + (lambda (x) + (let* ((sep (if (= pos (length fields)) ";" ",")) + (start (if (= pos 1) + (string "\t" + (tab-pad-string (string type) 2)) + (string "\t\t")) + ) + (comment (string (if (= pos 1) "" "\t") "/* " + (tab-pad-string + (field-name-constant name (car x)) 3) + " */")) + (field (tab-pad-string + (string-append (string (car x)) sep) 2)) + ) + (set! pos (+ pos 1)) + (string-append start field comment "\n") + ) + ) + fields) + ) + ) + ) + + (init-field-list + (lambda () + (let* ((old-type #f) + (type-list types) + (new-type #f) + (fields (list)) + ) + (for-each + (lambda (x) + (set! new-type (car type-list)) + (set! type-list (cdr type-list)) + (if (equal? old-type new-type) + (set-car! fields + (append (list new-type) + (cdr (car fields)) + (list (list x)) + ) + ) + (if (equal? old-type #f) + (set! fields (list (list new-type (list x)))) + (set! fields (append (list (list new-type (list x))) fields)) + ) + ) + (set! old-type new-type) + ) + names) + fields) + ) + ) + + (make-struct-body + (lambda (type) + (let* ((name (assoc-ref type "name")) + (data (assoc-ref type "fields")) + (output (string)) + ) + (for-each + (lambda (y) + (for-each + (lambda (z) + (set! output (string-append output z)) + ) + y) + ) + (map + (lambda (x) (make-field-list name (car x) (cdr x))) + data) + ) + output) + ) + ) + + (make-struct + (lambda (type) + (let* ((name (assoc-ref type "name")) + (data (assoc-ref type "fields")) + (output (string-append + (tab-pad-string + (string "typedef struct _glibtop_" name) + 5) + (string "glibtop_" name ";\n\n" + "struct glibtop_" name "\n{\n\t" + "unsigned long\tflags;\n") + ) + ) + ) + (string-append output (make-struct-body type) "};\n") + ) + ) + ) + ) + + (set! decl-list (assoc-set! decl-list "name" name)) + (set! decl-list (assoc-set! decl-list "label" label)) + (set! decl-list (assoc-set! decl-list "fields" (init-field-list))) + + (string-append section-string + description-string + synopsis-start-string + (string "
\n\n") + funcsynopsisinfo-string + funcdef-noserver-string + paramdef-noserver-string + (string "\n") + (string "\n") + funcdef-string + paramdef-string + (string "\n
\n") + definition-start-string + (string "
\n\n") + (make-struct decl-list) + (string "\n
\n") + ) + ) + ) + ) + +;; +;; <function>glibtop_get_cpu()</function> - get CPU usage +;; +;; +;; +;; #include <glibtop.h> +;; #include <glibtop/cpu.h> +;; void glibtop_get_cpu +;; glibtop *server, glibtop_cpu *cpu_usage +;; + + + +(begin + (make-sysdeps-list) + (for-each (lambda (x) + (display (make-docbook x)) + ) + (glibtop-names-sysdeps)) + )