diff --git a/lib/chibi/binary-record.sld b/lib/chibi/binary-record.sld index d15f4ebe..3e686c47 100644 --- a/lib/chibi/binary-record.sld +++ b/lib/chibi/binary-record.sld @@ -1,11 +1,21 @@ (define-library (chibi binary-record) (import (scheme base) - (srfi 1) (srfi 9) - (chibi io) (chibi string) - (only (chibi) identifier? er-macro-transformer)) + (srfi 1) + (chibi string)) (cond-expand ((library (srfi 33)) (import (srfi 33))) (else (import (srfi 60)))) + (cond-expand + (chibi + (import (only (chibi) identifier? er-macro-transformer))) + (chicken + (import chicken) + (begin + (define identifier? symbol?))) + (sagittarius + (import (sagittarius)) + (begin + (define identifier? symbol?)))) (export define-binary-record-type) (include "binary-record.scm")) diff --git a/lib/chibi/filesystem.sld b/lib/chibi/filesystem.sld index e3603a82..d1b7a8bd 100644 --- a/lib/chibi/filesystem.sld +++ b/lib/chibi/filesystem.sld @@ -35,6 +35,90 @@ file-is-readable? file-is-writable? file-is-executable? lock/shared lock/exclusive lock/non-blocking lock/unlock chmod is-a-tty?) - (import (chibi) (chibi string)) - (include-shared "filesystem") + (import (chibi string)) + (cond-expand + (chibi + (import (chibi)) + (include-shared "filesystem")) + (chicken + (import (scheme base) (library) (posix)) + (begin + (define file-status file-stat) + (define (file-link-status x) (file-stat x #t)) + (define (stat-dev x) (vector-ref x 9)) + (define (stat-ino x) (vector-ref x 0)) + (define (stat-mode x) (vector-ref x 1)) + (define (stat-nlinks x) (vector-ref x 2)) + (define (stat-uid x) (vector-ref x 3)) + (define (stat-gid x) (vector-ref x 4)) + (define (stat-rdev x) (vector-ref x 10)) + (define (stat-size x) (vector-ref x 5)) + (define (stat-blksize x) (vector-ref x 11)) + (define (stat-blocks x) (vector-ref x 12)) + (define (stat-atime x) (vector-ref x 6)) + (define (stat-mtime x) (vector-ref x 7)) + (define (stat-ctime x) (vector-ref x 8)) + (define duplicate-file-descriptor duplicate-fileno) + (define duplicate-file-descriptor-to duplicate-fileno) + (define close-file-descriptor file-close) + (define open-input-file-descriptor open-input-file*) + (define open-output-file-descriptor open-output-file*) + (define link-file file-link) + (define symbolic-link-file create-symbolic-link) + (define read-link read-symbolic-link) + (define open file-open) + (define open-pipe create-pipe) + (define make-fifo create-fifo) + (define file-regular? regular-file?) + (define file-directory? directory?) + (define file-character? character-device?) + (define file-block? block-device?) + (define file-fifo? fifo?) + (define file-link? symbolic-link?) + (define file-socket? socket?) + (define file-is-readable? file-read-access?) + (define file-is-writable? file-write-access?) + (define file-is-executable? file-execute-access?) + (define (get-file-descriptor-flags fileno) + (file-control fileno fcntl/getfd)) + (define (set-file-descriptor-flags! fileno x) + (file-control fileno fcntl/setfd x)) + (define (get-file-descriptor-status fileno) + (file-control fileno fcntl/getfl)) + (define (set-file-descriptor-status! fileno x) + (file-control fileno fcntl/setfl x)) + (define open/read-write open/rdwr) + (define open/create open/creat) + (define open/exclusive open/excl) + (define open/truncate open/trunc) + (define open/non-block open/nonblock) + (define chmod change-file-mode) + (define is-a-tty? terminal-port?) + )) + (sagittarius + (import (scheme base) (sagittarius)) + (begin + (define (file-status x) x) + (define file-link-status file-status) + (define-syntax define-unimplemented + (syntax-rules () + ((define-unimplemented def ...) + (define (def . x) (error "unimplemented" 'def)) ...))) + (define-unimplemented + stat-dev stat-ino stat-mode stat-nlinks stat-uid stat-gid + stat-rdev stat-blksize stat-blocks) + (define (stat-size x) (file-size-in-bytes x)) + (define (stat-atime x) (file-stat-atime x)) + (define (stat-mtime x) (file-stat-mtime x)) + (define (stat-ctime x) (file-stat-ctime x)) + (define file-is-readable? file-readable?) + (define file-is-writable? file-writable?) + (define file-is-executable? file-executable?) + (define file-link? file-symbolic-link?) + + (define-unimplemented + duplicate-file-descriptor duplicate-file-descriptor-to + close-file-descriptor open-input-file-descriptor + open-output-file-descriptor) + ))) (include "filesystem.scm")) diff --git a/lib/chibi/snow/fort.sld b/lib/chibi/snow/fort.sld index 470f9608..8ebefa05 100644 --- a/lib/chibi/snow/fort.sld +++ b/lib/chibi/snow/fort.sld @@ -15,7 +15,6 @@ (scheme file) (srfi 1) (srfi 18) - (srfi 33) (chibi snow package) (chibi bytevector) (chibi config) @@ -29,6 +28,11 @@ (chibi string) (chibi sxml) (chibi tar)) + (cond-expand + ((library (srfi 33)) + (import (srfi 33))) + (else + (import (srfi 60)))) (cond-expand (chibi (import (only (chibi ast) diff --git a/lib/chibi/snow/interface.sld b/lib/chibi/snow/interface.sld index 88baf582..0be229d5 100644 --- a/lib/chibi/snow/interface.sld +++ b/lib/chibi/snow/interface.sld @@ -4,6 +4,54 @@ restore-history save-history) (import (scheme base) (scheme char) (scheme read) (scheme write) (scheme file) (scheme process-context) (srfi 1) - (chibi config) (chibi filesystem) (chibi pathname) - (chibi show) (chibi stty) (chibi term edit-line)) + (chibi config) (chibi pathname) (chibi show)) + (cond-expand + (chibi + (import (chibi filesystem) (chibi stty))) + (chicken + (import posix stty) + (begin + (define (create-directory* dir) (create-directory dir #t)) + (define (edit-line )))) + (sagittarius + (import (only (sagittarius) create-directory) + (chibi string)) + (begin + (define (create-directory* dir . o) + (let ((mode (if (pair? o) (car o) #o755))) + (or (file-directory? dir) + (create-directory dir mode) + (let* ((start (string-cursor-start dir)) + (slash + (string-find-right dir #\/ start + (string-skip-right dir #\/)))) + (and (string-cursor>? slash start) + (let ((parent (substring-cursor dir start slash))) + (and (not (equal? parent dir)) + (not (file-exists? parent)) + (create-directory* parent mode) + (create-directory dir mode)))))))) + (define (with-stty spec thunk) + (thunk))))) + (cond-expand + (chibi + (import (chibi term edit-line))) + (else + (begin + (define (get-key ls key . o) + (let ((x (memq key ls))) + (if (and x (pair? (cdr x))) (cadr x) (and (pair? o) (car o))))) + (define (edit-line . args) + (let ((in (if (and (pair? args) (input-port? (car args))) + (car args) + (current-input-port))) + (out (if (and (eq? in (car args)) + (pair? (cdr args)) + (output-port? (cadr args))) + (cadr args) + (current-output-port))) + (prompter (get-key args 'prompt: "> "))) + (display (if (procedure? prompter) (prompter) prompter) out) + (flush-output-port out) + (read-line in)))))) (include "interface.scm")) diff --git a/lib/chibi/snow/package.sld b/lib/chibi/snow/package.sld index 38ad66f7..91045800 100644 --- a/lib/chibi/snow/package.sld +++ b/lib/chibi/snow/package.sld @@ -34,7 +34,6 @@ (chibi crypto md5) (chibi crypto rsa) (chibi crypto sha2) - (chibi filesystem) (chibi io) (chibi pathname) (chibi regexp) diff --git a/lib/chibi/tar.sld b/lib/chibi/tar.sld index d5693664..4c335ed9 100644 --- a/lib/chibi/tar.sld +++ b/lib/chibi/tar.sld @@ -1,8 +1,14 @@ (define-library (chibi tar) - (import (scheme base) (scheme file) (scheme time) (srfi 1) (srfi 33) - (chibi string) (chibi binary-record) - (chibi pathname) (chibi filesystem) (chibi system)) + (import (scheme base) (scheme file) (scheme time) (srfi 1) + (chibi string) (chibi binary-record) (chibi pathname) + (chibi filesystem) + (chibi system)) + (cond-expand + ((library (srfi 33)) + (import (srfi 33))) + (else + (import (srfi 60)))) (export ;; basic tar make-tar tar? read-tar write-tar