From 67fc9ed5450a20215c4dbefa86f6f8b388bbdb92 Mon Sep 17 00:00:00 2001 From: Masamichi Hosoda Date: Sat, 9 May 2015 22:49:14 +0900 Subject: [PATCH] Issue 4374 / 4: Use mkstemp for intermediate ps files When backend is `ps' (default), intermediate ps files are created by mkstemp. The following issues are fixed. Filename issue (to compile lines.ly, gs_init.ly etc.) Intermediate file issue (to overwrite and delete .ps file) --- scm/backend-library.scm | 53 ++++++++++++++++++++++++----------------- scm/framework-eps.scm | 10 +++++--- scm/framework-ps.scm | 44 +++++++++++++++------------------- scm/ps-to-png.scm | 19 +++++++-------- 4 files changed, 65 insertions(+), 61 deletions(-) diff --git a/scm/backend-library.scm b/scm/backend-library.scm index 712033849c..b1cc5f5c4b 100644 --- a/scm/backend-library.scm +++ b/scm/backend-library.scm @@ -55,11 +55,9 @@ ;; must be sure that we don't catch stuff from old GUBs. (search-executable '("gs"))) -(define-public (postscript->pdf paper-width paper-height name) - (let* ((pdf-name (string-append - (dir-basename name ".ps" ".eps") - ".pdf")) - (is-eps (string-match "\\.eps$" name)) +(define-public (postscript->pdf paper-width paper-height + base-name tmp-name is-eps) + (let* ((pdf-name (string-append base-name ".pdf")) (*unspecified* (if #f #f)) (cmd (remove (lambda (x) (eq? x *unspecified*)) @@ -89,19 +87,20 @@ (string-split pdf-name #\%) "%%")) "-c.setpdfwrite" - (string-append "-f" name))))) + (string-append "-f" tmp-name))))) (ly:message (_ "Converting to `~a'...\n") pdf-name) (ly:system cmd))) -(define-public (postscript->png resolution paper-width paper-height name) +(define-public (postscript->png resolution paper-width paper-height + base-name tmp-name is-eps) (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. (ly:message (_ "Converting to ~a...") "PNG") - (make-ps-images name + (make-ps-images base-name tmp-name is-eps #:resolution resolution #:page-width paper-width #:page-height paper-height @@ -111,6 +110,14 @@ #:pixmap-format (ly:get-option 'pixmap-format)) (ly:progress "\n"))) +(define-public (postscript->ps base-name tmp-name is-eps) + (let* ((ps-name (string-append base-name + (if is-eps ".eps" ".ps")))) + (if (not (equal? ps-name tmp-name)) + (begin + (ly:message (_ "Copying to `~a'...\n") ps-name) + (copy-binary-file tmp-name ps-name))))) + (define-public (copy-binary-file from-name to-name) (if (eq? PLATFORM 'windows) ;; MINGW hack: MinGW Guile's copy-file is broken. @@ -164,23 +171,25 @@ ;; Pass through the return value of mkstemp! port-tmp))) -(define-public (postprocess-output paper-book module filename formats) - (let* ((completed (completize-formats formats)) - (base (dir-basename filename ".ps" ".eps")) - (intermediate (remove (lambda (x) (member x formats)) completed))) +(define-public (postprocess-output paper-book module formats + base-name tmp-name is-eps) + (let* ((completed (completize-formats formats is-eps))) (for-each (lambda (f) - ((eval (string->symbol (format #f "convert-to-~a" f)) - module) paper-book filename)) completed) - (if (ly:get-option 'delete-intermediate-files) - (for-each (lambda (f) - (if (file-exists? f) (delete-file f))) - (map (lambda (x) (string-append base "." x)) intermediate))))) - -(define-public (completize-formats formats) + ((eval (string->symbol (format #f "convert-to-~a" f)) module) + paper-book base-name tmp-name is-eps)) completed) + (if (and (ly:get-option 'delete-intermediate-files) + (or (not is-eps) + (not (member "ps" completed))) + (file-exists? tmp-name)) + (begin (ly:message (_ "Deleting `~a'...\n") tmp-name) + (delete-file tmp-name))))) + +(define-public (completize-formats formats is-eps) (define new-fmts '()) - (if (member "png" formats) + (if (and is-eps (member "eps" formats)) (set! formats (cons "ps" formats))) - (if (member "pdf" formats) + (if (not (or (member "pdf" formats) + (member "png" formats))) (set! formats (cons "ps" formats))) (for-each (lambda (x) (if (member x formats) (set! new-fmts (cons x new-fmts)))) diff --git a/scm/framework-eps.scm b/scm/framework-eps.scm index 353d5f8f91..60d468a123 100644 --- a/scm/framework-eps.scm +++ b/scm/framework-eps.scm @@ -83,8 +83,10 @@ alignment." ;; First, create the output, then if necessary, individual staves and ;; finally write some auxiliary files if desired (dump-infinite-stack-EPS stencils) - (postprocess-output book framework-eps-module - (format #f "~a.eps" basename) (ly:output-formats)) + (postprocess-output book framework-eps-module (ly:output-formats) + basename + (format #f "~a.eps" basename) + #t) ;; individual staves (*-1.eps etc.); only print if more than one stencil ;; Otherwise the .eps and the -1.eps file will be identical and waste space @@ -95,7 +97,9 @@ alignment." (eps-files (map dump-counted-stencil counted-systems))) (if do-pdf ;; par-for-each: a bit faster ... - (for-each (lambda (y) (postscript->pdf 0 0 y)) + (for-each (lambda (y) (postscript->pdf 0 0 + (dir-basename y ".eps") + y #t)) eps-files)))) ;; Now, write some aux files if requested: .texi, .tex and .count diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 9e2b7521ad..96c584d34f 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -474,12 +474,10 @@ (define-public (output-framework basename book scopes fields) - (let* ((filename (format #f "~a.ps" basename)) + (let* ((port-tmp (make-tmpfile)) + (tmp-name (port-filename port-tmp)) (outputter (ly:make-paper-outputter - ;; FIXME: better wrap open/open-file, - ;; content-mangling is always bad. - ;; MINGW hack: need to have "b"inary for embedding CFFs - (open-file filename "wb") + port-tmp 'ps)) (paper (ly:paper-book-paper book)) (header (ly:paper-book-header book)) @@ -507,8 +505,8 @@ page-stencils) (display "%%Trailer\n%%EOF\n" port) (ly:outputter-close outputter) - (postprocess-output book framework-ps-module filename - (ly:output-formats)))) + (postprocess-output book framework-ps-module (ly:output-formats) + basename tmp-name #f))) (define-public (dump-stencil-as-EPS paper dump-me filename load-fonts) @@ -615,10 +613,10 @@ (ly:get-option 'include-eps-fonts) bbox) (if do-pdf - (postscript->pdf 0 0 (format #f "~a.eps" filename))) + (postscript->pdf 0 0 filename (format #f "~a.eps" filename) #t)) (if do-png (postscript->png (ly:get-option 'resolution) 0 0 - (format #f "~a.eps" filename))))) + filename (format #f "~a.eps" filename) #t)))) extents-system-pairs))) (define-public (clip-system-EPSes basename paper-book) @@ -678,8 +676,11 @@ (format #f "~a.preview" basename) #t) (postprocess-output book framework-ps-module + (cons "png" (ly:output-formats)) + (format #f "~a.preview" basename) (format #f "~a.preview.eps" basename) - (cons "png" (ly:output-formats))))) + #t + ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -700,30 +701,23 @@ 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) +(define-public (convert-to-pdf book base-name tmp-name is-eps) (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))) + (height (cdr width-height))) + (postscript->pdf width height base-name tmp-name is-eps))) -(define-public (convert-to-png book name) +(define-public (convert-to-png book base-name tmp-name is-eps) (let* ((defs (ly:paper-book-paper book)) (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))) + (height (cdr width-height))) + (postscript->png resolution width height base-name tmp-name is-eps))) -(define-public (convert-to-ps book name) - #t) +(define-public (convert-to-ps book base-name tmp-name is-eps) + (postscript->ps base-name tmp-name is-eps)) (define-public (output-classic-framework basename book scopes fields) (ly:error (_ "\nThe PostScript backend does not support the diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm index 7e94ac0516..3b6b6c2452 100644 --- a/scm/ps-to-png.scm +++ b/scm/ps-to-png.scm @@ -96,7 +96,7 @@ header)))) (if match (string->number (match:substring match 1)) 0))) -(define-public (make-ps-images ps-name . rest) +(define-public (make-ps-images base-name tmp-name is-eps . rest) (let-keywords* rest #f ((resolution 90) @@ -114,17 +114,14 @@ ((string-contains format-str "jpeg") "jpeg") (else (ly:error "Unknown pixmap format ~a" pixmap-format)))) - (base (string-join - (string-split (dir-basename ps-name ".ps" ".eps") #\%) - "%%")) - (png1 (format #f "~a.~a" base extension)) - (pngn (format #f "~a-page%d.~a" base extension)) - (page-count (ps-page-count ps-name)) + (png1 (format #f "~a.~a" base-name extension)) + (pngn (format #f "~a-page%d.~a" base-name extension)) + (page-count (ps-page-count tmp-name)) (multi-page? (> page-count 1)) (output-file (if multi-page? pngn png1)) (gs-variable-options - (if (string-suffix-ci? ".eps" ps-name) + (if is-eps "-dEPSCrop" (format #f "-dDEVICEWIDTHPOINTS=~,2f -dDEVICEHEIGHTPOINTS=~,2f" page-width page-height))) @@ -144,7 +141,7 @@ gs-variable-options pixmap-format output-file - (* anti-alias-factor resolution) ps-name)) + (* anti-alias-factor resolution) tmp-name)) (status 0) (files '())) @@ -161,9 +158,9 @@ (if multi-page? (map (lambda (n) - (format #f "~a-page~a.png" base (1+ n))) + (format #f "~a-page~a.png" base-name (1+ n))) (iota page-count)) - (list (format #f "~a.png" base)))) + (list (format #f "~a.png" base-name)))) (if (not (= 0 status)) (begin -- 2.39.2