From: Ian Hulin Date: Thu, 12 Nov 2009 22:20:36 +0000 (+0000) Subject: Tracker 836: Add facility to change output file-name for a \book block X-Git-Tag: release/2.13.8-1~52 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=cacc27ec40e1d28f6667bc0f29789637a3ed09ad;p=lilypond.git Tracker 836: Add facility to change output file-name for a \book block ...or to set a suffix to prevent multiple files over-writing each other during a compilation. This change allows user to do this via functions rather than having to do so by using set! and define on parser variables in Scheme. --- diff --git a/lily/parser.yy b/lily/parser.yy index 813452ef59..f4fa5f4e2b 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -44,7 +44,7 @@ of the parse stack onto the heap. */ or - \repeat { \repeat } \alternative + \repeat { \repeat } \alternative */ @@ -151,8 +151,8 @@ void set_music_properties (Music *p, SCM a); FIXME: Bison needs to translate some of these, eg, STRING. -*/ - +*/ + /* Keyword tokens with plain escaped name. */ %token ACCEPTS "\\accepts" %token ADDLYRICS "\\addlyrics" @@ -672,6 +672,8 @@ book_body: push_paper (PARSER, $$->paper_); $$->header_ = PARSER->lexer_->lookup_identifier ("$defaultheader"); PARSER->lexer_->set_identifier (ly_symbol2scm ("$current-book"), $$->self_scm ()); + PARSER->lexer_->set_identifier (ly_symbol2scm ("book-output-suffix"), SCM_BOOL_F); + PARSER->lexer_->set_identifier (ly_symbol2scm ("book-filename"), SCM_BOOL_F); } | BOOK_IDENTIFIER { $$ = unsmob_book ($1); diff --git a/ly/init.ly b/ly/init.ly index 93048100ae..20416624c2 100644 --- a/ly/init.ly +++ b/ly/init.ly @@ -12,14 +12,15 @@ #(ly:set-option 'old-relative #f) #(define toplevel-scores (list)) #(define toplevel-bookparts (list)) -#(define output-count 0) #(define $defaultheader #f) #(define $current-book #f) #(define $current-bookpart #f) #(define version-seen #f) -#(define expect-error #f) +#(define expect-error #f) #(define output-empty-score-list #f) #(define output-suffix #f) +#(define book-filename #f) +#(define book-output-suffix #f) #(use-modules (scm clip-region)) \maininput %% there is a problem at the end of the input file diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index 4283157d6a..f016fe0eaf 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -130,7 +130,7 @@ balloonGrobText = #(define-music-function (parser location grob-name offset text) (symbol? number-pair? markup?) (_i "Attach @var{text} to @var{grob-name} at offset @var{offset} -(use like @code{\\once})") +use like @code{\\once})") (make-music 'AnnotateOutputEvent 'symbol grob-name 'X-offset (car offset) @@ -169,7 +169,20 @@ bendAfter = #(define-music-function (parser location delta) (real?) (_i "Create a fall or doit of pitch interval @var{delta}.") (make-music 'BendAfterEvent - 'delta-step delta)) + 'delta-step delta)) + +bookOutputName = +#(define-music-function (parser location newfilename) (string?) + (_i "Direct output for the current book block to @var{newfilename}.") + (set! book-filename newfilename) + (make-music 'SequentialMusic 'void #t)) + +bookOutputSuffix = +#(define-music-function (parser location newsuffix) (string?) + (_i "Set the output filename suffix for the current book block to +@var{newsuffix}.") + (set! book-output-suffix newsuffix) + (make-music 'SequentialMusic 'void #t)) %% why a function? breathe = @@ -586,7 +599,7 @@ partcombine = #(define-music-function (parser location part1 part2) (ly:music? ly:music?) (_i "Take the music in @var{part1} and @var{part2} and typeset so that they share a staff.") (make-part-combine-music parser - (list part1 part2))) + (list part1 part2))) pitchedTrill = #(define-music-function @@ -594,35 +607,32 @@ pitchedTrill = (ly:music? ly:music?) (_i "Print a trill with @var{main-note} as the main note of the trill and print @var{secondary-note} as a stemless note head in parentheses.") - (let* - ((get-notes (lambda (ev-chord) - (filter - (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name))) - (ly:music-property ev-chord 'elements)))) - (sec-note-events (get-notes secondary-note)) - (trill-events (filter (lambda (m) (music-has-type m 'trill-span-event)) - (ly:music-property main-note 'elements)))) + (let* ((get-notes (lambda (ev-chord) + (filter + (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name))) + (ly:music-property ev-chord 'elements)))) + (sec-note-events (get-notes secondary-note)) + (trill-events (filter (lambda (m) (music-has-type m 'trill-span-event)) + (ly:music-property main-note 'elements)))) (if (pair? sec-note-events) - (begin - (let* - ((trill-pitch (ly:music-property (car sec-note-events) 'pitch)) - (forced (ly:music-property (car sec-note-events ) 'force-accidental))) - - (if (ly:pitch? trill-pitch) - (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch)) - trill-events) - (begin - (ly:warning (_ "Second argument of \\pitchedTrill should be single note: ")) - (display sec-note-events))) - - (if (eq? forced #t) - (for-each (lambda (m) (ly:music-set-property! m 'force-accidental forced)) - trill-events))))) + (begin + (let* ((trill-pitch (ly:music-property (car sec-note-events) 'pitch)) + (forced (ly:music-property (car sec-note-events) 'force-accidental))) + + (if (ly:pitch? trill-pitch) + (for-each (lambda (m) + (ly:music-set-property! m 'pitch trill-pitch)) trill-events) + (begin + (ly:warning (_ "Second argument of \\pitchedTrill should be single note: ")) + (display sec-note-events))) + + (if (eq? forced #t) + (for-each (lambda (m) + (ly:music-set-property! m 'force-accidental forced)) + trill-events))))) main-note)) - - quoteDuring = #(define-music-function (parser location what main-music) @@ -631,12 +641,10 @@ quoteDuring = of the quoted voice, as specified in an @code{\\addQuote} command. @var{main-music} is used to indicate the length of music to be quoted; usually contains spacers or multi-measure rests.") - (make-music 'QuoteMusic - 'element main-music - 'quoted-music-name what - 'origin location)) - - + (make-music 'QuoteMusic + 'element main-music + 'quoted-music-name what + 'origin location)) removeWithTag = #(define-music-function diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 572972169f..b2255b7381 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -135,33 +135,59 @@ (ly:make-score music)) -(define (get-outfile-name parser base) - (let* ((output-suffix (ly:parser-lookup parser 'output-suffix)) +(define (get-current-filename parser) + "return any suffix value for output filename allowing for settings by +calls to bookOutputName function" + (let ((book-filename (ly:parser-lookup parser 'book-filename))) + (if (not book-filename) + (ly:parser-output-name parser) + book-filename))) + +(define (get-current-suffix parser) + "return any suffix value for output filename allowing for settings by calls to +bookoutput function" + (let ((book-output-suffix (ly:parser-lookup parser 'book-output-suffix))) + (if (not (string? book-output-suffix)) + (ly:parser-lookup parser 'output-suffix) + book-output-suffix))) + +(define-public current-outfile-name #f) ; for use by regression tests + +(define (get-outfile-name parser) + "return current filename for generating backend output files" + ;; user can now override the base file name, so we have to use + ;; the file-name concatenated with any potential output-suffix value + ;; as the key to out internal a-list + (let* ((base-name (get-current-filename parser)) + (output-suffix (get-current-suffix parser)) + (alist-key (format "~a~a" base-name output-suffix)) (counter-alist (ly:parser-lookup parser 'counter-alist)) - (output-count (assoc-get output-suffix counter-alist 0)) - (result base)) + (output-count (assoc-get alist-key counter-alist 0)) + (result base-name)) ;; Allow all ASCII alphanumerics, including accents (if (string? output-suffix) - (set! result (format "~a-~a" - base (string-regexp-substitute - "[^-[:alnum:]]" "_" output-suffix)))) + (set! result + (format "~a-~a" + result + (string-regexp-substitute + "[^-[:alnum:]]" + "_" + output-suffix)))) ;; assoc-get call will always have returned a number (if (> output-count 0) - (set! result (format #f "~a-~a" result output-count))) + (set! result (format #f "~a-~a" result output-count))) (ly:parser-define! - parser 'counter-alist - (assoc-set! counter-alist output-suffix (1+ output-count))) + parser 'counter-alist + (assoc-set! counter-alist alist-key (1+ output-count))) + (set! current-outfile-name result) result)) (define (print-book-with parser book process-procedure) (let* ((paper (ly:parser-lookup parser '$defaultpaper)) (layout (ly:parser-lookup parser '$defaultlayout)) - (count (ly:parser-lookup parser 'output-count)) - (base (ly:parser-output-name parser)) - (outfile-name (get-outfile-name parser base))) - + (outfile-name (get-outfile-name parser))) (process-procedure book paper layout outfile-name))) (define-public (print-book-with-defaults parser book)