+(define-public (smaller-markup grob props . rest)
+ "Syntax: \\smaller MARKUP"
+ (let*
+ (
+ (fs (cdr (chain-assoc 'font-relative-size props)))
+ (entry (cons 'font-relative-size (- fs 1)))
+ )
+ (interpret-markup
+ grob (cons (list entry) props)
+ (car rest))
+ ))
+
+(define-public (bigger-markup grob props . rest)
+ "Syntax: \\bigger MARKUP"
+ (let*
+ (
+ (fs (cdr (chain-assoc 'font-relative-size props)))
+ (entry (cons 'font-relative-size (+ fs 1)))
+ )
+ (interpret-markup
+ grob (cons (list entry) props)
+ (car rest))
+ ))
+
+(define-public (box-markup grob props . rest)
+ "Syntax: \\box MARKUP"
+ (let*
+ (
+ (th 0.1)
+ (pad 0.2)
+ (m (interpret-markup grob props (car rest)))
+ )
+ (box-molecule m th pad)
+ ))
+
+(define (markup-signature-to-keyword sig)
+ " (A B C) -> a0-b1-c2 "
+
+ (let* ((count 0))
+ (string->symbol (string-join
+
+ (map
+ (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 (markup-function? x)
+ (object-property x 'markup-signature)
+ )
+
+(define (markup-list? arg)
+ (define (markup-list-inner? l)
+ (if (null? l)
+ #t
+ (and (markup? (car l)) (markup-list-inner? (cdr l)))
+ )
+ )
+ (and (list? arg) (markup-list-inner? arg)))
+
+(define (markup-argument-list? signature arguments)
+ "Typecheck argument list."
+ (if (and (pair? signature) (pair? arguments))
+ (and ((car signature) (car arguments))
+ (markup-argument-list? (cdr signature) (cdr arguments)))
+ (and (null? signature) (null? arguments)))
+ )
+
+
+(define (markup-argument-list-error signature arguments number)
+ "return (ARG-NR TYPE-EXPECTED ARG-FOUND) if an error is detected, or
+#f is no error found.
+"
+ (if (and (pair? signature) (pair? arguments))
+ (if (not ((car signature) (car arguments)))
+ (list number (type-name (car signature)) (car arguments))
+ (markup-argument-list-error (cdr signature) (cdr arguments) (+ 1 number)))
+ #f
+ ))
+
+;;
+;; full recursive typecheck.
+;;
+(define (markup-typecheck? 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)
+ )
+ ((not (markup-function? (car arg)))
+ (throw 'markup-format "Not a markup function " (car arg)))
+
+
+ ((not (markup-argument-list?
+ (object-property (car arg) 'markup-signature)
+ (cdr arg)))
+ (throw 'markup-format "Arguments failed typecheck for " arg)))
+ #t
+ )
+
+;;
+;; good enough if you only use make-XXX-markup functions.
+;;
+(define (cheap-markup? x)
+ (or (string? x)
+ (and (pair? x)
+ (markup-function? (car x))))
+)
+
+;;
+;; replace by markup-thrower-typecheck for more detailed diagnostics.
+;;
+(define markup? cheap-markup?)
+
+(define markup-functions-and-signatures
+ (list
+
+ ;; abs size
+ (cons teeny-markup (list markup?))
+ (cons tiny-markup (list markup?))
+ (cons small-markup (list markup?))
+ (cons dynamic-markup (list markup?))
+ (cons large-markup (list markup?))
+
+ (cons huge-markup (list markup?))
+
+ ;; size
+ (cons smaller-markup (list markup?))
+ (cons bigger-markup (list markup?))
+; (cons char-number-markup (list string?))
+
+ ;;
+ (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 finger-markup (list markup?))
+ (cons bold-markup (list markup?))
+ (cons italic-markup (list markup?))
+ (cons roman-markup (list markup?))
+ (cons number-markup (list markup?))
+ (cons hbracket-markup (list markup?))
+ (cons bracket-markup (list markup?))
+ (cons note-markup (list integer? integer? ly:dir?))
+
+ (cons column-markup (list markup-list?))
+ (cons dir-column-markup (list markup-list?))
+ (cons center-markup (list markup-list?))
+ (cons line-markup (list markup-list?))
+
+ (cons combine-markup (list markup? markup?))
+ (cons simple-markup (list string?))
+ (cons musicglyph-markup (list scheme?))
+ (cons translate-markup (list number-pair? markup?))
+ (cons override-markup (list pair? markup?))
+ (cons char-markup (list integer?))
+ (cons lookup-markup (list string?))
+
+ (cons hspace-markup (list number?))
+
+ (cons raise-markup (list number? markup?))
+ (cons magnify-markup (list number? markup?))
+ (cons fontsize-markup (list number? markup?))
+
+ (cons box-markup (list markup?))
+ )
+ )
+
+
+(define markup-module (current-module))
+