diff --git a/top.rkt b/top.rkt index 3c31a15..b640464 100644 --- a/top.rkt +++ b/top.rkt @@ -11,12 +11,34 @@ (provide (except-out (all-defined-out) top~) (rename-out (top~ #%top))) +;; Allow tag attributes to be specified as follows: +;; @foo['shape: "square" 'color: "red"]{hello} (define-syntax-rule (top~ . id) - (λ x `(id ,@x))) + (λ x + (define attrs null) + (define elements + (let chomp ([x x]) + (define result+regexp (and ((length x) . >= . 2) + (symbol? (car x)) + ;; accept strings only + ;; numbers are difficult because they don't parse as cleanly. + ;; string will read as a string even if there's no space to the left. + (or (string? (cadr x))) + ;; Looking for symbol ending with a colon + (regexp-match #rx"^(.*?):(.*)$" (symbol->string (car x))))) + (if result+regexp + (begin + ; reuse result value cadr is first group in match. + (set! attrs (cons (list (string->symbol (cadr result+regexp))(cadr x)) attrs)) + (chomp (cddr x))) + x))) + + `(id ,@(if (equal? attrs null) null (list (reverse attrs))) ,@elements))) + (define-syntax (bound/c stx) - (syntax-case stx () - [(_ x) - (if (identifier-binding #'x ) - #'x - #'(#%top . x))])) + (syntax-case stx () + [(_ x) + (if (identifier-binding #'x ) + #'x + #'(#%top . x))]))