Fix some bugs in the dynamic engraver and PostScript backend

[lilypond.git] / scm / markup.scm

diff --git a/scm/markup.scm b/scm/markup.scm
index 58b7433b4b83160fc49926052d91254bbb5e26b1..a98ba122db072d329bcc29e65eff99ecbeb9f0f0 100644 (file)
--- a/scm/markup.scm
+++ b/scm/markup.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;; 
-;;;; (c) 2003--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2003--2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 
 "
 Internally markup is stored as lists, whose head is a function.
@@ -20,9 +20,9 @@ The function should return a stencil (i.e. a formatted, ready to
 print object).
 
 
-To add a function, use the def-markup-command utility.
+To add a function, use the define-markup-command utility.
 
-  (def-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
+  (define-markup-command (mycommand layout prop arg1 ...) (arg1-type? ...)
     \"my command usage and description\"
     ...function body...)
 
@@ -35,10 +35,10 @@ The command is now available in markup mode, e.g.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; markup definer utilities
-;;; `def-markup-command' can be used both for built-in markup
+;;; `define-markup-command' can be used both for built-in markup
 ;;; definitions and user defined markups.
 
-(defmacro-public def-markup-command (command-and-args signature . body)
+(defmacro-public define-markup-command (command-and-args signature . body)
   "
 
 * Define a COMMAND-markup function after command-and-args and body,
@@ -51,11 +51,11 @@ register COMMAND-markup and its signature,
 * define a make-COMMAND-markup function.
 
 Syntax:
-  (def-markup-command (COMMAND layout props arg1 arg2 ...) (arg1-type? arg2-type? ...)
+  (define-markup-command (COMMAND layout props arg1 arg2 ...) (arg1-type? arg2-type? ...)
     \"documentation string\"
     ...command body...)
  or:
-  (def-markup-command COMMAND (arg1-type? arg2-type? ...)
+  (define-markup-command COMMAND (arg1-type? arg2-type? ...)
     function)
 "
   (let* ((command (if (pair? command-and-args) (car command-and-args) command-and-args))
@@ -84,15 +84,16 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
                         (markup-argument-list-error signature args 1)
                         #f)))
     (if (or (not (= arglen siglen)) (< siglen 0) (< arglen 0))
-        (scm-error 'markup-format make-name
-                   "Expect ~A arguments for ~A. Found ~A: ~S"
-                   (list siglen make-name arglen args)
-                   #f))
+        (ly:error (string-append make-name ": "
+                   (_ "Wrong number of arguments.  Expect: ~A, found ~A: ~S"))
+                 siglen arglen args))
     (if error-msg
-        (scm-error 'markup-format make-name
-                   "Invalid argument in position ~A\nExpect: ~A\nFound: ~S."
-                   error-msg #f)
-        (cons markup-function args))))
+        (ly:error
+        (string-append
+         make-name ": "
+         (_ "Invalid argument in position ~A.  Expect: ~A, found: ~S.")
+         error-msg))
+       (cons markup-function args))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; markup constructors
@@ -147,13 +148,15 @@ Use `markup*' in a \\notes block."
   (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',
-e.g. (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
+  "Return two values: the first complete canonical markup expression
+   found in `expr', e.g. (make-COMMAND-markup arg1 arg2 ...),
+   and the rest expression."
   (cond ((and (pair? expr)
               (keyword? (car expr)))
          ;; expr === (#:COMMAND arg1 ...)
          (let* ((command (symbol->string (keyword->symbol (car expr))))
-                (sig (markup-command-signature (car (lookup-markup-command command))))
+                (sig (markup-command-signature
+                     (car (lookup-markup-command command))))
                 (sig-len (length sig)))
            (do ((i 0 (1+ i))
                 (args '() args)
@@ -217,43 +220,6 @@ e.g. (make-COMMAND-markup arg1 arg2 ...), and the rest expression."
          (values (cons 'list (compile-all-markup-args (car expr))) (cdr expr)))
         (else (values (car expr) (cdr expr)))))
 
-;;;;;;;;;;;;;;;
-;;; Debugging utilities: print markup expressions in a friendly fashion
-
-(use-modules (ice-9 format))
-(define (markup->string markup-expr)
-  "Return a string describing, in LilyPond syntax, the given markup expression."
-  (define (proc->command proc)
-    (let ((cmd-markup (symbol->string (procedure-name proc))))
-      (substring cmd-markup 0 (- (string-length cmd-markup)
-                                 (string-length "-markup")))))
-  (define (arg->string arg)
-    (cond ((and (pair? arg) (pair? (car arg))) ;; markup list
-           (format #f "~{ ~a~}" (map markup->string arg)))
-          ((pair? arg)                         ;; markup
-           (markup->string arg))
-          ((string? arg)                       ;; scheme string argument
-           (format #f "#\"~a\"" arg))
-          (else                                ;; other scheme arg
-           (format #f "#~a" arg))))
-  (let ((cmd (car markup-expr))
-        (args (cdr markup-expr)))
-    (cond ((eqv? cmd simple-markup) ;; a simple string
-           (format #f "\"~a\"" (car args)))
-          ((eqv? cmd line-markup)   ;; { ... }
-           (format #f "{~a}" (arg->string (car args))))
-          ((eqv? cmd center-align-markup) ;; \center < ... >
-           (format #f "\\center-align <~a>" (arg->string (car args))))
-          ((eqv? cmd column-markup) ;; \column < ... >
-           (format #f "\\column <~a>" (arg->string (car args))))
-          (else                ;; \command ...
-           (format #f "\\~a~{ ~a~} " (proc->command cmd) (map arg->string args))))))
-
-(define-public (display-markup markup-expr)
-  "Print a LilyPond-syntax equivalent for the given markup expression."
-  (display "\\markup ")
-  (display (markup->string markup-expr)))
-
 ;;;;;;;;;;;;;;;
 ;;; Utilities for storing and accessing markup commands signature
 ;;; and keyword.
@@ -425,7 +391,7 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
       empty-markup))
 
 
-(define-public interpret-markup Text_interface::interpret_markup)
+(define-public interpret-markup ly:text-interface::interpret-markup)
 (define-public (prepend-alist-chain key val chain)
   (cons (acons key val (car chain)) (cdr chain)))
 
@@ -436,7 +402,7 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
       
       (if (and (pair? (cdr stencils))
               (ly:stencil? (cadr stencils)))
-          (let* ((tail (stack-stencil-line  space (cdr stencils)))
+          (let* ((tail (stack-stencil-line space (cdr stencils)))
                  (head (car stencils))
                  (xoff (+ space (cdr (ly:stencil-extent head X)))))
             (ly:stencil-add head