...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.
or
- \repeat { \repeat } \alternative
+ \repeat { \repeat } \alternative
*/
FIXME: Bison needs to translate some of these, eg, STRING.
-*/
-
+*/
+
/* Keyword tokens with plain escaped name. */
%token ACCEPTS "\\accepts"
%token ADDLYRICS "\\addlyrics"
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);
#(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
#(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)
#(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 =
#(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
(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)
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
(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)
projects / lilypond.git / commitdiff