I was unable to find any mention of a function for copying files in the Chicken documentation. However, the Chicken source does have a copy-file function in chicken-setup.scm. It is somewhat brittle as it uses the shell, relying on the fact that you are running the function from the same shell you used to build Chicken.
$ find . | egrep '.scm$' | xargs grep 'copy-file'
(define *windows-shell* (memq *windows* '(msvc mingw32)))
(define *copy-command* (if *windows-shell* 'copy "cp -r"))
(define (copy-file from to)
(let ((from (if (pair? from) (car from) from))
(to (if (pair? from) (make-pathname to (cadr from)) to)) )
(ensure-directory to)
(run (,*copy-command* ,(quotewrap from) ,(quotewrap to)) ) ) )
A solution with the Win32 function CopyFile would be more robust but would probably need some work to do a recursive copy. I don’t need the recursive functionality and fortunately, it is straight-forward to wrap using Chicken’s foreign function interface. I created a file called win32_lib.impl to keep all the syntax highlighting working.
#include "Windows.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
char* w32_error_message()
{
char* buffer;
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER
| FORMAT_MESSAGE_FROM_SYSTEM
| FORMAT_MESSAGE_IGNORE_INSERTS,
NULL,
GetLastError(),
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
(LPTSTR) &buffer,
0, NULL);
buffer[strlen(buffer) - 2] = '';
return buffer;
}
int w32_copy_file(const char* file1,
const char* file2,
int fail_if_exists)
{
return CopyFile(file1, file2, fail_if_exists);
}
</pre>
The wrapper from Chicken is trivial:
(define-extension win32_lib)
#>
#include "win32_lib.impl"
<#
(define w32-error-message
(foreign-lambda c-string* "w32_error_message"))
(define w32-copy-file
(foreign-lambda int "w32_copy_file" c-string c-string int))
The makefile takes care of making a .dll so we can load it into csi (the Chicken REPL) for testing purposes.
all: win32_lib.dll prog.exe
prog.exe: main.scm win32_lib.scm win32_lib.impl
csc -c main.scm
csc -c win32_lib.scm
csc -o prog.exe main.o win32_lib.o
win32_lib.dll: win32_lib.scm
csc win32_lib.scm -dynamic -dll
clean:
rm *.o prog.exe win32_lib.dll
And finally the test harness:
(declare (uses win32_lib))
(define args (cdr (argv)))
(display args)
(newline)
(define (wrap-copy-file file1 file2)
(let ((r (w32-copy-file (car args) (cadr args) 1)))
(if (= r 0)
(printf "[~a]~n" (w32-error-message))
(printf "Success!~n"))))
(wrap-copy-file (car args) (cadr args))
