Lilypond-book: regtest files restructuring/renaming

[lilypond.git] / scm / markup.scm

diff --git a/scm/markup.scm b/scm/markup.scm
index 4c050ba9ce82a31dedbe3422116d00d866dc9b45..92ffaf47c5b42e928696e3700b2d0151c6cb143b 100644 (file)
--- a/scm/markup.scm
+++ b/scm/markup.scm
@@ -22,7 +22,7 @@ Internally markup is stored as lists, whose head is a function.
 
 When the markup is formatted, then FUNCTION is called as follows
 
-  (FUNCTION GROB PROPS ARG1 ARG2 ... ) 
+  (FUNCTION GROB PROPS ARG1 ARG2 ... )
 
 GROB is the current grob, PROPS is a list of alists, and ARG1.. are
 the rest of the arguments.
@@ -66,7 +66,7 @@ register COMMAND-markup and its signature,
 
 * add COMMAND-markup to markup-functions-by-category,
 
-* sets COMMAND-markup markup-signature and markup-keyword object properties,
+* sets COMMAND-markup markup-signature object property,
 
 * define a make-COMMAND-markup function.
 
@@ -261,17 +261,17 @@ Example:
          <==>
   (markup \"foo\"
           #:raise 0.2 #:hbracket #:bold \"bar\"
-          #:override '(baseline-skip . 4) 
+          #:override '(baseline-skip . 4)
           #:bracket #:column (\"baz\" \"bazr\" \"bla\"))
 Use `markup*' in a \\notemode context."
-  
+
   (car (compile-all-markup-expressions `(#:line ,body))))
 
 (defmacro*-public markup* (#:rest body)
   "Same as `markup', for use in a \\notes block."
   `(ly:export (markup ,@body)))
-  
-  
+
+
 (define (compile-all-markup-expressions expr)
   "Return a list of canonical markups expressions, e.g.:
   (#:COMMAND1 arg11 arg12 #:COMMAND2 arg21 arg22 arg23)
@@ -366,58 +366,28 @@ Use `markup*' in a \\notemode context."
 
 ;;;;;;;;;;;;;;;
 ;;; Utilities for storing and accessing markup commands signature
-;;; and keyword.
 ;;; Examples:
 ;;;
 ;;; (set! (markup-command-signature raise-markup) (list number? markup?))
-;;; ==> ((#<primitive-procedure number?> #<procedure markup? (obj)>) . scheme0-markup1)
+;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
 ;;;
 ;;; (markup-command-signature raise-markup)
 ;;; ==> (#<primitive-procedure number?> #<procedure markup? (obj)>)
 ;;;
-;;; (markup-command-keyword raise-markup) ==> "scheme0-markup1"
-;;; 
-
-(define-public (markup-command-keyword markup-command)
-  "Return markup-command's argument keyword, ie a string describing the command
-  arguments, eg. \"scheme0markup1\""
-  (object-property markup-command 'markup-keyword))
 
 (define-public (markup-command-signature-ref markup-command)
   "Return markup-command's signature (the 'markup-signature object property)"
   (object-property markup-command 'markup-signature))
 
 (define-public (markup-command-signature-set! markup-command signature)
-  "Set markup-command's signature and keyword (as object properties)"
+  "Set markup-command's signature (as object property)"
   (set-object-property! markup-command 'markup-signature signature)
-  (set-object-property! markup-command 'markup-keyword 
-                        (markup-signature-to-keyword signature))
   signature)
 
 (define-public markup-command-signature
   (make-procedure-with-setter markup-command-signature-ref
                               markup-command-signature-set!))
 
-(define-public (markup-signature-to-keyword sig)
-  " (A B C) -> a0-b1-c2 "
-  (if (null? sig)
-      'empty
-      (string->symbol (string-join (map
-                                    (let* ((count 0))
-                                      (lambda (func)
-                                        (set! count (+ count 1))
-                                        (string-append
-                                         ;; for reasons I don't get,
-                                         ;; (case func ((markup?) .. )
-                                         ;; doesn't work.
-                                         (cond 
-                                          ((eq? func markup?) "markup")
-                                          ((eq? func markup-list?) "markup-list")
-                                          (else "scheme"))
-                                         (number->string (- count 1)))))
-                                    sig)
-                         "-"))))
-
 (define (lookup-markup-command-aux symbol)
   (let ((proc (catch 'misc-error
                 (lambda ()
@@ -429,13 +399,13 @@ Use `markup*' in a \\notemode context."
   (let ((proc (lookup-markup-command-aux
               (string->symbol (format #f "~a-markup" code)))))
     (and proc (markup-function? proc)
-        (cons proc (markup-command-keyword proc)))))
+        (cons proc (markup-command-signature proc)))))
 
 (define-public (lookup-markup-list-command code)
   (let ((proc (lookup-markup-command-aux
               (string->symbol (format #f "~a-markup-list" code)))))
      (and proc (markup-list-function? proc)
-         (cons proc (markup-command-keyword proc)))))
+         (cons proc (markup-command-signature proc)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;; used in parser.yy to map a list of markup commands on markup arguments
@@ -507,10 +477,10 @@ a markup list function and its arguments."
            (markup-argument-list? (markup-command-signature (car arg))
                                   (cdr arg)))))
 
-;; 
-;; 
 ;;
-;; 
+;;
+;;
+;;
 (define (markup-thrower-typecheck arg)
   "typecheck, and throw an error when something amiss.
 
@@ -528,7 +498,7 @@ Uncovered - cheap-markup? is used."
 
 ;;
 ;; good enough if you only  use make-XXX-markup functions.
-;; 
+;;
 (define (cheap-markup? x)
   (or (string? x)
       (and (pair? x)
@@ -536,7 +506,7 @@ Uncovered - cheap-markup? is used."
 
 ;;
 ;; replace by markup-thrower-typecheck for more detailed diagnostics.
-;; 
+;;
 (define-public markup? cheap-markup?)
 
 ;; utility
@@ -568,7 +538,7 @@ Uncovered - cheap-markup? is used."
   "DOCME"
   (if (and (pair? stencils)
           (ly:stencil? (car stencils)))
-      
+
       (if (and (pair? (cdr stencils))
               (ly:stencil? (cadr stencils)))
           (let* ((tail (stack-stencil-line space (cdr stencils)))