;;;;
;;;; 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>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))
value
#f)))
(cond ((music-property 'page-marker)
- ;; a page marker: set page break/turn permissions
- (for-each (lambda (symbol)
- (let ((permission (music-property symbol)))
- (if (symbol? permission)
- (score-handler
- (ly:make-page-marker symbol
- (if (eqv? 'forbid permission)
- '()
- permission))))))
- (list 'line-break-permission 'page-break-permission
- 'page-turn-permission)))
+ ;; 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
(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)
))
(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) '()))
(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,
;; 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
- (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)))