* lily/font-interface.cc (get-font): take alist chain i.s.o. alist

[lilypond.git] / scm / new-markup.scm

diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index 78cbb7779a8f4744455b31ad02eaab106e50e8b8..dcd7407d48da0604df5153b7fb2a46999886c1e3 100644 (file)
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -8,7 +8,7 @@
 (define-public (line-markup grob props . rest)
   (stack-molecules
    X 1 1.0 
-   (map (lambda (x) (interpret_markup grob props x)) (car rest)))
+   (map (lambda (x) (interpret-markup grob props x)) (car rest)))
   )
 
 (define (combine-molecule-list lst)
@@ -17,37 +17,71 @@
       ))
 
 (define-public (combine-markup grob props . rest)
-   (combine-molecule-list (map (lambda (x) (interpret_markup grob props x)) (car rest))))
+   (combine-molecule-list (map (lambda (x) (interpret-markup grob props x)) (car rest))))
 
 (define-public (bold-markup grob props . rest)
-   (interpret_markup grob (cons '((font-series .  bold)) props) (car rest))
+   (interpret-markup grob (cons (cons '(font-series . bold) (car props)) (cdr props)) (car rest))
   )
 
 (define-public (column-markup grob props . rest)
   (stack-molecules
    Y -1 0.0 
-   (map (lambda (x) (interpret_markup grob props x)) (car rest)))
+   (map (lambda (x) (interpret-markup grob props x)) (car rest)))
   )
 
-;; todo. Use macro?  
-(map
- (lambda (x)
+(define-public (music-markup grob props . rest)
+  (ly:find-glyph-by-name
+   (ly:get-font grob (cons '((font-family . music)) props))
+   (car rest))
+  )
+
+(define-public (lookup-markup grob props . rest)
+  "Lookup a glyph by name."
+  (ly:find-glyph-by-name
+   (ly:get-font grob props)
+   (car rest))
+  )
 
-   (set-object-property!
-    (eval (string->symbol (string-append (symbol->string x) "-markup")) (current-module))
-    'markup-function? #t))
+(define-public (override-markup grob props . rest)
+  "Tack the 1st args in REST onto PROPS."
+  (interpret-markup grob (cons (list (car rest)) props)
+                   (cadr rest)))
+
+(map (lambda (x)
+       (set-object-property! (car x) 'markup-signature (cdr x))
+       )
+     (list (cons bold-markup 'markup0)
+          (cons column-markup 'markup-list0)
+          (cons line-markup  'markup-list0)
+          (cons combine-markup 'markup0-markup1)
+          (cons simple-markup 'markup0)
+          (cons music-markup 'scm0)
+          (cons override-markup 'scm0-markup1)
+          (cons lookup-markup 'scm0)
+          ))
+
+(define markup-module (current-module))
+
+(define-public (lookup-markup-command code)
+  (let*
+      ( (sym (string->symbol (string-append code "-markup")))
+       (var (module-local-variable markup-module sym))
+       )
+    (if (eq? var #f)
+       #f   
+       (cons (variable-ref var) (object-property  (variable-ref var) 'markup-signature))
+    )
+  ))
 
- '(simple column bold combine line )
- )
 
 (define-public (brew-new-markup-molecule grob)
-  (interpret_markup grob
+  (interpret-markup grob
                    (Font_interface::get_property_alist_chain grob)
                    (ly:get-grob-property grob 'text)
                    )
   )
 
-(define (interpret_markup  grob props markup)
+(define (interpret-markup  grob props markup)
   (let*
       (
        (func (car markup))
@@ -57,9 +91,10 @@
     (apply func (cons grob (cons props args)) )
     ))
 
+
 (define (new-markup? x)
        (markup-function? (car x))
 )
 
 (define (markup-function? x)
-       (object-property 'markup-function? x))
+       (object-property 'markup-signature? x))