~ chicken-core (chicken-5) c3c499cd7d8445e7b40b81501307dbc324174cd5
commit c3c499cd7d8445e7b40b81501307dbc324174cd5
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Jan 21 09:22:36 2010 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Jan 21 09:22:36 2010 +0100
added setter for file-modification-time
diff --git a/manual/Unit posix b/manual/Unit posix
index 55993bbb..1ac12793 100644
--- a/manual/Unit posix
+++ b/manual/Unit posix
@@ -373,10 +373,14 @@ this port. Otherwise an error is signaled.
<procedure>(file-access-time FILE)</procedure><br>
<procedure>(file-change-time FILE)</procedure><br>
<procedure>(file-modification-time FILE)</procedure>
+<procedure>(set! (file-modification-time FILE) SECONDS)</procedure>
Returns time (in seconds) of the last access, modification or change of {{FILE}}. {{FILE}}
may be a filename or a file-descriptor. If the file does not exist,
-an error is signaled.
+an error is signaled.
+
+{{(set! (file-modification-time FILE) SECONDS)}} sets the access- and modification
+time of {{FILE}} to {{SECONDS}}.
==== file-stat
diff --git a/posixunix.scm b/posixunix.scm
index e51202bf..3bbb27f8 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -54,6 +54,7 @@ static C_TLS int C_wait_status;
#include <fcntl.h>
#include <dirent.h>
#include <pwd.h>
+#include <sys/utime.h>
#if defined(__sun__) && defined(__svr4__)
# include <sys/tty.h>
@@ -479,6 +480,14 @@ static int get_tty_size(int p, int *rows, int *cols)
}
#endif
+static int set_file_mtime(char *filename, C_word tm)
+{
+ struct _utimbuf tb;
+
+ tb.actime = tb.modtime = C_num_to_int(tm);
+ return _utime(filename, &tb);
+}
+
EOF
) )
@@ -780,7 +789,20 @@ EOF
_stat_st_blksize _stat_st_blocks) )
(define (file-size f) (##sys#stat f #f 'file-size) _stat_st_size)
-(define (file-modification-time f) (##sys#stat f #f 'file-modification-time) _stat_st_mtime)
+
+(define file-modification-time
+ (getter-with-setter
+ (lambda (f)
+ (##sys#stat f #f 'file-modification-time) _stat_st_mtime)
+ (lambda (f t)
+ (##sys#check-number t 'set-file-modification-time)
+ (let ((r ((foreign-lambda int "set_file_mtime" c-string scheme-object)
+ (##sys#expand-home-path file) t)))
+ (when (fx< r 0)
+ (posix-error
+ #:file-error 'set-file-modification-time
+ "cannot set file modification-time" f t))))))
+
(define (file-access-time f) (##sys#stat f #f 'file-access-time) _stat_st_atime)
(define (file-change-time f) (##sys#stat f #f 'file-change-time) _stat_st_ctime)
(define (file-owner f) (##sys#stat f #f 'file-owner) _stat_st_uid)
diff --git a/posixwin.scm b/posixwin.scm
index 7e92b08c..d61950f9 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -103,6 +103,7 @@ int C_not_implemented() { return -1; }
#include <sys/stat.h>
#include <fcntl.h>
#include <direct.h>
+#include <utime.h>
#include <time.h>
@@ -913,6 +914,14 @@ C_process(const char * app, const char * cmdlin, const char ** env,
return success;
}
+
+static int set_file_mtime(char *filename, C_word tm)
+{
+ struct _utimbuf tb;
+
+ tb.actime = tb.modtime = C_num_to_int(tm);
+ return _utime(filename, &tb);
+}
EOF
) )
@@ -1093,7 +1102,20 @@ EOF
0 0 0 0) )
(define (file-size f) (##sys#stat f) _stat_st_size)
-(define (file-modification-time f) (##sys#stat f) _stat_st_mtime)
+
+(define file-modification-time
+ (getter-with-setter
+ (lambda (f)
+ (##sys#stat f) _stat_st_mtime)
+ (lambda (f t)
+ (##sys#check-number t 'set-file-modification-time)
+ (let ((r ((foreign-lambda int "set_file_mtime" c-string scheme-object)
+ (##sys#expand-home-path f) t)))
+ (when (fx< r 0)
+ (posix-error
+ #:file-error 'set-file-modification-time
+ "cannot set file modification-time" f t))))))
+
(define (file-access-time f) (##sys#stat f) _stat_st_atime)
(define (file-change-time f) (##sys#stat f) _stat_st_ctime)
(define (file-owner f) (##sys#stat f) _stat_st_uid)
Trap