Prepend dynamic-urlprefix to dynamic URLs from send/suspend and friends

This commit is contained in:
Tony Garnock-Jones 2015-09-24 15:31:22 -04:00
parent 84eac6defe
commit b8d0b17e33

View File

@ -88,6 +88,18 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (send/suspend/dispatch/dynamic proc)
(send/suspend/dispatch
(lambda (embed-url)
(proc (lambda args (string-append dynamic-urlprefix (apply embed-url args)))))))
(define (send/suspend/dynamic proc)
(send/suspend
(lambda (k-url)
(proc (string-append dynamic-urlprefix k-url)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (named-url . args) (define (named-url . args)
(string-append dynamic-urlprefix (apply relative-named-url args))) (string-append dynamic-urlprefix (apply relative-named-url args)))
@ -266,7 +278,7 @@
(define (login-form [error-message #f]) (define (login-form [error-message #f])
(with-site-config (with-site-config
(send/suspend/dispatch (send/suspend/dispatch/dynamic
(lambda (embed-url) (lambda (embed-url)
(bootstrap-response "Login" (bootstrap-response "Login"
`(form ((class "form-horizontal") `(form ((class "form-horizontal")
@ -315,7 +327,7 @@
#:code [code ""] #:code [code ""]
#:error-message [error-message #f]) #:error-message [error-message #f])
(with-site-config (with-site-config
(send/suspend/dispatch (send/suspend/dispatch/dynamic
(lambda (embed-url) (lambda (embed-url)
(bootstrap-response "Register/Reset Account" (bootstrap-response "Register/Reset Account"
#:title-element "" #:title-element ""
@ -394,7 +406,7 @@
(define (summarise-code-emailing reason email) (define (summarise-code-emailing reason email)
(with-site-config (with-site-config
(send/suspend/dispatch (send/suspend/dispatch/dynamic
(lambda (embed-url) (lambda (embed-url)
(bootstrap-response reason (bootstrap-response reason
`(p `(p
@ -830,7 +842,7 @@
(define (package-form error-message draft) (define (package-form error-message draft)
(with-site-config (with-site-config
(send/suspend/dispatch (send/suspend/dispatch/dynamic
(lambda (embed-url) (lambda (embed-url)
(define (build-versions-table) (define (build-versions-table)
@ -975,7 +987,7 @@
(define ((confirm-package-deletion package-name-str) request) (define ((confirm-package-deletion package-name-str) request)
(with-site-config (with-site-config
(send/suspend (send/suspend/dynamic
(lambda (k-url) (lambda (k-url)
(bootstrap-response "Confirm Package Deletion" (bootstrap-response "Confirm Package Deletion"
`(div ((class "confirm-package-deletion")) `(div ((class "confirm-package-deletion"))