commit 313176569f59d94b3ae9c6c48dc1ef2fb9082b1c
parent 189bf9d63ce18022a65e3cd6a7e7eb3d60a4f813
Author: Eli Barzilay <eli@barzilay.org>
Date: Mon, 20 Sep 2010 11:17:50 -0400
Allow getting the absolute URL of a resource
original commit: 93bd86ccc4f8d7e2ab822a5fd3f1306c445c0b2e
Diffstat:
1 file changed, 7 insertions(+), 3 deletions(-)
diff --git a/collects/meta/web/html/resource.rkt b/collects/meta/web/html/resource.rkt
@@ -197,16 +197,20 @@
(printf " ~a\n" path)
(renderer filename))))))
(define (url) (relativize filename dirpathlist (rendered-dirpath)))
+ (define absolute-url (delay (relativize filename dirpathlist "")))
(add-renderer path render)
(make-keyword-procedure
(lambda (kws kvs . args) (keyword-apply referrer kws kvs (url) args))
- (case-lambda [(x) (if (eq? x get-resource-path) (url) (referrer (url) x))]
+ (case-lambda [(x) (if (and (pair? x) (eq? (car x) get-path))
+ (if (cdr x) absolute-url (url))
+ (referrer (url) x))]
[args (apply referrer (url) args)]))))
;; make it possible to always get the path to a resource
(provide get-resource-path)
-(define (get-resource-path resource)
- (resource get-resource-path))
+(define get-path (gensym))
+(define (get-resource-path resource [absolute? #f])
+ (resource (cons get-path absolute?)))
;; a convenient utility to create renderers from some output function (like
;; `output-xml' or `display') and some content
