minor parmesan fixes

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

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index 5258bcf516249978a06d25166fa46b6b50964dc4..c09e7572d5d3d0a77f687ca37c71e2c6e6c0bd3a 100644 (file)
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -8,7 +8,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;; backend helpers.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;; backend helpers.
 

-(define-public (ly:system command)
+(define-public (ly:system command . rest)

   (let* ((status 0)
         (dev-null "/dev/null")
         (silenced (if (or (ly:get-option 'verbose)
   (let* ((status 0)
         (dev-null "/dev/null")
         (silenced (if (or (ly:get-option 'verbose)


@@ -17,8 +17,12 @@
                       (format #f "~a > ~a 2>&1 " command dev-null))))
     (if (ly:get-option 'verbose)
        (ly:message (_ "Invoking `~a'...") command))
                       (format #f "~a > ~a 2>&1 " command dev-null))))
     (if (ly:get-option 'verbose)
        (ly:message (_ "Invoking `~a'...") command))

-    
-    (set! status (system silenced))
+
+    (set! status
+         (if (pair? rest)
+             (system-with-env silenced (car rest))
+             (system silenced)))
+       

     (if (> status 0)
        (begin
          (ly:message (_ "`~a' failed (~a)") command status)
     (if (> status 0)
        (begin
          (ly:message (_ "`~a' failed (~a)") command status)


@@ -26,6 +30,22 @@
          ;; hmmm.  what's the best failure option? 
          (throw 'ly-file-failed)))))
 
          ;; hmmm.  what's the best failure option? 
          (throw 'ly-file-failed)))))
 

+(define-public (system-with-env cmd env)
+
+  "Execute CMD in fork, with ENV (a list of strings) as the environment"
+  (let*
+      ;; laziness: should use execle?
+      
+      ((pid (primitive-fork)))
+    (if (= 0 pid)
+       ;; child
+       (begin
+         (environ env)
+         (system cmd))
+       
+       ;; parent
+       (cdr (waitpid pid)))))
+

 (define-public (sanitize-command-option str)
   "Kill dubious shell quoting"
   
 (define-public (sanitize-command-option str)
   "Kill dubious shell quoting"
   


@@ -94,8 +114,7 @@
 
     (ly:message (_ "Converting to `~a'...") pdf-name)
     (ly:progress "\n")
 
     (ly:message (_ "Converting to `~a'...") pdf-name)
     (ly:progress "\n")

-    (ly:system cmd)
-    ))
+    (ly:system cmd)))

 
 (use-modules (scm ps-to-png))
 
 
 (use-modules (scm ps-to-png))
 


@@ -104,58 +123,40 @@
     ;; GS produces PNG files like BASE-page%d.png.
     ;;(ly:message (_ "Converting to `~a'...")
     ;;     (string-append (basename name ".ps") "-page1.png" )))
     ;; GS produces PNG files like BASE-page%d.png.
     ;;(ly:message (_ "Converting to `~a'...")
     ;;     (string-append (basename name ".ps") "-page1.png" )))

-  (let ((verbose (ly:get-option 'verbose))
-       (rename-page-1 #f))
-
+  (let* ((verbose (ly:get-option 'verbose))
+        (rename-page-1 #f))

     (ly:message (_ "Converting to ~a...") "PNG")
     (ly:message (_ "Converting to ~a...") "PNG")

-

     (make-ps-images name
                    #:resolution resolution
     (make-ps-images name
                    #:resolution resolution

-                   #:page-width  paper-width
+                   #:page-width paper-width

                    #:page-height paper-height
                    #:rename-page-1 rename-page-1
                    #:be-verbose verbose
                    #:anti-alias-factor (ly:get-option 'anti-alias-factor)
                    #:page-height paper-height
                    #:rename-page-1 rename-page-1
                    #:be-verbose verbose
                    #:anti-alias-factor (ly:get-option 'anti-alias-factor)

-                   #:pixmap-format (ly:get-option 'pixmap-format) 
-                   )
-    
+                   #:pixmap-format (ly:get-option 'pixmap-format))

     (ly:progress "\n")))
 
 (define-public (postprocess-output paper-book module filename formats)
     (ly:progress "\n")))
 
 (define-public (postprocess-output paper-book module filename formats)

-  (let*
-      ((completed (completize-formats formats))
-       (base (string-regexp-substitute "\\.[a-z]+$" "" filename))
-       (intermediate (remove
-                     (lambda (x)
-                       (member x formats)) 
-                     completed)))
-
-    (for-each
-     (lambda (f)
-       ((eval (string->symbol (format "convert-to-~a" f)) module)
-       paper-book filename))
-     completed)
-
+  (let* ((completed (completize-formats formats))
+        (base (string-regexp-substitute "\\.[a-z]+$" "" filename))
+        (intermediate (remove (lambda (x) (member x formats)) completed)))
+    
+    (for-each (lambda (f)
+               ((eval (string->symbol (format "convert-to-~a" f))
+                      module) paper-book filename)) completed)

     (if (ly:get-option 'delete-intermediate-files)
     (if (ly:get-option 'delete-intermediate-files)

-       (for-each
-        (lambda (f)
-          (delete-file (string-append base "." f)))
-        intermediate))
-    ))
+       (for-each (lambda (f)
+                   (delete-file (string-append base "." f))) intermediate))))

 
 (define-public (completize-formats formats)
   (define new-fmts '())
 
 (define-public (completize-formats formats)
   (define new-fmts '())

-

   (if (member "png" formats)
       (set! formats (cons "ps" formats)))
   (if (member "pdf" formats)
       (set! formats (cons "ps" formats)))
   (if (member "png" formats)
       (set! formats (cons "ps" formats)))
   (if (member "pdf" formats)
       (set! formats (cons "ps" formats)))

-
-  (for-each
-   (lambda (x)
-     (if (member x formats) (set! new-fmts (cons x new-fmts))))
-   '("tex" "dvi" "ps" "pdf" "png"))
-
+  (for-each (lambda (x)
+             (if (member x formats) (set! new-fmts (cons x new-fmts))))
+           '("tex" "dvi" "ps" "pdf" "png"))

   (uniq-list (reverse new-fmts)))
 
 (define (header-to-file file-name key value)
   (uniq-list (reverse new-fmts)))
 
 (define (header-to-file file-name key value)