[PATCH] Issues 714 and 404: Add greater user flexibility in naming output files using output-suffix. output name handling now moved to its own procedure in lily-library.scm Amended to use ly:get-assoc to pick up initial value of parser variable output-count and remove redundant check on initial call. Accented characters now supported in output-suffix.

[Ian Hulin <ian@xxxxxxxxxxxx>]

Signed-off-by: Ian Hulin <ian@xxxxxxxxxxxx>
---
 scm/lily-library.scm |   86 ++++++++++++++++++++------------------------------
 1 files changed, 34 insertions(+), 52 deletions(-)

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index e7f1d29..152f6f1 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -52,10 +52,6 @@
 (define-public (moment-min a b)
   (if (ly:moment<? a b) a b))
 
-(define-public (moment<=? a b)
-  (or (equal? a b)
-      (ly:moment<? a b)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; arithmetic
 (define-public (average x . lst)
@@ -134,27 +130,35 @@
 
   (ly:make-score music))
 
+
+(define (get-outfile-name parser base)
+(let*
+    ((output-suffix (ly:parser-lookup parser 'output-suffix))
+     (counter-alist (ly:parser-lookup parser 'counter-alist))
+     (output-count (assoc-get output-suffix counter-alist 0))
+     (result base ) )
+    ;; Allow all ASCII alphanumerics,
+    ;;   including accents
+    (if (string? output-suffix)
+	    (set! result (format "~a-~a" base (string-regexp-substitute
+   					   "[^-[:alnum:]]" "_" output-suffix))))
+
+    ;; assoc-get call will always have returned a number
+    (if (> output-count 0)
+	(set! result (format #f "~a-~a" result output-count)))
+    
+    (ly:parser-define!
+	  parser 'counter-alist (assoc-set! counter-alist output-suffix  (1+ output-count)))
+    result ) )
+
 (define (print-book-with parser book process-procedure)
   (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))
-       (output-suffix (ly:parser-lookup parser 'output-suffix)) )
+       (outfile-name (get-outfile-name parser base)) )
 
-    (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))
-	(set! count 0))
-
-    (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)
-    ))
+      (process-procedure book paper layout outfile-name)  ) )
 
 (define-public (print-book-with-defaults parser book)
   (print-book-with parser book ly:book-process))
@@ -347,7 +351,7 @@ found."
   Example: (split-at-predicate < '(1 2 3 2 1)) ==> ((1 2 3) . (2 1))"
   (if (null? lst)
       (list lst)
-      (let ((i (list-index pred (cdr lst) lst)))
+      (let ((i (list-index predicate (cdr lst) lst)))
         (if i
             (cons (take lst (1+ i)) (drop lst (1+ i)))
             (list lst)))))
@@ -396,8 +400,6 @@ found."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; intervals
 
-(define-public empty-interval '(+inf.0 . -inf.0))
-
 (define-public (interval-length x)
   "Length of the number-pair X, when an interval"
   (max 0 (- (cdr x) (car x))))
@@ -453,10 +455,6 @@ found."
 	    (inf? (cdr i))
 	    (> (car i) (cdr i)))))
 
-(define-public (add-point interval p)
-  (cons (min (interval-start interval) p)
-        (max (interval-end interval) p)))
-
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; string
@@ -562,20 +560,6 @@ possibly turned off."
       0
       (if (< x 0) -1 1)))
 
-(define-public (binary-search start end getter target-val)
-  (_i "Find the index between @var{start} and @var{end} (an integer)
-which will produce the closest match to @var{target-val} when
-applied to function @var{getter}.")
-  (if (<= end start)
-      start
-      (let* ((compare (quotient (+ start end) 2))
-	     (get-val (getter compare)))
-	(cond
-	 ((< target-val get-val)
-	  (set! end (1- compare)))
-	 ((< get-val target-val)
-	  (set! start (1+ compare))))
-	(binary-search start end getter target-val))))
 
 (define-public (car< a b)
   (< (car a) (car b)))
@@ -618,19 +602,17 @@ applied to function @var{getter}.")
 
 ;;; FONT may be font smob, or pango font string...
 (define-public (font-name-style font)
-  ;; FIXME: ughr, barf: feta-alphabet is actually emmentaler
-  (if (and (string? font)
-	   (string-prefix? "feta-alphabet" font))
-      (string-append "emmentaler"
-		     "-"
-		     (substring font
-				(string-length "feta-alphabet")
-				(string-length font)))
+      ;; FIXME: ughr, (ly:font-name) sometimes also has Style appended.
       (let* ((font-name (ly:font-name font))
-	     (full-name (if font-name font-name (ly:font-file-name font))))
-	(if (string-prefix? "Aybabtu" full-name)
-	    "aybabtu"
-	    (string-downcase full-name)))))
+	     (full-name (if font-name font-name (ly:font-file-name font)))
+	     (name-style (string-split full-name #\-)))
+	;; FIXME: ughr, barf: feta-alphabet is actually emmentaler
+	(if (string-prefix? "feta-alphabet" full-name)
+	    (list "emmentaler"
+		  (substring  full-name (string-length "feta-alphabet")))
+	    (if (not (null? (cdr name-style)))
+	    name-style
+	    (append name-style '("Regular"))))))
 
 (define-public (modified-font-metric-font-scaling font)
   (let* ((designsize (ly:font-design-size font))
-- 
1.6.0.4


--------------010104060603070808000304--

---

----
Join the Frogs!