]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/lily-library.scm
Doc-de: update of translation de.po file
[lilypond.git] / scm / lily-library.scm
index 4a7973abb1b39e1447cd3ea2e79fe44d7715ff32..0e2c810da912504b32010ab56219732712c2cf5b 100644 (file)
@@ -1,10 +1,20 @@
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
 ;;;;
-;;;; lily-library.scm -- utilities
+;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
 ;;;;
 ;;;;
-;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
 ; for take, drop, take-while, list-index, and find-tail:
 (use-modules (srfi srfi-1))
 
 ; for take, drop, take-while, list-index, and find-tail:
 (use-modules (srfi srfi-1))
   (or (equal? a b)
       (ly:moment<? a b)))
 
   (or (equal? a b)
       (ly:moment<? a b)))
 
+(define-public (fraction->moment fraction)
+  (if (null? fraction)
+      ZERO-MOMENT
+      (ly:make-moment (car fraction) (cdr fraction))))
+
+(define-public (moment->fraction moment)
+  (cons (ly:moment-main-numerator moment)
+        (ly:moment-main-denominator moment)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; arithmetic
 (define-public (average x . lst)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; arithmetic
 (define-public (average x . lst)
@@ -65,7 +84,7 @@
 ;; parser <-> output hooks.
 
 (define-public (collect-bookpart-for-book parser book-part)
 ;; parser <-> output hooks.
 
 (define-public (collect-bookpart-for-book parser book-part)
-  "Toplevel book-part handler"
+  "Toplevel book-part handler."
   (define (add-bookpart book-part)
     (ly:parser-define!
        parser 'toplevel-bookparts
   (define (add-bookpart book-part)
     (ly:parser-define!
        parser 'toplevel-bookparts
         (score-handler (scorify-music music parser)))))
 
 (define-public (collect-music-for-book parser music)
         (score-handler (scorify-music music parser)))))
 
 (define-public (collect-music-for-book parser music)
-  "Top-level music handler"
+  "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)
   (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"
+  "Book music handler."
   (collect-music-aux (lambda (score)
                       (ly:book-add-score! book score))
                      parser
                     music))
 
 (define-public (scorify-music music parser)
   (collect-music-aux (lambda (score)
                       (ly:book-add-score! book score))
                      parser
                     music))
 
 (define-public (scorify-music music parser)
-  "Preprocess MUSIC."
+  "Preprocess @var{music}."
 
   (for-each (lambda (func)
              (set! music (func music parser)))
 
   (for-each (lambda (func)
              (set! music (func music parser)))
   (ly:make-score music))
 
 
   (ly:make-score music))
 
 
-(define (get-outfile-name parser base)
-  (let* ((output-suffix (ly:parser-lookup parser 'output-suffix))
+(define (get-current-filename parser)
+  "return any suffix value for output filename allowing for settings by
+calls to bookOutputName function"
+  (let ((book-filename (ly:parser-lookup parser 'book-filename)))
+    (if (not book-filename)
+       (ly:parser-output-name parser)
+       book-filename)))
+
+(define (get-current-suffix parser)
+  "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)))
+    (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)
+  "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))
         (counter-alist (ly:parser-lookup parser 'counter-alist))
         (counter-alist (ly:parser-lookup parser 'counter-alist))
-        (output-count (assoc-get output-suffix counter-alist 0))
-        (result base))
+        (output-count (assoc-get alist-key counter-alist 0))
+        (result base-name))
     ;; Allow all ASCII alphanumerics, including accents
     (if (string? output-suffix)
     ;; Allow all ASCII alphanumerics, including accents
     (if (string? output-suffix)
-       (set! result (format "~a-~a"
-                            base (string-regexp-substitute
-                                   "[^-[:alnum:]]" "_" output-suffix))))
+        (set! result
+              (format "~a-~a"
+                      result
+                      (string-regexp-substitute
+                       "[^-[:alnum:]]"
+                       "_"
+                       output-suffix))))
 
     ;; assoc-get call will always have returned a number
     (if (> output-count 0)
 
     ;; assoc-get call will always have returned a number
     (if (> output-count 0)
-       (set! result (format #f "~a-~a" result output-count)))
+        (set! result (format #f "~a-~a" result output-count)))
 
     (ly:parser-define!
 
     (ly:parser-define!
-      parser 'counter-alist
-      (assoc-set! counter-alist output-suffix (1+ output-count)))
+     parser 'counter-alist
+     (assoc-set! counter-alist alist-key (1+ output-count)))
+    (set! current-outfile-name result)
     result))
 
 (define (print-book-with parser book process-procedure)
   (let* ((paper (ly:parser-lookup parser '$defaultpaper))
         (layout (ly:parser-lookup parser '$defaultlayout))
     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))
-        (outfile-name (get-outfile-name parser base)))
-
+        (outfile-name (get-outfile-name parser)))
     (process-procedure book paper layout outfile-name)))
 
 (define-public (print-book-with-defaults parser book)
     (process-procedure book paper layout outfile-name)))
 
 (define-public (print-book-with-defaults parser book)
            (map-alist-vals func (cdr list)))))
 
 (define (map-alist-keys func list)
            (map-alist-vals func (cdr list)))))
 
 (define (map-alist-keys func list)
-  "map FUNC over the keys of an alist LIST, leaving the vals. "
+  "map FUNC over the keys of an alist LIST, leaving the vals."
   (if (null?  list)
       '()
       (cons (cons (func (caar list)) (cdar list))
            (map-alist-keys func (cdr list)))))
 
 (define-public (first-member members lst)
   (if (null?  list)
       '()
       (cons (cons (func (caar list)) (cdar list))
            (map-alist-keys func (cdr list)))))
 
 (define-public (first-member members lst)
-  "Return first successful MEMBER of member from MEMBERS in LST."
+  "Return first successful member (of member) from @var{members} in
+@var{lst}."
   (if (null? members)
       #f
       (let ((m (member (car members) lst)))
        (if m m (first-member (cdr members) lst)))))
 
 (define-public (first-assoc keys lst)
   (if (null? members)
       #f
       (let ((m (member (car members) lst)))
        (if m m (first-member (cdr members) lst)))))
 
 (define-public (first-assoc keys lst)
-  "Return first successful ASSOC of key from KEYS in LST."
+  "Return first successful assoc of key from @var{keys} in @var{lst}."
   (if (null? keys)
       #f
       (let ((k (assoc (car keys) lst)))
   (if (null? keys)
       #f
       (let ((k (assoc (car keys) lst)))
            (cons (cdar alist)
                  (flatten-alist (cdr alist))))))
 
            (cons (cdar alist)
                  (flatten-alist (cdr alist))))))
 
+(define (assoc-remove key alist)
+  "Remove key (and its corresponding value) from an alist.
+   Different than assoc-remove! because it is non-destructive."
+  (define (assoc-crawler key l r)
+    (if (null? r)
+        l
+        (if (equal? (caar r) key)
+            (append l (cdr r))
+            (assoc-crawler key (append l `(,(car r))) (cdr r)))))
+  (assoc-crawler key '() alist))
+
+(define-public (map-selected-alist-keys function keys alist)
+  "Return @var{alist} with @var{function} applied to all of the values
+in list @var{keys}.
+
+For example:
+@example
+@code{guile> (map-selected-alist-keys - '(a b) '((a . 1) (b . -2) (c . 3) (d . 4)))}
+@code{((a . -1) (b . 2) (c . 3) (d . 4)}
+@end example"
+   (define (map-selected-alist-keys-helper function key alist)
+     (map
+     (lambda (pair)
+       (if (equal? key (car pair))
+           (cons key (function (cdr pair)))
+           pair))
+     alist))
+   (if (null? keys)
+       alist
+       (map-selected-alist-keys
+         function
+         (cdr keys)
+         (map-selected-alist-keys-helper function (car keys) alist))))
+
 ;;;;;;;;;;;;;;;;
 ;; vector
 
 ;;;;;;;;;;;;;;;;
 ;; vector
 
 (define (functional-or . rest)
   (if (pair? rest)
       (or (car rest)
 (define (functional-or . rest)
   (if (pair? rest)
       (or (car rest)
-          (apply functional-and (cdr rest)))
+          (apply functional-or (cdr rest)))
       #f))
 
 (define (functional-and . rest)
       #f))
 
 (define (functional-and . rest)
   (helper lst 0))
 
 (define-public (count-list lst)
   (helper lst 0))
 
 (define-public (count-list lst)
-  "Given lst (E1 E2 .. ) return ((E1 . 1) (E2 . 2) ... )  "
+  "Given @var{lst} as @code{(E1 E2 .. )}, return
+@code{((E1 . 1) (E2 . 2) ... )}."
 
   (define (helper l acc count)
     (if (pair? l)
 
   (define (helper l acc count)
     (if (pair? l)
   (reverse (helper lst '() 1)))
 
 (define-public (list-join lst intermediate)
   (reverse (helper lst '() 1)))
 
 (define-public (list-join lst intermediate)
-  "put INTERMEDIATE  between all elts of LST."
+  "Put @var{intermediate} between all elts of @var{lst}."
 
   (fold-right
    (lambda (elem prev)
 
   (fold-right
    (lambda (elem prev)
    (lambda (x) x)
    (map proc lst)))
 
    (lambda (x) x)
    (map proc lst)))
 
-(define (flatten-list x)
+(define-public (flatten-list x)
   "Unnest list."
   (cond ((null? x) '())
         ((not (pair? x)) (list x))
   "Unnest list."
   (cond ((null? x) '())
         ((not (pair? x)) (list x))
   (lset-difference eq? a b))
 
 (define-public (uniq-list lst)
   (lset-difference eq? a b))
 
 (define-public (uniq-list lst)
-  "Uniq LST, assuming that it is sorted. Uses equal? for comparisons."
+  "Uniq @var{lst}, assuming that it is sorted.  Uses @code{equal?}
+for comparisons."
 
   (reverse!
    (fold (lambda (x acc)
 
   (reverse!
    (fold (lambda (x acc)
 
 (define (split-at-predicate pred lst)
   "Split LST into two lists at the first element that returns #f for
 
 (define (split-at-predicate pred lst)
   "Split LST into two lists at the first element that returns #f for
-  (PRED previous_element element). Return the two parts as a pair.
+  (PRED previous_element element).  Return the two parts as a pair.
   Example: (split-at-predicate < '(1 2 3 2 1)) ==> ((1 2 3) . (2 1))"
   (if (null? lst)
       (list lst)
   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 (lambda (x y) (not (pred x y)))
+                          lst
+                          (cdr lst))))
         (if i
             (cons (take lst (1+ i)) (drop lst (1+ i)))
             (list lst)))))
 
 (define-public (split-list-by-separator lst pred)
         (if i
             (cons (take lst (1+ i)) (drop lst (1+ i)))
             (list lst)))))
 
 (define-public (split-list-by-separator lst pred)
-  "Split LST at each element that satisfies PRED, and return the parts
-  (with the separators removed) as a list of lists. Example:
-  (split-list-by-separator '(a 0 b c 1 d) number?) ==> ((a) (b c) (d))"
+  "Split @var{lst} at each element that satisfies @var{pred}, and return
+the parts (with the separators removed) as a list of lists.  For example,
+executing @samp{(split-list-by-separator '(a 0 b c 1 d) number?)} returns
+@samp{((a) (b c) (d))}."
   (let loop ((result '()) (lst lst))
     (if (and lst (not (null? lst)))
         (loop
   (let loop ((result '()) (lst lst))
     (if (and lst (not (null? lst)))
         (loop
       (cons (cons (car coords) (cadr coords))
            (ly:list->offsets accum (cddr coords)))))
 
       (cons (cons (car coords) (cadr coords))
            (ly:list->offsets accum (cddr coords)))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; numbers
-
-(if (not (defined? 'nan?)) ;; guile 1.6 compat
-    (define-public (nan? x) (not (or (< 0.0 x)
-                                    (> 0.0 x)
-                                    (= 0.0 x)))))
-
-(if (not (defined? 'inf?))
-    (define-public (inf? x) (= (/ 1.0 x) 0.0)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; intervals
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; intervals
 
   (cons (- expr) expr))
 
 (define-public (interval-length x)
   (cons (- expr) expr))
 
 (define-public (interval-length x)
-  "Length of the number-pair X, when an interval"
+  "Length of the number-pair @var{x}, if an interval."
   (max 0 (- (cdr x) (car x))))
 
 (define-public (ordered-cons a b)
   (max 0 (- (cdr x) (car x))))
 
 (define-public (ordered-cons a b)
   ((if (= dir RIGHT) cdr car) interval))
 
 (define-public (interval-index interval dir)
   ((if (= dir RIGHT) cdr car) interval))
 
 (define-public (interval-index interval dir)
-  "Interpolate INTERVAL between between left (DIR=-1) and right (DIR=+1)"
+  "Interpolate @var{interval} between between left (@var{dir}=-1) and
+right (@var{dir}=+1)."
 
   (* (+  (interval-start interval) (interval-end interval)
         (* dir (- (interval-end interval) (interval-start interval))))
      0.5))
 
 (define-public (interval-center x)
 
   (* (+  (interval-start interval) (interval-end interval)
         (* dir (- (interval-end interval) (interval-start interval))))
      0.5))
 
 (define-public (interval-center x)
-  "Center the number-pair X, when an interval"
+  "Center the number-pair @var{x}, if an interval."
   (if (interval-empty? x)
       0.0
       (/ (+ (car x) (cdr x)) 2)))
   (if (interval-empty? x)
       0.0
       (/ (+ (car x) (cdr x)) 2)))
 
 (define-public interval-end cdr)
 
 
 (define-public interval-end cdr)
 
-(define-public (interval-translate iv amount)
-  (cons (+ amount (car iv))
-       (+ amount (cdr iv))))
-
 (define (other-axis a)
   (remainder (+ a 1) 2))
 
 (define-public (interval-widen iv amount)
 (define (other-axis a)
   (remainder (+ a 1) 2))
 
 (define-public (interval-widen iv amount)
-   (cons (- (car iv) amount)
-         (+ (cdr iv) amount)))
+  (cons (- (car iv) amount)
+    (+ (cdr iv) amount)))
 
 (define-public (interval-empty? iv)
    (> (car iv) (cdr iv)))
 
 (define-public (interval-union i1 i2)
 
 (define-public (interval-empty? iv)
    (> (car iv) (cdr iv)))
 
 (define-public (interval-union i1 i2)
-   (cons (min (car i1) (car i2))
-        (max (cdr i1) (cdr i2))))
+  (cons
+    (min (car i1) (car i2))
+    (max (cdr i1) (cdr i2))))
 
 (define-public (interval-intersection i1 i2)
 
 (define-public (interval-intersection i1 i2)
-   (cons (max (car i1) (car i2))
-        (min (cdr i1) (cdr i2))))
+   (cons
+     (max (car i1) (car i2))
+     (min (cdr i1) (cdr i2))))
 
 (define-public (interval-sane? i)
   (not (or  (nan? (car i))
 
 (define-public (interval-sane? i)
   (not (or  (nan? (car i))
   (cons (min (interval-start interval) p)
         (max (interval-end interval) p)))
 
   (cons (min (interval-start interval) p)
         (max (interval-end interval) p)))
 
+(define-public (reverse-interval iv)
+  (cons (cdr iv) (car iv)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; coordinates
+
+(define coord-x car)
+(define coord-y cdr)
+
+(define (coord-operation operator operand coordinate)
+  (if (pair? operand)
+    (cons (operator (coord-x operand) (coord-x coordinate))
+          (operator (coord-y operand) (coord-y coordinate)))
+    (cons (operator operand (coord-x coordinate))
+          (operator operand (coord-y coordinate)))))
+
+(define (coord-apply function coordinate)
+  (if (pair? function)
+    (cons
+      ((coord-x function) (coord-x coordinate))
+      ((coord-y function) (coord-y coordinate)))
+    (cons
+      (function (coord-x coordinate))
+      (function (coord-y coordinate)))))
+
+(define-public (coord-translate coordinate amount)
+  (coord-operation + amount coordinate))
+
+(define-public (coord-scale coordinate amount)
+  (coord-operation * amount coordinate))
+
+(define-public (coord-rotate coordinate degrees-in-radians)
+  (let*
+    ((coordinate
+      (cons
+        (exact->inexact (coord-x coordinate))
+        (exact->inexact (coord-y coordinate))))
+     (radius
+      (sqrt
+        (+ (* (coord-x coordinate) (coord-x coordinate))
+           (* (coord-y coordinate) (coord-y coordinate)))))
+    (angle (angle-0-2pi (atan (coord-y coordinate) (coord-x coordinate)))))
+   (cons
+     (* radius (cos (+ angle degrees-in-radians)))
+     (* radius (sin (+ angle degrees-in-radians))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; trig
+
+(define-public PI (* 4 (atan 1)))
+
+(define-public TWO-PI (* 2 PI))
+
+(define-public PI-OVER-TWO (/ PI 2))
+
+(define-public THREE-PI-OVER-TWO (* 3 PI-OVER-TWO))
+
+(define-public (cyclic-base-value value cycle)
+  "Take @var{value} and modulo-maps it between 0 and base @var{cycle}."
+  (if (< value 0)
+      (cyclic-base-value (+ value cycle) cycle)
+      (if (>= value cycle)
+          (cyclic-base-value (- value cycle) cycle)
+          value)))
+
+(define-public (angle-0-2pi angle)
+  "Take @var{angle} (in radians) and maps it between 0 and 2pi."
+  (cyclic-base-value angle TWO-PI))
+
+(define-public (angle-0-360 angle)
+  "Take @var{angle} (in degrees) and maps it between 0 and 360 degrees."
+  (cyclic-base-value angle 360.0))
+
+(define-public PI-OVER-180  (/ PI 180))
+
+(define-public (degrees->radians angle-degrees)
+  "Convert the given angle from degrees to radians."
+  (* angle-degrees PI-OVER-180))
+
+(define-public (ellipse-radius x-radius y-radius angle)
+  (/
+    (* x-radius y-radius)
+    (sqrt
+      (+ (* (expt y-radius 2)
+            (* (cos angle) (cos angle)))
+        (* (expt x-radius 2)
+           (* (sin angle) (sin angle)))))))
+
+(define-public (polar->rectangular radius angle-in-degrees)
+  "Return polar coordinates (@var{radius}, @var{angle-in-degrees})
+as rectangular coordinates @ode{(x-length . y-length)}."
+
+  (let ((complex (make-polar
+                    radius
+                    (degrees->radians angle-in-degrees))))
+     (cons
+       (real-part complex)
+       (imag-part complex))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; string
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; string
 
                 (ly:number->string (cdr c))))
 
 (define-public (dir-basename file . rest)
                 (ly:number->string (cdr c))))
 
 (define-public (dir-basename file . rest)
-  "Strip suffixes in REST, but leave directory component for FILE."
+  "Strip suffixes in @var{rest}, but leave directory component for
+@var{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)
   (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,
-possibly turned off."
+  "Return @var{x}.  Display @var{message} and write @var{x}.
+Handy for debugging, possibly turned off."
   (display message) (write x) (newline) x)
 ;;  x)
 
   (display message) (write x) (newline) x)
 ;;  x)
 
@@ -543,7 +716,7 @@ possibly turned off."
   (cons (f (car x)) (f (cdr x))))
 
 (define-public (list-insert-separator lst between)
   (cons (f (car x)) (f (cdr x))))
 
 (define-public (list-insert-separator lst between)
-  "Create new list, inserting BETWEEN between elements of LIST"
+  "Create new list, inserting @var{between} between elements of @var{lst}."
   (define (conc x y )
     (if (eq? y #f)
        (list x)
   (define (conc x y )
     (if (eq? y #f)
        (list x)
@@ -583,7 +756,7 @@ possibly turned off."
 
 (define-public (binary-search start end getter target-val)
   (_i "Find the index between @var{start} and @var{end} (an integer)
 
 (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
+which produces the closest match to @var{target-val} if
 applied to function @var{getter}.")
   (if (<= end start)
       start
 applied to function @var{getter}.")
   (if (<= end start)
       start
@@ -599,6 +772,9 @@ applied to function @var{getter}.")
 (define-public (car< a b)
   (< (car a) (car b)))
 
 (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)))
 
 (define-public (symbol<? lst r)
   (string<? (symbol->string lst) (symbol->string r)))
 
@@ -606,9 +782,9 @@ applied to function @var{getter}.")
   (string<? (symbol->string (car lst)) (symbol->string (car r))))
 
 (define-public (eval-carefully symbol module . default)
   (string<? (symbol->string (car lst)) (symbol->string (car r))))
 
 (define-public (eval-carefully symbol module . default)
-  "Check if all symbols in expr SYMBOL are reachable
-   in module MODULE. In that case evaluate, otherwise
-   print a warning and set an optional DEFAULT."
+  "Check whether all symbols in expr @var{symbol} are reachable
+in module @var{module}.  In that case evaluate, otherwise
+print a warning and set an optional @var{default}."
   (let* ((unavailable? (lambda (sym)
                          (not (module-defined? module sym))))
         (sym-unavailable (if (pair? symbol)
   (let* ((unavailable? (lambda (sym)
                          (not (module-defined? module sym))))
         (sym-unavailable (if (pair? symbol)
@@ -660,19 +836,11 @@ applied to function @var{getter}.")
 
 ;;; FONT may be font smob, or pango font string...
 (define-public (font-name-style font)
 
 ;;; 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)))
+  (if (string? font)
+      (string-downcase font)
       (let* ((font-name (ly:font-name font))
             (full-name (if font-name font-name (ly:font-file-name font))))
       (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)))))
+         (string-downcase full-name))))
 
 (define-public (modified-font-metric-font-scaling font)
   (let* ((designsize (ly:font-design-size font))
 
 (define-public (modified-font-metric-font-scaling font)
   (let* ((designsize (ly:font-design-size font))