diff --git a/src/page-home.rkt b/src/page-home.rkt index 26eb1aa..042d4ad 100644 --- a/src/page-home.rkt +++ b/src/page-home.rkt @@ -15,6 +15,7 @@ (define examples '(("crosscode" "CrossCode_Wiki") + ("pokemon" "Eevee") ("minecraft" "Bricks") ("undertale" "Hot_Dog...%3F") ("tardis" "Eleanor_Blake") diff --git a/src/page-wiki.rkt b/src/page-wiki.rkt index ff86b20..f09900f 100644 --- a/src/page-wiki.rkt +++ b/src/page-wiki.rkt @@ -13,6 +13,7 @@ web-server/http web-server/dispatchers/dispatch ; my libs + "config.rkt" "pure-utils.rkt" "xexpr-utils.rkt" "url-utils.rkt" @@ -231,12 +232,17 @@ (define body (generate-wiki-page source-url wikiname title (update-tree-wiki page wikiname))) (define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body))) + (define headers (if redirect-msg + (let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))] + [value (bytes-append #"0;url=" (string->bytes/utf-8 dest))]) + (list (header #"Refresh" value))) + (list))) + (when (config-true? 'debug) + ; used for its side effects + ; convert to string with error checking, error will be raised if xexp is invalid + (xexp->html body)) (response/output #:code 200 - #:headers (if redirect-msg - (let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))] - [value (bytes-append #"0;url=" (string->bytes/utf-8 dest))]) - (list (header #"Refresh" value))) - (list)) + #:headers headers (λ (out) (write-html body out))))))])) diff --git a/src/xexpr-utils.rkt b/src/xexpr-utils.rkt index 87f52fe..5b87d34 100644 --- a/src/xexpr-utils.rkt +++ b/src/xexpr-utils.rkt @@ -158,7 +158,8 @@ (define attributes (bits->attributes (cdr element))) (define contents (filter element-is-content? (cdr element))) ; provide elements and strings (if (or (equal? element-type '*DECL) - (equal? element-type '@)) + (equal? element-type '@) + (equal? element-type '&)) ; special element, do nothing element ; regular element, transform it @@ -169,6 +170,10 @@ (map (λ (content) (if (element-is-element? content) (loop content) content)) contents))])))) +(module+ test + ; check (& x) sequences are preserved + (check-equal? (update-tree (λ (e t a c) (list t a c)) '(body "Hey" (& nbsp) (a (@ (href "/"))))) + '(body "Hey" (& nbsp) (a (@ (href "/")))))) (define (has-class? name attributes) (and (member name (string-split (or (get-attribute 'class attributes) "") " ")) #t))