suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Allow getting the absolute URL of a resource

Browse Source 
original commit: 93bd86ccc4f8d7e2ab822a5fd3f1306c445c0b2e
This commit is contained in:
Eli Barzilay 2010-09-20 11:17:50 -04:00
parent 189bf9d63c
commit 313176569f
1 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/meta/web/html/resource.rkt
View File

@ -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