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

[lilypond.git] / scm / backend-library.scm

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index a8899e83f1b28023151212b57c503258fbb79c44..712033849cc9cd0ab353ccb646120954a99ce316 100644 (file)
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2005--2014 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 2005--2015 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -82,6 +82,7 @@
                    "-dNOPAUSE"
                    "-dBATCH"
                    "-r1200"
+                   (if (ly:bigpdfs) "-dSubsetFonts=false")
                    "-sDEVICE=pdfwrite"
                    (string-append "-sOutputFile="
                                   (string-join
@@ -110,6 +111,59 @@
                     #: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
+                          ;; MINGW hack: TMP / TEMP may include
+                          ;; unusable characters (Unicode etc.).
+                          ((eq? PLATFORM 'windows) "./tmp-")
+                          ;; Cygwin can handle any characters
+                          ;; including Unicode.
+                          ((eq? PLATFORM 'cygwin) (string-append
+                                                   (or (getenv "TMP")
+                                                       (getenv "TEMP"))
+                                                   "/"))
+                          ;; Other platforms (POSIX platforms)
+                          ;; use TMPDIR or /tmp.
+                          (else (string-append
+                                 (or (getenv "TMPDIR")
+                                     "/tmp")
+                                 "/")))
+                          "lilypond-XXXXXX"))
+         (port-tmp (mkstemp! tmpl)))
+    (if (eq? PLATFORM 'windows)
+        ;; MINGW hack: MinGW Guile's mkstemp! is broken.
+        ;; It creates a file by the text mode instead of the binary mode.
+        ;; (It is fixed from Guile 2.0.9.)
+        ;; We need the binary mode for embeddings CFFs.
+        ;; So, we re-open the same file by the binary mode.
+        (let* ((filename (port-filename port-tmp))
+               (port (open-file filename "r+b")))
+          (close port-tmp)
+          port)
+        ;; Cygwin and other platforms:
+        ;; Pass through the return value of mkstemp!
+        port-tmp)))
+
 (define-public (postprocess-output paper-book module filename formats)
   (let* ((completed (completize-formats formats))
          (base (dir-basename filename ".ps" ".eps"))