diff options
Diffstat (limited to 'ioext.c')
| -rwxr-xr-x[-rw-r--r--] | ioext.c | 64 |
1 files changed, 61 insertions, 3 deletions
@@ -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\ |