Use g_spawn_sync () instead of system (). Fixes #1429.

[lilypond.git] / scm / framework-ps.scm

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index fcd3604d1671337471291e26d8b561e57fe03fd4..c4d1d010ca1f8e287a53b534b0d67894e9dbbb2d 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2004--2010 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2004--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -48,37 +48,15 @@
        "%" "_" name)))
      "m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))))))
 
-(define (define-fonts paper)
-  (define font-list (ly:paper-fonts paper))
+(define (ps-define-pango-pf pango-pf font-name scaling)
+  "")
 
-  (define (define-font command fontname scaling)
-    (string-append
-      "/" command
-      " { /" fontname
-      " " (ly:number->string scaling) " output-scale div selectfont }"
-      " bind def\n"))
-
-  (define (font-load-command font)
-    (let* ((specced-font-name (ly:font-name font))
-          (fontname (if specced-font-name
-                        specced-font-name
-                        (ly:font-file-name font)))
-          (command (ps-font-command font))
-
-          ;; FIXME -- see (ps-font-command)
-          (plain (ps-font-command font))
-          (designsize (ly:font-design-size font))
-          (magnification (* (ly:font-magnification font)))
-          (ops (ly:output-def-lookup paper 'output-scale))
-          (scaling (* ops magnification designsize)))
-      (if (equal? fontname "unknown")
-         (display (list font fontname)))
-      (define-font plain fontname scaling)))
-
-  (apply string-append
-        (map (lambda (x) (font-load-command x))
-             (filter (lambda (x) (not (ly:pango-font? x)))
-                     font-list))))
+(define (ps-define-font font font-name scaling)
+  (string-append
+   "/" (ps-font-command font)
+   " { /" font-name
+   " " (ly:number->string scaling) " output-scale div selectfont }"
+   " bind def\n"))
 
 ;; FIXME: duplicated in other output backends
 ;; FIXME: silly interface name
@@ -202,7 +180,7 @@
 (define (setup-variables paper)
   (string-append
    "\n"
-   (define-fonts paper)
+   (define-fonts paper ps-define-font ps-define-pango-pf)
    (output-variables paper)))
 
 (define (cff-font? font)
@@ -289,10 +267,12 @@
     (let* ((dir-name (tmpnam))
           (files '())
           (status 0)
-          (embed #f))
+          (embed #f)
+          (cwd (getcwd)))
       (mkdir dir-name #o700)
-      (set! status (ly:system
-                   (format "cd ~a && fondu -force '~a'" dir-name filename)))
+      (chdir dir-name)
+      (set! status (ly:system (list "fondu" "-force" file-name)))
+      (chdir cwd)
       (set! files (dir-listing dir-name))
       (for-each
        (lambda (f)
@@ -615,9 +595,8 @@ fonts inline."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-public (convert-to-pdf book name)
-  (let* ((defs (ly:paper-book-paper book))
-        (landscape (ly:output-def-lookup defs 'landscape))
+(define (output-width-height defs)
+  (let* ((landscape (ly:output-def-lookup defs 'landscape))
         (output-scale (ly:output-def-lookup defs 'output-scale))
         (convert (lambda (x)
                    (* x output-scale (/ (ly:bp 1)))))
@@ -625,25 +604,35 @@ fonts inline."
         (paper-height (convert (ly:output-def-lookup defs 'paper-height)))
         (w (if landscape paper-height paper-width))
         (h (if landscape paper-width paper-height)))
-    (if (equal? (basename name ".ps") "-")
-       (set! name (string-append "./" name)))
-    (postscript->pdf w h name)))
+    (cons w h)))
+
+(define (output-resolution defs)
+  (let ((defs-resolution (ly:output-def-lookup defs 'pngresolution)))
+    (if (number? defs-resolution)
+       defs-resolution
+       (ly:get-option 'resolution))))
+
+(define (output-filename name)
+  (if (equal? (basename name ".ps") "-")
+      (string-append "./" name)
+      name))
+
+(define-public (convert-to-pdf book name)
+  (let* ((defs (ly:paper-book-paper book))
+        (width-height (output-width-height defs))
+        (width (car width-height))
+        (height (cdr width-height))
+        (filename (output-filename name)))
+    (postscript->pdf width height filename)))
 
 (define-public (convert-to-png book name)
   (let* ((defs (ly:paper-book-paper book))
-        (defs-resolution (ly:output-def-lookup defs 'pngresolution))
-        (resolution (if (number? defs-resolution)
-                        defs-resolution
-                        (ly:get-option 'resolution)))
-        (paper-width (ly:output-def-lookup defs 'paper-width))
-        (paper-height (ly:output-def-lookup defs 'paper-height))
-        (output-scale (ly:output-def-lookup defs 'output-scale)))
-    (if (equal? (basename name ".ps") "-")
-       (set! name (string-append "./" name)))
-    (postscript->png resolution
-                    (* paper-width output-scale (/ (ly:bp 1)))
-                    (* paper-height output-scale (/ (ly:bp 1)))
-                    name)))
+        (resolution (output-resolution defs))
+        (width-height (output-width-height defs))
+        (width (car width-height))
+        (height (cdr width-height))
+        (filename (output-filename name)))
+    (postscript->png resolution width height filename)))
 
 (define-public (convert-to-ps book name)
   #t)