translation-functions.scm: Tidy formatting.

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

diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index 5258bcf516249978a06d25166fa46b6b50964dc4..2f1bc6f41acffa7ac6c317c9b727e9a6b3ce9196 100644 (file)
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -2,13 +2,16 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 

-;;;; (c) 2005--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2005--2009 Jan Nieuwenhuizen <janneke@gnu.org>

 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;; backend helpers.
 
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;; backend helpers.
 

-(define-public (ly:system command)
+(use-modules (scm ps-to-png)
+            (ice-9 optargs))
+
+(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)


@@ -16,9 +19,15 @@
                       command
                       (format #f "~a > ~a 2>&1 " command dev-null))))
     (if (ly:get-option 'verbose)
                       command
                       (format #f "~a > ~a 2>&1 " command dev-null))))
     (if (ly:get-option 'verbose)

-       (ly:message (_ "Invoking `~a'...") command))
-    
-    (set! status (system silenced))
+       (begin
+         (ly:message (_ "Invoking `~a'...") command))
+         (ly:progress "\n"))
+
+    (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 +35,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"
   


@@ -51,24 +76,24 @@
   
 (define-public (postscript->pdf paper-width paper-height name)
   (let* ((pdf-name (string-append
   
 (define-public (postscript->pdf paper-width paper-height name)
   (let* ((pdf-name (string-append

-                   (basename (basename name ".ps") ".eps")
+                   (dir-basename name ".ps" ".eps")

                    ".pdf"))
         (is-eps (string-match "\\.eps$" name))
         (paper-size-string (if is-eps
                    ".pdf"))
         (is-eps (string-match "\\.eps$" name))
         (paper-size-string (if is-eps

-                               " -dEPSCrop "
-                               (format "-dDEVICEWIDTHPOINTS=~,2f \
--dDEVICEHEIGHTPOINTS=~,2f "
-                                       paper-width paper-height )))
+                               "-dEPSCrop"
+                               (ly:format "-dDEVICEWIDTHPOINTS=~$\
+ -dDEVICEHEIGHTPOINTS=~$"
+                                       paper-width paper-height)))

 
 

-        (cmd (format #f
+        (cmd (ly:format

                      "~a\
  ~a\
  ~a\
  ~a\
                      "~a\
  ~a\
  ~a\
  ~a\

- -dCompatibilityLevel=1.4 \
+ -dCompatibilityLevel=1.4\

  -dNOPAUSE\
  -dBATCH\
  -dNOPAUSE\
  -dBATCH\

- -r1200 \
+ -r1200\

  -sDEVICE=pdfwrite\
  -sOutputFile=~S\
  -c .setpdfwrite\
  -sDEVICE=pdfwrite\
  -sOutputFile=~S\
  -c .setpdfwrite\


@@ -76,9 +101,10 @@
 "
                      (search-gs)
                      (if (ly:get-option 'verbose) "" "-q")
 "
                      (search-gs)
                      (if (ly:get-option 'verbose) "" "-q")

-                     (if (ly:get-option 'gs-load-fonts)
-                         " -dNOSAFER "
-                         " -dSAFER ")
+                     (if (or (ly:get-option 'gs-load-fonts)
+                             (ly:get-option 'gs-load-lily-fonts))
+                         "-dNOSAFER"
+                         "-dSAFER")

                      paper-size-string
                      pdf-name
                      name)))
                      paper-size-string
                      pdf-name
                      name)))


@@ -87,75 +113,52 @@
     (if (eq? PLATFORM 'windows)
        (begin
          (set! cmd (string-regexp-substitute "=" "#" cmd))
     (if (eq? PLATFORM 'windows)
        (begin
          (set! cmd (string-regexp-substitute "=" "#" cmd))

-         (set! cmd (string-regexp-substitute "-dSAFER " "" cmd))))
-
-    (if (access? pdf-name W_OK)
-       (delete-file pdf-name))
+         (set! cmd (string-regexp-substitute "-dSAFER " "" cmd))
+         (if (access? pdf-name W_OK)
+             (delete-file pdf-name))))

 
     (ly:message (_ "Converting to `~a'...") pdf-name)
     (ly:progress "\n")
 
     (ly:message (_ "Converting to `~a'...") pdf-name)
     (ly:progress "\n")

-    (ly:system cmd)
-    ))
-
-(use-modules (scm ps-to-png))
+    (ly:system cmd)))

 
 (define-public (postscript->png resolution paper-width paper-height name)
 
 (define-public (postscript->png resolution paper-width paper-height name)

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

     ;; Do not try to guess the name of the png file,
     ;; GS produces PNG files like BASE-page%d.png.
     ;; 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" )))
-  (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 (dir-basename filename ".ps" ".eps"))
+        (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)
+                   (if (file-exists? f) (delete-file f)))
+                 (map (lambda (x) (string-append base "." x)) 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))))
+           '("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)


@@ -187,3 +190,26 @@
       scope)))
   (apply string-append (map output-scope scopes)))
 
       scope)))
   (apply string-append (map output-scope scopes)))
 

+(define missing-stencil-list '())
+
+(define-public (backend-testing output-module)
+  (define (missing-stencil-expression name)
+    (begin
+      (ly:warning (_ "missing stencil expression `~S'") name)
+      ""))
+
+  (map (lambda (x)
+        (if (not (module-defined? output-module x))
+            (begin
+              (module-define! output-module x
+                              (lambda* (#:optional y . z)
+                                (missing-stencil-expression x)))
+              (set! missing-stencil-list (append (list x)
+                                                 missing-stencil-list)))))
+       (ly:all-stencil-commands)))
+
+(define-public (remove-stencil-warnings output-module)
+  (for-each
+    (lambda (x)
+      (module-remove! output-module x))
+    missing-stencil-list))