Re: Issue 4516: Make \offset handle unpure/pure containers (issue 250590043 by address@hidden)

[dak]

Reviewers: david.nalesnik,

Message:
On 2015/07/22 16:20:48, david.nalesnik wrote:
> Yet compare the output of

> {
>    \offset Y-offset #-5 DynamicLineSpanner
>    \repeat unfold 200 {
>      c'2\f\< c'2\!
>    }
> }

> with

> {
>    \override DynamicLineSpanner.Y-offset = #-15
>    \repeat unfold 200 {
>      c'2\f\< c'2\!
>    }
> }

> Shouldn't the offset to the result of calling the pure function result
in better
> vertical spacing?

Oh, this doesn't work yet: looks nice but I did not think it through
correctly.  And I'm still puzzling this one out: creating an
unpure-pure-container that will contain closures recognizing the
unpure-pure-container's identity in the property chain is actually
murderously non-trivial.  Since once you created the
unpure-pure-container (and only then is its identity established), you
can no longer change its contents.

I still got a scheme going that should work for this.  But wrapping the
basic mechanism I'm going to use in code that is reasonably
straightforward is quite a challenge.

Description:
Issue 4516: Make \offset handle unpure/pure containers

I have no clue whether this does what is expected from it.  Not really
understanding \offset, I cannot come up with reasonable test cases.
The linked example from the mailing list does not appear to do
anything.  As opposed to before, it does not print warnings, however.

Please review this at https://codereview.appspot.com/250590043/

Affected files (+49, -47 lines):
  M scm/music-functions.scm


Index: scm/music-functions.scm
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index  
304becef0331f593e305add09ae891e1d44ef140..1deaa1cf48d1b06daa0649a99220a81a308ba645  
100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -2292,41 +2292,25 @@ 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)
-    (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.
-           (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))
-           (can-type-be-offset?
-             (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.
-          (if (equal? empty-interval vals)
-              (ly:warning "default '~a of ~a is ~a and can't be offset"
-                property grob vals)
-              (let* ((orig (ly:grob-original grob))
-                     (siblings
+  (define (final-offsetter grob vals)
+    (cond ((or (number? vals)
+               (number-pair? vals)
+               (number-pair-list? vals))
+           ;; '(+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)
+               (let* ((orig (ly:grob-original grob))
+                      (siblings
                        (if (ly:spanner? grob)
                            (ly:spanner-broken-into orig)
                            '()))
-                     (total-found (length siblings))
-                     ; Since there is some flexibility in input syntax,
-                     ; structure of `offsets' is normalized.
-                     (offsets
+                      (total-found (length siblings))
+                      ;; Since there is some flexibility in input
+                      ;; syntax, structure of `offsets' is normalized.
+                      (offsets
                        (if (or (not (pair? offsets))
                                (number-pair? offsets)
                                (and (number-pair-list? offsets)
@@ -2334,24 +2318,42 @@ Offsets are restricted to immutable properties and  
values of type @code{number},
                            (list offsets)
                            offsets)))

-                (define (helper sibs offs)
-                  ; apply offsets to the siblings of broken spanners
-                  (if (pair? offs)
-                      (if (eq? (car sibs) grob)
-                          (offset-multiple-types vals (car offs))
-                          (helper (cdr sibs) (cdr offs)))
-                      vals))
+                 (define (helper sibs offs)
+                   ;; apply offsets to the siblings of broken spanners
+                   (if (pair? offs)
+                       (if (eq? (car sibs) grob)
+                           (offset-multiple-types vals (car offs))
+                           (helper (cdr sibs) (cdr offs)))
+                       vals))

-                (if (>= total-found 2)
+                 (if (>= total-found 2)
                     (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)
-
+           ((procedure? vals)
+            ;; the rest argument is awkward but needed for pure calls
+            ;; in unpure-pure-containers
+            (lambda (grob . rest) (final-offsetter grob (apply vals grob  
rest))))
+           ((ly:unpure-pure-container? vals)
+            (ly:unpure-pure-container
+             (final-offsetter grob (ly:unpure-pure-container-unpure-part  
vals))
+             (final-offsetter grob (ly:unpure-pure-container-pure-part  
vals))))
+           (else
+            (ly:warning "the property '~a of ~a cannot be offset" property  
grob)
+            vals))))
+  (define (self grob)
+    (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.
+           (target (find-value-to-offset property self immutable)))
+      (final-offsetter grob target)))
+  ;; return the closure named `self'
+  self)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; \magnifyMusic and \magnifyStaff