Retropikzel
/
foreign-c-srfis
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Improving file-info related functionality

This commit is contained in:
retropikzel 2026-07-01 21:11:06 +03:00
parent be4a61a865
commit 32ab290142
3 changed files with 60 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
srfi/170.scm
View File

@ -117,22 +117,22 @@
(random-to 128))))))))) (random-to 128)))))))))
(looper "" (random-to 128)))) (looper "" (random-to 128))))
(define-record-type file-info-record (define-record-type <file-info>
(make-file-info-record device (make-file-info device
inode inode
mode mode
nlinks nlinks
uid uid
gid gid
rdev rdev
size size
blksize blksize
blocks blocks
atime atime
mtime mtime
ctime ctime
fname/port fname/port
follow?) follow?)
file-info? file-info?
(device file-info:device) (device file-info:device)
(inode file-info:inode) (inode file-info:inode)
@ -156,9 +156,8 @@
(cond ((> handle 0) (c-close handle) #f) (cond ((> handle 0) (c-close handle) #f)
(else #t)))) (else #t))))
(define-c-struct-type timespec-struct '((tv_sec long) (tv_nsec long)))
(define-c-struct-type stat-struct (define-c-struct-type stat-struct
'((st_dev int) `((st_dev int)
(st_ino uint) (st_ino uint)
(st_mode uint) (st_mode uint)
(st_nlink int) (st_nlink int)
@ -168,9 +167,12 @@
(st_size int) (st_size int)
(st_blksize int) (st_blksize int)
(st_blocks int) (st_blocks int)
(st_atim timespec-struct) (st_atim-tv_sec long)
(st_mtim timespec-struct) (st_atim-tv_nsec long)
(st_ctim timespec-struct))) (st_mtim-tv_sec long)
(st_mtim-tv_nsec long)
(st_ctim-tv_sec long)
(st_ctim-tv_nsec long)))
;;> The file-info procedure returns a file-info record containing useful ;;> The file-info procedure returns a file-info record containing useful
;;> information about a file. If the follow? flag is true the procedure will ;;> information about a file. If the follow? flag is true the procedure will
;;> follow symlinks and report on the file to which they refer. If follow? is ;;> follow symlinks and report on the file to which they refer. If follow? is
@ -192,21 +194,28 @@
(c-bytevector-free stat-pointer) (c-bytevector-free stat-pointer)
(c-bytevector-free error-pointer) (c-bytevector-free error-pointer)
(error error-message fname/port)) (error error-message fname/port))
(make-file-info-record #f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 0) (native-endianness)) (make-file-info
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 1) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_dev)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 2) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_ino)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 3) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_mode)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 4) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_nlink)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 5) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_uid)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 6) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_gid)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 7) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_rdev)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 8) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_size)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 9) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_blksize)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 10) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_blocks)
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 11) (native-endianness)) (make-time time-utc
#f ;(c-bytevector-u64-ref stat-pointer (* (c-type-size 'uint64) 12) (native-endianness)) (c-bytevector-ref stat-pointer stat-struct 'st_atim-tv_sec)
fname/port (c-bytevector-ref stat-pointer stat-struct 'st_atim-tv_nsec))
follow?))) (make-time time-utc
(c-bytevector-ref stat-pointer stat-struct 'st_mtim-tv_sec)
(c-bytevector-ref stat-pointer stat-struct 'st_mtim-tv_nsec))
(make-time time-utc
(c-bytevector-ref stat-pointer stat-struct 'st_ctim-tv_sec)
(c-bytevector-ref stat-pointer stat-struct 'st_ctim-tv_nsec))
fname/port
follow?)))
;;> The permission-bits for create-directory default to #o775 but are masked ;;> The permission-bits for create-directory default to #o775 but are masked
;;> by the current umask. ;;> by the current umask.
(define create-directory (define create-directory

26
srfi/170.sld
View File

@ -24,19 +24,19 @@
truncate-file truncate-file
file-info file-info
file-info? file-info?
;file-info:device file-info:device
;file-info:inode file-info:inode
;file-info:mode file-info:mode
;file-info:nlinks file-info:nlinks
;file-info:uid file-info:uid
;file-info:gid file-info:gid
;file-info:rdev file-info:rdev
;file-info:size file-info:size
;file-info:blksize file-info:blksize
;file-info:blocks file-info:blocks
;file-info:atime file-info:atime
;file-info:mtime file-info:mtime
;file-info:ctime file-info:ctime
file-info-directory? file-info-directory?
;file-info-fifo? ;file-info-fifo?
;file-info-symlink? ;file-info-symlink?

2
srfi/170/test.scm
View File

@ -11,6 +11,8 @@
(test-assert (> niceness 0)) (test-assert (> niceness 0))
(define fi (file-info "/tmp" #f)) (define fi (file-info "/tmp" #f))
(write fi)
(newline)
(write (file-info-directory? fi)) (write (file-info-directory? fi))
(newline) (newline)