[PATCH]: Tracker 836 - Allow output filename and output-suffix to be specified for a \book block

[Ian Hulin]

init.ly - Add new parser variables book-output-suffix and book-filename initialized as #f and empty queue/stack structure.

music-functions-init.ly adds three new functions

• \bookOutputSuffix - to set the output suffix for the \book block
• \bookOutputName - to set output filename for the current \book block
• \bookOuptutNameRevert - to restore the the output filename to the value prior to that of the last \bookOuputName call.

\bookOutputName and \bookOuptutNameRevert use the book-filename as a stack structure.  I have used this so we can we could eventually allow users to do stuff like the following (controlling the names used to open the midi files is not part of the current patch).
\book {
    \bookOutputName "My-Homeland"
    \score {
       \bookOutputName "Vysehrad"
          music-declarations ...
          \midi{
          % midi file gets written to Vysehrad.mid(i)
          }
          \layout{
          }
       \bookOutputNameRevert
    }
    \score {
        \bookOuputName "Vltava"
        ...
        \midi {
        % midi file is written to Vltava.mid(i)
        }
    }
.
.
. 

lily-library.scm has changes to the filename generating code in print-book-with to pick up the current values of the new parser variables if set before using the current output-suffix or result of a call to ly:parser-output-name.
The routine to get the name now uses as combination of the current output name and output suffix value to at as a key for the internal a-list of filenames being written to during a compilation.

lily-guile.hh, lily-guile.cc and parser.yy have code that I would like to use to re-initialize book-output-suffix and book-filename to initial values on encountering the end of a \book block, but  I've hit a dead-end currently in this  as the code I tried to use in parser.yy negates the effect of calling the new functions altogether.  If anyone with more experience of how bison works has any better ideas as to how do this I'd be interested in hearing them.

Thanks in advance for any feedback.

Cheers,

Ian Hulin

>From c99522fea1e518f33b24307b7b64f5780bb34add Mon Sep 17 00:00:00 2001
From: ian <address@hidden>
Date: Fri, 23 Oct 2009 02:06:24 +0100
Subject: [PATCH] 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 to this via functions rather than having to do so
  so by manipulating semi-documented parser variables.

---
 input/regression/backend-svg.ly |    4 +-
 lily/include/lily-guile.hh      |    2 +
 lily/lily-guile.cc              |   11 ++++++++
 lily/parser.yy                  |    7 +++++
 ly/init.ly                      |    3 ++
 ly/music-functions-init.ly      |   52 +++++++++++++++++++++++++++------------
 scm/lily-library.scm            |   52 ++++++++++++++++++++++++++++----------
 7 files changed, 99 insertions(+), 32 deletions(-)

diff --git a/input/regression/backend-svg.ly b/input/regression/backend-svg.ly
index 69116f1..b8b6ffd 100644
--- a/input/regression/backend-svg.ly
+++ b/input/regression/backend-svg.ly
@@ -1,6 +1,6 @@
 %{
 #(ly:set-option 'backend 'svg)
-#(set! output-count 1)
+#(define output-suffix "1")
 
 
 \include "typography-demo.ly"
@@ -26,7 +26,7 @@
    (format #f "FONTCONFIG_FILE=~a/fonts/fonts.conf" (ly:effective-prefix))
    (ly:start-environment)))
 
-#(set! output-count 0)
+#(define output-suffix #f)
 #(set-default-paper-size "a5")
 
 \book { 
diff --git a/lily/include/lily-guile.hh b/lily/include/lily-guile.hh
index 859131a..ec1b0b0 100644
--- a/lily/include/lily-guile.hh
+++ b/lily/include/lily-guile.hh
@@ -117,6 +117,8 @@ inline SCM ly_append4 (SCM x1, SCM x2, SCM x3, SCM x4)
   return scm_append (scm_listify (x1, x2, x3, x4, SCM_UNDEFINED));
 }
 
+SCM ly_scm_make_q ();
+
 /*
   display and print newline.
 */
diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc
index d81eec8..f3054b9 100644
--- a/lily/lily-guile.cc
+++ b/lily/lily-guile.cc
@@ -187,6 +187,17 @@ to_boolean (SCM s)
 }
 
 /*
+ QUEUES - for compatibility with (ice-9 q)
+ 1. ly_scm_make_q - initialize a queue
+*/
+
+SCM
+ly_scm_make_q ()
+{  
+    return scm_cons ( SCM_EOL, SCM_BOOL_F);
+}
+
+/*
   DIRECTIONS
  */
 Direction
