aboutsummaryrefslogtreecommitdiffstats
path: root/ioext.c
diff options
context:
space:
mode:
Diffstat (limited to 'ioext.c')
-rwxr-xr-x[-rw-r--r--]ioext.c64
1 files changed, 61 insertions, 3 deletions
diff --git a/ioext.c b/ioext.c
index 2cc4dc0..abc0fd2 100644..100755
--- a/ioext.c
+++ b/ioext.c
@@ -569,6 +569,54 @@ SCM ren_fil(oldname, newname)
return ans;
#endif
}
+static char s_copy_file[] = "copy-file";
+SCM scm_copy_file(oldname, newname)
+ SCM oldname, newname;
+{
+ ASRTER(NIMP(oldname) && STRINGP(oldname), oldname, ARG1, s_copy_file);
+ ASRTER(NIMP(newname) && STRINGP(newname), newname, ARG2, s_copy_file);
+ {
+ FILE* fin = fopen(CHARS(oldname), "rb");
+ FILE* fout;
+ unsigned char buff[1024];
+ int cnt, retval = BOOL_T;
+ if (!fin) return BOOL_F;
+ fout = fopen(CHARS(newname), "wb");
+ if (!fout) {fclose(fin); return BOOL_F;}
+ {
+#ifndef THINK_C
+# ifndef MCH_AMIGA
+# ifndef vms
+ int i;
+ struct stat stat_temp;
+ struct utimbuf utm_tmp;
+ SYSCALL(i = fstat(fileno(fin), &stat_temp););
+# endif
+# endif
+#endif
+ while ((cnt = fread(buff, 1, 1024, fin))) {
+ if ((cnt > 0) && (cnt != fwrite(buff, 1, cnt, fout))) retval = BOOL_F;
+ }
+ if (!feof(fin)) retval = BOOL_F;
+ fclose(fin);
+ fclose(fout);
+#ifndef THINK_C
+# ifndef MCH_AMIGA
+# ifndef vms
+ if (!i) {
+ utm_tmp.actime = stat_temp.st_atime;
+ utm_tmp.modtime = stat_temp.st_mtime;
+ SYSCALL(i = utime(CHARS(newname), &utm_tmp););
+ }
+ if (i) return BOOL_F;
+# endif
+# endif
+#endif
+ return retval;
+ }
+ }
+}
+
static char s_fileno[] = "fileno";
SCM l_fileno(port)
SCM port;
@@ -754,6 +802,7 @@ static iproc subr1os[] = {
static iproc subr2s[] = {
{s_ren_fil, ren_fil},
+ {s_copy_file, scm_copy_file},
#ifndef macintosh
{s_access, l_access},
#endif
@@ -859,9 +908,10 @@ void init_ioext()
scm_ldstr("\n\
(define (file-exists? path) (access path \"r\"))\n\
(define (make-directory path)\n\
- (define umsk (umask 18))\n\
- (umask umsk)\n\
- (mkdir path (logxor #o777 umsk)))\n\
+ (define umsk (umask #o022))\n\
+ (let ((success? (mkdir path (logxor #o777 umsk))))\n\
+ (umask umsk)\n\
+ success?))\n\
(define current-directory getcwd)\n\
(define (directory-for-each proc dirname . args)\n\
(define dir (opendir (if (symbol? dirname)\n\
@@ -884,6 +934,14 @@ void init_ioext()
(do ((filename (readdir dir) (readdir dir)))\n\
((not filename) (closedir dir))\n\
(and (selector filename) (proc filename))))))\n\
+(define (directory*-for-each proc path-glob)\n\
+ (define dir (pathname->vicinity path-glob))\n\
+ (let ((glob (substring path-glob\n\
+ (string-length dir)\n\
+ (string-length path-glob))))\n\
+ (directory-for-each proc\n\
+ (if (equal? \"\" dir) \".\" dir)\n\
+ glob)))\n\
(define (system->line command . tmp)\n\
(require 'filename)\n\
(cond ((null? tmp)\n\