Run `make grand-replace'.

[lilypond.git] / scm / lily-library.scm

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 068bbb2873688b478fd0cd31ca75a0200ab5bc1b..8176db1d7b66ee31ec1ebd4f881709e662cc8545 100644 (file)
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -3,7 +3,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 

-;;;; (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2008 Jan Nieuwenhuizen <janneke@gnu.org>

 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


@@ -56,14 +56,28 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; parser <-> output hooks.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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-scores-for-book parser score)
   (ly:parser-define!
    parser 'toplevel-scores
    (cons score (ly:parser-lookup parser 'toplevel-scores))))
 

-(define (collect-music-aux score-handler 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))
   (define (music-property symbol)
     (let ((value (ly:music-property music symbol)))
       (if (not (null? value))


@@ -117,9 +131,13 @@
   (let*
       ((paper (ly:parser-lookup parser '$defaultpaper))
        (layout (ly:parser-lookup parser '$defaultlayout))
   (let*
       ((paper (ly:parser-lookup parser '$defaultpaper))
        (layout (ly:parser-lookup parser '$defaultlayout))

-

        (count (ly:parser-lookup parser 'output-count))
        (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))
 
     ;; must be careful: output-count is under user control.
     (if (not (integer? count))


@@ -127,7 +145,6 @@
 
     (if (> count 0)
        (set! base (format #f "~a-~a" base count)))
 
     (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)
     ))
     (ly:parser-define! parser 'output-count (1+ count))
     (process-procedure book paper layout base)
     ))


@@ -306,13 +323,13 @@ found."
   (lset-difference eq? a b))
 
 (define-public (uniq-list lst)
   (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)
 
   (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) '()))
                   acc
                   (cons x acc))))
         '() lst) '()))


@@ -488,6 +505,11 @@ found."
   (string-append (ly:number->string (car c)) " "
                 (ly:number->string (cdr c))))
 
   (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,
 
 (define-public (write-me message x)
   "Return X.  Display MESSAGE and write X.  Handy for debugging,