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.dllAnd 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))
hey Ian, I’m interested in the same things right now.
You should put up a contact page in the about so people could easily
contact you 🙂
I’m getting into scheme right now. I’m checking out DrScheme, but I would really
like a scheme that has access to the ATL and GDI. Do you know of one that fits
the bill?