suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

plt-web: add call-with-registered-roots

Browse Source
This commit is contained in:
Matthew Flatt 2014-03-20 13:13:41 -06:00
parent 68f6ab86f7
commit 43af294068
2 changed files with 12 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/plt-web-pkgs/plt-web-doc/plt-web.scrbl
View File

@ -236,6 +236,11 @@ file lists the content specified by @racket[content], where
an integer corresponds to a file size and @racket['dir] indicates an integer corresponds to a file size and @racket['dir] indicates
a directory.} a directory.}
@defproc[(call-with-registered-roots [thunk (-> any)]) any]{
Calls @racket[thunk] with @racket[url-roots] set to a mapping for
registered sites.}
@; ---------------------------------------- @; ----------------------------------------
@section{Generating Site Content} @section{Generating Site Content}

9
pkgs/plt-web-pkgs/plt-web-lib/layout.rkt
View File

@ -13,7 +13,8 @@
site-css-path site-css-path
site-favicon-path site-favicon-path
site-navbar site-navbar
site-navbar-dynamic-js) site-navbar-dynamic-js
call-with-registered-roots)
(define-for-syntax (process-contents who layouter stx xs) (define-for-syntax (process-contents who layouter stx xs)
(let loop ([xs xs] [kws '()] [id? #f]) (let loop ([xs xs] [kws '()] [id? #f])
@ -70,7 +71,7 @@
;; if this is true, return only the html -- don't create ;; if this is true, return only the html -- don't create
;; a resource -- therefore no file is made, and no links ;; a resource -- therefore no file is made, and no links
;; to it can be made (useful only for stub templates) ;; to it can be made (useful only for stub templates)
#:html-only [html-only? #f] #:html-only? [html-only? #f]
#:title [label (if id #:title [label (if id
(let* ([id (format "~a" (force id))] (let* ([id (format "~a" (force id))]
[id (regexp-replace #rx"^.*/" id "")] [id (regexp-replace #rx"^.*/" id "")]
@ -344,3 +345,7 @@
} }
}) })
(define (call-with-registered-roots proc)
(parameterize ([url-roots (registered-url-roots)])
(proc)))