Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-05 12:16:37 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Try to fix it again

Browse source
This commit is contained in:
Locria Cyber 2023-06-19 22:32:04 +00:00
parent f339e95eb6
commit 99b793118b
No known key found for this signature in database
GPG key ID: ED0D424AE4406330
1 changed files with 32 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
tools/generate-docs.scm
View file

@ -5,7 +5,7 @@
(chibi process) (chibi process)
(chibi filesystem) (chibi filesystem)
(chibi pathname) (chibi pathname)
(srfi 18)) (srfi 98))
(define (walk-directory path) (define (walk-directory path)
#;(write (cons "visiting: " path)) #;(write (cons "visiting: " path))
@ -34,34 +34,50 @@
(string-suffix? ".sld" filename) (string-suffix? ".sld" filename)
(not (string-contains filename "-test")))) (not (string-contains filename "-test"))))
(define (char-replacer from to)
(lambda (c)
(if (eq? from c) to c)))
(define (process x) (define (process x)
(define strlen-ext (string-length ".sdl"))
(define outfile (define outfile
(string-append (string-append
"doc/" "doc/"
(substring x 0 (- (string-length x) 4)) (substring x 0 (- (string-length x) strlen-ext))
".html")) ".html"))
(display `("Processing" ,x ,outfile)) (define doc-mod-name (string-map (char-replacer #\/ #\.) (substring x (string-length "lib/") (- (string-length x) strlen-ext))))
(newline) (let ((output (process->string `("./chibi-scheme" "tools/chibi-doc" "--html" ,doc-mod-name))))
(let ((output (process->string `("./chibi-scheme" "tools/chibi-doc" "--html" ,x))))
(create-directory* (path-directory outfile)) (create-directory* (path-directory outfile))
(call-with-output-file (call-with-output-file
outfile outfile
(lambda (port) (lambda (port)
(display output port))))) (display output port))))
(display `("Processed" ,doc-mod-name ,x ,outfile))
(newline))
(define (fork-map f xs) (define (fork-map f xs)
(if (pair? xs) (if (pair? xs)
(let* ((x (car xs)) (let ((pid (fork)))
(thread (make-thread (lambda () (f x))))) (if (= 0 pid)
(thread-start! thread) (begin
(fork-map f (cdr xs)) (f (car xs))
(thread-join! thread)) (exit))
(begin))) (begin
(fork-map f (cdr xs))
(waitpid pid 0))))))
; fork-map is broken. The HTML files produced are empty ; fork-map is naive
; BUG: some files like chibi.show are broken
(map (define (main)
process (define CHIBI_MODULE_PATH (get-environment-variable "CHIBI_MODULE_PATH"))
(filter filename-filter (walk-directory "lib"))) (cond
((not CHIBI_MODULE_PATH) (begin
(display "USAGE: CHIBI_IGNORE_SYSTEM_PATH=1 CHIBI_MODULE_PATH=lib ./chibi-scheme tools/generate-docs.scm")
(newline)))
(else
(fork-map
process
(filter filename-filter (walk-directory CHIBI_MODULE_PATH))))))
(main)