;;;;
;;;; 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>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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-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 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
+ (score-handler (scorify-music music parser)))))
+
(define-public (collect-music-for-book parser music)
- ;; discard music if its 'void property is true.
- (let ((void-music (ly:music-property music 'void)))
- (if (or (null? void-music) (not void-music))
- (collect-scores-for-book parser (scorify-music music parser)))))
+ "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."
(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))
(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)
))
(string<? (symbol->string (car x))
(symbol->string (car y))))
-(define-public (chain-assoc x alist-list)
- (if (null? alist-list)
- #f
- (let* ((handle (assoc x (car alist-list))))
- (if (pair? handle)
- handle
- (chain-assoc x (cdr alist-list))))))
-
(define-public (chain-assoc-get x alist-list . default)
"Return ALIST entry for X. Return DEFAULT (optional, else #f) if not
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) '()))
(make-string 1 (integer->char (+ 65 (modulo i 26))))
(string-encode-integer (quotient i 26))))))
-(define-public (ly:numbers->string lst)
- (string-join (map ly:number->string lst) " "))
-
(define (number->octal-string x)
(let* ((n (inexact->exact x))
(n64 (quotient n 64))
(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,
0
(if (< x 0) -1 1)))
-(define-public (round2 num)
- (/ (round (* 100 num)) 100))
-
-(define-public (round4 num)
- (/ (round (* 10000 num)) 10000))
-(define-public (car< a b) (< (car a) (car b)))
+(define-public (car< a b)
+ (< (car a) (car b)))
(define-public (symbol<? lst r)
(string<? (symbol->string lst) (symbol->string r)))
projects / lilypond.git / blobdiff