Doc: IR - Improve grob 'size' description

[lilypond.git] / scm / ps-to-png.scm

diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index 20569ca35844b8cd57e780cc20a335ae1c20349a..f5d40d0c5ceefdcd94cbcf4e39cc126c0b57a57b 100644 (file)
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -33,25 +33,51 @@
 (define-public (gulp-file file-name . max-size)
   (ly:gulp-file file-name (if (pair? max-size) (car max-size))))
 
+(define (search-pngtopam)
+  (search-executable
+   (if (eq? PLATFORM 'windows)
+       '("pngtopam.exe" "pngtopnm.exe")
+       '("pngtopam" "pngtopnm"))))
+
+(define (search-pamscale)
+  (search-executable
+   (if (eq? PLATFORM 'windows)
+       '("pamscale.exe" "pnmscale.exe")
+       '("pamscale" "pnmscale"))))
+
+(define (search-pnmtopng)
+  (search-executable
+   (if (eq? PLATFORM 'windows)
+       '("pnmtopng.exe")
+       '("pnmtopng"))))
+
 (define (scale-down-image factor file)
-  (let* ((old (string-append file ".old"))
+  (let* ((port-tmp1 (make-tmpfile))
+         (tmp1-name (port-filename port-tmp1))
+         (port-tmp2 (make-tmpfile))
+         (tmp2-name (port-filename port-tmp2))
          ;; Netpbm commands (pngtopnm, pnmscale, pnmtopng)
          ;; outputs only standard output instead of a file.
          ;; So we need pipe and redirection.
          ;; However, ly:system can't handle them.
-         ;; Therefore, we use /bin/sh for handling them.
-         ;; FIXME: MinGW (except Cygwin) doesn't have /bin/sh.
+         ;; Therefore, we use ly:system-with-shell.
          (cmd
-          (list
-           "/bin/sh"
-           "-c"
-           (ly:format
-            "pngtopnm \"~a\" | pnmscale -reduce ~a | pnmtopng -compression 9 > \"~a\""
-            old factor file))))
-
-    (rename-file file old)
-    (ly:system cmd)
-    (delete-file old)))
+          (ly:format
+           "~a \"~a\" | ~a -reduce ~a | ~a -compression 9 > \"~a\""
+           (search-pngtopam) tmp1-name
+           (search-pamscale) factor
+           (search-pnmtopng)
+           tmp2-name)))
+
+    (ly:debug (_ "Copying `~a' to `~a'...") file tmp1-name)
+    (copy-binary-file file tmp1-name)
+    (ly:system-with-shell cmd)
+    (ly:debug (_ "Copying `~a' to `~a'...") tmp2-name file)
+    (copy-binary-file tmp2-name file)
+    (ly:debug (_ "Deleting `~a'...") tmp1-name)
+    (delete-file tmp1-name)
+    (ly:debug (_ "Deleting `~a'...") tmp2-name)
+    (delete-file tmp2-name)))
 
 (define-public (ps-page-count ps-name)
   (let* ((byte-count 10240)