Update Debian font description.

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

diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index b3f3d6d046b2d32b79d155701e1965e56b0f78ad..3b5eb11fcdbdf453578fe75f51855304ee05928e 100644 (file)
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c)  2003--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2003--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 "
 Internally markup is stored as lists, whose head is a function.
@@ -22,7 +22,7 @@ print object).
 
 To add a function, use the def-markup-command utility.
 
-  (def-markup-command (mycommand paper prop arg1 ...) (arg1-type? ...)
+  (def-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
     \"my command usage and description\"
     ...function body...)
 
@@ -51,7 +51,7 @@ register COMMAND-markup and its signature,
 * define a make-COMMAND-markup function.
 
 Syntax:
-  (def-markup-command (COMMAND paper props arg1 arg2 ...) (arg1-type? arg2-type? ...)
+  (def-markup-command (COMMAND layout props arg1 arg2 ...) (arg1-type? arg2-type? ...)
     \"documentation string\"
     ...command body...)
  or:
@@ -130,7 +130,7 @@ Use `markup*' in a \\notes block."
   
   
 (define (compile-all-markup-expressions expr)
-  "Return a list of canonical markups expressions, eg:
+  "Return a list of canonical markups expressions, e.g.:
   (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
   ===>
   ((make-COMMAND1-markup arg11 arg12)
@@ -143,12 +143,12 @@ Use `markup*' in a \\notes block."
              (set! rest r))))
 
 (define (keyword->make-markup key)
-  "Transform a keyword, eg. #:COMMAND, in a make-COMMAND-markup symbol."
+  "Transform a keyword, e.g. #:COMMAND, in a make-COMMAND-markup symbol."
   (string->symbol (string-append "make-" (symbol->string (keyword->symbol key)) "-markup")))
 
 (define (compile-markup-expression expr)
   "Return two values: the first complete canonical markup expression found in `expr',
-eg (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
+e.g. (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
   (cond ((and (pair? expr)
               (keyword? (car expr)))
          ;; expr === (#:COMMAND arg1 ...)
@@ -175,8 +175,11 @@ eg (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
          ;; expr === ((#:COMMAND arg1 ...) ...)
          (receive (m r) (compile-markup-expression (car expr))
                   (values m (cdr expr))))
+        ((and (pair? expr)
+              (string? (car expr))) ;; expr === ("string" ...)
+         (values `(make-simple-markup ,(car expr)) (cdr expr)))
         (else
-         ;; expr === (symbol ...) or ("string" ...) or ((funcall ...) ...)
+         ;; expr === (symbol ...) or ((funcall ...) ...)
          (values (car expr)
                  (cdr expr)))))
 
@@ -328,16 +331,34 @@ Also set markup-signature and markup-keyword object properties."
   (let ((proc (markup-symbol-to-proc (string->symbol (string-append code "-markup")))))
     (and proc (cons proc (markup-command-keyword proc)))))
 
+;;;;;;;;;;;;;;;;;;;;;;
+;;; used in parser.yy to map a list of markup commands on markup arguments
+(define-public (map-markup-command-list commands markups)
+  "`markups' being a list of markups, eg (markup1 markup2 markup3),
+and `commands' a list of commands with their scheme arguments, in reverse order,
+eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
+ ((bold (raise 4 (italic markup1)))
+  (bold (raise 4 (italic markup2)))
+  (bold (raise 4 (italic markup3))))
+"
+  (map-in-order (lambda (arg)
+                  (let ((result arg))
+                    (for-each (lambda (cmd)
+                                (set! result (append cmd (list result))))
+                              commands)
+                    result))
+                markups))
+
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;; markup type predicates
 
 (define (markup-function? x)
   (not (not (markup-command-signature x))))
 
-(define (markup-list? arg)
-  (define (markup-list-inner? l)
-    (or (null? l)
-        (and (markup? (car l)) (markup-list-inner? (cdr l)))))
+(define-public (markup-list? arg)
+  (define (markup-list-inner? lst)
+    (or (null? lst)
+        (and (markup? (car lst)) (markup-list-inner? (cdr lst)))))
   (and (list? arg) (markup-list-inner? arg)))
 
 (define (markup-argument-list? signature arguments)
@@ -403,8 +424,8 @@ Also set markup-signature and markup-keyword object properties."
       (make-line-markup (list-insert-separator markups sep))
       empty-markup))
 
-(define-public brew-new-markup-stencil Text_item::print)
-(define-public interpret-markup Text_item::interpret_markup)
+(define-public brew-new-markup-stencil Text_interface::print)
+(define-public interpret-markup Text_interface::interpret_markup)
 (define-public (prepend-alist-chain key val chain)
   (cons (acons key val (car chain)) (cdr chain)))
 
@@ -412,6 +433,7 @@ Also set markup-signature and markup-keyword object properties."
 
 
 (define-public (stack-stencil-line space stencils)
+  "DOCME"
   (if (and (pair? stencils)
           (ly:stencil? (car stencils)))
       
@@ -419,7 +441,7 @@ Also set markup-signature and markup-keyword object properties."
               (ly:stencil? (cadr stencils)))
           (let* ((tail (stack-stencil-line  space (cdr stencils)))
                  (head (car stencils))
-                 (xoff (+ space (cdr (ly:stencil-get-extent head X)))))
+                 (xoff (+ space (cdr (ly:stencil-extent head X)))))
             (ly:stencil-add head
                              (ly:stencil-translate-axis tail xoff X)))
           (car stencils))