diff --git a/lily/parser.yy b/lily/parser.yy
index 813452e..12a3e6b 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -656,6 +656,13 @@ book_block:
                $$ = $3;
                pop_paper (PARSER);
                PARSER->lexer_->set_identifier (ly_symbol2scm 
("$current-book"), SCM_BOOL_F);
+/*             TODO
+*        It would be nice to scope book-output-suffix and book-filename to the 
current 
+*        book block, but using this cancels
+*        _all_ changes made by calling the functions in the \book block.
+*        PARSER->lexer_->set_identifier (ly_symbol2scm ("book-output-suffix"), 
SCM_BOOL_F); 
+*               PARSER->lexer_->set_identifier (ly_symbol2scm 
("book-filename"), ly_scm_make_q () ); 
+*/
        }
        ;
 
diff --git a/ly/init.ly b/ly/init.ly
index 5418b80..bc24247 100644
--- a/ly/init.ly
+++ b/ly/init.ly
@@ -7,6 +7,7 @@
 \version "2.12.0"
 
 \include "declarations-init.ly"
+#(use-modules (ice-9 q))
 
 #(ly:set-option 'old-relative #f)
 #(define toplevel-scores (list))
@@ -18,6 +19,8 @@
 #(define expect-error #f) 
 #(define output-empty-score-list #f)
 #(define output-suffix #f)
+#(define book-filename (make-q) )
+#(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 a8a2ece..797a7d9 100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -9,7 +9,8 @@
 
 %% need SRFI-1 for filter; optargs for lambda*
 #(use-modules (srfi srfi-1)
-             (ice-9 optargs))
+              (ice-9 optargs)
+              (ice-9 q))
 
 %% TODO: using define-music-function in a .scm causes crash.
 
@@ -179,8 +180,27 @@ breathe =
              'origin location
              'elements (list (make-music 'BreathingEvent))))
 
