X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fbackend-library.scm;h=74e53693594a9c836aed76fbd10a5768a2c3428a;hb=b6970d44a8b11d1499e0054a98e9359ca3db5d93;hp=f162ea97d76717310da8fd17db00f3c12de5ff86;hpb=1df6e5262afa02036e6c4db7ae0f2526f1500fa1;p=lilypond.git

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index f162ea97d7..74e5369359 100644
--- 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,47 +33,64 @@
    "\""))
 
 (define-public (postscript->pdf papersizename name)
-  (let* ((cmd (format #f "ps2pdf -sPAPERSIZE=~a '~a'"
-		      (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)
-    (newline (current-error-port))
+    (ly:message (_ "Converting to `~a'...") pdf-name)
+    (ly:progress "\n")
     (ly:system cmd)))
 
 (define-public (postscript->png resolution papersizename name)
   (let* ((prefix (ly:effective-prefix))
-	 ;; FIXME: should scripts/ps2png.py be installed in PREFIX?
+
+	 ;; run the source, if  we are in the build-directory
 	 (ps2png-source (if prefix
-			   (format "~a/scripts/ps2png.py" prefix)
-			   "ps2png"))
+			   (format "~a/scripts/lilypond-ps2png.py" prefix)
+			   "lilypond-ps2png"))
 	 (cmd (format #f
-		      "~a --resolution=~S --papersize=~a~a '~a'"
+		      "~a --resolution=~S --papersize=~a~a ~S"
 		      (if (file-exists? ps2png-source)
 			  (format "python ~a" ps2png-source)
-			  "ps2png")
+			  "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.
-    ;;(format (current-error-port) (_ "Converting to `~a'...")
+    ;;(ly:message (_ "Converting to `~a'...")
     ;;	    (string-append (basename name ".ps") "-page1.png" )))
-    (format (current-error-port) (_ "Converting to ~a...") "PNG")
-    (newline (current-error-port))
-    (ly:system cmd)))
+    (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)
@@ -90,20 +106,19 @@
      (if (member x formats) (set! new-fmts (cons x new-fmts))))
    '("tex" "dvi" "ps" "pdf" "png"))
 
-  (reverse 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)))
-  (format (current-error-port)
-	  (_ "Writing header field `~a' to `~a'...")
-	  key
-	  (if (equal? "-" file-name) "<stdout>" file-name))
+  (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")))
-  (newline (current-error-port))
+  (ly:progress "\n")
   "")
 
 (define-public (output-scopes scopes fields basename)