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

Fix rendering in local build mode -- make it create file:// urls when

Browse Source 
insisting on an absolute url (currently happens only in the tr pages).
(cherry picked from commit 1e2d4b8169)
This commit is contained in:
Eli Barzilay 2010-10-19 21:06:32 -04:00 committed by Ryan Culpepper
parent c05b501f1b
commit 0ed9334cc1
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -47,10 +47,10 @@
(define cached-roots '(#f . #f))
(define (current-url-roots)
;; takes in a (listof (list prefix-string url-string . flags)), and produces
;; an alist with lists of strings for the keys; the prefix-strings are split
;; on "/"s, and the url-strings can be anything at all actually (they are put
;; as-is before the path with a "/" between them).
;; takes `url-roots', a (listof (list prefix-string url-string . flags)), and
;; produces an alist with lists of strings for the keys; the prefix-strings
;; are split on "/"s, and the url-strings can be anything at all actually
;; (they are put as-is before the path with a "/" between them).
(let ([roots (url-roots)])
(unless (eq? roots (car cached-roots))
(set! cached-roots
@ -86,7 +86,7 @@
;; find shared prefix
[(and (pair? t) (pair? c) (equal? (car t) (car c)))
(loop (cdr t) (cdr c) (cons (car t) pfx))]
;; done
;; done with the shared prefix, deal with the root now
;; no roots => always use a relative path (useful for debugging)
[(not roots) `(,@(map (lambda (_) "..") c) ,@t ,file*)]
;; share a root => use a relative path unless its an absolute root
@ -197,7 +197,13 @@
(printf " ~a\n" path)
(renderer filename))))))
(define (url) (relativize filename dirpathlist (rendered-dirpath)))
(define absolute-url (delay (relativize filename dirpathlist "")))
(define absolute-url
(delay (let ([url (relativize filename dirpathlist '())])
(if (url-roots)
url
;; we're in local build mode, and insist on an absolute url,
;; so construct a `file://' result
(list* "file://" (current-directory) url)))))
(add-renderer path render)
(make-keyword-procedure
(lambda (kws kvs . args) (keyword-apply referrer kws kvs (url) args))