]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/framework-ps.scm
Build: end directories in their bare names and avoid some double slashes in logs.
[lilypond.git] / scm / framework-ps.scm
index a179295cf5087f168f9999645d6c46b594e9a867..032f0c5de1f263beae33126e2ce1edd09b3b9233 100644 (file)
@@ -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
     (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)
           (pfas (map font-loader font-names)))
       pfas))
 
+
   (display "%%BeginProlog\n" port)
   (format
    port
   (display "%%EndProlog\n" port)
   (display "%%BeginSetup\ninit-lilypond-parameters\n%%EndSetup\n\n" port))
 
+;;; Create DOCINFO pdfmark containing metadata
+;;; header fields with pdf prefix override those without the prefix
+(define (handle-metadata header port)
+  (define (metadata-lookup-output overridevar fallbackvar field)
+    (let* ((overrideval (ly:modules-lookup (list header) overridevar))
+          (fallbackval (ly:modules-lookup (list header) fallbackvar))
+          (val (if overrideval overrideval fallbackval)))
+      (if val
+         (format port "/~a (~a)\n" field (markup->string val)))))
+  (display "[ " port)
+  (metadata-lookup-output 'pdfcomposer 'composer "Author")
+  (format port "/Creator (LilyPond ~a)\n" (lilypond-version))
+  (metadata-lookup-output 'pdftitle 'title "Title")
+  (metadata-lookup-output 'pdfsubject 'subject "Subject")
+  (metadata-lookup-output 'pdfkeywords 'keywords "Keywords")
+  (metadata-lookup-output 'pdfmodDate 'modDate "ModDate")
+  (metadata-lookup-output 'pdfsubtitle 'subtitle "Subtitle")
+  (metadata-lookup-output 'pdfcomposer 'composer "Composer")
+  (metadata-lookup-output 'pdfarranger 'arranger "Arranger")
+  (metadata-lookup-output 'pdfpoet 'poet "Poet")
+  (metadata-lookup-output 'pdfcopyright 'copyright "Copyright")
+  (display "/DOCINFO pdfmark\n\n" port))
+
+
 (define-public (output-framework basename book scopes fields)
   (let* ((filename (format "~a.ps" basename))
         (outputter (ly:make-paper-outputter
                     (open-file filename "wb")
                     'ps))
         (paper (ly:paper-book-paper book))
+        (header (ly:paper-book-header book))
         (systems (ly:paper-book-systems book))
         (page-stencils (map page-stencil (ly:paper-book-pages book)))
         (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
     ;; don't do BeginDefaults PageMedia: A4
     ;; not necessary and wrong
     (write-preamble paper #t port)
+    (if (module? header)
+       (handle-metadata header port))
     (for-each
      (lambda (page)
        (set! page-number (1+ page-number))
 (define-public (dump-stencil-as-EPS-with-bbox paper dump-me filename
                                              load-fonts
                                              bbox)
-  "Create an EPS file from stencil DUMP-ME to FILENAME. BBOX has
-format (left-x, lower-y, right x, up-y).  If LOAD-FONTS set, include
-fonts inline."
+  "Create an EPS file from stencil @var{dump-me} to @var{filename}.
+@var{bbox} has format @code{(left-x, lower-y, right-x, upper-y)}.  If
+@var{load-fonts} set, include fonts inline."
   (define (to-rounded-bp-box box)
     "Convert box to 1/72 inch with rounding to enlarge the box."
     (let* ((scale (ly:output-def-lookup paper 'output-scale))
@@ -593,9 +623,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)))))
@@ -603,25 +632,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)