From: Masamichi Hosoda <trueroad@trueroad.jp>
Date: Mon, 1 Jun 2015 13:12:49 +0000 (+0900)
Subject: Issue 4431 / 2: Add ly:system-with-shell for pipe and redirection handling
X-Git-Tag: release/2.19.22-1~47
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=c50743b786e68dfd298ffbe7ee2c01e794ac9fda;p=lilypond.git

Issue 4431 / 2: Add ly:system-with-shell for pipe and redirection handling

ly:system can't handle pipe and redirection.
This procedure can handle them by using shell.
It also works on MinGW by switching shell.
---

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index 2d03394134..26987cd099 100644
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -32,6 +32,30 @@
           ;; hmmm.  what's the best failure option?
           (throw 'ly-file-failed)))))
 
+;; ly:system can't handle pipe and redirection.
+;; This procedure can handle them by using shell.
+(define-public (ly:system-with-shell command)
+  (let ((s (if (eq? PLATFORM 'windows)
+               ;; MinGW (except Cygwin): Use COMSPEC (cmd.exe)
+               ;; FIXME: Command window is displayed briefly
+               (list (or (getenv "COMSPEC")
+                         "cmd.exe")
+                     "/c")
+               ;; POSIX (also Cygwin): Use /bin/sh
+               (list "/bin/sh"
+                     "-c")))
+        (c (list (if (eq? PLATFORM 'windows)
+                     ;; MinGW hack: Double quotes can not be used here.
+                     ;; So we remove them.
+                     ;; FIXME: The filename that contains space
+                     ;; can't be handled.
+                     (string-join (string-split command #\") "")
+                     ;; Other environments (also Cygwin):
+                     ;; Double quotes can be used. Pass through.
+                     command
+                     ))))
+    (ly:system (append s c))))
+
 (define-public (search-executable names)
   (define (helper path lst)
     (if (null? (cdr lst))