diff --git a/collects/meta/web/html/resource.rkt b/collects/meta/web/html/resource.rkt
index 0047f9ab..774a299c 100644
--- a/collects/meta/web/html/resource.rkt
+++ b/collects/meta/web/html/resource.rkt
@@ -43,25 +43,31 @@
;; 'abs is used below for roots that should always use absolute links (needed
;; for some skeleton pages that are used in nested subdirectories).
(provide url-roots)
-(define url-roots
+(define url-roots (make-parameter #f))
+
+(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).
- (make-parameter #f
- (lambda (x)
- (and (list? x) (pair? x)
- (map (lambda (x)
- (list* (regexp-match* #rx"[^/]+" (car x))
- (regexp-replace #rx"/$" (cadr x) "")
- (cddr x)))
- x)))))
+ (let ([roots (url-roots)])
+ (unless (eq? roots (car cached-roots))
+ (set! cached-roots
+ (cons roots
+ (and (list? roots) (pair? roots)
+ (map (lambda (root)
+ (list* (regexp-match* #rx"[^/]+" (car root))
+ (regexp-replace #rx"/$" (cadr root) "")
+ (cddr root)))
+ roots)))))
+ (cdr cached-roots)))
;; a utility for relative paths, taking the above `default-file' and
;; `url-roots' into consideration.
(define (relativize file tgtdir curdir)
(define file* (if (equal? file default-file) "" file))
- (define roots (url-roots))
+ (define roots (current-url-roots))
(define (find-root path mode)
(ormap (lambda (root+url+flags)
(let loop ([r (car root+url+flags)] [p path])
@@ -194,7 +200,13 @@
(add-renderer path render)
(make-keyword-procedure
(lambda (kws kvs . args) (keyword-apply referrer kws kvs (url) args))
- (lambda args (apply referrer (url) args)))))
+ (case-lambda [(x) (if (eq? x get-resource-path) (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))
;; a convenient utility to create renderers from some output function (like
;; `output-xml' or `display') and some content
diff --git a/collects/meta/web/html/xml.rkt b/collects/meta/web/html/xml.rkt
index 09c92e0c..d5e0a03a 100644
--- a/collects/meta/web/html/xml.rkt
+++ b/collects/meta/web/html/xml.rkt
@@ -37,6 +37,15 @@
"missing attribute value for `~s:'" a)]
[else (loop (cddr xs) (cons (cons a (cadr xs)) as))]))))
+;; similar, but keeps the attributes as a list, useful to build new functions
+;; that accept attributes without knowing about the xml structs.
+(provide split-attributes+body)
+(define (split-attributes+body xs)
+ (let loop ([xs xs] [as '()])
+ (if (and (pair? xs) (pair? (cdr xs)) (attribute->symbol (car xs)))
+ (loop (cddr xs) (list* (cadr xs) (car xs) as))
+ (values (reverse as) xs))))
+
;; ----------------------------------------------------------------------------
;; An output that handles xml quoting, customizable
diff --git a/collects/scribble/doclang.rkt b/collects/scribble/doclang.rkt
index 6e74a799..298659eb 100644
--- a/collects/scribble/doclang.rkt
+++ b/collects/scribble/doclang.rkt
@@ -1,11 +1,11 @@
-#lang scheme/base
+#lang racket/base
(require "struct.ss"
"decode.ss"
- (for-syntax scheme/base
+ (for-syntax racket/base
syntax/kerncase))
-(provide (except-out (all-from-out scheme/base) #%module-begin)
+(provide (except-out (all-from-out racket/base) #%module-begin)
(rename-out [*module-begin #%module-begin]))
;; Module wrapper ----------------------------------------
diff --git a/collects/scribblings/scribble/reader.scrbl b/collects/scribblings/scribble/reader.scrbl
index da1901ce..ca02c0d9 100644
--- a/collects/scribblings/scribble/reader.scrbl
+++ b/collects/scribblings/scribble/reader.scrbl
@@ -141,7 +141,7 @@ expressions.
}===|
The command part of an @"@"-form is optional as well. In that case,
-the @"@" forms is read as a list, which usually counts as a function
+the @"@" form is read as a list, which usually counts as a function
application, but it also useful when quoted with the usual Racket
@racket[quote]: