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))))
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
https://lists.gnu.org/mailman/listinfo/lilypond-devel