Fix compilation with g++ 4.5

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

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 54355336d89513d4b263c0c5caab657439e4f6ee..b70af4ec535b52dee47c6682da497ebf03e12d4d 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--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2009 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))


@@ -72,7 +86,7 @@
   (cond ((music-property 'page-marker)
         ;; a page marker: set page break/turn permissions or label
         (begin
   (cond ((music-property 'page-marker)
         ;; a page marker: set page break/turn permissions or label
         (begin

-          (let ((label (music-property 'label)))
+          (let ((label (music-property 'page-label)))

             (if (symbol? label)
                 (score-handler (ly:make-page-label-marker label))))
           (for-each (lambda (symbol)
             (if (symbol? label)
                 (score-handler (ly:make-page-label-marker label))))
           (for-each (lambda (symbol)


@@ -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,


@@ -564,11 +586,19 @@ possibly turned off."
 ;; don't confuse users with #<procedure .. > syntax. 
 ;; 
 (define-public (scm->string val)
 ;; don't confuse users with #<procedure .. > syntax. 
 ;; 
 (define-public (scm->string val)

-  (if (and (procedure? val) (symbol? (procedure-name val)))
+  (if (and (procedure? val)
+          (symbol? (procedure-name val)))

       (symbol->string (procedure-name val))
       (string-append
       (symbol->string (procedure-name val))
       (string-append

-       (if (self-evaluating? val) "" "'")
-       (call-with-output-string (lambda (port) (display val port))))))
+       (if (self-evaluating? val)
+          (if (string? val)
+              "\""
+              "")
+          "'")
+       (call-with-output-string (lambda (port) (display val port)))
+       (if (string? val)
+          "\""
+          ""))))

 
 (define-public (!= lst r)
   (not (= lst r)))
 
 (define-public (!= lst r)
   (not (= lst r)))


@@ -607,16 +637,16 @@ possibly turned off."
 
 (define-public (version-not-seen-message input-file-name)
   (ly:message
 
 (define-public (version-not-seen-message input-file-name)
   (ly:message

-   "~a:0: ~a: ~a" 
+   "~a:0: ~a ~a" 

     input-file-name
     input-file-name

-    (_ "warning: ")
+    (_ "warning:")

     (format #f
            (_ "no \\version statement found, please add~afor future compatibility")
            (format #f "\n\n\\version ~s\n\n" (lilypond-version)))))
 
 (define-public (old-relative-not-used-message input-file-name)
   (ly:message
     (format #f
            (_ "no \\version statement found, please add~afor future compatibility")
            (format #f "\n\n\\version ~s\n\n" (lilypond-version)))))
 
 (define-public (old-relative-not-used-message input-file-name)
   (ly:message

-   "~a:0: ~a: ~a" 
+   "~a:0: ~a ~a" 

     input-file-name
     input-file-name

-    (_ "warning: ")
+    (_ "warning:")

     (_ "old relative compatibility not used")))
     (_ "old relative compatibility not used")))