From: Patrick McCarty Date: Mon, 8 Feb 2010 23:01:36 +0000 (-0800) Subject: PS backend: move system-filtering code to backend-library. X-Git-Tag: release/2.13.13-1~13 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=d473dbfc4a6f500b14ccdd78a33675b90151f775;p=lilypond.git PS backend: move system-filtering code to backend-library. The SVG backend will need this code, so the backend-library is a better place for it. --- diff --git a/scm/backend-library.scm b/scm/backend-library.scm index 5116fecd82..90c0cd07ed 100644 --- a/scm/backend-library.scm +++ b/scm/backend-library.scm @@ -20,6 +20,7 @@ ;; backend helpers. (use-modules (scm ps-to-png) + (scm paper-system) (ice-9 optargs)) (define-public (ly:system command . rest) @@ -201,6 +202,26 @@ 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) diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 7b993fbb2b..baacb96124 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -602,20 +602,8 @@ fonts inline." (define-public (output-preview-framework basename book scopes fields) (let* ((paper (ly:paper-book-paper book)) - (systems (ly:paper-book-systems book)) - (to-dump-systems '())) - ;; skip booktitles. - (if (and (not (ly:get-option 'include-book-title-preview)) - (pair? systems) - (ly:prob-property (car systems) 'is-book-title #f)) - (set! systems (cdr 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) + (systems (relevant-book-systems book)) + (to-dump-systems (relevant-dump-systems systems))) (dump-stencil-as-EPS paper (stack-stencils Y DOWN 0.0 (map paper-system-stencil