+bookOutputName =
+#(define-music-function (parser location newfilename) (string?)
+    (_i "Direct output for the current book block to @var{newfilename}")
+        (q-push! book-filename newfilename)
+        (make-music 'SequentialMusic 'void #t))
 
-
+bookOutputNameRevert =
+#(define-music-function (parser location) ()
+    (_i "Restore output name for current book block to its value prior to the
+ last @code{\\bookOutputName} call" )
+    (q-pop! book-filename)
+    (if (q-empty? book-filename)
+        (q-push book-filename (ly:parser-output-name parser) ))
+        (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))
 clef =
 #(define-music-function (parser location type) (string?)
   (_i "Set the current clef to @var{type}.")
@@ -323,7 +343,7 @@ killCues =
    (music-map
     (lambda (mus)
       (if (and (string? (ly:music-property mus 'quoted-music-name))
-              (string=? (ly:music-property mus 'quoted-context-id "") "cue"))
+              (string=? (ly:music-property mus 'quoted-context-id "") "cue"))
          (ly:music-property mus 'element)
          mus)) music))
 
@@ -449,8 +469,8 @@ or @code{\"GrobName\"}")
 %% because music identifiers are not allowed at top-level.
 pageBreak =
 #(define-music-function (location parser) ()
-   (_i "Force a page break. May be used at toplevel (i.e. between scores or
- markups), or inside a score.")
+   (_i "Force a page break. May be used at toplevel (ie between scores or
+markups), or inside a score.")
    (make-music 'EventChord
               'page-marker #t
               'line-break-permission 'force
@@ -584,16 +604,17 @@ parenthesize =
 
 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
+(_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)))
 
 pitchedTrill =
 #(define-music-function
-(_i "Print a trill with @var{main-note} as the main note of the trill and 
-print @var{secondary-note} as stemless note head in parentheses")
    (parser location main-note secondary-note)
    (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 stemless note head in parentheses.")
    (let*
        ((get-notes (lambda (ev-chord)
                     (filter
@@ -625,12 +646,12 @@ print @var{secondary-note} as stemless note head in 
parentheses")
 
 quoteDuring =
 #(define-music-function
-(_i "Indicate a section of music to be quoted.  @var{what} indicates the name 
-of the quoted voice, as specified in a @code{\\addQuote} command.  
address@hidden is used to indicate the length of music to be quoted;
-usually contains spacers or multi-measure rests.")
   (parser location what main-music)
   (string? ly:music?)
+  (_i "Indicate a section of the music to be quoted.  @var{what} indicates the 
name
+ of the quoted voice, as specified in a @code{\\addQuote} command.
+ @var{main-music} is used to indicate the length of the music to be quoted; it
+ usually contains spacers or multi-measure rests.")
   (make-music 'QuoteMusic
              'element main-music
              'quoted-music-name what
@@ -810,11 +831,10 @@ tweak =
 
 unfoldRepeats =
 #(define-music-function (parser location music) (ly:music?)
-   (_i "Force any @code{\\repeat volta}, @code{\\repeat tremolo} or
+(_i "Force any @code{\\repeat volta}, @code{\\repeat tremolo} or
  @code{\\repeat percent} commands in @var{music} to be interpreted
  as @code{\\repeat unfold}.")
-   (unfold-repeats music))
-
+                 (unfold-repeats music))
 
 
 withMusicProperty =
diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 827fb24..06289bc 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -7,7 +7,8 @@
 ;;;; Han-Wen Nienhuys <address@hidden>
 
 ; for take, drop, take-while, list-index, and find-tail:
-(use-modules (srfi srfi-1))
+(use-modules (srfi srfi-1) 
+    (ice-9 q))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; constants.
@@ -134,16 +135,39 @@
 
   (ly:make-score music))
 
-
-(define (get-outfile-name parser base)
-  (let* ((output-suffix (ly:parser-lookup parser 'output-suffix))
-        (counter-alist (ly:parser-lookup parser 'counter-alist))
-        (output-count (assoc-get output-suffix counter-alist 0))
-        (result base))
+;; return any suffix value for output filename allowing for settings by 
+;; calls to \bookOutputName
+(define (get-current-filename parser)
+        (let* (
+                (book-filename (ly:parser-lookup parser 'book-filename)))
+            (if (q-empty? book-filename)
+            (ly:parser-output-name parser)
+            (q-front book-filename))))
+
+;; return any suffix value for output filename allowing for settings by 
+;; calls to \bookOutputSuffix
+(define (get-current-suffix parser)
+   (let* (
+            (book-output-suffix (ly:parser-lookup parser 'book-output-suffix)))
+    (if (string? book-output-suffix)
+        (ly:parser-lookup parser 'book-output-suffix)
+        (ly:parser-lookup parser 'output-suffix))))
+(define-public current-outfile-name #f)
+(define (get-outfile-name parser)
+    ;; 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 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
+                             result (string-regexp-substitute
                                    "[^-[:alnum:]]" "_" output-suffix))))
 
     ;; assoc-get call will always have returned a number
@@ -152,15 +176,15 @@
 
     (ly:parser-define!
       parser 'counter-alist
-      (assoc-set! counter-alist output-suffix (1+ output-count)))
+      (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)))
+  (let* (
+        (paper (ly:parser-lookup parser '$defaultpaper))
+        (layout (ly:parser-lookup parser '$defaultlayout))
+        (outfile-name (get-outfile-name parser)))
 
     (process-procedure book paper layout outfile-name)))
 
-- 
1.6.0.4