X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Flily-library.scm;h=eb537a8e7183b66238158bc047e92b5c85206dda;hb=46d25804011e815f0fbf782b3c7d330812d1acc7;hp=0e2c810da912504b32010ab56219732712c2cf5b;hpb=6d451df53791b15dc4707694deb3622b33299997;p=lilypond.git

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 0e2c810da9..eb537a8e71 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -19,6 +19,9 @@
 ; for take, drop, take-while, list-index, and find-tail:
 (use-modules (srfi srfi-1))
 
+; for define-safe-public when byte-compiling using Guile V2
+(use-modules (scm safe-utility-defs))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; constants.
 
@@ -154,39 +157,39 @@
   (ly:make-score music))
 
 
-(define (get-current-filename parser)
+(define (get-current-filename parser book)
   "return any suffix value for output filename allowing for settings by
 calls to bookOutputName function"
-  (let ((book-filename (ly:parser-lookup parser 'book-filename)))
+  (let ((book-filename (paper-variable parser book 'output-filename)))
     (if (not book-filename)
 	(ly:parser-output-name parser)
 	book-filename)))
 
-(define (get-current-suffix parser)
+(define (get-current-suffix parser book)
   "return any suffix value for output filename allowing for settings by calls to
 bookoutput function"
-  (let ((book-output-suffix (ly:parser-lookup parser 'book-output-suffix)))
+  (let ((book-output-suffix (paper-variable parser book 'output-suffix)))
     (if (not (string? book-output-suffix))
 	(ly:parser-lookup parser 'output-suffix)
 	book-output-suffix)))
 
 (define-public current-outfile-name #f)  ; for use by regression tests
 
-(define (get-outfile-name parser)
+(define (get-outfile-name parser book)
   "return current filename for generating backend output files"
   ;; user can now override the base file name, so we have to use
   ;; the file-name concatenated with any potential output-suffix value
   ;; as the key to out internal a-list
-  (let* ((base-name (get-current-filename parser))
-	 (output-suffix (get-current-suffix parser))
-	 (alist-key (format "~a~a" base-name output-suffix))
+  (let* ((base-name (get-current-filename parser book))
+	 (output-suffix (get-current-suffix parser book))
+	 (alist-key (format #f "~a~a" base-name output-suffix))
 	 (counter-alist (ly:parser-lookup parser 'counter-alist))
 	 (output-count (assoc-get alist-key counter-alist 0))
 	 (result base-name))
     ;; Allow all ASCII alphanumerics, including accents
     (if (string? output-suffix)
         (set! result
-              (format "~a-~a"
+              (format #f "~a-~a"
                       result
                       (string-regexp-substitute
                        "[^-[:alnum:]]"
@@ -206,7 +209,7 @@ bookoutput function"
 (define (print-book-with parser book process-procedure)
   (let* ((paper (ly:parser-lookup parser '$defaultpaper))
 	 (layout (ly:parser-lookup parser '$defaultlayout))
-	 (outfile-name (get-outfile-name parser)))
+	 (outfile-name (get-outfile-name parser book)))
     (process-procedure book paper layout outfile-name)))
 
 (define-public (print-book-with-defaults parser book)
@@ -227,6 +230,24 @@ bookoutput function"
       (else
           ((ly:parser-lookup parser 'toplevel-score-handler) parser score))))
 
+(define-public paper-variable
+  (let
+      ((get-papers
+	(lambda (parser book)
+	  (append (if (and book (ly:output-def? (ly:book-paper book)))
+		      (list (ly:book-paper book))
+		      '())
+	          (ly:parser-lookup parser '$papers)
+		  (list (ly:parser-lookup parser '$defaultpaper))))))
+    (make-procedure-with-setter
+     (lambda (parser book symbol)
+       (any (lambda (p) (ly:output-def-lookup p symbol #f))
+	    (get-papers parser book)))
+     (lambda (parser book symbol value)
+       (ly:output-def-set-variable!
+	(car (get-papers parser book))
+	symbol value)))))
+
 (define-public (add-text parser text)
   (add-score parser (list text)))
 
@@ -852,17 +873,12 @@ print a warning and set an optional @var{default}."
     scaling))
 
 (define-public (version-not-seen-message input-file-name)
-  (ly:message
-   "~a:0: ~a ~a"
-    input-file-name
-    (_ "warning:")
-    (format #f
-	    (_ "no \\version statement found, please add~afor future compatibility")
-	    (format #f "\n\n\\version ~s\n\n" (lilypond-version)))))
+  (ly:warning-located
+    (ly:format "~a:0" input-file-name)
+    (_ "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"
-    input-file-name
-    (_ "warning:")
+  (ly:warning-located
+    (ly:format "~a:0" input-file-name)
     (_ "old relative compatibility not used")))