]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/framework-ps.scm
Imported Upstream version 2.16.0
[lilypond.git] / scm / framework-ps.scm
index 7c44920d67ef05e33cd35d1720036a5bc7777a97..b412ab3269412a5a4809a10ea855b4c0b1adba1d 100644 (file)
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 2004--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2004--2012 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
@@ -90,7 +90,7 @@
   (ly:outputter-dump-string
    outputter
    (string-append
-    (format "%%Page: ~a ~a\n" page-number page-number)
+    (format #f "%%Page: ~a ~a\n" page-number page-number)
     "%%BeginPageSetup\n"
     (if landscape?
        "page-width output-scale lily-output-units mul mul 0 translate 90 rotate\n"
         (names (apply append (map extract-names fonts))))
     (apply string-append
           (map (lambda (f)
-                 (format
+                 (format #f
                   (if load-fonts?
                       "%%DocumentSuppliedResources: font ~a\n"
                       "%%DocumentNeededResources: font ~a\n")
                 "%%EndComments\n"))
 
 (define (procset file-name)
-  (format
+  (format #f
    "%%BeginResource: procset (~a) 1 0
 ~a
 %%EndResource
    file-name (cached-file-contents file-name)))
 
 (define (embed-document file-name)
-  (format "%%BeginDocument: ~a
+  (format #f "%%BeginDocument: ~a
 ~a
 %%EndDocument
 "
 (define-public (ps-embed-cff body font-set-name version)
   (let* ((binary-data
          (string-append
-          (format "/~a ~s StartData " font-set-name (string-length body))
+          (format #f "/~a ~s StartData " font-set-name (string-length body))
           body))
         (header
-         (format
+         (format #f
           "%%BeginResource: font ~a
 %!PS-Adobe-3.0 Resource-FontSet
 %%DocumentNeededResources: ProcSet (FontSetInit)
              (begin
                (set! file-name (ly:string-substitute (ly:get-option 'datadir)
                                                      "" file-name))
-               (format
+               (format #f
                 "lilypond-datadir (~a) concatstrings (r) file .loadfont\n"
                 file-name))
-             (format "(~a) (r) file .loadfont\n" file-name))
-         (format "% cannot find font file: ~a\n" file-name)))
+             (format #f "(~a) (r) file .loadfont\n" file-name))
+         (format #f "% cannot find font file: ~a\n" file-name)))
 
     (let* ((font (car font-name-filename))
           (name (cadr font-name-filename))
                (cond
                 ((internal-font? file-name)
                  (ps-load-file (ly:find-file
-                                (format "~a.otf" file-name))))
+                                (format #f "~a.otf" file-name))))
                 ((string? bare-file-name)
                  (ps-load-file file-name))
                 (else
           (fallbackval (ly:modules-lookup (list header) fallbackvar))
           (val (if overrideval overrideval fallbackval)))
       (if val
-         (format port "/~a (~a)\n" field (metadata-encode (markup->string val))))))
+         (format port "/~a (~a)\n" field (metadata-encode (markup->string val (list header)))))))
   (display "[ " port)
   (metadata-lookup-output 'pdfcomposer 'composer "Author")
   (format port "/Creator (LilyPond ~a)\n" (lilypond-version))
 
 
 (define-public (output-framework basename book scopes fields)
-  (let* ((filename (format "~a.ps" basename))
+  (let* ((filename (format #f "~a.ps" basename))
         (outputter (ly:make-paper-outputter
                     ;; FIXME: better wrap open/open-file,
                     ;; content-mangling is always bad.
                     ;; FIXME: better wrap open/open-file,
                     ;; content-mangling is always bad.
                     ;; MINGW hack: need to have "b"inary for embedding CFFs
-                    (open-file (format "~a.eps" filename) "wb")
+                    (open-file (format #f "~a.eps" filename) "wb")
                     'ps))
         (port (ly:outputter-port outputter))
         (rounded-bbox (to-rounded-bp-box bbox))
              (bbox (list (car xext) (car yext)
                          (cdr xext) (cdr yext)))
              (filename (if (< 0 count)
-                           (format "~a-~a" basename count)
+                           (format #f "~a-~a" basename count)
                            basename)))
         (set! count (1+ count))
         (dump-stencil-as-EPS-with-bbox paper
                                        (ly:get-option 'include-eps-fonts)
                                        bbox)
         (if do-pdf
-            (postscript->pdf 0 0 (format "~a.eps" filename)))
+            (postscript->pdf 0 0 (format #f "~a.eps" filename)))
         (if do-png
             (postscript->png (ly:get-option 'resolution) 0 0
-                             (format "~a.eps" filename)))))
+                             (format #f "~a.eps" filename)))))
      extents-system-pairs)))
 
 (define-public (clip-system-EPSes basename paper-book)
       (for-each
        (lambda (region)
         (clip-systems-to-region
-         (format "~a-from-~a-to-~a-clip"
+         (format #f "~a-from-~a-to-~a-clip"
                  basename
                  (rhythmic-location->file-string (car region))
                  (rhythmic-location->file-string (cdr region)))
                (if (pair? system-list)
                    (clip-score-systems
                     (if (> count 0)
-                        (format "~a-~a" basename count)
+                        (format #f "~a-~a" basename count)
                         basename)
                     system-list)))
              score-system-list)))
                         (stack-stencils Y DOWN 0.0
                                         (map paper-system-stencil
                                              (reverse to-dump-systems)))
-                        (format "~a.preview" basename)
+                        (format #f "~a.preview" basename)
                         #t)
     (postprocess-output book framework-ps-module
-                       (format "~a.preview.eps" basename)
+                       (format #f "~a.preview.eps" basename)
                        (cons "png" (ly:output-formats)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;