diff options
| -rw-r--r-- | doc/skribilo.scm | 51 |
1 files changed, 50 insertions, 1 deletions
diff --git a/doc/skribilo.scm b/doc/skribilo.scm index a666eed..45f35a8 100644 --- a/doc/skribilo.scm +++ b/doc/skribilo.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-171) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (texinfo) #:use-module (skribilo ast) #:use-module (skribilo engine) #:use-module (skribilo lib) @@ -41,7 +42,8 @@ scheme-source-form source-ref record-documentation - record-field)) + record-field + docstring-function-documentation)) ;; Constants (define %source-uri-base @@ -291,6 +293,53 @@ are a list of <record-field> objects." (record-field-documentation documented-field)))) fields))))) +(define-record-type <function> + (function name arguments docstring) + function? + (name function-name) + (arguments function-arguments) + (docstring function-docstring)) + +(define (find-function-definition file name) + "Return a @code{<function>} object describing a function named +@var{name} in @var{file}." + (call-with-input-file file + (cut port-transduce + (tmap identity) + (rany (match-lambda + (((or 'define 'define* 'define-lazy) + ((? (cut eq? name <>)) arguments ...) + docstring + body ...) + (function name arguments docstring)) + (_ #f))) + read + <>))) + +(define (stexi->skribe stexi) + "Convert @var{stexi}, a stexinfo tree, to a skribe tree." + (match stexi + (('*fragment* children ...) + (map stexi->skribe children)) + (('para children ...) + (cons 'paragraph children)))) + +(define (docstring-function-documentation file name) + "Document function of @var{name} from @var{file} using its docstring." + (let ((function (or (find-function-definition file name) + (error "Function not found in file:" name file)))) + (item #:key (code (list "(" + (bold (symbol->string name)) + (unless (null? (function-arguments function)) + " ") + (string-join (map expression->string + (function-arguments function))) + ")")) + (map (cut eval <> (current-module)) + (stexi->skribe + (texi-fragment->stexi + (function-docstring function))))))) + ;; HTML engine customizations (let ((html-engine (find-engine 'html))) (engine-custom-set! html-engine 'css "/style.css") |