Displaying grob ancestry: Difference between revisions

Line 10:

For example, the <code>System</code> grob can be both parent (on the Y-side) and grandparent (twice on the X-side) to a <code>VerticalAlignment</code> grob.

~~This~~ macro prints (to the console) a textual representation of a grob's ancestry.

The macro defined in this snippet prints (to the console) a textual representation of a grob's ancestry. For example, the call

~~When called this way:~~

{

\once \override NoteHead.before-line-breaking = #display-ancestry

c

}

~~<pre>{ \once \override NoteHead.before-line-breaking = #display-ancestry c }</pre>~~

generates the following output.

~~The~~ following output ~~is generated:~~

~~<pre>~~NoteHead

------------------------------------

X,Y: NoteColumn

X: PaperColumn

NoteHead

X,Y: System

X,Y: NoteColumn

Y: VerticalAxisGroup

X: PaperColumn

X: NonMusicalPaperColumn

X,Y: System

Y: VerticalAxisGroup

Y: VerticalAlignment

X: NonMusicalPaperColumn

X,Y: System

Y: VerticalAlignment

Y: System~~</pre>~~

X: NonMusicalPaperColumn

X,Y: System

Y: System

~~%% http://lsr.di.unimi.it/LSR/Item?id=622~~

#(define (get-ancestry grob)

(if (not (null? (ly:grob-parent grob X)))

(list (grob::name grob)

(get-ancestry (ly:grob-parent grob X))

(get-ancestry (ly:grob-parent grob Y)))

(grob::name grob)))

#(define (format-ancestry lst padding)

