X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-tex.scm;h=f0e3321a2ca9c3f6194f9244fc630e82a6b56f37;hb=d9fd01f2dc9ffb43038028859703f0788d1e384e;hp=f9b9e454e11f876c9f182b7c1ff19e12b2238dc9;hpb=2ceb589a4aa3060867116d8fc130fa994dc7e43a;p=lilypond.git

diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm
index f9b9e454e1..f0e3321a2c 100644
--- a/scm/framework-tex.scm
+++ b/scm/framework-tex.scm
@@ -5,9 +5,8 @@
 ;;;; (c)  2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 (define-module (scm framework-tex)
-  #:export (output-framework-tex	    
-	    output-classic-framework-tex
-))
+  #:export (output-framework-tex	
+	    output-classic-framework-tex))
 
 (use-modules (ice-9 regex)
 	     (ice-9 string-fun)
@@ -23,11 +22,11 @@
 ;; \lyitem{089.5557}{-15.3109}{\hbox{\magfontUGQLomTVo{}bla$\backslash${$\backslash$}}}%
 ;; --jcn
 (define-public (sanitize-tex-string s)
-   (if (ly:get-option 'safe)
-      (regexp-substitute/global #f "\\\\"
-				(regexp-substitute/global #f "([{}])" "bla{}" 'pre  "\\" 1 'post )
-				'pre "$\\backslash$" 'post)
-      
+  (if (ly:get-option 'safe)
+      (regexp-substitute/global
+       #f "\\\\"
+       (regexp-substitute/global #f "([{}])" s 'pre  "\\" 1 'post )
+       'pre "$\\backslash$" 'post)
       s))
 
 (define (symbol->tex-key sym)
@@ -47,10 +46,9 @@
    (string-encode-integer
     (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
 
-(define (font-load-command bookpaper font)
+(define (font-load-command paper font)
   (let* ((coding-alist (ly:font-encoding-alist font))
-	 (font-encoding (assoc-get 'output-name coding-alist))
-	 )
+	 (font-encoding (assoc-get 'output-name coding-alist)))
     (string-append
      "\\font\\lilypond" (tex-font-command font) "="
      (ly:font-filename font)
@@ -58,33 +56,33 @@
      (ly:number->string (inexact->exact
 			 (round (* 1000
 				   (ly:font-magnification font)
-				   (ly:bookpaper-outputscale bookpaper)))))
+				   (ly:paper-outputscale paper)))))
      "\n"
      "\\def\\" (tex-font-command font) "{%\n"
      ;; UGH.  Should be handled via alist.
-     (if (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
+     (if (or (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
+	     (not font-encoding))
 	 "  \\lilypondfontencoding{T1}"
 	 "  ")
      "\\lilypond" (tex-font-command font)
-     "}\n"
-     )))
+     "}%\n")))
 
-
-(define (define-fonts bookpaper)
+(define (define-fonts paper)
   (string-append
-   ;; UGH. FIXME.   
-   "\\def\\lilypondpaperunit{mm}\n"
+   ;; UGH. FIXME.
+   "\\def\\lilypondpaperunit{mm}%\n"
    (tex-number-def "lilypondpaper" 'outputscale
 		   (number->string (exact->inexact
-				    (ly:bookpaper-outputscale bookpaper))))
+				    (ly:paper-outputscale paper))))
    (tex-string-def "lilypondpaper" 'papersize
-		   (eval 'papersize (ly:output-def-scope bookpaper)))
+		   (eval 'papersizename (ly:output-def-scope paper)))
+   ;; paper/layout?
    (tex-string-def "lilypondpaper" 'inputencoding
-		   (eval 'inputencoding (ly:output-def-scope bookpaper)))
+		   (eval 'inputencoding (ly:output-def-scope paper)))
 
    (apply string-append
-	  (map (lambda (x) (font-load-command bookpaper x))
-	       (ly:bookpaper-fonts bookpaper)))))
+	  (map (lambda (x) (font-load-command paper x))
+	       (ly:paper-fonts paper)))))
 
 (define (header-to-file fn key val)
   (set! key (symbol->string key))
@@ -101,15 +99,13 @@
   (newline (current-error-port))
   "")
 
-(define (output-scopes  scopes fields basename)
+(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) ""))
-	      )
-	  
+	(let ((val (if (variable-bound? var) (variable-ref var) "")))
 	  (if (and (memq sym fields) (string? val))
 	      (header-to-file basename sym val))
 	  ""))
@@ -122,14 +118,12 @@
       (string-append "\\def\\" prefix (symbol->tex-key key)
 		     "{" (sanitize-tex-string str) "}%\n")))
 
-(define (header bookpaper page-count classic?)
-  (let ((scale (ly:output-def-lookup bookpaper 'outputscale))
+(define (header paper page-count classic?)
+  (let ((scale (ly:output-def-lookup paper 'outputscale))
 	(texpaper (string-append
-		   (ly:output-def-lookup bookpaper 'papersizename)
+		   (ly:output-def-lookup paper 'papersizename)
 		   "paper"))
-	(landscape? (eq? #t (ly:output-def-lookup bookpaper 'landscape)))
-	)
-    
+	(landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
     (string-append
      "% Generated by LilyPond "
      (lilypond-version) "\n"
@@ -144,15 +138,15 @@
 
      (tex-string-def
       "lilypondpaper" 'linewidth
-      (ly:number->string (* scale (ly:output-def-lookup bookpaper 'linewidth))))
+      (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
      "\\def\\lilyponddocumentclassoptions{"
-     texpaper
-     (if  landscape? ",landscape" "")
-      "}%\n"
+     (sanitize-tex-string texpaper)
+     (if landscape? ",landscape" "")
+     "}%\n"
      (tex-string-def
       "lilypondpaper" 'interscoreline
       (ly:number->string
-       (* scale (ly:output-def-lookup bookpaper 'interscoreline)))))))
+       (* scale (ly:output-def-lookup paper 'interscoreline)))))))
 
 (define (header-end)
   (string-append
@@ -165,7 +159,6 @@
    "\\ifx\\lilypondstart\\undefined\n"
    "  \\input lilyponddefs\n"
    "\\fi\n"
-   "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
    "\\lilypondstart\n"
    "\\lilypondspecial\n"
    "\\lilypondpostscript\n"))
@@ -173,44 +166,48 @@
 (define (dump-page putter page last? with-extents?)
   (ly:outputter-dump-string
    putter
-   (format "\\vbox to ~a\\outputscale{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n"
+   (format "\\lybox{~a}{~a}{%\n"
+	   (if with-extents?
+	       (interval-start (ly:stencil-extent page X))
+	       0.0)
 	   (if with-extents?
 	       (- (interval-start (ly:stencil-extent page Y)))
-	       	       0.0
-	       )))
+	       0.0)))
   (ly:outputter-dump-stencil putter page)
   (ly:outputter-dump-string
    putter
    (if last?
-       "}\\vss\n}\n\\vfill\n"
-       "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
+       "}%\n\\vfill\n"
+       "}%\n\\vfill\n\\lilypondpagebreak\n")))
 
 (define-public (output-framework outputter book scopes fields basename )
-  (let* ((bookpaper (ly:paper-book-book-paper book))
+  (let* ((paper (ly:paper-book-paper book))
 	 (pages (ly:paper-book-pages book))
 	 (last-page (car (last-pair pages)))
 	 (with-extents
-	  (eq? #t (ly:output-def-lookup bookpaper 'dump-extents)))
-	 )
+	  (eq? #t (ly:output-def-lookup paper 'dump-extents))))
     (for-each
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (list
-      (header bookpaper (length pages) #f)
-      (define-fonts bookpaper)
+      (header paper (length pages) #f)
+      (define-fonts paper)
       (header-end)))
-    (ly:outputter-dump-string outputter "\\lilypondnopagebreak")
+    (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
     (for-each
-     (lambda (page) (dump-page outputter page (eq? last-page page) with-extents))
+     (lambda (page)
+       (dump-page outputter page (eq? last-page page) with-extents))
      pages)
     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 
 (define (dump-line putter line last?)
   (ly:outputter-dump-string
    putter
-   (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
-		  (ly:number->string (interval-length (ly:paper-system-extent line Y)))
-		  "}{"))
+   (format "\\lybox{~a}{~a}{%\n"
+	   (ly:number->string
+	    (max 0 (interval-end (ly:paper-system-extent line X))))
+	   (ly:number->string
+	    (interval-length (ly:paper-system-extent line Y)))))
 
   (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
   (ly:outputter-dump-string
@@ -221,7 +218,7 @@
 
 (define-public (output-classic-framework
 		outputter book scopes fields basename)
-  (let* ((bookpaper (ly:paper-book-book-paper book))
+  (let* ((paper (ly:paper-book-paper book))
 	 (lines (ly:paper-book-systems book))
 	 (last-line (car (last-pair lines))))
     (for-each
@@ -229,89 +226,110 @@
        (ly:outputter-dump-string outputter x))
      (list
       ;;FIXME
-      (header bookpaper (length lines) #f)
+      (header paper (length lines) #f)
       "\\def\\lilypondclassic{1}%\n"
       (output-scopes scopes fields basename)
-      (define-fonts bookpaper)
+      (define-fonts paper)
       (header-end)))
 
     (for-each
      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 
-
 (define-public (output-preview-framework
 		outputter book scopes fields basename )
-  (let* ((bookpaper (ly:paper-book-book-paper book))
+  (let* ((paper (ly:paper-book-paper book))
 	 (lines (ly:paper-book-systems book)))
     (for-each
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (list
       ;;FIXME
-      (header bookpaper (length lines) #f)
+      (header paper (length lines) #f)
       "\\def\\lilypondclassic{1}%\n"
       (output-scopes scopes fields basename)
-      (define-fonts bookpaper)
+      (define-fonts paper)
       (header-end)))
 
     (dump-line outputter (car lines) #t)
     (ly:outputter-dump-string outputter "\\lilypondend\n")))
 
-
 (define-public (convert-to-pdf book name)
-  (let*
-      ((defs (ly:paper-book-book-paper book))
-       (size (ly:output-def-lookup defs 'papersize)))
-
-    (postscript->pdf (if (string? size) size "a4")
+  (let* ((defs (ly:paper-book-paper book))
+	 (papersizename (ly:output-def-lookup defs 'papersizename)))
+    (postscript->pdf (if (string? papersizename) papersizename "a4")
 		     (string-append
 		      (basename name ".tex")
-		      ".ps")
-		     )))
+		      ".ps"))))
 
 (define-public (convert-to-png book name)
-  (let*
-      ((defs (ly:paper-book-book-paper book))
-       (resolution (ly:output-def-lookup defs 'pngresolution)))
-
+  (let* ((defs (ly:paper-book-paper book))
+	 (resolution (ly:output-def-lookup defs 'pngresolution)))
     (postscript->png
-     (if (number? resolution) resolution 90)
-     (string-append (basename name ".tex") ".ps")
-     )))
+     (if (number? resolution)
+	 resolution
+	 (ly:get-option 'resolution))
+     (string-append (basename name ".tex") ".ps"))))
+
+
+;;
+;; ugh  -   double check this. We are leaking
+;; untrusted (user-settable) info to a command-line 
+;;
+
 
 (define-public (convert-to-ps book name)
-  (let*
-      ((bookpaper  (ly:paper-book-book-paper book))
-       (papersize (ly:output-def-lookup bookpaper 'papersizename))
-       (landscape? (eq? #t (ly:output-def-lookup bookpaper 'landscape)))
-       (cmd (string-append "dvips -t " papersize
-			   (if landscape? " -t landscape " " ") 
-			   "  -u+ec-mftrace.map -u+lilypond.map -Ppdf "
-			   (basename name ".tex"))))
-
-    (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
-    (newline (current-error-port))
-    (system cmd)))
+  (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 "
+			     (if preview?
+				 " -E "
+				 (string-append
+				  " -t "
+				  (sanitize-command-option papersizename)))
+				 
+			     (if landscape?
+				 " -t landscape "
+				 " ")
+			     "  -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)))
+    (if (not (ly:get-option 'verbose))
+	(begin
+	  (format (current-error-port) (_ "Converting to `~a.ps'...") base)
+	  (newline (current-error-port))))
+    (ly:system cmd)))
 
 (define-public (convert-to-dvi book name)
-  (let*
-      ((curr-extra-mem (string->number (regexp-substitute/global #f " *%.*\n?"
-								 (ly:kpathsea-expand-variable "$extra_mem_top")
-								 'pre "" 'post)))
-       (cmd (string-append "latex \\\\nonstopmode \\\\input " name)))
-
+  (let* ((curr-extra-mem
+	  (string->number
+	   (regexp-substitute/global
+	    #f " *%.*\n?"
+	    (ly:kpathsea-expand-variable "$extra_mem_top")
+	    'pre "" 'post)))
+	 (base (basename name ".tex"))
+	 (cmd (string-append
+	       "latex \\\\nonstopmode \\\\input " name)))
     (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
-    (newline (current-error-port))
-    (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
-    (newline (current-error-port))
+    (let ((dvi-name (string-append base ".dvi")))
+      (if (access? dvi-name W_OK)
+	  (delete-file dvi-name)))
+    (if (not (ly:get-option 'verbose))
+	(begin
+	  (format (current-error-port) (_ "Converting to `~a.dvi'...") base)
+	  (newline (current-error-port))))
 
     ;; fixme: set in environment?
     (if (ly:get-option 'safe)
 	(set! cmd (string-append "openout_any=p " cmd)))
-    
-    (system cmd)))
+
+    (ly:system cmd)))
 
 (define-public (convert-to-tex book name)
   #t)
-