diff --git a/retropikzel/file-append.scm b/retropikzel/file-append.scm index 379146d..d19021a 100644 --- a/retropikzel/file-append.scm +++ b/retropikzel/file-append.scm @@ -1,19 +1,19 @@ (define-c-library libc '("stdio.h") #f ()) (define-c-procedure c-fopen libc 'fopen 'pointer '(pointer pointer)) -(define-c-procedure c-fputc libc 'fputc 'int '(int pointer)) +(define-c-procedure c-fwrite libc 'fwrite 'int '(pointer int int pointer)) (define-c-procedure c-fclose libc 'fclose 'int '(pointer)) (define mode-cbv (string->c-bytevector "a")) (define (with-append-to-file path thunk) (let* ((path-cbv (string->c-bytevector path)) - (file-cbv (c-fopen path-cbv mode-cbv))) - (string-for-each - (lambda (c) - (c-fputc (char->integer c) file-cbv)) - (parameterize ((current-output-port (open-output-string))) - (apply thunk '()) - (get-output-string (current-output-port)))) + (file-cbv (c-fopen path-cbv mode-cbv)) + (output (parameterize ((current-output-port (open-output-string))) + (apply thunk '()) + (get-output-string (current-output-port)))) + (output-cbv (string->c-bytevector output)) + (output-length (string-length output))) + (c-fwrite output-cbv 1 output-length file-cbv) (c-fclose file-cbv) - (c-bytevector-free path-cbv))) + (c-bytevector-free path-cbv output-cbv))) diff --git a/retropikzel/file-append/VERSION b/retropikzel/file-append/VERSION index 0c62199..0d91a54 100644 --- a/retropikzel/file-append/VERSION +++ b/retropikzel/file-append/VERSION @@ -1 +1 @@ -0.2.1 +0.3.0