(string-append

(symbol->string (car lst))

(symbol->string (car lst)) "\n"

"\n"

(let ((X-ancestry (if (list? (cadr lst))

(let ((X-ancestry

(format-ancestry (cadr lst) (+ padding 3))

(if (list? (cadr lst))

(symbol->string (cadr lst))))

(format-ancestry (cadr lst) (+ padding 3))

(Y-ancestry (if (list? (caddr lst))

(symbol->string (cadr lst))))

(format-ancestry (caddr lst) (+ padding 3))

(Y-ancestry

(symbol->string (caddr lst)))))

(if (list? (caddr lst))

(format-ancestry (caddr lst) (+ padding 3))

(symbol->string (caddr lst)))))

(if (equal? X-ancestry Y-ancestry)

(string-append

(string-append (format #f "~&")

(format #f "~&")

(make-string padding #\space)

"X,Y: "

(if (list? (cadr lst))

(format-ancestry (cadr lst) (+ padding 5))

(symbol->string (cadr lst))))

(string-append (format #f "~&")

(string-append

(make-string padding #\space)

(format #f "~&")

"X: " X-ancestry "\n"

(make-string padding #\space)

"X: " X-ancestry

"Y: " Y-ancestry (format #f "~&"))))

"\n"

(make-string padding #\space)

"Y: " Y-ancestry

(format #f "~&"))))

(format #f "~&")))

#(define (display-ancestry grob)

(format (current-~~error~~-port)

(format (current-output-port)

"~3&~a~2%~a~&"

"~2&~a~2%~a~&"

(make-string 36 #\-)

(if (ly:grob? grob)

(format-ancestry (get-ancestry grob) 0)

(format #f "~a is not a grob" grob))))

\relative c' {

Line 86:

Line 81:

</lilypond>

~~[[Category:Scheme]]~~

[[Category:Scheme]]

[[Category:Tweaks and overrides]]

[[Category:Included in the official documentation]]

[[Category:Snippet]]

@@ Line 10: / Line 10: @@
 For example, the <code>System</code> grob can be both parent (on the Y-side) and grandparent (twice on the X-side) to a <code>VerticalAlignment</code> grob.
-This macro prints (to the console) a textual representation of a grob's ancestry.
+The macro defined in this snippet prints (to the console) a textual representation of a grob's ancestry.  For example, the call
-When called this way:
+ {
+   \once \override NoteHead.before-line-breaking = #display-ancestry
+   c
+ }
-<pre>{ \once \override NoteHead.before-line-breaking = #display-ancestry c }</pre>
+generates the following output.
-The following output is generated:
-<pre>NoteHead
+ ------------------------------------
-X,Y: NoteColumn
-     X: PaperColumn
+ NoteHead
-        X,Y: System
+ X,Y: NoteColumn
-     Y: VerticalAxisGroup
+      X: PaperColumn
-        X: NonMusicalPaperColumn
+         X,Y: System
-           X,Y: System
+      Y: VerticalAxisGroup
-        Y: VerticalAlignment
+         X: NonMusicalPaperColumn
-           X: NonMusicalPaperColumn
+            X,Y: System
-              X,Y: System
+         Y: VerticalAlignment
-           Y: System</pre>
+            X: NonMusicalPaperColumn
+               X,Y: System
+            Y: System
 <lilypond version="2.24">
-%% http://lsr.di.unimi.it/LSR/Item?id=622
 #(define (get-ancestry grob)
-  (if (not (null? (ly:grob-parent grob X)))
+   (if (not (null? (ly:grob-parent grob X)))
-      (list (grob::name grob)
+       (list (grob::name grob)
-            (get-ancestry (ly:grob-parent grob X))
+             (get-ancestry (ly:grob-parent grob X))
-            (get-ancestry (ly:grob-parent grob Y)))
+             (get-ancestry (ly:grob-parent grob Y)))
-      (grob::name grob)))
+       (grob::name grob)))
 #(define (format-ancestry lst padding)
     (string-append
-     (symbol->string (car lst))
+     (symbol->string (car lst)) "\n"
-    "\n"
+     (let ((X-ancestry (if (list? (cadr lst))
-     (let ((X-ancestry
+                          (format-ancestry (cadr lst) (+ padding 3))
-           (if (list? (cadr lst))
+                          (symbol->string (cadr lst))))
-               (format-ancestry (cadr lst) (+ padding 3))
+           (Y-ancestry (if (list? (caddr lst))
-               (symbol->string (cadr lst))))
+                          (format-ancestry (caddr lst) (+ padding 3))
-           (Y-ancestry
+                          (symbol->string (caddr lst)))))
-           (if (list? (caddr lst))
-               (format-ancestry (caddr lst) (+ padding 3))
-               (symbol->string (caddr lst)))))
        (if (equal? X-ancestry Y-ancestry)
-           (string-append
+           (string-append (format #f "~&")
-           (format #f "~&")
+                         (make-string padding #\space)
-           (make-string padding #\space)
+                         "X,Y: "
-           "X,Y: "
+                         (if (list? (cadr lst))
-           (if (list? (cadr lst))
+                             (format-ancestry (cadr lst) (+ padding 5))
-               (format-ancestry (cadr lst) (+ padding 5))
+                             (symbol->string (cadr lst))))
-               (symbol->string (cadr lst))))
+           (string-append (format #f "~&")
-           (string-append
+                         (make-string padding #\space)
-           (format #f "~&")
+                         "X: " X-ancestry "\n"
-           (make-string padding #\space)
+                         (make-string padding #\space)
-           "X: " X-ancestry
+                         "Y: " Y-ancestry (format #f "~&"))))
-           "\n"
-           (make-string padding #\space)
-           "Y: " Y-ancestry
-           (format #f "~&"))))
      (format #f "~&")))
 #(define (display-ancestry grob)
-    (format (current-error-port)
+    (format (current-output-port)
-      "~3&~a~2%~a~&"
+           "~2&~a~2%~a~&"
-      (make-string 36 #\-)
+           (make-string 36 #\-)
-      (if (ly:grob? grob)
+           (if (ly:grob? grob)
-          (format-ancestry (get-ancestry grob) 0)
+               (format-ancestry (get-ancestry grob) 0)
-          (format #f "~a is not a grob" grob))))
+               (format #f "~a is not a grob" grob))))
 \relative c' {
@@ Line 86: / Line 81: @@
 </lilypond>
-[[Category:Scheme]]
 [[Category:Scheme]]
 [[Category:Tweaks and overrides]]
 [[Category:Included in the official documentation]]
 [[Category:Snippet]]