minor typo fix

original commit: 14d181ddef75ee76b578a9f52d2ef11a2baa8d15
This commit is contained in:
Eli Barzilay 2010-07-05 18:27:10 -04:00
commit a0002db8f6
4 changed files with 36 additions and 15 deletions

View File

@ -43,25 +43,31 @@
;; 'abs is used below for roots that should always use absolute links (needed ;; 'abs is used below for roots that should always use absolute links (needed
;; for some skeleton pages that are used in nested subdirectories). ;; for some skeleton pages that are used in nested subdirectories).
(provide url-roots) (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 ;; 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 ;; 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 ;; on "/"s, and the url-strings can be anything at all actually (they are put
;; as-is before the path with a "/" between them). ;; as-is before the path with a "/" between them).
(make-parameter #f (let ([roots (url-roots)])
(lambda (x) (unless (eq? roots (car cached-roots))
(and (list? x) (pair? x) (set! cached-roots
(map (lambda (x) (cons roots
(list* (regexp-match* #rx"[^/]+" (car x)) (and (list? roots) (pair? roots)
(regexp-replace #rx"/$" (cadr x) "") (map (lambda (root)
(cddr x))) (list* (regexp-match* #rx"[^/]+" (car root))
x))))) (regexp-replace #rx"/$" (cadr root) "")
(cddr root)))
roots)))))
(cdr cached-roots)))
;; a utility for relative paths, taking the above `default-file' and ;; a utility for relative paths, taking the above `default-file' and
;; `url-roots' into consideration. ;; `url-roots' into consideration.
(define (relativize file tgtdir curdir) (define (relativize file tgtdir curdir)
(define file* (if (equal? file default-file) "" file)) (define file* (if (equal? file default-file) "" file))
(define roots (url-roots)) (define roots (current-url-roots))
(define (find-root path mode) (define (find-root path mode)
(ormap (lambda (root+url+flags) (ormap (lambda (root+url+flags)
(let loop ([r (car root+url+flags)] [p path]) (let loop ([r (car root+url+flags)] [p path])
@ -194,7 +200,13 @@
(add-renderer path render) (add-renderer path render)
(make-keyword-procedure (make-keyword-procedure
(lambda (kws kvs . args) (keyword-apply referrer kws kvs (url) args)) (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 ;; a convenient utility to create renderers from some output function (like
;; `output-xml' or `display') and some content ;; `output-xml' or `display') and some content

View File

@ -37,6 +37,15 @@
"missing attribute value for `~s:'" a)] "missing attribute value for `~s:'" a)]
[else (loop (cddr xs) (cons (cons a (cadr xs)) as))])))) [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 ;; An output that handles xml quoting, customizable

View File

@ -1,11 +1,11 @@
#lang scheme/base #lang racket/base
(require "struct.ss" (require "struct.ss"
"decode.ss" "decode.ss"
(for-syntax scheme/base (for-syntax racket/base
syntax/kerncase)) 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])) (rename-out [*module-begin #%module-begin]))
;; Module wrapper ---------------------------------------- ;; Module wrapper ----------------------------------------

View File

@ -141,7 +141,7 @@ expressions.
}===| }===|
The command part of an @"@"-form is optional as well. In that case, 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 application, but it also useful when quoted with the usual Racket
@racket[quote]: @racket[quote]: