Changeset 25377 in project


Ignore:
Timestamp:
10/19/11 22:03:26 (9 years ago)
Author:
Moritz Heidkamp
Message:

sxml-informal: encapsulate all field types in a `field' tag to avoid recursion for homonymous HTML tags; the code should probably be overhauled completely sometime soon.

Location:
release/4/sxml-informal/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/sxml-informal/trunk/sxml-informal.scm

    r20782 r25377  
    1717                             (element (fold (lambda (part element)
    1818                                              (receive (expanded-element . classes)
    19                                                 (apply part (cons (car element) args))
     19                                                  (apply part (cons (car element) args))
    2020                                                (cons (or expanded-element (car element))
    2121                                                      (append (cdr element) classes))))
     
    5656         (checkable (lambda (box #!key checked)
    5757                      (if checked
    58                           (sxml:add-attr box `(checked "checked")) box))))
     58                          (sxml:add-attr box `(checked "checked")) box)))
    5959
    60     `((string   . ,(element label (input "text") error))
    61       (password . ,(element label (input "password") error))
    62       (checkbox . ,(element (input "checkbox" checkable) label error))
    63       (radio    . ,(let ((input (element (input "radio" checkable) label error)))
    64                      (lambda (tag args)
    65                        (let* ((name (car args))
    66                               (args (cdr args))
    67                               (value (get-keyword value: args))
    68                               (suffix (or (get-keyword suffix: args) (and value (conc "-" value)))))
    69                          (input tag (cons* name id: (if suffix (conc name suffix) name) args))))))
     60         (fields `((string   . ,(element label (input "text") error))
     61                   (password . ,(element label (input "password") error))
     62                   (checkbox . ,(element (input "checkbox" checkable) label error))
     63                   (radio    . ,(let ((input (element (input "radio" checkable) label error)))
     64                                  (lambda (tag args)
     65                                    (let* ((name (car args))
     66                                           (args (cdr args))
     67                                           (value (get-keyword value: args))
     68                                           (suffix (or (get-keyword suffix: args) (and value (conc "-" value)))))
     69                                      (input tag (cons* name id: (if suffix (conc name suffix) name) args))))))
    7070
    71       (hidden   . ,(let ((input (input "hidden")))
    72                      (lambda (tag args)
    73                        (let* ((name (car args))
    74                               (value (cadr args)))
    75                          (car (input '() name value: value))))))
     71                   (hidden   . ,(let ((input (input "hidden")))
     72                                  (lambda (tag args)
     73                                    (let* ((name (car args))
     74                                           (value (cadr args)))
     75                                      (car (input '() name value: value))))))
    7676
    77       (text     . ,(element label
    78                      (lambda (el name #!key value)
    79                        (append el `((textarea (@ (id ,name) (name ,name) ) ,value))))
    80                      error))
     77                   (text     . ,(element label
     78                                  (lambda (el name #!key value)
     79                                    (append el `((textarea (@ (id ,name) (name ,name) ) ,value))))
     80                                  error))
    8181
    82       (select   . ,(element label
    83                      (lambda (el name #!key options value)
    84                        (append el `((select (@ (id ,name) (name ,name))
    85                                       ,@(map (lambda (o)
    86                                                (let ((option `(option (@ (value ,(car o))) ,(cadr o))))
    87                                                 (if (eq? value (car o))
    88                                                      (sxml:add-attr option '(selected "selected"))
    89                                                      option))) options)))))
    90                      error))
     82                   (select   . ,(element label
     83                                  (lambda (el name #!key options value)
     84                                    (append el `((select (@ (id ,name) (name ,name))
     85                                                   ,@(map (lambda (o)
     86                                                            (let ((option `(option (@ (value ,(car o))) ,(cadr o))))
     87                                                              (if (eq? value (car o))
     88                                                                  (sxml:add-attr option '(selected "selected"))
     89                                                                  option))) options)))))
     90                                  error))
    9191
    92       (submit   . ,(let ((element (element (input "submit"))))
    93                      (lambda (tag args)
    94                        (let* ((label (car args))
    95                               (name (or (get-keyword name: (cdr args)) "commit")))
    96                          (element tag `(,name value: ,label))))))
     92                   (submit   . ,(let ((element (element (input "submit"))))
     93                                  (lambda (tag args)
     94                                    (let* ((label (car args))
     95                                           (name (or (get-keyword name: (cdr args)) "commit")))
     96                                      (element tag `(,name value: ,label)))))))))
    9797
     98    `((field . ,(lambda (tag args)
     99                  (let ((name (car args)))
     100                    ((or (alist-ref name fields)
     101                         (error 'sxml-informal "invalid field" name))
     102                     name
     103                     (cdr args)))))
    98104      (fields *macro* . ,(lambda (tag elements)
    99105                           (receive (options elements)
  • release/4/sxml-informal/trunk/tests/run.scm

    r21001 r25377  
    2626           '(informal (@ (action "/foo") (method "POST"))
    2727                      (fields "Paste"
    28                               (string "title" label: "A Title")
    29                               (string "name" label: "Your Name"))))
     28                              (field string "title" label: "A Title")
     29                              (field string "name" label: "Your Name"))))
    3030
    3131
     
    3535(test-field '(li (@ (class "string foo"))
    3636                 (input (@ (type "text") (id "foo") (name "foo") (value "bar"))))
    37             '(string "foo" value: "bar"))
     37            '(field string "foo" value: "bar"))
    3838
    3939(test-field '(li (@ (class "password foo"))
    4040                 (input (@ (type "password") (id "foo") (name "foo") (value "bar"))))
    41             '(password "foo" value: "bar"))
     41            '(field password "foo" value: "bar"))
    4242
    4343(test-field '(li (@ (class "checkbox foo"))
    4444                 (input (@ (checked "checked") (type "checkbox") (id "foo") (name "foo") (value "bar"))))
    45             '(checkbox "foo" value: "bar" checked: #t))
     45            '(field checkbox "foo" value: "bar" checked: #t))
    4646
    4747(test-field '(li (@ (class "foo-bar radio foo"))
    4848                 (input (@ (checked "checked") (type "radio") (id "foo-bar") (name "foo") (value "bar"))))
    49             '(radio "foo" value: "bar" checked: #t))
     49            '(field radio "foo" value: "bar" checked: #t))
    5050
    5151(test-field '(li (@ (class "foo-baz radio foo"))
    5252                 (input (@ (type "radio") (id "foo-baz") (name "foo") (value "bar"))))
    53             '(radio "foo" value: "bar" checked: #f suffix: "-baz"))
     53            '(field radio "foo" value: "bar" checked: #f suffix: "-baz"))
    5454
    5555(test-field '(li (@ (class "text foo")) (textarea (@ (id "foo") (name "foo")) "bar"))
    56             '(text "foo" value: "bar"))
     56            '(field text "foo" value: "bar"))
    5757
    5858(test-field '(li (@ (class "text foo"))
    5959                 (label (@ (for "foo")) "a text")
    6060                 (textarea (@ (id "foo") (name "foo")) #f))
    61             '(text "foo" label: "a text"))
     61            '(field text "foo" label: "a text"))
    6262
    6363(test-field '(li (@ (class "select foo"))
     
    6767                   (option (@ (selected "selected") (value 30)) "qux")))
    6868
    69             '(select "foo" value: 30
    70                      options: ((10 "bar")
    71                                (20 "baz")
    72                                (30 "qux"))))
     69            '(field select "foo" value: 30
     70                    options: ((10 "bar")
     71                              (20 "baz")
     72                              (30 "qux"))))
    7373
    7474(test-field '(li (@ (class "submit commit")) (input (@ (type "submit") (id "commit") (name "commit") (value "submit!"))))
    75             '(submit "submit!"))
     75            '(field submit "submit!"))
    7676
    7777(test-field '(li (@ (class "password some")) (input (@ (type "password") (id "some") (name "some"))))
    78             '(password "some"))
     78            '(field password "some"))
    7979
    8080
    8181;; special case: hidden fields aren't wrapped in an li element
    8282(test-form '(input (@ (type "hidden") (id "foo") (name "foo") (value "bar")))
    83            '(hidden "foo" "bar") "hidden")
     83           '(field hidden "foo" "bar") "hidden")
    8484
    8585
     
    9494
    9595           '(informal ((prefix "foo-") (@ (foo "bar")))
    96                       (fields (string "bar" value: "baz" label: "foo!"))
    97                       (fields ((prefix "bar-") (legend "some fields")) (string "qux"))))
     96                      (fields (field string "bar" value: "baz" label: "foo!"))
     97                      (fields ((prefix "bar-") (legend "some fields")) (field string "qux"))))
    9898
    9999;; errors
     
    101101(test-field '(li (@ (class "string hehe invalid"))
    102102                 (input (@ (type "text") (id "hehe") (name "hehe") (value "hoho"))))
    103             '(string "hehe" value: "hoho" error: #t))
     103            '(field string "hehe" value: "hoho" error: #t))
    104104
    105105(test-field '(li (@ (class "string hehe invalid"))
    106106                 (input (@ (type "text") (id "hehe") (name "hehe") (value "hoho")))
    107107                 (span (@ (class "error")) "fail"))
    108             '(string "hehe" value: "hoho" error: "fail"))
     108            '(field string "hehe" value: "hoho" error: "fail"))
    109109
    110110(test-field '(li (@ (class "string hehe invalid"))
     
    113113                     (li "two")
    114114                     (li "errors")))
    115             '(string "hehe" value: "hoho" error: ("two" "errors")))
     115            '(field string "hehe" value: "hoho" error: ("two" "errors")))
    116116
    117 (unless (zero? (test-failure-count)) (exit 1))
     117(test-exit)
Note: See TracChangeset for help on using the changeset viewer.