*** empty log message ***

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

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index 431c7b48a616423188beb1d196fbc1800f211727..74e53693594a9c836aed76fbd10a5768a2c3428a 100644 (file)
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -10,20 +10,19 @@
 
 (define-public (ly:system command)
   (let* ((status 0)
-        (silenced
-         (string-append command (if (ly:get-option 'verbose)
-                                    ""
-                                    " > /dev/null 2>&1 "))))
-
+        (dev-null "/dev/null")
+        (silenced (if (or (ly:get-option 'verbose)
+                          (not (access? dev-null W_OK)))
+                      command
+                      (format #f "~a > ~a 2>&1 " command dev-null))))
     (if (ly:get-option 'verbose)
-       (format (current-error-port) (_ "Invoking `~a'...") command))
+       (ly:message (_ "Invoking `~a'...") command))
     
     (set! status (system silenced))
     (if (> status 0)
        (begin
-         (format (current-error-port) (_ "`~a' failed (~a)") command status)
-         (newline (current-error-port))
-         
+         (ly:message (_ "`~a' failed (~a)") command status)
+         (ly:progress "\n")
          ;; hmmm.  what's the best failure option? 
          (throw 'ly-file-failed)))))
 
@@ -34,40 +33,64 @@
    "\""))
 
 (define-public (postscript->pdf papersizename name)
-  (let* ((cmd (string-append "ps2pdf "
-                            (string-append
-                             " -sPAPERSIZE="
-                             (sanitize-command-option papersizename)
-                             " "
-                             name)))
-        (pdf-name (string-append (basename name ".ps") ".pdf" )))
+  (let* ((pdf-name (string-append (basename name ".ps") ".pdf" ))
+        (cmd (format #f
+                     "gs\
+ -dSAFER\
+ -dCompatibilityLevel=1.4 \
+ -sPAPERSIZE=~a\
+ -q\
+ -dNOPAUSE\
+ -dBATCH\
+ -sDEVICE=pdfwrite\
+ -sOutputFile=~S\
+ -c .setpdfwrite\
+ -f ~S\
+"
+                     (sanitize-command-option papersizename)
+                     pdf-name
+                     name)))
+    ;; The wrapper on windows cannot handle `=' signs,
+    ;; gs has a workaround with #.
+    (if (eq? PLATFORM 'windows)
+       (set! cmd (string-regex-substitute "=" "#" cmd)))
 
     (if (access? pdf-name W_OK)
        (delete-file pdf-name))
 
-    (format (current-error-port) (_ "Converting to `~a'...") pdf-name)
+    (ly:message (_ "Converting to `~a'...") pdf-name)
+    (ly:progress "\n")
     (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))
 
-    (ly:system cmd)))
+        ;; run the source, if  we are in the build-directory
+        (ps2png-source (if prefix
+                          (format "~a/scripts/lilypond-ps2png.py" prefix)
+                          "lilypond-ps2png"))
+        (cmd (format #f
+                     "~a --resolution=~S --papersize=~a~a ~S"
+                     (if (file-exists? ps2png-source)
+                         (format "python ~a" ps2png-source)
+                         "lilypond-ps2png")
+                     resolution
+                     (sanitize-command-option papersizename)
+                     (if (ly:get-option 'verbose) " --verbose " "")
+                     name)))
+    ;; Do not try to guess the name of the png file,
+    ;; GS produces PNG files like BASE-page%d.png.
+    ;;(ly:message (_ "Converting to `~a'...")
+    ;;     (string-append (basename name ".ps") "-page1.png" )))
+    (ly:message (_ "Converting to ~a...") "PNG")
+    (ly:system cmd)
+    (ly:progress "\n")))
 
 (define-public (postprocess-output paper-book module filename formats)
   (for-each
    (lambda (f)
-     ((eval (string->symbol (string-append "convert-to-" f))
-           module)
+     ((eval (string->symbol (string-append "convert-to-" f)) module)
       paper-book filename))
-   
    formats))
 
 (define-public (completize-formats formats)
@@ -83,5 +106,31 @@
      (if (member x formats) (set! new-fmts (cons x new-fmts))))
    '("tex" "dvi" "ps" "pdf" "png"))
 
-  new-fmts)
+  (uniq-list (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)))
+  (ly:message (_ "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")))
+  (ly:progress "\n")
+  "")
+
+(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)))