lilypond-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Move add-grob-definition from a snippet to scm/translation-functions


From: plroskin
Subject: Re: Move add-grob-definition from a snippet to scm/translation-functions.scm (issue 6128048)
Date: Sat, 28 Apr 2012 03:08:13 +0000

Reviewers: dak, c_sorensen_byu.edu,

Message:
OK, the problem I wanted to address is to have a documented way to
define new grobs.  I hoped that moving add-grob-definition to a "public
place" would be a good start.  If it's not, sorry for the noise.

Description:
Move add-grob-definition from a snippet to scm/translation-functions.scm

add-grob-definition should be public, as that's the "official" way to
create a new grob in Scheme.

Please review this at http://codereview.appspot.com/6128048/

Affected files:
  M input/regression/scheme-text-spanner.ly
  M scm/translation-functions.scm


Index: input/regression/scheme-text-spanner.ly
diff --git a/input/regression/scheme-text-spanner.ly b/input/regression/scheme-text-spanner.ly index c0204d55c71865f3c35ae69d28387916725b9adf..87314ec0dbcc0451fdaec8aa9a75e6c043fcb539 100644
--- a/input/regression/scheme-text-spanner.ly
+++ b/input/regression/scheme-text-spanner.ly
@@ -12,31 +12,6 @@ in scheme."
      music-event
      StreamEvent))

-#(define (add-grob-definition grob-name grob-entry)
-   (let* ((meta-entry   (assoc-get 'meta grob-entry))
-          (class        (assoc-get 'class meta-entry))
-          (ifaces-entry (assoc-get 'interfaces meta-entry)))
-     (set-object-property! grob-name 'translation-type? list?)
-     (set-object-property! grob-name 'is-grob? #t)
-     (set! ifaces-entry (append (case class
-                                  ((Item) '(item-interface))
-                                  ((Spanner) '(spanner-interface))
-                                  ((Paper_column) '((item-interface
- paper-column-interface)))
-                                  ((System) '((system-interface
-                                               spanner-interface)))
-                                  (else '(unknown-interface)))
-                                ifaces-entry))
-     (set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
-     (set! ifaces-entry (cons 'grob-interface ifaces-entry))
-     (set! meta-entry (assoc-set! meta-entry 'name grob-name))
-     (set! meta-entry (assoc-set! meta-entry 'interfaces
-                                  ifaces-entry))
-     (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
-     (set! all-grob-descriptions
-           (cons (cons grob-name grob-entry)
-                 all-grob-descriptions))))
-
 #(add-grob-definition
   'SchemeTextSpanner
   `(
Index: scm/translation-functions.scm
diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm
index a535497962c07b9ae8ca5d79d1faf3901d1b7e10..959ab8517e3e7cc1d9f328d75175d1ff113ff72c 100644
--- a/scm/translation-functions.scm
+++ b/scm/translation-functions.scm
@@ -701,3 +701,31 @@ with the subordinate symbols being interfaces."
                       `(cons ',(car form) ,(loop (cdr form)))))
                 forms))
        forms)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; create grob in Scheme
+
+(define-public (add-grob-definition grob-name grob-entry)
+  (let* ((meta-entry   (assoc-get 'meta grob-entry))
+         (class        (assoc-get 'class meta-entry))
+         (ifaces-entry (assoc-get 'interfaces meta-entry)))
+    (set-object-property! grob-name 'translation-type? list?)
+    (set-object-property! grob-name 'is-grob? #t)
+    (set! ifaces-entry (append (case class
+                                 ((Item) '(item-interface))
+                                 ((Spanner) '(spanner-interface))
+                                 ((Paper_column) '((item-interface
+ paper-column-interface)))
+                                 ((System) '((system-interface
+                                              spanner-interface)))
+                                 (else '(unknown-interface)))
+                         ifaces-entry))
+    (set! ifaces-entry (uniq-list (sort ifaces-entry symbol<?)))
+    (set! ifaces-entry (cons 'grob-interface ifaces-entry))
+    (set! meta-entry (assoc-set! meta-entry 'name grob-name))
+    (set! meta-entry (assoc-set! meta-entry 'interfaces
+                       ifaces-entry))
+    (set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
+    (set! all-grob-descriptions
+          (cons (cons grob-name grob-entry)
+            all-grob-descriptions))))





reply via email to

[Prev in Thread] Current Thread [Next in Thread]