Adds outside-staff-interface and outside-staff-axis-group-interface

[lilypond.git] / scm / lily-library.scm

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index b334517de1dbefdcb52e4db3ca64accf2e96ddbf..570c7407750e75d16d693628950d127b2f465158 100644 (file)
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -80,6 +80,11 @@
   (cons (ly:moment-main-numerator moment)
         (ly:moment-main-denominator moment)))
 
+(define-public (seconds->moment s context)
+  "Return a moment equivalent to s seconds at the current tempo."
+  (ly:moment-mul (ly:context-property context 'tempoWholesPerMinute)
+                 (ly:make-moment (/ s 60))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; durations
 
@@ -100,9 +105,9 @@ the numeric factor by which they increase the duration."
   (- 2 (/ (ash 1 dotcount))))
 
 (define-public (duration-length dur)
-  "Return the overall length of a duration, as a number of whole notes.
-(Not to be confused with ly:duration-length, which returns a less-useful
-     moment object.)"
+  "Return the overall length of a duration, as a number of whole
+notes.  (Not to be confused with ly:duration-length, which returns a
+less-useful moment object.)"
   (ly:moment-main (ly:duration-length dur)))
 
 (define-public (duration-visual dur)
@@ -116,6 +121,16 @@ non-visual scale factor 1."
 duration (base note length and dot count), as a number of whole notes."
   (duration-length (duration-visual dur)))
 
+(define-public (unity-if-multimeasure context dur)
+  "Given a context and a duration, return @code{1} if the duration is
+longer than the @code{measureLength} in that context, and @code{#f} otherwise.
+This supports historic use of @code{Completion_heads_engraver} to split
+@code{c1*3} into three whole notes."
+  (if (ly:moment<? (ly:context-property context 'measureLength)
+                   (ly:duration-length dur))
+    1
+    #f))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; arithmetic
 (define-public (average x . lst)
@@ -424,7 +439,7 @@ bookoutput function"
             (symbol->string (car y))))
 
 (define (map-alist-vals func list)
-  "map FUNC over the vals of  LIST, leaving the keys."
+  "map FUNC over the vals of LIST, leaving the keys."
   (if (null?  list)
       '()
       (cons (cons  (caar list) (func (cdar list)))
@@ -453,17 +468,6 @@ bookoutput function"
             (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}.
@@ -473,19 +477,14 @@ For 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)
+  (define (map-selected-alist-keys-helper 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))))
+  (fold map-selected-alist-keys-helper alist keys))
 
 ;;;;;;;;;;;;;;;;
 ;; vector
@@ -551,17 +550,14 @@ For example:
          (list elem)))
    '() lst))
 
-(define-public (filtered-map proc lst)
-  (filter
-   (lambda (x) x)
-   (map proc lst)))
+(define-public filtered-map filter-map)
 
 (define-public (flatten-list x)
   "Unnest list."
-  (cond ((null? x) '())
-        ((not (pair? x)) (list x))
-        (else (append (flatten-list (car x))
-                      (flatten-list (cdr x))))))
+  (let loop ((x x) (tail '()))
+    (cond ((list? x) (fold-right loop tail x))
+          ((not (pair? x)) (cons x tail))
+          (else (loop (car x) (loop (cdr x) tail))))))
 
 (define (list-minus a b)
   "Return list of elements in A that are not in B."