From f0af5303b36976d1d8b66b1bff40bdf19dc68f35 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 26 Jun 2010 16:40:12 -0400 Subject: [PATCH 1/4] Avoid changing the parameter value, so it is possible to extend it. original commit: 95c49e138eb1a2040e6d5b3bcd059dd093c780bc --- collects/meta/web/html/resource.rkt | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/collects/meta/web/html/resource.rkt b/collects/meta/web/html/resource.rkt index 0047f9ab..2cd219d7 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]) From e803175aff6ba01c16b63dd9c181d76c89646dd8 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 30 Jun 2010 15:48:53 -0600 Subject: [PATCH 2/4] scribble/doclang extends racket/base instead of scheme/base original commit: b37799f42c03c3ba6c1d597eb9af3f2f8dae3acf --- collects/scribble/doclang.rkt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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 ---------------------------------------- From 1bf7397ac869edaeb1032904aca8f6f66cdc2791 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 2 Jul 2010 01:13:39 -0400 Subject: [PATCH 3/4] Added `split-attributes+body', to make it easy to write xml-like wrapper functions, and used it in `center-div'. original commit: e339081fd037d8ac7ba0128414af182314cef8f0 --- collects/meta/web/html/xml.rkt | 9 +++++++++ 1 file changed, 9 insertions(+) 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 From a9f5a8c513f9d379668ec0f0ccd180a0bb009c81 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 2 Jul 2010 04:52:22 -0400 Subject: [PATCH 4/4] Added `get-resource-path' to get the path of any resource. Use it to allow getting the standard resource paths from the common layout. original commit: 8f69e94980760da76651a1140d052b0acbae90a7 --- collects/meta/web/html/resource.rkt | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/collects/meta/web/html/resource.rkt b/collects/meta/web/html/resource.rkt index 2cd219d7..774a299c 100644 --- a/collects/meta/web/html/resource.rkt +++ b/collects/meta/web/html/resource.rkt @@ -200,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