[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.

[ian <ian@xxxxxxxxxxxx>]

---
 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.  
-@var{main-music} 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 <hanwen@xxxxxxxxx>
 
 ; 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


--------------050607000708070701000409--

---

----
Join the Frogs!