]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/music-functions.scm
Let fret-diagram scale markups to fit into dots
[lilypond.git] / scm / music-functions.scm
index 132f2f236947c4b9395a37df53255556d7b0ed33..8b3647923d37e0c7b9a3d5bbfb538e1062d6ff74 100644 (file)
@@ -747,9 +747,7 @@ duration is replaced with the specified @var{duration}."
   ;; articulations on individual events since they can't actually get
   ;; into a repeat chord given its input syntax.
 
-  (define (keep-element? m)
-    (any (lambda (t) (music-is-of-type? m t))
-         event-types))
+  (define keep-element? (music-type-predicate event-types))
 
   (for-each
    (lambda (field)
@@ -2006,14 +2004,9 @@ not recursing into matches themselves."
   "Return a flat list of all music with @var{type} (either a single
 type symbol or a list of alternatives) inside of @var{music}, not
 recursing into matches themselves."
-  (extract-music
-   music
-   (if (cheap-list? type)
-       (lambda (m)
-         (any (lambda (t) (music-is-of-type? m t)) type))
-       (lambda (m) (music-is-of-type? m type)))))
+  (extract-music music (music-type-predicate type)))
 
-(define*-public (event-chord-wrap! music)
+(define-public (event-chord-wrap! music)
   "Wrap isolated rhythmic events and non-postevent events in
 @var{music} inside of an @code{EventChord}.  Chord repeats @samp{q}
 are expanded using the default settings of the parser."
@@ -2033,10 +2026,11 @@ are expanded using the default settings of the parser."
                   (set! (ly:music-property m 'articulations) '()))
               (make-event-chord (cons m arts))))
            (else #f)))
-   (expand-repeat-chords!
-    (cons 'rhythmic-event
-          (ly:parser-lookup '$chord-repeat-events))
-    music)))
+   (expand-repeat-notes!
+    (expand-repeat-chords!
+     (cons 'rhythmic-event
+           (ly:parser-lookup '$chord-repeat-events))
+     music))))
 
 (define-public (event-chord-notes event-chord)
   "Return a list of all notes from @var{event-chord}."
@@ -2299,29 +2293,41 @@ list or if there is a type-mismatch, @var{arg} will be returned."
   "Apply @var{offsets} to the default values of @var{property} of @var{grob}.
 Offsets are restricted to immutable properties and values of type @code{number},
 @code{number-pair}, or @code{number-pair-list}."
-  (define (self grob)
+  (define (worker self container-part grob . rest)
     (let* ((immutable (ly:grob-basic-properties grob))
-           ; We need to search the basic-properties alist for our property to
-           ; obtain values to offset.  Our search is complicated by the fact that
-           ; calling the music function `offset' as an override conses a pair to
-           ; the head of the alist.  This pair must be discounted.  The closure it
-           ; contains is named `self' so it can be easily recognized.  If `offset'
-           ; is called as a tweak, the basic-property alist is unaffected.
+           ;; We need to search the basic-properties alist for our
+           ;; property to obtain values to offset.  Our search is
+           ;; complicated by the fact that calling the music function
+           ;; `offset' as an override conses a pair to the head of the
+           ;; alist.  This pair must be discounted.  The closure it
+           ;; contains is named `self' so it can be easily recognized.
+           ;; If `offset' is called as a tweak, the basic-property
+           ;; alist is unaffected.
            (target (find-value-to-offset property self immutable))
-           ; if target is a procedure, we need to apply it to our grob to calculate
-           ; values to offset.
-           (vals
-             (if (procedure? target)
-                 (target grob)
-                 target))
+           ;; if target is a procedure, we need to apply it to our
+           ;; grob to calculate values to offset.
+           (vals (cond ((procedure? target) (target grob))
+                       ;; Argument lists for a pure procedure pulled
+                       ;; from an unpure-pure-container may be
+                       ;; different from a normal procedure, so we
+                       ;; need a different code path and calling
+                       ;; convention for procedures pulled from an
+                       ;; container as opposed to from the property
+                       ((ly:unpure-pure-container? target)
+                        (let ((part (container-part target)))
+                          (if (procedure? part)
+                              (apply part grob rest)
+                              part)))
+                       (else target)))
            (can-type-be-offset?
-             (or (number? vals)
-                 (number-pair? vals)
-                 (number-pair-list? vals))))
+            (or (number? vals)
+                (number-pair? vals)
+                (number-pair-list? vals))))
 
       (if can-type-be-offset?
-          ; '(+inf.0 . -inf.0) would offset to itself.  This will be confusing to a
-          ; user unaware of the default value of the property, so issue a warning.
+          ;; '(+inf.0 . -inf.0) would offset to itself.  This will be
+          ;; confusing to a user unaware of the default value of the
+          ;; property, so issue a warning.
           (if (equal? empty-interval vals)
               (ly:warning "default '~a of ~a is ~a and can't be offset"
                 property grob vals)
@@ -2331,8 +2337,8 @@ Offsets are restricted to immutable properties and values of type @code{number},
                            (ly:spanner-broken-into orig)
                            '()))
                      (total-found (length siblings))
-                     ; Since there is some flexibility in input syntax,
-                     ; structure of `offsets' is normalized.
+                     ;; Since there is some flexibility in input
+                     ;; syntax, structure of `offsets' is normalized.
                      (offsets
                        (if (or (not (pair? offsets))
                                (number-pair? offsets)
@@ -2342,7 +2348,7 @@ Offsets are restricted to immutable properties and values of type @code{number},
                            offsets)))
 
                 (define (helper sibs offs)
-                  ; apply offsets to the siblings of broken spanners
+                  ;; apply offsets to the siblings of broken spanners
                   (if (pair? offs)
                       (if (eq? (car sibs) grob)
                           (offset-multiple-types vals (car offs))
@@ -2353,12 +2359,19 @@ Offsets are restricted to immutable properties and values of type @code{number},
                     (helper siblings offsets)
                     (offset-multiple-types vals (car offsets)))))
 
-              (begin
-                (ly:warning "the property '~a of ~a cannot be offset" property grob)
-                vals))))
-    ; return the closure named `self'
-    self)
-
+          (begin
+            (ly:warning "the property '~a of ~a cannot be offset" property grob)
+            vals))))
+  ;; return the container named `self'.  The container self-reference
+  ;; seems like chasing its own tail but gets dissolved by
+  ;; define/lambda separating binding and referencing of "self".
+  (define self (ly:make-unpure-pure-container
+                (lambda (grob)
+                  (worker self ly:unpure-pure-container-unpure-part grob))
+                (lambda (grob . rest)
+                  (apply worker self ly:unpure-pure-container-pure-part
+                         grob rest))))
+  self)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; \magnifyMusic and \magnifyStaff