X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily-library.scm;h=f772d0527e931efa53cdf0917fcf359012e911bb;hb=516aed4f15699a29a60b574f7b943a039bd1208b;hp=6bd66501e4950e911c9ab1204cca99e4712fda9b;hpb=c27cdd423527bcd4d019bb54e2ab5fe470fba9a6;p=lilypond.git diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 6bd66501e4..f772d0527e 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--2006 Jan Nieuwenhuizen +;;;; (c) 1998--2007 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -117,9 +117,13 @@ (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)) @@ -127,7 +131,6 @@ (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) )) @@ -306,13 +309,13 @@ 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) '())) @@ -488,6 +491,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,