X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily-library.scm;h=8176db1d7b66ee31ec1ebd4f881709e662cc8545;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=2758825016cae1ed73b0aafeee287991754e32a8;hpb=5bb1618e65e0b8031b9aed8d5f218986e3d3c5a0;p=lilypond.git

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 2758825016..8176db1d7b 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -3,7 +3,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2008 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -56,36 +56,67 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; parser <-> output hooks.
-
 		
+(define-public (collect-bookpart-for-book parser book-part)
+  "Toplevel book-part handler"
+  (define (add-bookpart book-part)
+    (ly:parser-define!
+       parser 'toplevel-bookparts
+       (cons book-part (ly:parser-lookup parser 'toplevel-bookparts))))
+  ;; If toplevel scores have been found before this \bookpart,
+  ;; add them first to a dedicated bookpart
+  (if (pair? (ly:parser-lookup parser 'toplevel-scores))
+      (begin
+	(add-bookpart (ly:make-book-part
+		       (ly:parser-lookup parser 'toplevel-scores)))
+	(ly:parser-define! parser 'toplevel-scores (list))))
+  (add-bookpart book-part))
+
 (define-public (collect-scores-for-book parser score)
   (ly:parser-define!
    parser 'toplevel-scores
    (cons score (ly:parser-lookup parser 'toplevel-scores))))
 
-(define-public (collect-music-for-book parser music)
+(define-public (collect-music-aux score-handler parser music)
   (define (music-property symbol)
     (let ((value (ly:music-property music symbol)))
       (if (not (null? value))
 	  value
 	  #f)))
   (cond ((music-property 'page-marker)
-	 ;; a page marker: set page break/turn permissions
-	 (for-each (lambda (symbol)
-		     (let ((permission (music-property symbol)))
-		       (if (symbol? permission)
-			   (collect-scores-for-book
-			    parser
-			    (ly:make-page-marker symbol
-						 (if (eqv? 'forbid permission)
-						     '()
-						     permission))))))
-		   (list 'line-break-permission 'page-break-permission
-                         'page-turn-permission)))
+	 ;; a page marker: set page break/turn permissions or label
+	 (begin
+	   (let ((label (music-property 'page-label)))
+	     (if (symbol? label)
+		 (score-handler (ly:make-page-label-marker label))))
+	   (for-each (lambda (symbol)
+		       (let ((permission (music-property symbol)))
+			 (if (symbol? permission)
+			     (score-handler
+			      (ly:make-page-permission-marker symbol
+							      (if (eqv? 'forbid permission)
+								  '()
+								  permission))))))
+		     (list 'line-break-permission 'page-break-permission
+			   'page-turn-permission))))
 	((not (music-property 'void))
 	 ;; a regular music expression: make a score with this music
 	 ;; void music is discarded
-	 (collect-scores-for-book parser (scorify-music music parser)))))
+	 (score-handler (scorify-music music parser)))))
+
+(define-public (collect-music-for-book parser music)
+  "Top-level music handler"
+  (collect-music-aux (lambda (score)
+		       (collect-scores-for-book parser score))
+                     parser
+		     music))
+
+(define-public (collect-book-music-for-book parser book music)
+  "Book music handler"
+  (collect-music-aux (lambda (score)
+		       (ly:book-add-score! book score))
+                     parser
+		     music))
 
 (define-public (scorify-music music parser)
   "Preprocess MUSIC."
@@ -100,9 +131,13 @@
   (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)))
+       (base (ly:parser-output-name parser))
+       (output-suffix (ly:parser-lookup parser 'output-suffix)) )
+
+    (if (string? output-suffix)
+	(set! base (format "~a-~a" base (string-regexp-substitute
+					   "[^a-zA-Z0-9-]" "_" output-suffix))))
 
     ;; must be careful: output-count is under user control.
     (if (not (integer? count))
@@ -110,7 +145,6 @@
 
     (if (> count 0)
 	(set! base (format #f "~a-~a" base count)))
-
     (ly:parser-define! parser 'output-count (1+ count))
     (process-procedure book paper layout base)
     ))
@@ -289,13 +323,13 @@ found."
   (lset-difference eq? a b))
 
 (define-public (uniq-list lst)
-  "Uniq LST, assuming that it is sorted"
+  "Uniq LST, assuming that it is sorted. Uses equal? for comparisons."
 
   (reverse! 
    (fold (lambda (x acc)
 	   (if (null? acc)
 	       (list x)
-	       (if (eq? x (car acc))
+	       (if (equal? x (car acc))
 		   acc
 		   (cons x acc))))
 	 '() lst) '()))
@@ -471,6 +505,11 @@ found."
   (string-append (ly:number->string (car c)) " "
 		 (ly:number->string (cdr c))))
 
+(define-public (dir-basename file . rest)
+  "Strip suffixes in REST, but leave directory component for FILE."
+  (define (inverse-basename x y) (basename y x))
+  (simple-format #f "~a/~a" (dirname file)
+		 (fold inverse-basename file rest)))
 
 (define-public (write-me message x)
   "Return X.  Display MESSAGE and write X.  Handy for debugging,