]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/framework-tex.scm
* lily/tie.cc (print): idem.
[lilypond.git] / scm / framework-tex.scm
index 54f6539e4f7f8831755e1a52e8ae9e481589d0fd..3674054c6822b02c7c216bc41b27e4b5c486e86f 100644 (file)
             (guile)
             (srfi srfi-1)
             (srfi srfi-13)
+            (srfi srfi-14)
             (lily))
 
 (define (output-formats)
   (define formats (ly:output-formats))
   (set! formats (completize-formats formats))
   (if (member "ps" formats)
-      (set! formats (cons "dvi" formats))) 
+      (set! formats (cons "dvi" formats)))
   (if (member "dvi" formats)
       (set! formats (cons "tex" formats)))
 
          (map (lambda (x) (font-load-command paper x))
               (ly:paper-fonts paper)))))
 
-(define (header-to-file fn key val)
-  (set! key (symbol->string key))
-  (if (not (equal? "-" fn))
-      (set! fn (string-append fn "." key)))
-  (display
-   (format (_ "Writing header field `~a' to `~a'...")
-          key
-          (if (equal? "-" fn) "<stdout>" fn))
-   (current-error-port))
-  (if (equal? fn "-")
-      (display val)
-      (display val (open-file fn "w")))
-  (newline (current-error-port))
-  "")
-
-(define (output-scopes scopes fields basename)
-  (define (output-scope scope)
-    (apply
-     string-append
-     (module-map
-      (lambda (sym var)
-       (let ((val (if (variable-bound? var) (variable-ref var) "")))
-         (if (and (memq sym fields) (string? val))
-             (header-to-file basename sym val))
-         ""))
-      scope)))
-  (apply string-append (map output-scope scopes)))
-
 (define (tex-string-def prefix key str)
   (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
       (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
 
 (define-public (convert-to-png book name)
   (let* ((defs (ly:paper-book-paper book))
-        (resolution (ly:output-def-lookup defs 'pngresolution)))
+        (resolution (ly:output-def-lookup defs 'pngresolution))
+        (papersizename (ly:output-def-lookup defs 'papersizename)))
     (postscript->png
-     (if (number? resolution)
-        resolution
-        (ly:get-option 'resolution))
+     (if (number? resolution) resolution (ly:get-option 'resolution))
+     (if (string? papersizename) papersizename "a4")
      (string-append (basename name ".tex") ".ps"))))
 
 (define-public (convert-to-ps book name)
   (let* ((paper (ly:paper-book-paper book))
         (preview? (string-contains name ".preview"))
-
         (papersizename (ly:output-def-lookup paper 'papersizename))
         (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
         (base (basename name ".tex"))
-        (cmd (string-append "dvips "
+        (ps-name (format "~a.ps"  base ".ps"))
+        (cmd (string-append "dvips"
                             (if preview?
-                                "-E "
+                                " -E"
                                 (string-append
-                                 "-t"
+                                 " -t"
                                  ;; careful: papersizename is user-set.
                                  (sanitize-command-option papersizename)
-                                 " "))
-                            (if landscape? "-t landscape " "")
+                                 ""))
+                            (if landscape? " -tlandscape" "")
                             (if (ly:kpathsea-find-file "lm.map")
-                                "-u+lm.map " "")
+                                " -u+lm.map" "")
                             (if (ly:kpathsea-find-file "ecrm10.pfa")
-                                "-u+ec-mftrace.map " "")
-                            "-u+lilypond.map -Ppdf " ""
-                            base)))
-    (let ((ps-name (string-append base ".ps")))
-      (if (access? ps-name W_OK)
-         (delete-file ps-name)))
+                                " -u+ec-mftrace.map" "")
+                            " -u+lilypond.map -Ppdf" ""
+                            " -o" ps-name
+                            " " base)))
+    (if (access? ps-name W_OK)
+       (delete-file ps-name))
     (if (not (ly:get-option 'verbose))
        (begin
-         (format (current-error-port) (_ "Converting to `~a'...")
-                 (string-append base ".dvi"))
+         (format (current-error-port)
+                 (_ "Converting to `~a'...") (string-append base ".ps"))
          (newline (current-error-port))))
     (ly:system cmd)))
 
            (ly:kpathsea-expand-variable "$extra_mem_top")
            'pre "" 'post)))
         (base (basename name ".tex"))
-        (cmd (string-append
-              "latex \\\\nonstopmode \\\\input " name)))
+        (cmd (format
+              #f "latex \\\\nonstopmode \\\\input '~a'" name)))
+
+    ;; FIXME: latex 'foo bar' works, but \input 'foe bar' does not?
+    (if (string-index name (char-set #\space #\ht #\newline #\cr))
+       (error (format
+               #f
+               (_"TeX file name must not contain whitespace: `~a'") name)))
+
     (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
     (let ((dvi-name (string-append base ".dvi")))
       (if (access? dvi-name W_OK)
                  (string-append base ".dvi"))
          (newline (current-error-port))))
 
-    ;; fixme: set in environment?
+    ;; FIXME: set in environment?
     (if (ly:get-option 'safe)
        (set! cmd (string-append "openout_any=p " cmd)))