scm/new-markup.scm

   1
   2 "
   3 Internally markup is stored as lists, whose head is a function.
   4
   5   (FUNCTION ARG1 ARG2 ... )
   6
   7 When the markup is formatted, then FUNCTION is called as follows
   8
   9   (FUNCTION GROB PROPS ARG1 ARG2 ... )
  10
  11 GROB is the current grob, PROPS is a list of alists, and ARG1.. are
  12 the rest of the arguments.
  13
  14 The function should return a molecule (i.e. a formatted, ready to
  15 print object).
  16
  17
  18
  19 To add a function,
  20
  21 1. It should be named  COMMAND-markup
  22
  23 2. It should have an object property set that describes it's
  24 signature. This is to allow the parser to figure out how many
  25 arguments to expect:
  26
  27   (set-object-property! COMMAND-markup  scm0-markup1)
  28
  29 (insert in the list below).
  30
  31 3. The command is now available in markup mode, e.g.
  32
  33
  34   \markup { .... \COMMAND #1 argument ... }
  35
  36
  37 BUGS:
  38
  39 At present, markup functions must be defined in this
  40 file. Implementing user-access for markup functions is an excercise
  41 for the reader.
  42
  43
  44
  45
  46 " ; "
  47
  48
  49 ;;;;;;;;;;;;;;;;;
  50 ;; TODO:
  51 ;; each markup function should have a doc string with
  52 ;; syntax, description and example.
  53 ;;
  54
  55 (define-public (simple-markup grob props . rest)
  56   (Text_item::interpret_markup grob props (car rest)))
  57
  58 (define-public (stack-molecule-line space molecules)
  59   (if (pair? molecules)
  60       (if (pair? (cdr molecules))
  61           (let* (
  62                  (tail (stack-molecule-line  space (cdr molecules)))
  63                  (head (car molecules))
  64                  (xoff (+ space (cdr (ly:molecule-get-extent head X))))
  65                  )
  66
  67             (ly:molecule-add
  68              head
  69              (ly:molecule-translate-axis tail xoff X))
  70           )
  71           (car molecules))
  72       '())
  73   )
  74
  75 (define-public (line-markup grob props . rest)
  76   (stack-molecule-line
  77    (cdr (chain-assoc 'word-space props))
  78    (map (lambda (x) (interpret-markup grob props x)) (car rest)))
  79   )
  80
  81
  82 (define-public (combine-markup grob props . rest)
  83   (ly:molecule-add
  84    (interpret-markup grob props (car rest))
  85    (interpret-markup grob props (cadr rest))))
  86
  87 (define (font-markup qualifier value)
  88   (lambda (grob props . rest)
  89     (interpret-markup grob (cons (cons `(,qualifier . ,value) (car props)) (cdr props)) (car rest))
  90
  91   ))
  92
  93
  94 (define-public (set-property-markup qualifier)
  95   (lambda (grob props . rest  )
  96     (interpret-markup grob
  97                       (cons (cons `(,qualifier . ,(car rest))
  98                                   (car props)) (cdr props))
  99                       (cadr rest))
 100     ))
 101
 102 (define-public (finger-markup grob props . rest)
 103   (interpret-markup grob
 104                     (cons (list '(font-relative-size . -3)
 105                                 '(font-family . number))
 106                                 props)
 107                     (car rest)))
 108
 109 (define-public fontsize-markup (set-property-markup 'font-relative-size))
 110 (define-public magnify-markup (set-property-markup 'font-magnification))
 111
 112 (define-public bold-markup
 113   (font-markup 'font-series 'bold))
 114 (define-public number-markup
 115   (font-markup 'font-family 'number))
 116 (define-public roman-markup
 117   (font-markup 'font-family 'roman))
 118
 119
 120 (define-public huge-markup
 121   (font-markup 'font-relative-size 2))
 122 (define-public large-markup
 123   (font-markup 'font-relative-size 1))
 124 (define-public small-markup
 125   (font-markup 'font-relative-size -1))
 126 (define-public tiny-markup
 127   (font-markup 'font-relative-size -2))
 128 (define-public teeny-markup
 129   (font-markup 'font-relative-size -3))
 130 (define-public dynamic-markup
 131   (font-markup 'font-family 'dynamic))
 132 (define-public italic-markup
 133   (font-markup 'font-shape 'italic))
 134 (define-public typewriter-markup
 135   (font-markup 'font-family 'typewriter))
 136
 137
 138 ;; TODO: baseline-skip should come from the font.
 139 (define-public (column-markup grob props . rest)
 140   (stack-lines
 141    -1 0.0 (cdr (chain-assoc 'baseline-skip props))
 142    (map (lambda (x) (interpret-markup grob props x)) (car rest)))
 143   )
 144
 145 (define-public (dir-column-markup grob props . rest)
 146   "Make a column of args, going up or down, depending on DIRECTION."
 147   (let*
 148       (
 149        (dir (cdr (chain-assoc 'direction props)))
 150        )
 151     (stack-lines
 152      (if (number? dir) dir -1)
 153      0.0 (cdr (chain-assoc 'baseline-skip props))
 154      (map (lambda (x) (interpret-markup grob props x)) (car rest)))
 155     ))
 156
 157 (define-public (center-markup grob props . rest)
 158   (let*
 159     (
 160      (mols (map (lambda (x) (interpret-markup grob props x)) (car rest)))
 161      (cmols (map (lambda (x) (ly:molecule-align-to! x X CENTER)) mols))
 162      )
 163
 164     (stack-lines
 165      -1 0.0 (cdr (chain-assoc 'baseline-skip props))
 166      mols)
 167     ))
 168
 169 (define-public (musicglyph-markup grob props . rest)
 170   (ly:find-glyph-by-name
 171    (ly:get-font grob (cons '((font-family . music)) props))
 172    (car rest))
 173   )
 174
 175
 176 (define-public (lookup-markup grob props . rest)
 177   "Lookup a glyph by name."
 178   (ly:find-glyph-by-name
 179    (ly:get-font grob props)
 180    (car rest))
 181   )
 182
 183 (define-public (char-markup grob props . rest)
 184   "Syntax: \\char NUMBER. "
 185   (ly:get-glyph  (ly:get-font grob props) (car rest))
 186   )
 187
 188 (define-public (raise-markup grob props  . rest)
 189   "Syntax: \\raise AMOUNT MARKUP. "
 190   (ly:molecule-translate-axis (interpret-markup
 191                                grob
 192                                props
 193                                (cadr rest))
 194                               (car rest) Y)
 195   )
 196
 197
 198 (define-public (note-markup grob props . rest)
 199   "Syntax: \\note #LOG #DOTS #DIR. "
 200   (let*
 201       (
 202        (log (car rest))
 203        (dot-count (cadr rest))
 204        (dir (caddr rest))
 205        (font (ly:get-font grob (cons '((font-family .  music)) props)))
 206        (stemlen (max 3 (- log 1)))
 207        (headgl
 208         (ly:find-glyph-by-name font (string-append "noteheads-" (number->string (min log 2)))))
 209
 210        (stemth 0.13)
 211        (stemy (* dir stemlen))
 212        (attachx (if (> dir 0) (- (cdr (ly:molecule-get-extent headgl X)) stemth)
 213                     0))
 214        (attachy (* dir 0.28))
 215        (stemgl (if (> log 0)
 216                    (ly:round-filled-box (cons
 217                                      (cons attachx (+ attachx  stemth))
 218                                      (cons (min stemy attachy)
 219                                            (max stemy attachy)))
 220                                     (/ stemth 3)
 221                                     ) #f))
 222        (dot (ly:find-glyph-by-name font "dots-dot"))
 223        (dotwid  (interval-length (ly:molecule-get-extent dot X)))
 224        (dots (if (> dot-count 0)
 225                  (apply ly:molecule-add
 226                   (map (lambda (x)
 227                          (ly:molecule-translate-axis
 228                           dot  (* (+ 1 (* 2 x)) dotwid) X) )
 229                        (iota dot-count 1)))
 230                  #f))
 231
 232        (flaggl (if (> log 2)
 233                    (ly:molecule-translate
 234                     (ly:find-glyph-by-name
 235                      font
 236                      (string-append "flags-"
 237                                     (if (> dir 0) "u" "d")
 238                                     (number->string log)
 239                                     ))
 240                     (cons (+ attachx (/ stemth 2)) stemy))
 241
 242                     #f)))
 243
 244     (if flaggl
 245         (set! stemgl (ly:molecule-add flaggl stemgl)))
 246
 247     (if (ly:molecule? stemgl)
 248         (set! stemgl (ly:molecule-add stemgl headgl))
 249         (set! stemgl headgl)
 250         )
 251
 252     (if (ly:molecule? dots)
 253         (set! stemgl
 254               (ly:molecule-add
 255                (ly:molecule-translate-axis
 256                 dots
 257                 (+
 258                  (if (and (> dir 0) (> log 2))
 259                      (* 1.5 dotwid) 0)
 260                  ;; huh ? why not necessary?
 261                 ;(cdr (ly:molecule-get-extent headgl X))
 262                       dotwid
 263                  )
 264                 X)
 265                stemgl
 266                )
 267               ))
 268
 269     stemgl
 270     ))
 271
 272 (define-public (normal-size-super-markup grob props . rest)
 273   (ly:molecule-translate-axis (interpret-markup
 274                                grob
 275                                props (car rest))
 276                               (* 0.5 (cdr (chain-assoc 'baseline-skip props)))
 277                               Y)
 278   )
 279
 280 (define-public (super-markup grob props  . rest)
 281   "Syntax: \\super MARKUP. "
 282   (ly:molecule-translate-axis (interpret-markup
 283                                grob
 284                                (cons '((font-relative-size . -2)) props) (car rest))
 285                               (* 0.5 (cdr (chain-assoc 'baseline-skip props)))
 286                               Y)
 287   )
 288
 289 (define-public (translate-markup grob props . rest)
 290   "Syntax: \\translate OFFSET MARKUP. "
 291   (ly:molecule-translate (interpret-markup  grob props (cadr rest))
 292                          (car rest))
 293
 294   )
 295
 296 (define-public (sub-markup grob props  . rest)
 297   "Syntax: \\sub MARKUP."
 298   (ly:molecule-translate-axis (interpret-markup
 299                                grob
 300                                (cons '((font-relative-size . -2)) props)
 301                                (car rest))
 302                               (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
 303                               Y)
 304   )
 305
 306 (define-public (normal-size-sub-markup grob props . rest)
 307   (ly:molecule-translate-axis (interpret-markup
 308                                grob
 309                                props (car rest))
 310                               (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
 311                               Y)
 312   )
 313
 314 (define-public (hbracket-markup grob props . rest)
 315   (let*
 316       (
 317        (th 0.1) ;; todo: take from GROB.
 318        (m (interpret-markup grob props (car rest)))
 319        )
 320
 321     (bracketify-molecule m X th (* 2.5 th) th)
 322 ))
 323
 324 (define-public (bracket-markup grob props . rest)
 325   (let*
 326       (
 327        (th 0.1) ;; todo: take from GROB.
 328        (m (interpret-markup grob props (car rest)))
 329        )
 330
 331     (bracketify-molecule m Y th (* 2.5 th) th)
 332 ))
 333
 334 ;; todo: fix negative space
 335 (define (hspace-markup grob props . rest)
 336   "Syntax: \\hspace NUMBER."
 337   (let*
 338       ((amount (car rest)))
 339     (if (> amount 0)
 340         (ly:make-molecule "" (cons 0 amount) '(-1 . 1) )
 341         (ly:make-molecule "" (cons amount amount) '(-1 . 1)))
 342   ))
 343
 344 (define-public (override-markup grob props . rest)
 345   "Tack the 1st arg in REST onto PROPS, e.g.
 346
 347 \override #'(font-family . married) \"bla\"
 348
 349 "
 350
 351   (interpret-markup grob (cons (list (car rest)) props)
 352                     (cadr rest)))
 353
 354 (define-public (smaller-markup  grob props . rest)
 355   "Syntax: \\smaller MARKUP"
 356   (let*
 357       (
 358        (fs (cdr (chain-assoc 'font-relative-size props)))
 359        (entry (cons 'font-relative-size (- fs 1)))
 360        )
 361     (interpret-markup
 362      grob (cons (list entry) props)
 363      (car rest))
 364     ))
 365
 366 (define-public (bigger-markup  grob props . rest)
 367   "Syntax: \\bigger MARKUP"
 368   (let*
 369       (
 370        (fs (cdr (chain-assoc 'font-relative-size props)))
 371        (entry (cons 'font-relative-size (+ fs 1)))
 372        )
 373   (interpret-markup
 374    grob (cons (list entry) props)
 375    (car rest))
 376   ))
 377
 378 (define-public (box-markup grob props . rest)
 379   "Syntax: \\box MARKUP"
 380   (let*
 381       (
 382        (th 0.1)
 383        (pad 0.2)
 384        (m (interpret-markup grob props (car rest)))
 385        )
 386     (box-molecule m th pad)
 387   ))
 388
 389
 390 (define-public (strut-markup grob props . rest)
 391   "Syntax: \strut
 392
 393  A box of the same height as the space.
 394 "
 395
 396   (let*
 397       ((m (Text_item::text_to_molecule grob props " ")))
 398
 399     (ly:molecule-set-extent! m 0 '(1000 . -1000))
 400     m))
 401
 402
 403 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 404
 405
 406 (define (markup-signature-to-keyword sig)
 407   " (A B C) -> a0-b1-c2 "
 408
 409   (let* ((count  0))
 410     (string->symbol (string-join
 411
 412      (map
 413      (lambda (func)
 414        (set! count (+ count 1))
 415        (string-append
 416
 417         ;; for reasons I don't get,
 418         ;; (case func ((markup?) .. )
 419         ;; doesn't work.
 420         (cond
 421           ((eq? func markup?) "markup")
 422           ((eq? func markup-list?) "markup-list")
 423           (else "scheme")
 424           )
 425         (number->string (- count 1))
 426         ))
 427
 428      sig)
 429      "-"))
 430
 431   ))
 432
 433
 434 (define (markup-function? x)
 435   (object-property x 'markup-signature)
 436   )
 437
 438 (define (markup-list? arg)
 439   (define (markup-list-inner? l)
 440     (if (null? l)
 441         #t
 442         (and (markup? (car l)) (markup-list-inner? (cdr l)))
 443     )
 444   )
 445   (and (list? arg) (markup-list-inner? arg)))
 446
 447 (define (markup-argument-list? signature arguments)
 448   "Typecheck argument list."
 449   (if (and (pair? signature) (pair? arguments))
 450       (and ((car signature) (car arguments))
 451            (markup-argument-list? (cdr signature) (cdr arguments)))
 452       (and (null? signature) (null? arguments)))
 453   )
 454
 455
 456 (define (markup-argument-list-error signature arguments number)
 457   "return (ARG-NR TYPE-EXPECTED ARG-FOUND) if an error is detected, or
 458 #f is no error found.
 459 "
 460   (if (and (pair? signature) (pair? arguments))
 461       (if (not ((car signature) (car arguments)))
 462           (list number (type-name (car signature)) (car arguments))
 463           (markup-argument-list-error (cdr signature) (cdr arguments) (+ 1 number)))
 464       #f
 465   ))
 466
 467 ;;
 468 ;; full recursive typecheck.
 469 ;;
 470 (define (markup-typecheck? arg)
 471   (or (string? arg)
 472       (and (pair? arg)
 473        (markup-function? (car arg))
 474        (markup-argument-list?
 475         (object-property (car arg) 'markup-signature)
 476         (cdr arg))
 477   ))
 478 )
 479
 480 ;;
 481 ;; typecheck, and throw an error when something amiss.
 482 ;;
 483 (define (markup-thrower-typecheck arg)
 484   (cond
 485    ((string? arg) #t)
 486    ((not (pair? arg))
 487     (throw 'markup-format "Not a pair" arg)
 488     )
 489    ((not (markup-function? (car arg)))
 490     (throw 'markup-format "Not a markup function " (car arg)))
 491
 492
 493    ((not (markup-argument-list?
 494           (object-property (car arg) 'markup-signature)
 495           (cdr arg)))
 496     (throw 'markup-format "Arguments failed  typecheck for " arg)))
 497    #t
 498   )
 499
 500 ;;
 501 ;; good enough if you only  use make-XXX-markup functions.
 502 ;;
 503 (define (cheap-markup? x)
 504   (or (string? x)
 505       (and (pair? x)
 506            (markup-function? (car x))))
 507 )
 508
 509 ;;
 510 ;; replace by markup-thrower-typecheck for more detailed diagnostics.
 511 ;;
 512 (define markup?  cheap-markup?)
 513
 514 (define markup-functions-and-signatures
 515   (list
 516
 517    ;; abs size
 518    (cons teeny-markup (list markup?))
 519    (cons tiny-markup (list markup?))
 520    (cons small-markup (list markup?))
 521    (cons dynamic-markup (list markup?))
 522    (cons large-markup (list markup?))
 523
 524    (cons huge-markup (list markup?))
 525
 526    ;; size
 527    (cons smaller-markup (list markup?))
 528    (cons bigger-markup (list markup?))
 529 ;   (cons char-number-markup (list string?))
 530
 531    ;;
 532    (cons sub-markup (list markup?))
 533    (cons normal-size-sub-markup (list markup?))
 534
 535    (cons super-markup (list markup?))
 536    (cons normal-size-super-markup (list markup?))
 537
 538    (cons finger-markup (list markup?))
 539    (cons bold-markup (list markup?))
 540    (cons italic-markup (list markup?))
 541    (cons typewriter-markup (list markup?))
 542    (cons roman-markup (list markup?))
 543    (cons number-markup (list markup?))
 544    (cons hbracket-markup  (list markup?))
 545    (cons bracket-markup  (list markup?))
 546    (cons note-markup (list integer? integer? ly:dir?))
 547
 548    (cons column-markup (list markup-list?))
 549    (cons dir-column-markup (list markup-list?))
 550    (cons center-markup (list markup-list?))
 551    (cons line-markup  (list markup-list?))
 552
 553    (cons combine-markup (list markup? markup?))
 554    (cons simple-markup (list string?))
 555    (cons musicglyph-markup (list scheme?))
 556    (cons translate-markup (list number-pair? markup?))
 557    (cons override-markup (list pair? markup?))
 558    (cons char-markup (list integer?))
 559    (cons lookup-markup (list string?))
 560
 561    (cons hspace-markup (list number?))
 562
 563    (cons raise-markup (list number? markup?))
 564    (cons magnify-markup (list number? markup?))
 565    (cons fontsize-markup (list number? markup?))
 566
 567    (cons box-markup  (list markup?))
 568    (cons strut-markup '())
 569    ))
 570
 571
 572 (define markup-module (current-module))
 573
 574 (map (lambda (x)
 575        (set-object-property! (car x) 'markup-signature (cdr x))
 576        (set-object-property! (car x) 'markup-keyword (markup-signature-to-keyword (cdr x)))
 577        )
 578      markup-functions-and-signatures)
 579
 580 (define-public markup-function-list (map car markup-functions-and-signatures))
 581
 582
 583 ;; construct a
 584 ;;
 585 ;; make-FOO-markup function that typechecks its arguments.
 586 ;;
 587 ;; TODO: should construct a message says
 588 ;; Invalid argument 4 : expecting a BLADIBLA, found: (list-ref 4 args)
 589 ;;
 590 ;; right now, you get the entire argument list.
 591
 592
 593 (define (make-markup-maker  entry)
 594   (let*
 595         ((foo-markup (car entry))
 596          (signature (cons 'list (cdr entry)))
 597          (name (symbol->string (procedure-name foo-markup)))
 598          (make-name  (string-append "make-" name))
 599          )
 600
 601       `(define (,(string->symbol make-name) . args)
 602          (let*
 603              (
 604               (arglen (length  args))
 605               (siglen (length ,signature))
 606               (error-msg
 607                (if (and (> 0 siglen) (> 0 arglen))
 608                    (markup-argument-list-error ,signature args 1)))
 609
 610               )
 611
 612          (if (or (not (= arglen siglen)) (< siglen 0) (< 0 arglen))
 613              (scm-error 'markup-format ,make-name "Expect ~A arguments for ~A. Found ~A: ~S"
 614                         (list (length ,signature)
 615                               ,make-name
 616                               (length args)
 617                               args) #f))
 618          (if error-msg
 619              (scm-error 'markup-format ,make-name "Invalid argument in position ~A\n Expect: ~A\nFound: ~S." error-msg #f)
 620
 621              (cons ,foo-markup args)
 622              )))
 623     )
 624 )
 625
 626
 627
 628 (define (make-markup markup-function make-name signature args)
 629
 630   " Construct a markup object from MARKUP-FUNCTION and ARGS. Typecheck
 631 against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
 632 "
 633
 634   (let*
 635       ((arglen (length args))
 636        (siglen (length signature))
 637        (error-msg
 638         (if (and (> siglen 0) (> arglen 0))
 639             (markup-argument-list-error signature args 1)
 640             #f)))
 641
 642
 643     (if (or (not (= arglen siglen)) (< siglen 0) (< arglen 0))
 644         (scm-error 'markup-format make-name "Expect ~A arguments for ~A. Found ~A: ~S"
 645                    (list siglen
 646                          make-name
 647                          arglen
 648                          args) #f))
 649
 650     (if error-msg
 651         (scm-error 'markup-format make-name "Invalid argument in position ~A\nExpect: ~A\nFound: ~S." error-msg #f)
 652
 653         (cons markup-function  args)
 654         )))
 655
 656 (define (make-markup-maker entry)
 657   (let* (
 658          (name (symbol->string (procedure-name (car entry))))
 659          (make-name  (string-append "make-" name))
 660          (signature (object-property (car entry) 'markup-signature))
 661          )
 662
 663     `(define-public (,(string->symbol make-name) . args)
 664        (make-markup ,(car entry) ,make-name ,(cons 'list signature)  args)
 665        ))
 666   )
 667
 668 (eval
 669  (cons 'begin (map make-markup-maker markup-functions-and-signatures))
 670  markup-module
 671  )
 672
 673 ;;
 674 ;; TODO: add module argument so user-defined markups can also be
 675 ;; processed.
 676 ;;
 677 (define-public (lookup-markup-command code)
 678   (let*
 679       ((sym (string->symbol (string-append code "-markup")))
 680        (var (module-local-variable markup-module sym))
 681        )
 682     (if (eq? var #f)
 683         #f
 684         (cons (variable-ref var) (object-property  (variable-ref var) 'markup-keyword))
 685     )
 686   ))
 687
 688
 689 (define-public brew-new-markup-molecule Text_item::brew_molecule)
 690
 691 (define-public empty-markup (make-simple-markup ""))
 692
 693 (define-public interpret-markup Text_item::interpret_markup)
 694
 695
 696 ;;;;;;;;;;;;;;;;
 697 ;; utility
 698
 699 (define (markup-join markups sep)
 700   "Return line-markup of MARKUPS, joining them with markup SEP"
 701   (if (pair? markups)
 702       (make-line-markup (list-insert-separator markups sep))
 703       empty-markup))
 704
 705
 706 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 707
 708 (if #f
 709    (define (typecheck-with-error x)
 710      (catch
 711       'markup-format
 712       (lambda () (markup? x))
 713       (lambda (key message arg)
 714         (display "\nERROR: markup format error: \n")
 715         (display message)
 716         (newline)
 717         (write arg (current-output-port))
 718         )
 719       )))
 720
 721 ;; test make-foo-markup functions
 722 (if #f
 723     (begin
 724       (newline)
 725       (newline)
 726       (display (make-line-markup (list (make-simple-markup "FOO"))))
 727
 728       (make-line-markup (make-simple-markup "FOO"))
 729       (make-line-markup (make-simple-markup "FOO") (make-simple-markup "foo"))
 730       (make-raise-markup "foo" (make-simple-markup "foo"))
 731       )
 732     )
 733
 734
 735 ;;
 736 ;; test typecheckers. Not wholly useful, because errors are detected
 737 ;; in other places than they're made.
 738 ;;
 739 (if #f
 740  (begin
 741
 742    ;; To get error messages, see above to install the alternate
 743    ;; typecheck routine for markup?.
 744
 745
 746
 747    (display (typecheck-with-error `(,simple-markup "foobar")))
 748    (display (typecheck-with-error `(,simple-markup "foobar")))
 749    (display (typecheck-with-error `(,simple-markup 1)))
 750    (display
 751     (typecheck-with-error  `(,line-markup ((,simple-markup "foobar"))
 752                                           (,simple-markup 1))))
 753    (display
 754     (typecheck-with-error  `(,line-markup (,simple-markup "foobar")
 755                                          (,simple-markup "bla"))))
 756
 757    ))