OLD | NEW |
1 ;;;; | 1 ;;;; |
2 ;;;; lily-library.scm -- utilities | 2 ;;;; lily-library.scm -- utilities |
3 ;;;; | 3 ;;;; |
4 ;;;; source file of the GNU LilyPond music typesetter | 4 ;;;; source file of the GNU LilyPond music typesetter |
5 ;;;; | 5 ;;;; |
6 ;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org> | 6 ;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org> |
7 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> | 7 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> |
8 | 8 |
9 ; for take, drop, take-while, list-index, and find-tail: | 9 ; for take, drop, take-while, list-index, and find-tail: |
10 (use-modules (srfi srfi-1)) | 10 (use-modules (srfi srfi-1)) |
(...skipping 117 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
128 (define-public (scorify-music music parser) | 128 (define-public (scorify-music music parser) |
129 "Preprocess MUSIC." | 129 "Preprocess MUSIC." |
130 | 130 |
131 (for-each (lambda (func) | 131 (for-each (lambda (func) |
132 (set! music (func music parser))) | 132 (set! music (func music parser))) |
133 toplevel-music-functions) | 133 toplevel-music-functions) |
134 | 134 |
135 (ly:make-score music)) | 135 (ly:make-score music)) |
136 | 136 |
137 | 137 |
138 (define (get-outfile-name parser base) | 138 (define (get-current-filename parser) |
139 (let* ((output-suffix (ly:parser-lookup parser 'output-suffix)) | 139 "return any suffix value for output filename allowing for settings by |
140 » (counter-alist (ly:parser-lookup parser 'counter-alist)) | 140 calls to bookOutputName function" |
141 » (output-count (assoc-get output-suffix counter-alist 0)) | 141 (let ((book-filename (ly:parser-lookup parser 'book-filename))) |
142 » (result base)) | 142 (if (not book-filename) |
| 143 » (ly:parser-output-name parser) |
| 144 » book-filename))) |
| 145 |
| 146 (define (get-current-suffix parser) |
| 147 "return any suffix value for output filename allowing for settings by calls to |
| 148 bookoutput function" |
| 149 (let ((book-output-suffix (ly:parser-lookup parser 'book-output-suffix))) |
| 150 (if (not (string? book-output-suffix)) |
| 151 » (ly:parser-lookup parser 'output-suffix) |
| 152 » book-output-suffix))) |
| 153 |
| 154 (define-public current-outfile-name #f) ; for use by regression tests |
| 155 |
| 156 (define (get-outfile-name parser) |
| 157 "return current filename for generating backend output files" |
| 158 ;; user can now override the base file name, so we have to use |
| 159 ;; the file-name concatenated with any potential output-suffix value |
| 160 ;; as the key to out internal a-list |
| 161 (let* ((base-name (get-current-filename parser)) |
| 162 » (output-suffix (get-current-suffix parser)) |
| 163 » (alist-key (format "~a~a" base-name output-suffix)) |
| 164 » (counter-alist (ly:parser-lookup parser 'counter-alist))· |
| 165 » (output-count (assoc-get alist-key counter-alist 0)) |
| 166 » (result base-name)) |
143 ;; Allow all ASCII alphanumerics, including accents | 167 ;; Allow all ASCII alphanumerics, including accents |
144 (if (string? output-suffix) | 168 (if (string? output-suffix) |
145 » (set! result (format "~a-~a" | 169 (set! result |
146 » » » base (string-regexp-substitute | 170 (format "~a-~a" |
147 » » » » "[^-[:alnum:]]" "_" output-suffix)))) | 171 result |
148 | 172 (string-regexp-substitute |
| 173 "[^-[:alnum:]]" |
| 174 "_" |
| 175 output-suffix)))) |
| 176 ···· |
149 ;; assoc-get call will always have returned a number | 177 ;; assoc-get call will always have returned a number |
150 (if (> output-count 0) | 178 (if (> output-count 0) |
151 » (set! result (format #f "~a-~a" result output-count))) | 179 (set! result (format #f "~a-~a" result output-count))) |
152 | 180 |
153 (ly:parser-define! | 181 (ly:parser-define! |
154 parser 'counter-alist | 182 parser 'counter-alist |
155 (assoc-set! counter-alist output-suffix (1+ output-count))) | 183 (assoc-set! counter-alist alist-key (1+ output-count))) |
| 184 (set! current-outfile-name result) |
156 result)) | 185 result)) |
157 | 186 |
158 (define (print-book-with parser book process-procedure) | 187 (define (print-book-with parser book process-procedure) |
159 (let* ((paper (ly:parser-lookup parser '$defaultpaper)) | 188 (let* ((paper (ly:parser-lookup parser '$defaultpaper)) |
160 (layout (ly:parser-lookup parser '$defaultlayout)) | 189 (layout (ly:parser-lookup parser '$defaultlayout)) |
161 » (count (ly:parser-lookup parser 'output-count)) | 190 » (outfile-name (get-outfile-name parser))) |
162 » (base (ly:parser-output-name parser)) | |
163 » (outfile-name (get-outfile-name parser base))) | |
164 | |
165 (process-procedure book paper layout outfile-name))) | 191 (process-procedure book paper layout outfile-name))) |
166 | 192 |
167 (define-public (print-book-with-defaults parser book) | 193 (define-public (print-book-with-defaults parser book) |
168 (print-book-with parser book ly:book-process)) | 194 (print-book-with parser book ly:book-process)) |
169 | 195 |
170 (define-public (print-book-with-defaults-as-systems parser book) | 196 (define-public (print-book-with-defaults-as-systems parser book) |
171 (print-book-with parser book ly:book-process-to-systems)) | 197 (print-book-with parser book ly:book-process-to-systems)) |
172 | 198 |
173 ;; Add a score to the current bookpart, book or toplevel | 199 ;; Add a score to the current bookpart, book or toplevel |
174 (define-public (add-score parser score) | 200 (define-public (add-score parser score) |
(...skipping 516 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
691 (format #f | 717 (format #f |
692 (_ "no \\version statement found, please add~afor future compatibili
ty") | 718 (_ "no \\version statement found, please add~afor future compatibili
ty") |
693 (format #f "\n\n\\version ~s\n\n" (lilypond-version))))) | 719 (format #f "\n\n\\version ~s\n\n" (lilypond-version))))) |
694 | 720 |
695 (define-public (old-relative-not-used-message input-file-name) | 721 (define-public (old-relative-not-used-message input-file-name) |
696 (ly:message | 722 (ly:message |
697 "~a:0: ~a ~a" | 723 "~a:0: ~a ~a" |
698 input-file-name | 724 input-file-name |
699 (_ "warning:") | 725 (_ "warning:") |
700 (_ "old relative compatibility not used"))) | 726 (_ "old relative compatibility not used"))) |
OLD | NEW |