Reviewers: ,
Message:
I've found that LilyPond fail to compile the source file whose name
contains `%' to png files.
For example, the following command fails.
$ lilypond --png %foobar.ly
This patch solve it.
Description:
Fix png filename handling
This patch can compile the source file
whose name contains `%' and convert to png files.
(e.g. `%foobar.ly' to `%foobar.png')
Use ly:system in make-ps-images (ps-to-png.scm)
In make-ps-images,
use ly:system instead of my-system for invoking gs.
It is the same way as postscript->pdf
(backend-library.scm).
Delete duplicate procedures in ps-to-png.scm
PLATFORM: lily.scm
search-executable: backend-library.scm
search-gs: backend-library.scm
gulp-port: unused
Please review this at https://codereview.appspot.com/241760043/
Affected files (+36, -61 lines):
M scm/ps-to-png.scm
Index: scm/ps-to-png.scm
diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index
3b6b6c2452c719aa9963685d30861944172af19c..9c977b6463fd20d3a535ddcb353e567992736958
100644
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -31,32 +31,9 @@
(define-public _ gettext)
-(define PLATFORM
- (string->symbol
- (string-downcase
- (car (string-tokenize (utsname:sysname (uname)) char-set:letter)))))
-
(define (re-sub re sub string)
(regexp-substitute/global #f re string 'pre sub 'post))
-(define (search-executable names)
- (define (helper path lst)
- (if (null? (cdr lst))
- (car lst)
- (if (search-path path (car lst)) (car lst)
- (helper path (cdr lst)))))
-
- (let ((path (parse-path (getenv "PATH"))))
- (helper path names)))
-
-(define (search-gs)
- (search-executable '("gs-nox" "gs-8.15" "gs")))
-
-(define (gulp-port port max-length)
- (let ((str (make-string max-length)))
- (read-string!/partial str port 0 max-length)
- str))
-
(define-public (gulp-file file-name . max-size)
(ly:gulp-file file-name (if (pair? max-size) (car max-size))))
@@ -118,41 +95,44 @@
(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 is-eps
- "-dEPSCrop"
- (format #f "-dDEVICEWIDTHPOINTS=~,2f
-dDEVICEHEIGHTPOINTS=~,2f"
- page-width page-height)))
- (cmd (ly:format "~a\
- ~a\
- ~a\
- -dGraphicsAlphaBits=4\
- -dTextAlphaBits=4\
- -dNOPAUSE\
- -sDEVICE=~a\
- -sOutputFile=~S\
- -r~a\
- ~S\
- -c quit"
- (search-gs)
- (if be-verbose "" "-q")
- gs-variable-options
- pixmap-format
- output-file
- (* anti-alias-factor resolution) tmp-name))
- (status 0)
- (files '()))
- ;; The wrapper on windows cannot handle `=' signs,
- ;; gs has a workaround with #.
- (if (eq? PLATFORM 'windows)
- (begin
- (set! cmd (re-sub "=" "#" cmd))
- (set! cmd (re-sub "-dSAFER " "" cmd))))
+ ;; Escape `%' (except `page%d') for ghostscript
+ (base-name-gs (string-join
+ (string-split base-name #\%)
+ "%%"))
+ (png1-gs (format #f "~a.~a" base-name-gs extension))
+ (pngn-gs (format #f "~a-page%d.~a" base-name-gs extension))
+ (output-file (if multi-page? pngn-gs png1-gs))
+
+ (*unspecified* (if #f #f))
+ (cmd
+ (remove (lambda (x) (eq? x *unspecified*))
+ (list
+ (search-gs)
+ (if (ly:get-option 'verbose) *unspecified* "-q")
+ (if (or (ly:get-option 'gs-load-fonts)
+ (ly:get-option 'gs-load-lily-fonts)
+ (eq? PLATFORM 'windows))
+ "-dNOSAFER"
+ "-dSAFER")
+
+ (if is-eps
+ "-dEPSCrop"
+ (ly:format "-dDEVICEWIDTHPOINTS=~$" page-width))
+ (if is-eps
+ *unspecified*
+ (ly:format "-dDEVICEHEIGHTPOINTS=~$" page-height))
+ "-dGraphicsAlphaBits=4"
+ "-dTextAlphaBits=4"
+ "-dNOPAUSE"
+ "-dBATCH"
+ (ly:format "-sDEVICE=~a" pixmap-format)
+ (string-append "-sOutputFile=" output-file)
+ (ly:format "-r~a" (* anti-alias-factor resolution))
+ (string-append "-f" tmp-name))))
+ (files '()))
- (set! status (my-system be-verbose #f cmd))
+ (ly:system cmd)
(set! files
(if multi-page?
@@ -162,11 +142,6 @@
(iota page-count))
(list (format #f "~a.png" base-name))))
- (if (not (= 0 status))
- (begin
- (for-each delete-file files)
- (exit 1)))
-
(if (and rename-page-1 multi-page?)
(begin
(rename-file (re-sub "%d" "1" pngn) png1)
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-devel
