X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fbackend-library.scm;h=cc689d848273502ada9073aa84e05880d9a82a77;hb=881db1b187834477b7da0cf6f21552f768bccd8b;hp=c09e7572d5d3d0a77f687ca37c71e2c6e6c0bd3a;hpb=a4992991028b90b7080ad53a942bdb6c268e9a3c;p=lilypond.git diff --git a/scm/backend-library.scm b/scm/backend-library.scm index c09e7572d5..cc689d8482 100644 --- a/scm/backend-library.scm +++ b/scm/backend-library.scm @@ -1,13 +1,28 @@ -;;;; backend-library.scm -- helpers for the backends. +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2005--2006 Jan Nieuwenhuizen +;;;; Copyright (C) 2005--2010 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; backend helpers. +(use-modules (scm ps-to-png) + (scm paper-system) + (ice-9 optargs)) + (define-public (ly:system command . rest) (let* ((status 0) (dev-null "/dev/null") @@ -16,7 +31,9 @@ command (format #f "~a > ~a 2>&1 " command dev-null)))) (if (ly:get-option 'verbose) - (ly:message (_ "Invoking `~a'...") command)) + (begin + (ly:message (_ "Invoking `~a'...") command)) + (ly:progress "\n")) (set! status (if (pair? rest) @@ -71,24 +88,24 @@ (define-public (postscript->pdf paper-width paper-height name) (let* ((pdf-name (string-append - (basename (basename name ".ps") ".eps") + (dir-basename name ".ps" ".eps") ".pdf")) (is-eps (string-match "\\.eps$" name)) (paper-size-string (if is-eps - " -dEPSCrop " - (format "-dDEVICEWIDTHPOINTS=~,2f \ --dDEVICEHEIGHTPOINTS=~,2f " - paper-width paper-height ))) + "-dEPSCrop" + (ly:format "-dDEVICEWIDTHPOINTS=~$\ + -dDEVICEHEIGHTPOINTS=~$" + paper-width paper-height))) - (cmd (format #f + (cmd (ly:format "~a\ ~a\ ~a\ ~a\ - -dCompatibilityLevel=1.4 \ + -dCompatibilityLevel=1.4\ -dNOPAUSE\ -dBATCH\ - -r1200 \ + -r1200\ -sDEVICE=pdfwrite\ -sOutputFile=~S\ -c .setpdfwrite\ @@ -96,9 +113,10 @@ " (search-gs) (if (ly:get-option 'verbose) "" "-q") - (if (ly:get-option 'gs-load-fonts) - " -dNOSAFER " - " -dSAFER ") + (if (or (ly:get-option 'gs-load-fonts) + (ly:get-option 'gs-load-lily-fonts)) + "-dNOSAFER" + "-dSAFER") paper-size-string pdf-name name))) @@ -109,22 +127,16 @@ (set! cmd (string-regexp-substitute "=" "#" cmd)) (set! cmd (string-regexp-substitute "-dSAFER " "" cmd)))) - (if (access? pdf-name W_OK) - (delete-file pdf-name)) - (ly:message (_ "Converting to `~a'...") pdf-name) (ly:progress "\n") (ly:system cmd))) -(use-modules (scm ps-to-png)) - (define-public (postscript->png resolution paper-width paper-height name) - ;; 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'...") - ;; (string-append (basename name ".ps") "-page1.png" ))) (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 #:resolution resolution @@ -138,15 +150,15 @@ (define-public (postprocess-output paper-book module filename formats) (let* ((completed (completize-formats formats)) - (base (string-regexp-substitute "\\.[a-z]+$" "" filename)) + (base (dir-basename filename ".ps" ".eps")) (intermediate (remove (lambda (x) (member x formats)) completed))) - (for-each (lambda (f) ((eval (string->symbol (format "convert-to-~a" f)) module) paper-book filename)) completed) (if (ly:get-option 'delete-intermediate-files) (for-each (lambda (f) - (delete-file (string-append base "." f))) intermediate)))) + (if (file-exists? f) (delete-file f))) + (map (lambda (x) (string-append base "." x)) intermediate))))) (define-public (completize-formats formats) (define new-fmts '()) @@ -156,7 +168,7 @@ (set! formats (cons "ps" formats))) (for-each (lambda (x) (if (member x formats) (set! new-fmts (cons x new-fmts)))) - '("tex" "dvi" "ps" "pdf" "png")) + '("ps" "pdf" "png")) (uniq-list (reverse new-fmts))) (define (header-to-file file-name key value) @@ -188,3 +200,46 @@ scope))) (apply string-append (map output-scope scopes))) +(define-public (relevant-book-systems book) + (let ((systems (ly:paper-book-systems book))) + ;; skip booktitles. + (if (and (not (ly:get-option 'include-book-title-preview)) + (pair? systems) + (ly:prob-property (car systems) 'is-book-title #f)) + (cdr systems) + systems))) + +(define-public (relevant-dump-systems systems) + (let ((to-dump-systems '())) + (for-each + (lambda (sys) + (if (or (paper-system-title? sys) + (not (pair? to-dump-systems)) + (paper-system-title? (car to-dump-systems))) + (set! to-dump-systems (cons sys to-dump-systems)))) + systems) + to-dump-systems)) + +(define missing-stencil-list '()) + +(define-public (backend-testing output-module) + (define (missing-stencil-expression name) + (begin + (ly:warning (_ "missing stencil expression `~S'") name) + "")) + + (map (lambda (x) + (if (not (module-defined? output-module x)) + (begin + (module-define! output-module x + (lambda* (#:optional y . z) + (missing-stencil-expression x))) + (set! missing-stencil-list (append (list x) + missing-stencil-list))))) + (ly:all-stencil-commands))) + +(define-public (remove-stencil-warnings output-module) + (for-each + (lambda (x) + (module-remove! output-module x)) + missing-stencil-list))