Makes all side-positioning based on skylines instead of boxes.

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

diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index ec1097a32b7ace1ae756e86f61fd5fa08f6cffd7..5519bb8263207d5faa33c5ec77ecdfefd324d2bf 100644 (file)
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -259,9 +259,9 @@ bookoutput function"
 
 (define-public (context-mod-from-music parser music)
   (let ((warn #t) (mods (ly:make-context-mod)))
-    (let loop ((m music) (context #f))
+    (let loop ((m music))
       (if (music-is-of-type? m 'layout-instruction-event)
-         (let ((symbol (cons context (ly:music-property m 'symbol))))
+         (let ((symbol (ly:music-property m 'symbol)))
            (ly:add-context-mod
             mods
             (case (ly:music-property m 'name)
@@ -275,30 +275,34 @@ bookoutput function"
                (cons* 'push
                       symbol
                       (ly:music-property m 'grob-value)
-                      (ly:music-property m 'grob-property-path)))
-              ((RevertProperty)
+                       (cond
+                        ((ly:music-property m 'grob-property #f) => list)
+                        (else
+                         (ly:music-property m 'grob-property-path)))))
+               ((RevertProperty)
                (cons* 'pop
                       symbol
-                      (ly:music-property m 'grob-property-path))))))
+                       (cond
+                        ((ly:music-property m 'grob-property #f) => list)
+                        (else
+                         (ly:music-property m 'grob-property-path))))))))
          (case (ly:music-property m 'name)
            ((ApplyContext)
             (ly:add-context-mod mods
                                 (list 'apply
                                       (ly:music-property m 'procedure))))
            ((ContextSpeccedMusic)
-            (loop (ly:music-property m 'element)
-                  (ly:music-property m 'context-type)))
+            (loop (ly:music-property m 'element)))
            (else
             (let ((callback (ly:music-property m 'elements-callback)))
               (if (procedure? callback)
-                  (fold loop context (callback m))
+                  (for-each loop (callback m))
                   (if (and warn (ly:duration? (ly:music-property m 'duration)))
                       (begin
                         (ly:music-warning
                          music
                          (_ "Music unsuitable for context-mod"))
-                        (set! warn #f))))))))
-      context)
+                        (set! warn #f)))))))))
     mods))
 
 (define-public (context-defs-from-music parser output-def music)
@@ -326,11 +330,17 @@ bookoutput function"
              (cons* 'push
                     (ly:music-property m 'symbol)
                     (ly:music-property m 'grob-value)
-                    (ly:music-property m 'grob-property-path)))
+                     (cond
+                      ((ly:music-property m 'grob-property #f) => list)
+                      (else
+                       (ly:music-property m 'grob-property-path)))))
             ((RevertProperty)
              (cons* 'pop
                     (ly:music-property m 'symbol)
-                    (ly:music-property m 'grob-property-path)))))
+                     (cond
+                      ((ly:music-property m 'grob-property #f) => list)
+                      (else
+                       (ly:music-property m 'grob-property-path)))))))
          (case (ly:music-property m 'name)
            ((ApplyContext)
             (ly:add-context-mod mods
@@ -401,17 +411,11 @@ bookoutput function"
 (define-public (first-member members 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)))))
+  (any (lambda (m) (member m lst)) members))
 
 (define-public (first-assoc keys lst)
   "Return first successful assoc of key from @var{keys} in @var{lst}."
-  (if (null? keys)
-      #f
-      (let ((k (assoc (car keys) lst)))
-       (if k k (first-assoc (cdr keys) lst)))))
+  (any (lambda (k) (assoc k lst)) keys))
 
 (define-public (flatten-alist alist)
   (if (null? alist)
@@ -467,30 +471,23 @@ For example:
 ;; hash
 
 (define-public (hash-table->alist t)
-  (hash-fold (lambda (k v acc) (acons  k v  acc))
-            '() t))
+  (hash-fold acons '() t))
 
 ;; todo: code dup with C++.
 (define-safe-public (alist->hash-table lst)
   "Convert alist to table"
   (let ((m (make-hash-table (length lst))))
-    (map (lambda (k-v) (hashq-set! m (car k-v) (cdr k-v))) lst)
+    (for-each (lambda (k-v) (hashq-set! m (car k-v) (cdr k-v))) lst)
     m))
 
 ;;;;;;;;;;;;;;;;
 ;; list
 
 (define (functional-or . rest)
-  (if (pair? rest)
-      (or (car rest)
-          (apply functional-or (cdr rest)))
-      #f))
+  (any identity rest))
 
 (define (functional-and . rest)
-  (if (pair? rest)
-      (and (car rest)
-          (apply functional-and (cdr rest)))
-      #t))
+  (every identity rest))
 
 (define (split-list lst n)
   "Split LST in N equal sized parts"
@@ -508,14 +505,7 @@ For example:
   (helper lst (make-vector n '()) (1- n)))
 
 (define (list-element-index lst x)
-  (define (helper todo k)
-    (cond
-     ((null? todo) #f)
-     ((equal? (car todo) x) k)
-     (else
-      (helper (cdr todo) (1+ k)))))
-
-  (helper lst 0))
+  (list-index (lambda (m) (equal? m x))))
 
 (define-public (count-list lst)
   "Given @var{lst} as @code{(E1 E2 .. )}, return
@@ -687,6 +677,15 @@ right (@var{dir}=+1)."
 (define-public (reverse-interval iv)
   (cons (cdr iv) (car iv)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; boolean
+
+(define (lily-and a b)
+  (and a b))
+
+(define (lily-or a b)
+  (or a b))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; coordinates
 
@@ -987,11 +986,11 @@ print a warning and set an optional @var{default}."
 
 (define-public (version-not-seen-message input-file-name)
   (ly:warning-located
-    (ly:format "~a:0" input-file-name)
+    (ly:format "~a:1" 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:warning-located
-    (ly:format "~a:0" input-file-name)
+    (ly:format "~a:1" input-file-name)
     (_ "old relative compatibility not used")))