Add mouth library

This commit is contained in:
retropikzel 2026-02-12 06:29:53 +02:00
parent 03fc4b05fc
commit b3b07a0566
2 changed files with 34 additions and 0 deletions

26
retropikzel/mouth.scm Normal file
View File

@ -0,0 +1,26 @@
(define bite-size 4000)
(define (slurp file-path)
(when (not (string? file-path)) (error "slurp: file-path must be string" file-path))
(when (not (file-exists? file-path)) (error "slurp: file-path does not exist" file-path))
(letrec ((looper (lambda (str result)
(if (eof-object? str)
result
(looper (read-string bite-size) (string-append result str))))))
(with-input-from-file file-path (lambda () (looper (read-string bite-size) "")))))
(define (spit file-path text . append?)
(when (not (string? file-path)) (error "spit: file-path must be string" file-path))
(when (not (string? text)) (error "spit: text must be string" text))
(when (and (not (null? append?))
(not (boolean? (car append?))))
(error "spit: append? must be boolean" (car append?)))
(let ((content (if (and (not (null? append?)) (equal? (car append?) #t))
(slurp file-path)
"")))
(when (file-exists? file-path) (delete-file file-path))
(with-output-to-file
file-path
(lambda ()
(display content)
(display text)))))

8
retropikzel/mouth.sld Normal file
View File

@ -0,0 +1,8 @@
(define-library
(retropikzel mouth)
(import (scheme base)
(scheme write)
(scheme file))
(export slurp
spit)
(include "mouth.scm"))