From 042f66eec99633a5d1d60e8fc2daa15cc433666a Mon Sep 17 00:00:00 2001 From: Masamichi Hosoda Date: Sat, 9 May 2015 22:29:14 +0900 Subject: [PATCH] Issue 4374 / 3: Add copy-binary-file procedure Procedure "copy-binary-file" is to copy a binary file correctly on any platforms. --- scm/backend-library.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/scm/backend-library.scm b/scm/backend-library.scm index ffb9685268..712033849c 100644 --- 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 -- 2.39.5