X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily-library.scm;h=8176db1d7b66ee31ec1ebd4f881709e662cc8545;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=ae13bbebf0ec748142485952847b75a2d1273587;hpb=5fef810883521d169090b76a91bb16c811d29865;p=lilypond.git diff --git a/scm/lily-library.scm b/scm/lily-library.scm index ae13bbebf0..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--2007 Jan Nieuwenhuizen +;;;; (c) 1998--2008 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -56,14 +56,28 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 (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)) @@ -491,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,