1 files changed, 109 insertions, 0 deletions
diff --git a/doc/skribilo.scm b/doc/skribilo.scm
new file mode 100644
index 0000000..23a1829
--- /dev/null
+++ b/doc/skribilo.scm
@@ -0,0 +1,109 @@
+;;; tissue --- Text based issue tracker
+;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of tissue.
+;;;
+;;; tissue is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; tissue is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with tissue.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (doc skribilo)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-171)
+  #:use-module (ice-9 match)
+  #:use-module (texinfo)
+  #:use-module (skribilo package base)
+  #:export (file
+            docstring-function-documentation
+            function-documentation))
+
+;; Aliases
+(define file samp)
+
+(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 (quoted-write object port)
+  "Write @var{object} to @var{port} printing quoted expressions using
+the quote character."
+  (match object
+    (('quote child)
+     (display "'" port)
+     (quoted-write child port))
+    ((parent children ...)
+     (display "(" port)
+     (quoted-write parent port)
+     (unless (null? children)
+       (display " " port))
+     (for-each (cut quoted-write <> port)
+               children)
+     (display ")" port))
+    (_ (write object port))))
+
+(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 (lambda (element)
+                                                (call-with-output-string
+                                                  (cut quoted-write element <>)))
+                                              (function-arguments function)))
+                            ")"))
+          (map (cut eval <> (current-module))
+               (stexi->skribe
+                (texi-fragment->stexi
+                 (function-docstring function)))))))
+
+(define (function-documentation name arguments . documentation)
+  "Document function of @var{name} with @var{arguments} and
+@var{documentation}."
+  (apply item
+         #:key (code (list "("
+                            (bold (symbol->string name))
+                            " "
+                            arguments
+                            ")"))
+        documentation))