texi2html: Use only one <pre class="example"> for @example -> valid HTML now

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

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index c925a808f17c0704598ccd452e38bd7432f256c3..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--2007 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))


@@ -309,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) '()))


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


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


@@ -610,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")))