Issue 4374 / 3: Add copy-binary-file procedure

Procedure "copy-binary-file" is
to copy a binary file correctly on any platforms.

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index ffb96852687c5690643aaa85f570879a52db8ba0..712033849cc9cd0ab353ccb646120954a99ce316 100644 (file)
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -111,6 +111,25 @@
                     #:pixmap-format (ly:get-option 'pixmap-format))
     (ly:progress "\n")))
 
+(define-public (copy-binary-file from-name to-name)
+  (if (eq? PLATFORM 'windows)
+      ;; MINGW hack: MinGW Guile's copy-file is broken.
+      ;; It opens files by the text mode instead of the binary mode.
+      ;; (It is fixed from Guile 2.0.9.)
+      ;; By the text mode, copied binary files are broken.
+      ;; So, we open files by the binary mode and copy by ourselves.
+      (let ((port-from (open-file from-name "rb"))
+            (port-to (open-file to-name "wb")))
+        (let loop((c (read-char port-from)))
+          (if (eof-object? c)
+              (begin (close port-from)
+                     (close port-to))
+              (begin (write-char c port-to)
+                     (loop (read-char port-from))))))
+      ;; Cygwin and other platforms:
+      ;; Pass through to copy-file
+      (copy-file from-name to-name)))
+
 (define-public (make-tmpfile)
   (let* ((tmpl
           (string-append (cond