append -key to key structs

quad2/constants.rkt

@@ -9,8 +9,8 @@
     (define LIST-NAME (list ATTR-NAME ...))))
 
 (define-attr-list all-attrs
-  [:font-family (attr-uncased-string 'font-family)]
-  [:font-path (attr-path 'font-path)]
-  [:font-bold (attr-boolean 'font-bold)]
-  [:font-italic (attr-boolean 'font-italic)]
-  [:font-size (attr-dimension-string 'font-size)])
+  [:font-family (attr-uncased-string-key 'font-family)]
+  [:font-path (attr-path-key 'font-path)]
+  [:font-bold (attr-boolean-key 'font-bold)]
+  [:font-italic (attr-boolean-key 'font-italic)]
+  [:font-size (attr-dimension-string-key 'font-size)])

quad2/param.rkt

@@ -13,7 +13,7 @@
                         val))) ...))
 
 (define-guarded-parameters
-  [current-attrs (λ (xs) (and (list? xs) (andmap attr? xs))) null]
+  [current-attrs (λ (xs) (and (list? xs) (andmap attr-key? xs))) null]
   [current-show-timing? boolean? #false]
   [current-strict-attrs? boolean? #false]
   [current-use-preconditions? boolean? #true]

quad2/struct.rkt

@@ -1,4 +1,5 @@
 #lang racket/base
+(require (for-syntax racket/base racket/syntax))
 (provide (all-defined-out))
 
 (struct $drawing-inst () #:transparent)
@@ -7,10 +8,20 @@
 (struct $doc $drawing-inst (inst) #:transparent)
 (struct $page $drawing-inst (inst) #:transparent)
 
-(struct attr (name) #:transparent)
-(struct attr-uncased-string attr () #:transparent)
-(struct attr-cased-string attr () #:transparent)
-(struct attr-dimension-string attr () #:transparent)
-(struct attr-path attr () #:transparent)
-(struct attr-numeric attr () #:transparent)
-(struct attr-boolean attr () #:transparent)
+(struct attr-key (name) #:transparent)
+
+(define-syntax (define-attr-key-types stx)
+  (syntax-case stx ()
+    [(_ ID ...)
+     (with-syntax ([(ATTR-ID-KEY ...) (map (λ (id-stx) (format-id stx "attr-~a-key" id-stx)) (syntax->list #'(ID ...)))])
+       #'(begin
+           (struct ATTR-ID-KEY attr-key () #:transparent) ...))]))
+
+;; for type X, creates struct called attr-X-key
+(define-attr-key-types
+  uncased-string
+  cased-string
+  dimension-string
+  path
+  numeric
+  boolean)