(derived_mark): call

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

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index 010bff09dc4e42763d2d74dadecebc47c236b26d..5c94dba6c0ea46817775b32b12927c5ab826419f 100644 (file)
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -22,7 +22,10 @@
     (if (> status 0)
        (begin
          (format (current-error-port) (_ "`~a' failed (~a)") command status)
-         (newline (current-error-port))))))
+         (newline (current-error-port))
+         
+         ;; hmmm.  what's the best failure option? 
+         (throw 'ly-file-failed)))))
 
 (define-public (sanitize-command-option str)
   (string-append
@@ -31,12 +34,8 @@
    "\""))
 
 (define-public (postscript->pdf papersizename name)
-  (let* ((cmd (string-append "ps2pdf "
-                            (string-append
-                             " -sPAPERSIZE="
-                             (sanitize-command-option papersizename)
-                             " "
-                             name)))
+  (let* ((cmd (format #f "ps2pdf -sPAPERSIZE=~a '~a'"
+                     (sanitize-command-option papersizename) name))
         (pdf-name (string-append (basename name ".ps") ".pdf" )))
 
     (if (access? pdf-name W_OK)
@@ -45,17 +44,23 @@
     (format (current-error-port) (_ "Converting to `~a'...") pdf-name)
     (ly:system cmd)))
 
-(define-public (postscript->png resolution name)
-  (let ((cmd (string-append
-             "ps2png --resolution="
-             (if (number? resolution)
-                 (number->string resolution)
-                 "90 ")
-             (if (ly:get-option 'verbose)
-                 " --verbose "
-                 " ")
-             name)))
-
+(define-public (postscript->png resolution papersizename name)
+  (let* ((prefix (ly:effective-prefix))
+        ;; FIXME: should scripts/ps2png.py be installed in PREFIX?
+        (ps2png-source (if prefix
+                          (format "~a/scripts/ps2png.py" prefix)
+                          "ps2png"))
+        (cmd (format #f
+                     "~a --resolution=~S --papersize=~a~a '~a'"
+                     (if (file-exists? ps2png-source)
+                         (format "python ~a" ps2png-source)
+                         "ps2png")
+                     resolution
+                     (sanitize-command-option papersizename)
+                     (if (ly:get-option 'verbose) " --verbose " "")
+                     name)))
+    ;; Do not try to guess the name of the png file
+    (format (current-error-port) (_ "Converting to `~a'...") (format "~a.png" name))
     (ly:system cmd)))
 
 (define-public (postprocess-output paper-book module filename formats)
@@ -80,5 +85,32 @@
      (if (member x formats) (set! new-fmts (cons x new-fmts))))
    '("tex" "dvi" "ps" "pdf" "png"))
 
-  new-fmts)
+  (reverse new-fmts))
+
+(define (header-to-file file-name key value)
+  (set! key (symbol->string key))
+  (if (not (equal? "-" file-name))
+      (set! file-name (string-append file-name "." key)))
+  (format (current-error-port)
+         (_ "Writing header field `~a' to `~a'...")
+         key
+         (if (equal? "-" file-name) "<stdout>" file-name))
+  (if (equal? file-name "-")
+      (display value)
+      (display value (open-file file-name "w")))
+  (newline (current-error-port))
+  "")
+
+(define-public (output-scopes scopes fields basename)
+  (define (output-scope scope)
+    (apply
+     string-append
+     (module-map
+      (lambda (sym var)
+       (let ((val (if (variable-bound? var) (variable-ref var) "")))
+         (if (and (memq sym fields) (string? val))
+             (header-to-file basename sym val))
+         ""))
+      scope)))
+  (apply string-append (map output-scope scopes)))