~evhan/beaker

ref: ff2aa6197e1a2e681c4fb02ee53d18ad9e3fe86e beaker/lib/beaker/wiki.scm -rw-r--r-- 2.3 KiB
ff2aa619Evan Hanson Import beaker sources 3 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Generate wiki documentation.
;;;
;;; Copyright (c) 2018, Evan Hanson
;;;
;;; See LICENSE for details.
;;;

(declare
  (module (beaker wiki))
  (export document-dependencies
          document-extension
          document-license
          document-program)
  (import (beaker egg info)
          (chicken io)
          (chicken pathname)
          (chicken port)
          (chicken process)
          (chicken process-context)
          (chicken read-syntax)
          (chicken string)
          (markdown-svnwiki)
          (schematic extract)
          (srfi 13)))

;;
;; Reads Scheme source from `input` and writes wiki documentation
;; fragments to `output`.
;;
;; If no arguments are given, `input` and `output` default to
;; the `(current-input-port)` and `(current-output-port)`.
;;
(define (generate-documentation #!optional input output)
  (let* ((buffer  (open-output-string))
         (input*  (or input (current-input-port)))
         (output* (or output (current-output-port)))
         (_       (extract-definitions '(";;") #t input* buffer))
         (buffer* (open-input-string (get-output-string buffer))))
    (parameterize ((current-input-port buffer*)
                   (current-output-port output*))
      (do ((x (read) (read)))
          ((eof-object? x))
        (for-each (lambda (d)
                    (unless (eq? (car d) 'declaration)
                      (print "<" (car d) ">" (cdr d) "</" (car d) ">")))
                  (cdr x))
        (newline)
        (markdown->svnwiki (car x))))))

(define (document-file file)
  (string-trim-both
   (with-input-from-file file
    (lambda ()
      (with-output-to-string generate-documentation)))))

(define (document-command command)
  (string-append " " (string-trim-both (with-input-from-pipe command read-string))))

(define (document-extension file)
  (document-file file))

(define (document-program file command)
  (string-append (document-command command) "\n\n" (document-file file)))

(define (document-dependencies egg-file)
  (string-intersperse
   (map (lambda (d) (conc "* [[/eggref/5/" d "|" d "]]"))
        (egg-dependencies egg-file))
   "\n"))

(define (document-license file)
  (string-intersperse
   (map (lambda (l) (string-append " " l))
        (with-input-from-file file read-lines))
   "\n"))