Juergens patch.

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

diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index 07f6d11f34c6de8d84b7b0887b43eec734b7a091..e2cded650b47b2bc2ba6401ce2e9c44cb5c38499 100644 (file)
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -163,7 +163,7 @@ for the reader.
                              (car rest) Y)
   )
 
-(define-public (normal-size-superscript-markup grob props . rest)
+(define-public (normal-size-super-markup grob props . rest)
   (ly:molecule-translate-axis (interpret-markup
                               grob
                               props (car rest))
@@ -197,6 +197,15 @@ for the reader.
                              Y)
   )
 
+(define-public (normal-size-sub-markup grob props . rest)
+  (ly:molecule-translate-axis (interpret-markup
+                              grob
+                              props (car rest))
+                             (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
+                             Y)
+  )
+
+
 ;; todo: fix negative space
 (define (hspace-markup grob props . rest)
   "Syntax: \\hspace NUMBER."
@@ -307,18 +316,21 @@ for the reader.
 ;; full recursive typecheck.
 ;;
 (define (markup-typecheck? arg)
-  (and (pair? arg)
+  (or (string? arg)
+      (and (pair? arg)
        (markup-function? (car arg))
        (markup-argument-list?
        (object-property (car arg) 'markup-signature)
        (cdr arg))
   ))
+)
 
 ;; 
 ;; typecheck, and throw an error when something amiss.
 ;; 
 (define (markup-thrower-typecheck arg)
   (cond
+   ((string? arg) #t)
    ((not (pair? arg))
     (throw 'markup-format "Not a pair" arg)
     )
@@ -333,13 +345,13 @@ for the reader.
    #t
   )
 
-
 ;;
 ;; good enough if you only  use make-XXX-markup functions.
 ;; 
 (define (cheap-markup? x)
-  (and (pair? x)
-       (markup-function? (car x)))
+  (or (string? x)
+      (and (pair? x)
+          (markup-function? (car x))))
 )
 
 ;;
@@ -366,7 +378,10 @@ for the reader.
 
    ;; 
    (cons sub-markup (list markup?))
+   (cons normal-size-sub-markup (list markup?))
+   
    (cons super-markup (list markup?))
+   (cons normal-size-super-markup (list markup?))
    
    (cons bold-markup (list markup?))
    (cons italic-markup (list markup?))
@@ -484,7 +499,7 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
         (signature (object-property (car entry) 'markup-signature))
         )
   
-    `(define (,(string->symbol make-name) . args)
+    `(define-public (,(string->symbol make-name) . args)
        (make-markup ,(car entry) ,make-name ,(cons 'list signature)  args)
        ))
   )
@@ -516,14 +531,16 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
 (define-public empty-markup `(,simple-markup ""))
 
 (define (interpret-markup  grob props markup)
-  (let*
-      (
-       (func (car markup))
-       (args (cdr markup))
-       )
-    
-    (apply func (cons grob (cons props args)) )
-    ))
+  (if (string? markup)
+      (simple-markup grob props markup)
+      (let*
+         (
+          (func (car markup))
+          (args (cdr markup))
+          )
+       
+       (apply func (cons grob (cons props args)) )
+       )))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -542,7 +559,7 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
       )))
 
 ;; test make-foo-markup functions
-(if #t
+(if #f
     (begin
       (newline)
       (newline)