refactoring for first stable release

pull/110/head
Matthew Butterick 9 years ago
parent ee12ea9f15
commit 10e3918fba

@ -1,3 +1,3 @@
Pollen
© 20132015 Matthew Butterick
© 20132016 Matthew Butterick
Licensed under the LGPL (see "LGPL.txt")

@ -1,167 +0,0 @@
#lang racket/base
(require racket/path racket/file compiler/cm file/cache sugar/coerce sugar/list "project.rkt" "rerequire.rkt" "debug.rkt" "file.rkt" racket/place "world.rkt")
;; The cache is a hash with paths as keys.
;; The cache values are also hashes, with key/value pairs for that path.
(provide reset-cache preheat-cache cached-require paths->key key->source-path)
(define (reset-cache [starting-dir (world:current-project-root)])
(when (or (not (path-string? starting-dir)) (not (directory-exists? starting-dir)))
(error 'reset-cache (format "~a is not a directory" starting-dir)))
(for ([path (in-directory starting-dir)]
#:when (and (directory-exists? path)
(equal? (path->string (car (reverse (explode-path path)))) (world:current-cache-dir-name))))
(message (format "removing cache directory: ~a" path))
(delete-directory/files path)))
(define (preheat-cache [starting-dir (world:current-project-root)])
(when (or (not (path-string? starting-dir)) (not (directory-exists? starting-dir)))
(error 'preheat-cache (format "~a is not a directory" starting-dir)))
(define max-places 8) ; number of parallel processes to spawn at a time
(define paths-that-should-be-cached (for/list ([path (in-directory starting-dir)]
#:when (or (preproc-source? path)
(markup-source? path)
(markdown-source? path)
(pagetree-source? path)))
path))
;; if a file is already in the cache, no need to hit it again.
;; this allows partially completed preheat jobs to resume.
(define uncached-paths (filter
(λ(path)
;; #t = not cached; #f = already cached
;; seems like it would be slow to load cache.rktd but it's not.
(define-values (_ private-cache-dir) (make-cache-dirs path))
(define cache-db-file (build-path private-cache-dir "cache.rktd"))
(cond
[(not (file-exists? cache-db-file)) #t]
[else (define cache-db (file->value cache-db-file))
(not (hash-has-key? cache-db (paths->key path)))])) paths-that-should-be-cached))
;; compile a path inside a place (= parallel processing)
(define (path-into-place path)
(message (format "caching: ~a" (find-relative-path starting-dir path)))
(define p (place ch
(define path (place-channel-get ch))
(define-values (path-dir path-name _) (split-path path))
(message (format "compiling: ~a" path-name))
;; use #f to signal compile error. Otherwise allow errors to pass.
(define result (with-handlers ([exn:fail? (λ _ (message (format "compile failed: ~a" path-name)) #f)])
(path->hash path)))
(place-channel-put ch result)))
(place-channel-put p path)
p)
;; compile the paths in groups, so they can be incrementally saved.
;; that way, if there's a failure, the progress is preserved.
;; but the slowest file in a group will prevent further progress.
(for ([path-group (in-list (slice-at uncached-paths max-places))])
(define path-places (map path-into-place path-group))
(for ([path (in-list path-group)]
[ppl (in-list path-places)])
(define result (place-channel-get ppl))
(when result ; #f is used to signal compile error
(cache-ref! (paths->key path) (λ _ result))))))
(define (paths->key source-path [template-path #f])
;; key is list of file + mod-time pairs, use #f for missing
(define path-strings (append (list source-path)
(append (list (and template-path (or (get-source template-path) template-path))) ; if template has a source file, track that instead
(->list (get-directory-require-files source-path))))) ; is either list of files or (list #f)
;; can't use relative paths for cache keys because source files include `here-path` which is absolute.
;; problem is that cache could appear valid on another filesystem (based on relative pathnames & mod dates)
;; but would actually be invalid (because the `here-path` names are wrong).
(define poly-flag (and (has-inner-poly-ext? source-path) (world:current-poly-target)))
(define pollen-env (getenv "POLLEN"))
(define path+mod-time-pairs
(map (λ(ps) (and ps (let ([cp (->complete-path ps)])
(cons (path->string cp) (with-handlers ([exn:fail? (λ _ 0)])
(file-or-directory-modify-seconds cp)))))) path-strings))
(list* pollen-env poly-flag path+mod-time-pairs))
(define (key->source-path key)
(car (caddr key)))
(require sugar/test)
(module-test-external
(define ps "/users/nobody/project/source.html.pm")
(check-equal? (key->source-path (paths->key ps)) ps))
(define-namespace-anchor anchor-to-this-namespace)
(define (path->hash path)
;; new namespace forces dynamic-require to re-instantiate 'path'
;; otherwise it gets cached in current namespace.
(define drfs (get-directory-require-files path))
(for-each managed-compile-zo (or drfs null))
(define path-dir (dirname path))
(apply hash
(let ([doc-key (world:current-main-export)]
[meta-key (world:current-meta-export)])
(parameterize ([current-namespace (make-base-namespace)]
[current-directory path-dir])
;; I monkeyed around with using the metas submodule to pull out the metas (for speed)
;; but in practice most files get their doc requested too.
;; so it's just simpler to get both at once and be done with it.
;; the savings of avoiding two cache fetches at the outset outweighs
;; the benefit of not reloading doc when you just need metas.
(namespace-attach-module (namespace-anchor->namespace anchor-to-this-namespace) 'pollen/world) ; brings in params
(list doc-key (dynamic-require path doc-key) meta-key (dynamic-require path meta-key))))))
(define (my-make-directory* dir)
(let-values ([(base name dir?) (split-path dir)])
(when (and (path? base) (not (directory-exists? base)))
(my-make-directory* base))
(unless (directory-exists? dir)
(with-handlers ([exn:fail:filesystem:exists? void])
(make-directory dir)))))
(define (make-cache-dirs path)
(define path-dir (dirname path))
(define cache-dir (build-path path-dir (world:current-cache-dir-name)))
(define private-cache-dir (build-path cache-dir "private"))
(my-make-directory* private-cache-dir) ; will also make cache-dir, if needed
(values cache-dir private-cache-dir))
(define ram-cache (make-hash))
(define (cache-ref! key path-hash-thunk)
(define path (key->source-path key))
(define-values (cache-dir private-cache-dir) (make-cache-dirs path))
(define-values (path-dir path-filename _) (split-path path))
(define dest-file (build-path cache-dir (format "~a.rktd" path-filename)))
(cache-file dest-file
#:exists-ok? #t
key
private-cache-dir
(λ _
(write-to-file (path-hash-thunk) dest-file #:exists 'replace))
#:max-cache-size (world:current-compile-cache-max-size))
(file->value dest-file))
(define (cached-require path-string subkey)
(define path (with-handlers ([exn:fail? (λ _ (raise-argument-error 'cached-require "valid path-string" path-string))])
(->complete-path path-string)))
(when (not (file-exists? path))
(raise-argument-error 'cached-require "path to existing file" path))
(cond
[(world:current-compile-cache-active path)
(define key (paths->key path))
(hash-ref (hash-ref! ram-cache key (λ _
(cache-ref! key (λ _ (path->hash path))))) subkey)]
[else (parameterize ([current-namespace (make-base-namespace)])
(namespace-attach-module (namespace-anchor->namespace anchor-to-this-namespace) 'pollen/world) ; brings in params
(dynamic-require path subkey))]))

@ -1,453 +0,0 @@
#lang racket/base
(require xml txexpr racket/string racket/match racket/list (prefix-in html: pollen/html) sugar/list sugar/container sugar/len sugar/define sugar/coerce sugar/test)
(require "debug.rkt" "world.rkt")
(define (symbols? x) (and (list? x) (andmap symbol? x)))
(define+provide (to-string x)
(if (string? x)
x ; fast exit for strings
(with-handlers ([exn:fail? (λ(exn) (error (format "Pollen decoder: can't convert ~v to ~a" x 'string)))])
(cond
[(equal? '() x) ""]
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[(path? x) (path->string x)]
[(char? x) (format "~a" x)]
[(void? x) ""]
;; todo: guard against weird shit like lists of procedures
[(or (list? x) (hash? x) (vector? x)) (format "~v" x)] ; ok to convert datatypes
[else (error)])))) ; but things like procedures should throw an error
(define decode-proc-output-contract (or/c xexpr/c (listof xexpr/c)))
(define (->list/tx x)
;; same as ->list but catches special case of single txexpr,
;; which is itself a list, but in this case should be wrapped into a list,
;; for use with append-map.
(if (txexpr? x)
(list x)
(->list x)))
;; decoder wireframe
(define+provide/contract (decode tx-in
#:txexpr-tag-proc [txexpr-tag-proc (λ(x)x)]
#:txexpr-attrs-proc [txexpr-attrs-proc (λ(x)x)]
#:txexpr-elements-proc [txexpr-elements-proc (λ(x)x)]
#:block-txexpr-proc [block-txexpr-proc (λ(x)x)]
#:inline-txexpr-proc [inline-txexpr-proc (λ(x)x)]
#:string-proc [string-proc (λ(x)x)]
#:entity-proc [entity-proc (λ(x)x)]
#:cdata-proc [cdata-proc (λ(x)x)]
#:exclude-tags [excluded-tags '()]
#:exclude-attrs [excluded-attrs '()])
((xexpr/c)
(#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
#:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
#:txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?)
#:block-txexpr-proc (block-txexpr? . -> . decode-proc-output-contract)
#:inline-txexpr-proc (txexpr? . -> . decode-proc-output-contract)
#:string-proc (string? . -> . decode-proc-output-contract)
#:entity-proc ((or/c symbol? valid-char?) . -> . decode-proc-output-contract)
#:cdata-proc (cdata? . -> . decode-proc-output-contract)
#:exclude-tags (listof txexpr-tag?)
#:exclude-attrs txexpr-attrs?) . ->* . (or/c xexpr/c (listof xexpr/c)))
(let loop ([x tx-in])
(cond
[(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)])
(if (or (member tag excluded-tags) (ormap (λ(attr) (member attr excluded-attrs)) attrs))
x ; because it's excluded
;; we apply processing here rather than do recursive descent on the pieces
;; because if we send them back through loop, certain element types are ambiguous
;; e.g., ((p "foo")) tests out as both txexpr-attrs and txexpr-elements
(let ([decoded-txexpr
(apply make-txexpr (list (txexpr-tag-proc tag)
(txexpr-attrs-proc attrs)
(txexpr-elements-proc (append-map (compose1 ->list/tx loop) elements))))])
((if (block-txexpr? decoded-txexpr)
block-txexpr-proc
inline-txexpr-proc) decoded-txexpr))))]
[(string? x) (string-proc x)]
[(or (symbol? x) (valid-char? x)) (entity-proc x)]
[(cdata? x) (cdata-proc x)]
[else (error "decode: can't decode" x)])))
(module-test-external
(require racket/list txexpr racket/function)
(define (doubler x) (list x x))
(check-equal? (decode #:txexpr-elements-proc identity '(p "foo")) '(p "foo"))
;; can't use doubler on txexpr-elements because it needs a list, not list of lists
(check-equal? (decode #:txexpr-elements-proc (λ(elems) (append elems elems)) '(p "foo")) '(p "foo" "foo"))
(check-equal? (decode #:block-txexpr-proc identity '(p "foo")) '(p "foo"))
(check-equal? (decode #:block-txexpr-proc doubler '(p "foo")) (list '(p "foo") '(p "foo")))
(check-equal? (decode #:inline-txexpr-proc identity '(p (span "foo"))) '(p (span "foo")))
(check-equal? (decode #:inline-txexpr-proc doubler '(p (span "foo"))) '(p (span "foo") (span "foo")))
(check-equal? (decode #:string-proc identity '(p (span "foo"))) '(p (span "foo")))
(check-equal? (decode #:string-proc doubler '(p (span "foo"))) '(p (span "foo" "foo")))
(check-equal? (decode #:entity-proc identity '(p (span "foo" 'amp))) '(p (span "foo" 'amp)))
(check-equal? (decode #:entity-proc identity '(p 42)) '(p 42))
(check-equal? (decode #:entity-proc doubler '(p 42)) '(p 42 42))
(check-equal? (decode #:entity-proc identity '(p amp)) '(p amp))
;; next text doesn't work because list of symbol elements is ambiguous with tagged X-expression
;; is there a general patch for this? maybe, but for now it's better to not patch selectively
;; otherwise ambiguous expressions will have erratic misbehavior (instead of merely consistent misbehavior)
;;(check-equal? (decode #:entity-proc doubler '(p amp)) '(p amp amp))
(check-equal? (decode-elements #:string-proc identity '("foo")) '("foo"))
(check-equal? (decode-elements #:string-proc doubler '("foo")) '("foo" "foo")))
;; it would be nice to not repeat this, but with all the keywords, it's simpler to repeat than do a macro
(define+provide/contract (decode-elements elements
#:txexpr-tag-proc [txexpr-tag-proc (λ(x)x)]
#:txexpr-attrs-proc [txexpr-attrs-proc (λ(x)x)]
#:txexpr-elements-proc [txexpr-elements-proc (λ(x)x)]
#:block-txexpr-proc [block-txexpr-proc (λ(x)x)]
#:inline-txexpr-proc [inline-txexpr-proc (λ(x)x)]
#:string-proc [string-proc (λ(x)x)]
#:entity-proc [entity-proc (λ(x)x)]
#:cdata-proc [cdata-proc (λ(x)x)]
#:exclude-tags [excluded-tags '()]
#:exclude-attrs [excluded-attrs '()])
((txexpr-elements?)
(#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
#:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
#:txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?)
#:block-txexpr-proc (block-txexpr? . -> . decode-proc-output-contract)
#:inline-txexpr-proc (txexpr? . -> . decode-proc-output-contract)
#:string-proc (string? . -> . decode-proc-output-contract)
#:entity-proc ((or/c symbol? valid-char?) . -> . decode-proc-output-contract)
#:cdata-proc (cdata? . -> . decode-proc-output-contract)
#:exclude-tags (listof txexpr-tag?)
#:exclude-attrs txexpr-attrs?) . ->* . (or/c xexpr/c (listof xexpr/c)))
(define temp-tag (gensym "temp-tag"))
(define decode-result (decode `(temp-tag ,@elements)
#:txexpr-tag-proc txexpr-tag-proc
#:txexpr-attrs-proc txexpr-attrs-proc
#:txexpr-elements-proc txexpr-elements-proc
#:block-txexpr-proc block-txexpr-proc
#:inline-txexpr-proc inline-txexpr-proc
#:string-proc string-proc
#:entity-proc entity-proc
#:cdata-proc cdata-proc
#:exclude-tags excluded-tags
#:exclude-attrs excluded-attrs))
(get-elements decode-result))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Blocks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; initial set of block tags: from html
(define+provide project-block-tags
(make-parameter html:block-tags))
;; tags are inline unless they're registered as block tags.
(define+provide/contract (block-txexpr? x)
(any/c . -> . boolean?)
(and (txexpr? x) (member (get-tag x) (project-block-tags)) #t))
(define+provide/contract (register-block-tag tag)
(txexpr-tag? . -> . void?)
(project-block-tags (cons tag (project-block-tags))))
(module-test-external
(check-true (begin (register-block-tag 'barfoo) (block-txexpr? '(barfoo "foo")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Typography
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-replacer query+replacement)
(let ([queries (map car query+replacement)]
[replacements (map second query+replacement)])
;; reverse because first in list should be first applied to str (and compose1 works right-to-left)
(apply compose1 (reverse (map (λ(query replacement) (λ(str) (regexp-replace* query str replacement))) queries replacements)))))
(define+provide/contract (smart-dashes str)
(string? . -> . string?)
(define dashes
;; fix em dashes first, else they'll be mistaken for en dashes
;; \\s is whitespace + #\u00A0 is nonbreaking space
'((#px"[\\s#\u00A0]*(---|—)[\\s#\u00A0]*" "") ; em dash
(#px"[\\s#\u00A0]*(--|)[\\s#\u00A0]*" ""))) ; en dash
((make-replacer dashes) str))
(module-test-external
(check-equal? (smart-dashes "I had --- maybe 13 -- 20 --- hob-nobs.") "I had—maybe 1320—hob-nobs.")
(check-equal? (smart-quotes "\"Why,\" she could've asked, \"are we in Oahu watching 'Mame'?\"")
"“Why,” she couldve asked, “are we in Oahu watching Mame?”")
(check-equal? (smart-quotes "\"\'Impossible.\' Yes.\"") "Impossible. Yes.”"))
(define+provide/contract (smart-quotes str)
(string? . -> . string?)
(define quotes
'((#px"(?<=\\w)'(?=\\w)" "") ; apostrophe
(#px"(?<!\\w)'(?=\\S)" "") ; single_at_beginning
(#px"(?<=\\S)'(?!\\w)" "") ; single_at_end
(#px"(?<!\\w)\"(?=\\S)" "") ; double_at_beginning
(#px"(?<=\\S)\"(?!\\w)" ""))) ; double_at_end
((make-replacer quotes) str))
;; insert nbsp between last two words
(define+provide/contract (nonbreaking-last-space x #:nbsp [nbsp (->string #\u00A0)]
#:minimum-word-length [minimum-word-length 6]
#:last-word-proc [last-word-proc (λ(x) x)])
((txexpr?) (#:nbsp string? #:minimum-word-length integer? #:last-word-proc procedure?) . ->* . txexpr?)
;; todo: parameterize this, as it will be different for each project
(define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs
(define (replace-last-space str)
(if (#\space . in? . str)
(let ([reversed-str-list (reverse (string->list str))]
[reversed-nbsp (reverse (string->list (->string nbsp)))])
(define-values (last-word-chars other-chars)
(splitf-at reversed-str-list (λ(i) (not (eq? i #\space)))))
(define front-chars (if (< (len last-word-chars) minimum-word-length) ; OK for long words to be on their own line
; first char of other-chars will be the space, so use cdr
(string-append (list->string (reverse (cdr other-chars))) (->string nbsp))
(list->string (reverse other-chars))))
(define last-word (list->string (reverse last-word-chars)))
`(,front-chars ,(last-word-proc last-word))) ; don't concatenate last word bc last-word-proc might be a txexpr wrapper
(list str)))
(define (find-last-word-space x) ; recursively traverse xexpr
(cond
[(string? x) (replace-last-space x)] ; todo: this assumes a paragraph only has one string in it.
[(txexpr? x)
(let-values([(tag attr elements) (txexpr->values x)])
(if (> (length elements) 0) ; elements is list of xexprs
(let-values ([(all-but-last last) (split-at elements (sub1 (length elements)))])
(define result (find-last-word-space (car last)))
(define result-items (if (txexpr? result) (list result) result)) ; might be txexpr, or list of new elements
(make-txexpr tag attr `(,@all-but-last ,@result-items)))
x))]
[else x]))
(if ((car x) . in? . tags-to-pay-attention-to)
(find-last-word-space x)
x))
(module-test-external
;; todo: make some tougher tests, it gets flaky with edge cases
(check-equal? (nonbreaking-last-space '(p "Hi there")) '(p "Hi " "there")) ; nbsp in between last two words
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "Ø") '(p "HiØ" "there")) ; but let's make it visible
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_") '(p "Hi_up_" "there"))
(check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_" #:minimum-word-length 3)
'(p "Hi " "there"))
(check-equal? (nonbreaking-last-space '(p "Hi here" (em "ho there")) #:nbsp "Ø") '(p "Hi here" (em "hoØ" "there"))))
; wrap initial quotes for hanging punctuation
; todo: improve this
; does not handle <p>“<em>thing</em> properly
(define+provide/contract (wrap-hanging-quotes nx
#:single-prepend [single-pp '(squo)]
#:double-prepend [double-pp '(dquo)])
((txexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . txexpr?)
(define two-or-more-char-string? (λ(i) (and (string? i) (>= (len i) 2))))
(define-values (tag attr elements) (txexpr->values nx))
(make-txexpr tag attr
(if (and (list? elements) (not (empty? elements)))
(let ([new-car-elements (match (car elements)
[(? two-or-more-char-string? tcs)
(define str-first (get tcs 0))
(define str-rest (get tcs 1 (len tcs)))
(cond
[(str-first . in? . '("\"" ""))
;; can wrap with any inline tag
;; so that linebreak detection etc still works
`(,@double-pp ,(->string #\“) ,str-rest)]
[(str-first . in? . '("\'" ""))
`(,@single-pp ,(->string #\) ,str-rest)]
[else tcs])]
[(? txexpr? nx) (wrap-hanging-quotes nx)]
[else (car elements)])])
(cons new-car-elements (cdr elements)))
elements)))
(module-test-external
(check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (dquo "" "Hi\" there")))
(check-equal? (wrap-hanging-quotes '(p "'Hi' there")) '(p (squo "" "Hi' there")))
(check-equal? (wrap-hanging-quotes '(p "'Hi' there") #:single-prepend '(foo ((bar "ino"))))
'(p (foo ((bar "ino")) "" "Hi' there")))
;; make sure txexpr without elements passes through unscathed
(check-equal? (wrap-hanging-quotes '(div ((style "height:2em")))) '(div ((style "height:2em")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Lines, blocks, paragraphs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; turn the right items into <br> tags
(define+provide/contract (detect-linebreaks xc
#:separator [newline (world:current-linebreak-separator)]
#:insert [linebreak '(br)])
((txexpr-elements?) (#:separator string? #:insert xexpr?) . ->* . txexpr-elements?)
;; todo: should this test be not block + not whitespace?
(define not-block? (λ(i) (not (block-txexpr? i))))
(filter-not empty?
(for/list ([i (in-range (len xc))])
(let ([item (get xc i)])
(cond
;; skip first and last
[(or (= i 0) (= i (sub1 (len xc)))) item]
[(equal? item newline)
(match (get xc (- i 1) (+ i 2)) ; a three-element slice with x[i] in the middle
;; only convert if neither adjacent tag is a block
;; (because blocks automatically force a newline before & after)
[(list (? not-block?) newline (? not-block?)) linebreak]
[else empty])] ; otherwise delete
[else item])))))
(module-test-external
(check-equal? (detect-linebreaks '("foo" "\n" "bar")) '("foo" (br) "bar"))
(check-equal? (detect-linebreaks '("\n" "foo" "\n" "bar" "\n")) '("\n" "foo" (br) "bar" "\n"))
(check-equal? (detect-linebreaks '((p "foo") "\n" (p "bar"))) '((p "foo") (p "bar")))
(check-equal? (detect-linebreaks '("foo" "\n" (p "bar"))) '("foo" (p "bar")))
(check-equal? (detect-linebreaks '("foo" "moo" "bar")) '("foo" "moo" "bar"))
(check-equal? (detect-linebreaks '("foo" "moo" "bar") #:insert "moo") '("foo" "moo" "bar"))
(check-equal? (detect-linebreaks '("foo" "\n\n" "bar")) '("foo" "\n\n" "bar")))
(define+provide/contract (whitespace? x [nbsp? #f])
((any/c)(boolean?) . ->* . coerce/boolean?)
(define pat (pregexp (format "^[\\s~a]+$" (if nbsp? #\u00A0 ""))))
(cond
[(equal? "" x) #t] ; empty string is deemed whitespace
[(or (string? x) (symbol? x)) (regexp-match pat (->string x))]
[(or (list? x) (vector? x)) (and (not (empty? x)) (andmap (λ(i) (whitespace? i nbsp?)) (->list x)))] ; andmap returns #t for empty lists
[else #f]))
(module-test-external
(require racket/format)
(check-true (whitespace? " "))
(check-false (whitespace? (~a #\u00A0)))
(check-true (whitespace/nbsp? (~a #\u00A0)))
(check-true (whitespace/nbsp? (vector (~a #\u00A0))))
(check-false (whitespace? (format " ~a " #\u00A0)))
(check-true (whitespace/nbsp? (format " ~a " #\u00A0))))
(define+provide/contract (whitespace/nbsp? x)
(any/c . -> . coerce/boolean?)
(whitespace? x #t))
;; is x a paragraph break?
(define+provide/contract (paragraph-break? x #:separator [sep (world:current-paragraph-separator)])
((any/c) (#:separator pregexp?) . ->* . coerce/boolean?)
(define paragraph-pattern (pregexp (format "^~a+$" sep)))
(and (string? x) (regexp-match paragraph-pattern x)))
;; Find adjacent newline characters in a list and merge them into one item
;; Scribble, by default, makes each newline a separate list item.
(define+provide/contract (merge-newlines x)
(txexpr-elements? . -> . txexpr-elements?)
(define (newlines? x)
(and (string? x)
(let ([newline-pat (regexp (format "^~a+$" (world:current-newline)))])
(regexp-match newline-pat x))))
(define (merge-if-newlines xs)
(if (newlines? (car xs))
(list (string-append* xs))
xs))
(let loop ([x x])
(if (pair? x)
(let ([xs (map loop x)])
(append-map merge-if-newlines (slicef xs newlines?)))
x)))
(module-test-external
(require racket/list)
(check-equal? (merge-newlines empty) empty)
(check-equal? (merge-newlines '(p "\n" "\n" "foo" "\n" "\n\n" "bar" (em "\n" "\n" "\n")))
'(p "\n\n" "foo" "\n\n\n" "bar" (em "\n\n\n"))))
;; detect paragraphs
;; todo: unit tests
(define+provide/contract (detect-paragraphs elements #:tag [tag 'p]
#:separator [sep (world:current-paragraph-separator)]
#:linebreak-proc [linebreak-proc detect-linebreaks]
#:force? [force-paragraph #f])
((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?) #:force? boolean?)
. ->* . txexpr-elements?)
;; prepare elements for paragraph testing
(define (prep-paragraph-flow elems)
(linebreak-proc (merge-newlines (trimf elems whitespace?))))
(define my-paragraph-break? (λ(x) (and (paragraph-break? x #:separator sep) #t)))
(define (wrap-paragraph elems)
(match elems
[(list (? block-txexpr? bxs) ...) bxs] ; leave a series of block xexprs alone
[else (list (make-txexpr tag empty elems))])) ; otherwise wrap in p tag
(let ([elements (prep-paragraph-flow elements)])
(define explicit-or-implicit-paragraph-break? (λ(x) (or (my-paragraph-break? x) (block-txexpr? x))))
(if (ormap explicit-or-implicit-paragraph-break? elements) ; need this condition to prevent infinite recursion
;; use append-map on wrap-paragraph rather than map to permit return of multiple elements
(append-map wrap-paragraph (append-map (λ(es) (filter-split es my-paragraph-break?)) (slicef elements block-txexpr?))) ; split into ¶¶, using both implied and explicit paragraph breaks
(if force-paragraph
(append-map wrap-paragraph (slicef elements block-txexpr?)) ; upconverts non-block elements to paragraphs
elements))))
(module-test-external
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para"))
'((p "First para") (p "Second para")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line"))
'((p "First para") (p "Second para" (br) "Second line")))
(check-equal? (detect-paragraphs '("First para" "\n\n" (div "Second block")))
'((p "First para") (div "Second block")))
(check-equal? (detect-paragraphs '((div "First block") "\n\n" (div "Second block")))
'((div "First block") (div "Second block")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para") #:tag 'ns:p)
'((ns:p "First para") (ns:p "Second para")))
(check-equal? (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (detect-linebreaks x #:insert '(newline))))
'((p "First para") (p "Second para" (newline) "Second line")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar") (div "zam")))
'((p "foo") (div "bar") (div "zam")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar") "\n\n" (div "zam")))
'((p "foo") (div "bar") (div "zam")))
(check-equal? (detect-paragraphs '("foo")) '("foo"))
(check-equal? (detect-paragraphs '("foo") #:force? #t) '((p "foo")))
(check-equal? (detect-paragraphs '((div "foo"))) '((div "foo")))
(check-equal? (detect-paragraphs '((div "foo")) #:force? #t) '((div "foo")))
(check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar"))) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar"))) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar")) #:force? #t) '((p "foo") (div "bar")))
(check-equal? (detect-paragraphs '("foo" (div "bar") "zam")) '((p "foo") (div "bar") (p "zam")))
(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam")) '((p "foo" (span "zing")) (div "bar") (p "zam")))
(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam") #:force? #t) '((p "foo" (span "zing")) (div "bar") (p "zam"))))

@ -1,13 +1,8 @@
#lang info
(define collection "pollen")
(define version "1.0")
(define collection 'multi)
(define deps '("base" "txexpr" "sugar" ("markdown" #:version "0.18") "htdp"
"at-exp-lib" "html-lib" "rackjure" "web-server-lib" "scribble-text-lib" "rackunit-lib"
"gui-lib"))
(define build-deps '("plot-gui-lib" "scribble-lib" "racket-doc" "rackunit-doc" "plot-doc" "scribble-doc" "slideshow-doc" "web-server-doc"))
(define update-implies '("txexpr" "sugar"))
(define scribblings '(("scribblings/pollen.scrbl" (multi-page))))
(define raco-commands '(("pollen" (submod pollen/command raco) "issue Pollen command" #f)))
(define compile-omit-paths '("test" "tools" "server-extras" "scribblings/third-tutorial-files"))
;; it's redundant to test "pollen.scrbl" because it incorporates the other scribble sources by reference
(define test-omit-paths '("test/data" "tools" "server-extras" "scribblings/third-tutorial-files" "scribblings/pollen.scrbl"))
(define module-suffixes '(#"pp" #"pm" #"pmd" #"ptree"))

@ -1,8 +0,0 @@
#lang racket/base
(require pollen/main-base)
(define+provide-module-begin-in-mode world:mode-preproc) ; because default mode in submodule is preproc
(module reader racket/base
(require pollen/reader-base)
;; because default mode in file is auto
(define+provide-reader-in-mode world:mode-auto))

@ -1,8 +0,0 @@
#lang racket/base
(require pollen/main-base)
(define+provide-module-begin-in-mode world:mode-markdown)
(module reader racket/base
(require pollen/reader-base)
(define+provide-reader-in-mode world:mode-markdown))

@ -1,8 +0,0 @@
#lang racket/base
(require pollen/main-base)
(define+provide-module-begin-in-mode world:mode-markup)
(module reader racket/base
(require pollen/reader-base)
(define+provide-reader-in-mode world:mode-markup))

@ -0,0 +1,51 @@
#lang racket/base
(require racket/file
sugar/define
"private/cache-utils.rkt"
"private/debug.rkt"
"world.rkt")
;; The cache is a hash with paths as keys.
;; The cache values are also hashes, with key/value pairs for that path.
(define+provide (reset-cache [starting-dir (world:current-project-root)])
(unless (and (path-string? starting-dir) (directory-exists? starting-dir))
(raise-argument-error 'reset-cache "path-string to existing directory" starting-dir))
(for ([path (in-directory starting-dir)]
#:when (and (directory-exists? path)
(equal? (path->string (car (reverse (explode-path path)))) (world:current-cache-dir-name))))
(message (format "removing cache directory: ~a" path))
(delete-directory/files path)))
(define-namespace-anchor cache-module-ns)
(define cached-require-base
(let ([ram-cache (make-hash)])
(λ(path-or-path-string subkey caller-name)
(define path (with-handlers ([exn:fail? (λ(e) (raise-argument-error caller-name "valid path or path-string" path-or-path-string))])
(path->complete-path (if (path? path-or-path-string)
path-or-path-string
(string->path path-or-path-string)))))
(unless (file-exists? path)
(raise-argument-error caller-name "path to existing file" path-or-path-string))
(cond
[(world:current-compile-cache-active path)
(define key (paths->key path))
(hash-ref (hash-ref! ram-cache key (λ _ (cache-ref! key (λ _ (path->hash path))))) subkey)]
[else (parameterize ([current-namespace (make-base-namespace)])
(namespace-attach-module (namespace-anchor->namespace cache-module-ns) 'pollen/world) ; brings in params
(dynamic-require path subkey))]))))
(define+provide (cached-require path-string subkey)
(cached-require-base path-string subkey 'cached-require))
(define+provide (cached-doc path-string)
(cached-require-base path-string (world:current-main-export) 'cached-doc))
(define+provide (cached-metas path-string)
(cached-require-base path-string (world:current-meta-export) 'cached-metas))

@ -0,0 +1,248 @@
#lang racket/base
(require xml txexpr racket/list sugar/list sugar/define sugar/test)
(require "world.rkt"
"private/whitespace.rkt")
(define (->list/tx x)
;; same as ->list but catches special case of single txexpr,
;; which is itself a list, but in this case should be wrapped into a list,
;; for use with append-map.
(cond
[(txexpr? x) (list x)]
[(list? x) x]
[else (list x)]))
(define decode-proc-output-contract (or/c txexpr-element? txexpr-elements?))
(define identity (λ(x) x))
;; decoder wireframe
(define+provide/contract (decode tx-in
#:txexpr-tag-proc [txexpr-tag-proc identity]
#:txexpr-attrs-proc [txexpr-attrs-proc identity]
#:txexpr-elements-proc [txexpr-elements-proc identity]
#:txexpr-proc [txexpr-proc identity]
#:block-txexpr-proc [block-txexpr-proc identity]
#:inline-txexpr-proc [inline-txexpr-proc identity]
#:string-proc [string-proc identity]
#:entity-proc [entity-proc identity]
#:cdata-proc [cdata-proc identity]
#:exclude-tags [excluded-tags empty]
#:exclude-attrs [excluded-attrs empty])
((xexpr/c)
(#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
#:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
#:txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?)
#:txexpr-proc (txexpr? . -> . decode-proc-output-contract)
#:block-txexpr-proc (block-txexpr? . -> . decode-proc-output-contract)
#:inline-txexpr-proc (txexpr? . -> . decode-proc-output-contract)
#:string-proc (string? . -> . decode-proc-output-contract)
#:entity-proc ((or/c symbol? valid-char?) . -> . decode-proc-output-contract)
#:cdata-proc (cdata? . -> . decode-proc-output-contract)
#:exclude-tags txexpr-tags?
#:exclude-attrs txexpr-attrs?) . ->* . decode-proc-output-contract)
(let loop ([x tx-in])
(cond
[(txexpr? x) (let-values([(tag attrs elements) (txexpr->values x)])
(if (or (member tag excluded-tags) (ormap (λ(attr) (member attr excluded-attrs)) attrs))
x ; because it's excluded
;; we apply processing here rather than do recursive descent on the pieces
;; because if we send them back through loop, certain element types are ambiguous
;; e.g., ((p "foo")) tests out as both txexpr-attrs and txexpr-elements
(let ([decoded-txexpr
(apply make-txexpr (list (txexpr-tag-proc tag)
(txexpr-attrs-proc attrs)
(txexpr-elements-proc (append-map (compose1 ->list/tx loop) elements))))])
((compose1 txexpr-proc (if (block-txexpr? decoded-txexpr)
block-txexpr-proc
inline-txexpr-proc)) decoded-txexpr))))]
[(string? x) (string-proc x)]
[(or (symbol? x) (valid-char? x)) (entity-proc x)]
[(cdata? x) (cdata-proc x)]
[else (error "decode: can't decode" x)])))
(module-test-external
(require racket/list txexpr racket/function)
(define (doubler x) (list x x))
(define (doubletag x) (txexpr (string->symbol (format "~a~a" (get-tag x) (get-tag x))) (get-attrs x) (get-elements x)))
(check-equal? (decode #:txexpr-elements-proc identity '(p "foo")) '(p "foo"))
;; can't use doubler on txexpr-elements because it needs a list, not list of lists
(check-equal? (decode #:txexpr-elements-proc (λ(elems) (append elems elems)) '(p "foo")) '(p "foo" "foo"))
(check-equal? (decode #:block-txexpr-proc identity '(p "foo")) '(p "foo"))
(check-equal? (decode #:block-txexpr-proc doubler '(p "foo")) (list '(p "foo") '(p "foo")))
(check-equal? (decode #:block-txexpr-proc doubler '(p "foo")) (list '(p "foo") '(p "foo")))
(check-equal? (decode #:txexpr-proc doubletag '(root (p "foo") (b "bar"))) '(rootroot (pp "foo") (bb "bar")))
(check-equal? (decode #:block-txexpr-proc doubletag '(root (p "foo") (b "bar"))) '(rootroot (pp "foo") (b "bar")))
(check-equal? (decode #:inline-txexpr-proc doubletag '(root (p "foo") (b "bar"))) '(root (p "foo") (bb "bar")))
(check-equal? (decode #:inline-txexpr-proc identity '(p (span "foo"))) '(p (span "foo")))
(check-equal? (decode #:inline-txexpr-proc doubler '(p (span "foo"))) '(p (span "foo") (span "foo")))
(check-equal? (decode #:string-proc identity '(p (span "foo"))) '(p (span "foo")))
(check-equal? (decode #:string-proc doubler '(p (span "foo"))) '(p (span "foo" "foo")))
(check-equal? (decode #:entity-proc identity '(p (span "foo" 'amp))) '(p (span "foo" 'amp)))
(check-equal? (decode #:entity-proc identity '(p 42)) '(p 42))
(check-equal? (decode #:entity-proc doubler '(p 42)) '(p 42 42))
(check-equal? (decode #:entity-proc identity '(p amp)) '(p amp))
;; next text doesn't work because list of symbol elements is ambiguous with tagged X-expression
;; is there a general patch for this? maybe, but for now it's better to not patch selectively
;; otherwise ambiguous expressions will have erratic misbehavior (instead of merely consistent misbehavior)
;;(check-equal? (decode #:entity-proc doubler '(p amp)) '(p amp amp))
(check-equal? (decode-elements #:string-proc identity '("foo")) '("foo"))
(check-equal? (decode-elements #:string-proc doubler '("foo")) '("foo" "foo")))
;; it would be nice to not repeat this, but with all the keywords, it's simpler to repeat than do a macro
(define+provide/contract decode-elements
((txexpr-elements?)
(#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
#:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
#:txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?)
#:txexpr-proc (txexpr? . -> . decode-proc-output-contract)
#:block-txexpr-proc (block-txexpr? . -> . decode-proc-output-contract)
#:inline-txexpr-proc (txexpr? . -> . decode-proc-output-contract)
#:string-proc (string? . -> . decode-proc-output-contract)
#:entity-proc ((or/c symbol? valid-char?) . -> . decode-proc-output-contract)
#:cdata-proc (cdata? . -> . decode-proc-output-contract)
#:exclude-tags txexpr-tags?
#:exclude-attrs txexpr-attrs?) . ->* . decode-proc-output-contract)
(make-keyword-procedure
(λ (kws kwargs . args)
(define temp-tag (gensym "temp-tag"))
(define elements (car args))
(define decode-result (keyword-apply decode kws kwargs (list (cons temp-tag elements))))
(get-elements decode-result))))
(define+provide/contract (block-txexpr? x)
(any/c . -> . boolean?)
;; Mostly this is used inside `decode`,
;; so rather than test for `txexpr?` at the beginning (which is potentially slow)
;; just look at the tag.
(and (pair? x)
(memq (get-tag x) (world:current-block-tags))
#t))
(define+provide/contract (decode-linebreaks elems [maybe-linebreak-proc '(br)]
#:separator [newline (world:current-linebreak-separator)])
((txexpr-elements?) ((or/c txexpr-element? (txexpr-element? txexpr-element? . -> . txexpr-element?)) #:separator string?) . ->* . txexpr-elements?)
(define linebreak-proc (if (procedure? maybe-linebreak-proc)
maybe-linebreak-proc
(λ (e1 e2) maybe-linebreak-proc)))
(define elems-vec (list->vector elems))
(filter identity
(for/list ([(item i) (in-indexed elems-vec)])
(cond
[(or (= i 0) (= i (sub1 (vector-length elems-vec)))) item] ; pass through first & last items
[(equal? item newline)
(let ([prev (vector-ref elems-vec (sub1 i))]
[next (vector-ref elems-vec (add1 i))])
;; only convert if neither adjacent tag is a block
;; (because blocks automatically force a newline before & after)
(if (or (block-txexpr? prev) (block-txexpr? next))
#f ; flag for filtering
(linebreak-proc prev next)))]
[else item]))))
(module-test-external
(check-equal? (decode-linebreaks '("foo" "\n" "bar")) '("foo" (br) "bar"))
(check-equal? (decode-linebreaks '("\n" "foo" "\n" "bar" "\n")) '("\n" "foo" (br) "bar" "\n"))
(check-equal? (decode-linebreaks '((p "foo") "\n" (p "bar"))) '((p "foo") (p "bar")))
(check-equal? (decode-linebreaks '("foo" "\n" (p "bar"))) '("foo" (p "bar")))
(check-equal? (decode-linebreaks '("foo" "moo" "bar")) '("foo" "moo" "bar"))
(check-equal? (decode-linebreaks '("foo" "moo" "bar") "moo") '("foo" "moo" "bar"))
(check-equal? (decode-linebreaks '("foo" "\n\n" "bar")) '("foo" "\n\n" "bar")))
;; Find adjacent newline characters in a list and merge them into one item
;; Scribble, by default, makes each newline a separate list item.
(define+provide/contract (merge-newlines x)
(txexpr-elements? . -> . txexpr-elements?)
(define newline-pat (regexp (format "^~a+$" (world:current-newline))))
(define (newlines? x) (and (string? x) (regexp-match newline-pat x)))
(define (merge-if-newlines xs)
(if (newlines? (car xs))
(list (apply string-append xs))
xs))
(let loop ([x x])
(if (pair? x)
(let ([xs (map loop x)])
(append-map merge-if-newlines (slicef xs newlines?)))
x)))
(module-test-external
(require racket/list)
(check-equal? (merge-newlines empty) empty)
(check-equal? (merge-newlines '(p "\n" "\n" "foo" "\n" "\n\n" "bar" (em "\n" "\n" "\n")))
'(p "\n\n" "foo" "\n\n\n" "bar" (em "\n\n\n"))))
;; detect paragraphs
;; todo: unit tests
(define+provide/contract (decode-paragraphs elements [maybe-wrap-proc 'p]
#:linebreak-proc [linebreak-proc decode-linebreaks]
#:force? [force-paragraph #f])
((txexpr-elements?) ((or/c txexpr-tag? ((listof xexpr?) . -> . txexpr?))
#:linebreak-proc (txexpr-elements? . -> . txexpr-elements?)
#:force? boolean?)
. ->* . txexpr-elements?)
(define (prep-paragraph-flow elems)
(linebreak-proc (merge-newlines (trimf elems whitespace?))))
(define (paragraph-break? x)
(define paragraph-separator (world:current-paragraph-separator))
(define paragraph-pattern (pregexp (format "^~a+$" paragraph-separator)))
(and (string? x) (regexp-match paragraph-pattern x)))
(define (explicit-or-implicit-paragraph-break? x)
(or (paragraph-break? x) (block-txexpr? x)))
(define wrap-proc (if (procedure? maybe-wrap-proc)
maybe-wrap-proc
(λ(elems) (list* maybe-wrap-proc elems))))
(define (wrap-paragraph elems)
(if (andmap block-txexpr? elems)
elems ; leave a series of block xexprs alone
(list (wrap-proc elems)))) ; otherwise wrap in p tag
(let ([elements (prep-paragraph-flow elements)])
(if (ormap explicit-or-implicit-paragraph-break? elements) ; need this condition to prevent infinite recursion
;; use append-map on wrap-paragraph rather than map to permit return of multiple elements
(append-map wrap-paragraph (append-map (λ(es) (filter-split es paragraph-break?)) (slicef elements block-txexpr?))) ; split into ¶¶, using both implied and explicit paragraph breaks
(if force-paragraph
(append-map wrap-paragraph (slicef elements block-txexpr?)) ; upconverts non-block elements to paragraphs
elements))))
(module-test-external
(check-equal? (decode-paragraphs '("First para" "\n\n" "Second para"))
'((p "First para") (p "Second para")))
(check-equal? (decode-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line"))
'((p "First para") (p "Second para" (br) "Second line")))
(check-equal? (decode-paragraphs '("First para" "\n\n" (div "Second block")))
'((p "First para") (div "Second block")))
(check-equal? (decode-paragraphs '((div "First block") "\n\n" (div "Second block")))
'((div "First block") (div "Second block")))
(check-equal? (decode-paragraphs '("First para" "\n\n" "Second para") 'ns:p)
'((ns:p "First para") (ns:p "Second para")))
(check-equal? (decode-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (decode-linebreaks x '(newline))))
'((p "First para") (p "Second para" (newline) "Second line")))
(check-equal? (decode-paragraphs '("foo" "\n\n" (div "bar") (div "zam")))
'((p "foo") (div "bar") (div "zam")))
(check-equal? (decode-paragraphs '("foo" "\n\n" (div "bar") "\n\n" (div "zam")))
'((p "foo") (div "bar") (div "zam")))
(check-equal? (decode-paragraphs '("foo")) '("foo"))
(check-equal? (decode-paragraphs '("foo") #:force? #t) '((p "foo")))
(check-equal? (decode-paragraphs '((div "foo"))) '((div "foo")))
(check-equal? (decode-paragraphs '((div "foo")) #:force? #t) '((div "foo")))
(check-equal? (decode-paragraphs '("foo" "\n\n" (div "bar"))) '((p "foo") (div "bar")))
(check-equal? (decode-paragraphs '("foo" (div "bar"))) '((p "foo") (div "bar")))
(check-equal? (decode-paragraphs '("foo" (div "bar")) #:force? #t) '((p "foo") (div "bar")))
(check-equal? (decode-paragraphs '("foo" (div "bar") "zam")) '((p "foo") (div "bar") (p "zam")))
(check-equal? (decode-paragraphs '("foo" (span "zing") (div "bar") "zam")) '((p "foo" (span "zing")) (div "bar") (p "zam")))
(check-equal? (decode-paragraphs '("foo" (span "zing") (div "bar") "zam") #:force? #t) '((p "foo" (span "zing")) (div "bar") (p "zam"))))
(define+provide detect-paragraphs decode-paragraphs) ; bw compat
(define+provide detect-linebreaks decode-linebreaks) ; bw compat

@ -0,0 +1,52 @@
#lang racket/base
(require sugar/test racket/require (matching-identifiers-in #rx"-source\\?$" "private/file-utils.rkt")
(matching-identifiers-in #rx"-source-path$" "private/file-utils.rkt")
(matching-identifiers-in #rx"^get.*-source$" "private/file-utils.rkt")
(only-in "private/file-utils.rkt" ->output-path))
(provide (all-from-out "private/file-utils.rkt"))
;; do the tests here to verify that the right functions are available through file.rkt
(module-test-external
(require sugar/coerce pollen/world)
(check-true (preproc-source? "foo.pp"))
(check-false (preproc-source? "foo.bar"))
(check-false (preproc-source? #f))
(check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp"))
(check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.pp"))
(check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
(check-equal? (->preproc-source-path 'foo) (->path "foo.pp"))
(check-true (pagetree-source? (format "foo.~a" (world:current-pagetree-source-ext))))
(check-false (pagetree-source? (format "~a.foo" (world:current-pagetree-source-ext))))
(check-false (pagetree-source? #f))
(check-true (markup-source? "foo.pm"))
(check-false (markup-source? "foo.p"))
(check-false (markup-source? #f))
(check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm"))
(check-equal? (->markup-source-path (->path "foo.html")) (->path "foo.html.pm"))
(check-equal? (->markup-source-path "foo") (->path "foo.pm"))
(check-equal? (->markup-source-path 'foo) (->path "foo.pm"))
(check-true (markdown-source? "foo.html.pmd"))
(check-false (markdown-source? "foo.html"))
(check-false (markdown-source? #f))
(check-equal? (->markdown-source-path (->path "foo.pmd")) (->path "foo.pmd"))
(check-equal? (->markdown-source-path (->path "foo.html")) (->path "foo.html.pmd"))
(check-equal? (->markdown-source-path "foo") (->path "foo.pmd"))
(check-equal? (->markdown-source-path 'foo) (->path "foo.pmd"))
(check-false (get-source 42))
(check-equal? (->output-path (->path "foo.pmap")) (->path "foo.pmap"))
(check-equal? (->output-path "foo.html") (->path "foo.html"))
(check-equal? (->output-path 'foo.html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo.xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo.barml.p) (->path "foo.barml"))
(check-equal? (->output-path 'foo_html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo_html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo_xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo_barml.p) (->path "foo.barml"))
(check-equal? (->output-path "foo.poly.pm") (->path "foo.html"))
(check-equal? (->output-path "foo_poly.pp") (->path "foo.html")))

@ -0,0 +1,7 @@
#lang info
(define scribblings '(("scribblings/pollen.scrbl" (multi-page))))
(define raco-commands '(("pollen" (submod pollen/private/command raco) "issue Pollen command" #f)))
(define compile-omit-paths '("test" "tools" "server-extras" "scribblings/third-tutorial-files"))
;; it's redundant to test "pollen.scrbl" because it incorporates the other scribble sources by reference
(define test-omit-paths '("test/data" "tools" "server-extras" "scribblings/third-tutorial-files" "scribblings/pollen.scrbl"))
(define module-suffixes '(#"pp" #"pm" #"pmd" #"ptree"))

@ -0,0 +1,8 @@
#lang racket/base
(require "private/main-base.rkt")
(define+provide-module-begin-in-mode world:mode-preproc) ; because default mode in submodule is preproc
(module reader racket/base
(require pollen/private/reader-base)
(define+provide-reader-in-mode world:mode-auto)) ; because default mode in file is auto

@ -0,0 +1,8 @@
#lang racket/base
(require "private/main-base.rkt")
(define+provide-module-begin-in-mode world:mode-markdown)
(module reader racket/base
(require pollen/private/reader-base)
(define+provide-reader-in-mode world:mode-markdown))

@ -0,0 +1,8 @@
#lang racket/base
(require "private/main-base.rkt")
(define+provide-module-begin-in-mode world:mode-markup)
(module reader racket/base
(require pollen/private/reader-base)
(define+provide-reader-in-mode world:mode-markup))

@ -0,0 +1,3 @@
#lang racket/base
(require pollen/unstable/mb)
(provide smart-quotes smart-dashes)

@ -7,6 +7,11 @@ So this file
a) adapts the at-exp metalang from 6.2
b) incorporates the scribble/reader from 6.2
so that everything will work correctly in 6.0.
Note that pollen/mode uses world:command-char, NOT (world:current-command-char),
because doing so would create a loading loop if pollen/mode were used in "pollen.rkt"
(which is a likely place to use it)
Intractable problem, unavoiable limitation.
|#

@ -1,14 +1,15 @@
#lang racket/base
(require racket/path racket/list)
(require "file.rkt" "world.rkt" "decode.rkt" sugar txexpr "cache.rkt")
(require racket/path racket/list sugar txexpr)
(require "world.rkt"
"private/whitespace.rkt"
"private/file-utils.rkt"
"decode.rkt"
"cache.rkt")
(define+provide current-pagetree (make-parameter #f))
(define+provide (pagenode? x)
(->boolean (and (symbol? x) (with-handlers ([exn:fail? (λ(e) #f)])
(not (whitespace/nbsp? (->string x)))))))
(and (symbol? x) (not (whitespace/nbsp? (symbol->string x))) #t))
(module-test-external
(check-false (pagenode? "foo-bar"))
@ -21,18 +22,19 @@
(check-false (pagenode? " ")))
(define+provide (pagenodes? x)
;; for contracts: faster than (listof pagenode?)
(define (pagenodes? x)
(and (list? x) (andmap pagenode? x)))
(define+provide (pagenodeish? x)
(with-handlers ([exn:fail? (λ(e) #f)])
(pagenode? (->symbol x))))
(and (->pagenode x) #t)))
(define/contract+provide (->pagenode x)
(pagenodeish? . -> . pagenode?)
(->symbol x))
(define+provide (->pagenode x)
(with-handlers ([exn:fail? (λ(e) (raise-argument-error '->pagenode "can't convert input to pagenode" x))])
(->symbol x)))
(define+provide/contract (decode-pagetree xs)
@ -52,17 +54,17 @@
(define+provide (validate-pagetree x)
(and (txexpr? x)
(let ([pagenodes (pagetree->list x)])
(and
(andmap (λ(p) (or (pagenode? p) (error (format "validate-pagetree: \"~a\" is not a valid pagenode" p)))) pagenodes)
(with-handlers ([exn:fail? (λ(e) (error (format "validate-pagetree: ~a" (exn-message e))))])
(members-unique?/error pagenodes))
x))))
(for ([p (in-list pagenodes)]
#:when (not (pagenode? p)))
(error 'validate-pagetree (format "\"~a\" is not a valid pagenode" p)))
(with-handlers ([exn:fail? (λ(e) (error 'validate-pagetree (format "~a" (exn-message e))))])
(members-unique?/error pagenodes))
x)))
(define+provide (pagetree? x)
(with-handlers ([exn:fail? (λ(e) #f)])
(->boolean (validate-pagetree x))))
(and (validate-pagetree x) #t)))
(module-test-external
(check-true (pagetree? '(foo)))
@ -78,7 +80,7 @@
(define (unique-sorted-output-paths xs)
(define output-paths (map ->output-path xs))
(define all-paths (filter visible? (remove-duplicates output-paths)))
(define all-paths (filter path-visible? (remove-duplicates output-paths)))
(define path-is-directory? (λ(f) (directory-exists? (build-path dir f))))
(define-values (subdirectories files) (partition path-is-directory? all-paths))
(define-values (pagetree-sources other-files) (partition pagetree-source? files))
@ -93,14 +95,17 @@
(define (not-pollen-cache? path)
(not (member (->string path) world:cache-names)))
(if (directory-exists? dir )
(decode-pagetree (map ->symbol (unique-sorted-output-paths (filter not-pollen-cache? (directory-list dir)))))
(error (format "directory->pagetree: directory ~a doesn't exist" dir))))
(unless (directory-exists? dir)
(error 'directory->pagetree (format "directory ~v doesn't exist" dir)))
(decode-pagetree (map ->pagenode (unique-sorted-output-paths (filter not-pollen-cache? (directory-list dir))))))
(define+provide/contract (load-pagetree source-path)
(define+provide/contract (get-pagetree source-path)
(pathish? . -> . pagetree?)
(cached-require source-path (world:current-main-export)))
(cached-doc source-path))
(define+provide load-pagetree get-pagetree) ; bw compat
;; Try loading from pagetree file, or failing that, synthesize pagetree.
@ -120,14 +125,13 @@
(let loop ([pagenode (->pagenode pnish)][subtree pt])
(define current-parent (car subtree))
(define current-children (cdr subtree))
(if (member pagenode (map topmost-node current-children))
(if (memq pagenode (map topmost-node current-children))
current-parent
(ormap (λ(st) (loop pagenode st)) (filter subtree? current-children))))))
(if (eq? result (car pt))
(and allow-root? result)
result))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (parent 'three test-pagetree) 'two)
@ -141,7 +145,7 @@
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))
(and pt p
(let ([pagenode (->pagenode p)])
(if (equal? pagenode (car pt))
(if (eq? pagenode (car pt))
(map (λ(x) (if (list? x) (car x) x)) (cdr pt))
(ormap (λ(x) (children pagenode x)) (filter list? pt))))))
@ -171,7 +175,7 @@
(define+provide/contract (pagetree->list pt)
(pagetree? . -> . pagenodes?)
; use cdr to get rid of root tag at front
(cdr (flatten pt)))
(flatten (cdr pt)))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
@ -182,10 +186,11 @@
#;(symbol? pagenodeish? pagetree? . -> . pagenodes?)
(and pt pnish
(let* ([pagenode (->pagenode pnish)]
[proc (if (equal? side 'left) takef takef-right)]
[proc (if (eq? side 'left) takef takef-right)]
[pagetree-nodes (pagetree->list pt)]
[in-tree? (member pagenode pagetree-nodes)]
[result (and in-tree? (proc pagetree-nodes (λ(x) (not (equal? pagenode x)))))])
;; using `in-pagetree?` would require another flattening
[in-tree? (memq pagenode pagetree-nodes)]
[result (and in-tree? (proc pagetree-nodes (λ(x) (not (eq? pagenode x)))))])
(and (not (empty? result)) result))))
(module-test-internal
@ -247,4 +252,4 @@
(define+provide/contract (in-pagetree? pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . boolean?)
(->boolean (and pnish (member pnish (pagetree->list pt)))))
(and pnish (memq pnish (pagetree->list pt)) #t))

@ -0,0 +1,8 @@
#lang racket/base
(require "private/main-base.rkt")
(define+provide-module-begin-in-mode world:mode-preproc)
(module reader racket/base
(require pollen/private/reader-base)
(define+provide-reader-in-mode world:mode-preproc))

@ -0,0 +1,79 @@
#lang racket/base
(require "file-utils.rkt" "../world.rkt" "project.rkt" file/cache racket/file sugar/coerce compiler/cm)
(provide (all-defined-out))
(define (paths->key source-path [template-path #f])
;; key is list of file + mod-time pairs, use #f for missing
(define path-strings (append (list source-path)
;; if template has a source file, track that instead
(append (list (and template-path (or (get-source template-path) template-path)))
;; is either list of files or (list #f)
(->list (get-directory-require-files source-path)))))
;; can't use relative paths for cache keys because source files include `here-path` which is absolute.
;; problem is that cache could appear valid on another filesystem (based on relative pathnames & mod dates)
;; but would actually be invalid (because the `here-path` names are wrong).
(define poly-flag (and (has-inner-poly-ext? source-path) (world:current-poly-target)))
(define pollen-env (getenv world:env-name))
(define path+mod-time-pairs
(map (λ(ps) (and ps (let ([cp (->complete-path ps)])
(cons (path->string cp) (with-handlers ([exn:fail? (λ _ 0)])
(file-or-directory-modify-seconds cp)))))) path-strings))
(list* pollen-env poly-flag path+mod-time-pairs))
(define (key->source-path key)
(car (caddr key)))
(require sugar/test)
(module-test-internal
(define ps "/users/nobody/project/source.html.pm")
(check-equal? (key->source-path (paths->key ps)) ps))
(define-namespace-anchor cache-utils-module-ns)
(define (path->hash path)
;; new namespace forces dynamic-require to re-instantiate 'path'
;; otherwise it gets cached in current namespace.
(define drfs (get-directory-require-files path))
(for-each managed-compile-zo (or drfs null))
(define path-dir (dirname path))
(apply hash
(let ([doc-key (world:current-main-export)]
[meta-key (world:current-meta-export)])
(parameterize ([current-namespace (make-base-namespace)]
[current-directory path-dir])
;; I monkeyed around with using the metas submodule to pull out the metas (for speed)
;; but in practice most files get their doc requested too.
;; so it's just simpler to get both at once and be done with it.
;; the savings of avoiding two cache fetches at the outset outweighs
;; the benefit of not reloading doc when you just need metas.
(namespace-attach-module (namespace-anchor->namespace cache-utils-module-ns) 'pollen/world) ; brings in params
(list doc-key (dynamic-require path doc-key) meta-key (dynamic-require path meta-key))))))
(define (my-make-directory* dir)
(let-values ([(base name dir?) (split-path dir)])
(when (and (path? base) (not (directory-exists? base)))
(my-make-directory* base))
(unless (directory-exists? dir)
(with-handlers ([exn:fail:filesystem:exists? void])
(make-directory dir)))))
(define (make-cache-dirs path)
(define path-dir (dirname path))
(define cache-dir (build-path path-dir (world:current-cache-dir-name)))
(define private-cache-dir (build-path cache-dir "private"))
(my-make-directory* private-cache-dir) ; will also make cache-dir, if needed
(values cache-dir private-cache-dir))
(define (cache-ref! key path-hash-thunk)
(define path (key->source-path key))
(define-values (cache-dir private-cache-dir) (make-cache-dirs path))
(define-values (path-dir path-filename _) (split-path path))
(define dest-file (build-path cache-dir (format "~a.rktd" path-filename)))
(cache-file dest-file
#:exists-ok? #t
key
private-cache-dir
(λ _
(write-to-file (path-hash-thunk) dest-file #:exists 'replace))
#:max-cache-size (world:current-compile-cache-max-size))
(file->value dest-file))

@ -1,5 +1,5 @@
#lang racket/base
(require pollen/world pollen/render racket/file racket/path sugar/coerce pollen/file pollen/pagetree racket/string racket/list racket/vector racket/cmdline)
(require pollen/world pollen/render racket/file racket/path sugar/coerce "file-utils.rkt" pollen/pagetree racket/string racket/list racket/vector racket/cmdline)
;; The use of dynamic-require throughout this file is intentional:
;; this way, low-dependency raco commands (like "version") are faster.
@ -61,11 +61,11 @@ publish [dir] [dest] copy project in dir to dest without source files
(warning: overwrites existing dest dir)
setup preload cache
reset reset cache
version print the version (~a)" (world:current-server-port) (world:current-pollen-version))))
version print the version (~a)" (world:current-server-port) world:version)))
(define (handle-version)
(displayln (world:current-pollen-version)))
(displayln world:version))
(define (handle-reset directory-maybe)
@ -111,10 +111,10 @@ version print the version (~a)" (world:current-server-port) (worl
[else
(displayln (format "rendering preproc & pagetree files in directory ~a" dir))
preprocs-and-static-pagetrees])))
(apply render-batch batch-to-render)))
(apply render* batch-to-render)))
(begin ; first arg is a file
(displayln (format "rendering ~a" (string-join (map ->string path-args) " ")))
(apply render-batch path-args)))))
(apply render* path-args)))))
(define (handle-start directory-maybe [port #f])
(when (not (directory-exists? directory-maybe))
@ -122,7 +122,7 @@ version print the version (~a)" (world:current-server-port) (worl
(parameterize ([world:current-project-root directory-maybe]
[world:current-server-port (or port world:default-port)])
(displayln "Starting project server ...")
((dynamic-require 'pollen/server 'start-server))))
((dynamic-require 'pollen/private/project-server 'start-server))))
(define (handle-publish directory-maybe rest-args arg-command-name)

@ -0,0 +1,4 @@
#lang racket/base
(require "../world.rkt" sugar/file sugar/coerce sugar/test)
(provide (all-defined-out))

@ -1,21 +1,21 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(require racket/contract racket/path)
(require (only-in racket/path filename-extension))
(require "world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test)
(require racket/path)
(require "../world.rkt" sugar/define sugar/file sugar/string sugar/coerce sugar/test)
;; because it comes up all the time
(define+provide/contract (dirname path)
(coerce/path? . -> . path?)
(define+provide (dirname path)
;(coerce/path? . -> . path?)
(define-values (dir name dir?) (split-path path))
dir)
(define+provide/contract (find-upward-from starting-path filename-to-find
[exists-proc file-exists?])
(define+provide (find-upward-from starting-path filename-to-find
[exists-proc file-exists?])
;; use exists-proc to permit less strict matching.
;; for instance, maybe it's ok to find the source for the path.
((coerce/path? coerce/path?)((path? . -> . any/c)) . ->* . (or/c #f path?))
;((coerce/path? coerce/path?)((path? . -> . any/c)) . ->* . (or/c #f path?))
(parameterize ([current-directory (dirname (->complete-path starting-path))])
(let loop ([dir (current-directory)][path filename-to-find])
(and dir ; dir is #f when it hits the top of the filesystem
@ -27,11 +27,11 @@
;; for files like svg that are not source in pollen terms,
;; but have a textual representation separate from their display.
(define+provide/contract (sourceish? x)
(any/c . -> . coerce/boolean?)
(define+provide (sourceish? x)
;(any/c . -> . coerce/boolean?)
(define sourceish-extensions (list "svg"))
(with-handlers ([exn:fail? (λ(e) #f)])
(member (get-ext x) sourceish-extensions)))
(and (member (get-ext x) sourceish-extensions) #t)))
(module-test-external
(check-true (sourceish? "foo.svg"))
@ -40,8 +40,8 @@
;; compare directories by their exploded path elements,
;; not by equal?, which will give wrong result if no slash on the end
(define+provide/contract (directories-equal? dirx diry)
(coerce/path? coerce/path? . -> . coerce/boolean?)
(define+provide (directories-equal? dirx diry)
;(coerce/path? coerce/path? . -> . coerce/boolean?)
(equal? (explode-path dirx) (explode-path diry)))
(module-test-external
@ -49,31 +49,30 @@
(check-false (directories-equal? "/Users/MB/foo" "Users/MB/foo")))
;; helper function for pagetree
;; make paths absolute to test whether files exist,
;; then convert back to relative
(define+provide/contract (visible? path)
(coerce/path? . -> . coerce/boolean?)
(not ((->string path) . starts-with? . ".")))
(define (paths? x) (and (list? x) (andmap path? x)))
(define (complete-paths? x) (and (list? x) (andmap complete-path? x)))
(define+provide/contract (visible-files dir)
(pathish? . -> . paths?)
(filter visible?
(map (λ(p) (find-relative-path dir p))
(filter file-exists?
(directory-list dir #:build? #t)))))
(define+provide (path-visible? path)
;; make paths absolute to test whether files exist,
;; then convert back to relative
(not (regexp-match #rx"^\\." (path->string path))))
(define+provide (visible-files dir)
(let ([dir (->path dir)])
(filter path-visible?
(map (λ(p) (find-relative-path dir p))
(filter file-exists?
(directory-list dir #:build? #t))))))
(define+provide/contract (escape-last-ext x [escape-char (world:current-extension-escape-char)])
((pathish?) (char?) . ->* . coerce/path?)
(define+provide (escape-last-ext x [escape-char (world:current-extension-escape-char)])
;((pathish?) (char?) . ->* . coerce/path?)
;; if x has a file extension, reattach it with the escape char
(define current-ext (get-ext x))
(if current-ext
(format "~a~a~a" (->string (remove-ext x)) escape-char current-ext)
x))
(->path
(if current-ext
(format "~a~a~a" (->string (remove-ext x)) escape-char current-ext)
x)))
(module-test-external
(require sugar/coerce)
@ -84,25 +83,26 @@
(define second cadr)
(define third caddr)
(define (last x) (car (reverse x)))
(define+provide/contract (unescape-ext x [escape-char (world:current-extension-escape-char)])
((coerce/string?) (char?) . ->* . coerce/path?)
(define+provide (unescape-ext x [escape-char (world:current-extension-escape-char)])
;((coerce/string?) (char?) . ->* . coerce/path?)
;; if x has an escaped extension, unescape it.
(define-values (base name dir?) (split-path x))
(cond
[dir? x]
[else
(define x-parts (explode-path x))
(define filename (last x-parts))
(define escaped-extension-pat (pregexp (format "(.*)[~a](\\S+)$" escape-char)))
(define results (regexp-match escaped-extension-pat (->string filename)))
(if results
(let* ([filename-without-ext (second results)]
[ext (third results)]
[new-filename (add-ext filename-without-ext ext)])
(if (eq? base 'relative)
new-filename
(build-path base new-filename)))
x)]))
(->path
(cond
[dir? x]
[else
(define x-parts (explode-path x))
(define filename (last x-parts))
(define escaped-extension-pat (pregexp (format "(.*)[~a](\\S+)$" escape-char)))
(define results (regexp-match escaped-extension-pat (->string filename)))
(if results
(let* ([filename-without-ext (second results)]
[ext (third results)]
[new-filename (add-ext filename-without-ext ext)])
(if (eq? base 'relative)
new-filename
(build-path base new-filename)))
x)])))
(module-test-external
@ -152,29 +152,27 @@
(with-syntax ([world:current-stem-source-ext (format-id stx "world:current-~a-source-ext" #'stem)]
[stem-source? (format-id stx "~a-source?" #'stem)]
[get-stem-source (format-id stx "get-~a-source" #'stem)]
[has-stem-source? (format-id stx "has-~a-source?" #'stem)]
[has/is-stem-source? (format-id stx "has/is-~a-source?" #'stem)]
[->stem-source-path (format-id stx "->~a-source-path" #'stem)]
[->stem-source-paths (format-id stx "->~a-source-paths" #'stem)]
[->stem-source+output-paths (format-id stx "->~a-source+output-paths" #'stem)])
#`(begin
;; does file have particular extension
(define+provide (stem-source? x)
(->boolean (and (pathish? x) (has-ext? (->path x) (world:current-stem-source-ext)))))
(define+provide/contract (stem-source? x)
(any/c . -> . boolean?)
(and (pathish? x) (has-ext? (->path x) (world:current-stem-source-ext)) #t))
;; non-theoretical: want the first possible source that exists in the filesystem
(define+provide (get-stem-source x)
(and (pathish? x)
(let ([source-paths (->stem-source-paths (->path x))])
(and source-paths (ormap (λ(sp) (and (file-exists? sp) sp)) source-paths)))))
;; does the source-ified version of the file exist
(define+provide (has-stem-source? x)
(->boolean (get-stem-source x)))
(define+provide/contract (get-stem-source x)
(coerce/path? . -> . (or/c #f path?))
(let ([source-paths (->stem-source-paths x)])
(and source-paths (for/first ([sp (in-list source-paths)]
#:when (file-exists? sp))
sp))))
;; it's a file-ext source file, or a file that's the result of a file-ext source
(define+provide (has/is-stem-source? x)
(->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? has-stem-source?)))))
(->boolean (and (pathish? x) (ormap (λ(proc) (proc (->path x))) (list stem-source? get-stem-source)))))
;; get first possible source path (does not check filesystem)
(define+provide/contract (->stem-source-path x)
@ -183,8 +181,7 @@
(and paths (car paths)))
;; get all possible source paths (does not check filesystem)
(define+provide/contract (->stem-source-paths x)
(pathish? . -> . (or/c #f (non-empty-listof path?)))
(define (->stem-source-paths x)
(define results (if (stem-source? x)
(list x) ; already has the source extension
#,(if (eq? (syntax->datum #'stem) 'scribble)
@ -208,91 +205,61 @@
(and results (map ->path results)))
;; coerce either a source or output file to both
(define+provide/contract (->stem-source+output-paths path)
(pathish? . -> . (values path? path?))
(define+provide (->stem-source+output-paths path)
;(pathish? . -> . (values path? path?))
;; get the real source path if available, otherwise a theoretical path
(values (->complete-path (or (get-stem-source path) (->stem-source-path path)))
(->complete-path (->output-path path))))))]))
(make-source-utility-functions preproc)
(define+provide/contract (->source+output-paths source-or-output-path)
(complete-path? . -> . (values complete-path? complete-path?))
(define+provide (->source+output-paths source-or-output-path)
;(complete-path? . -> . (values complete-path? complete-path?))
;; file-proc returns two values, but ormap only wants one
(define file-proc (ormap (λ(test file-proc) (and (test source-or-output-path) file-proc))
(list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?)
(list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths ->scribble-source+output-paths ->markdown-source+output-paths ->template-source+output-paths)))
(list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? )
(list ->null-source+output-paths ->preproc-source+output-paths ->markup-source+output-paths ->scribble-source+output-paths ->markdown-source+output-paths )))
(file-proc source-or-output-path))
(module-test-external
(module-test-internal
(require sugar/coerce)
(check-true (preproc-source? "foo.pp"))
(check-false (preproc-source? "foo.bar"))
(check-false (preproc-source? #f))
(check-equal? (->preproc-source-paths (->path "foo.pp")) (list (->path "foo.pp")))
(check-equal? (->preproc-source-paths (->path "foo.html")) (list (->path "foo.html.pp") (->path "foo_html.pp")
(->path "foo.poly.pp") (->path "foo_poly.pp")))
(check-equal? (->preproc-source-paths "foo") (list (->path "foo.pp")))
(check-equal? (->preproc-source-paths 'foo) (list (->path "foo.pp")))
(check-equal? (->preproc-source-path (->path "foo.pp")) (->path "foo.pp"))
(check-equal? (->preproc-source-path (->path "foo.html")) (->path "foo.html.pp"))
(check-equal? (->preproc-source-path "foo") (->path "foo.pp"))
(check-equal? (->preproc-source-path 'foo) (->path "foo.pp")))
(check-equal? (->preproc-source-paths 'foo) (list (->path "foo.pp"))))
(make-source-utility-functions null)
(make-source-utility-functions pagetree)
(module-test-external
(require pollen/world)
(check-true (pagetree-source? (format "foo.~a" (world:current-pagetree-source-ext))))
(check-false (pagetree-source? (format "~a.foo" (world:current-pagetree-source-ext))))
(check-false (pagetree-source? #f)))
(make-source-utility-functions markup)
(module-test-external
(module-test-internal
(require sugar/coerce)
(check-true (markup-source? "foo.pm"))
(check-false (markup-source? "foo.p"))
(check-false (markup-source? #f))
(check-equal? (->markup-source-paths (->path "foo.pm")) (list (->path "foo.pm")))
(check-equal? (->markup-source-paths (->path "foo.html")) (list (->path "foo.html.pm") (->path "foo_html.pm")
(->path "foo.poly.pm") (->path "foo_poly.pm")))
(check-equal? (->markup-source-paths "foo") (list (->path "foo.pm")))
(check-equal? (->markup-source-paths 'foo) (list (->path "foo.pm")))
(check-equal? (->markup-source-path (->path "foo.pm")) (->path "foo.pm"))
(check-equal? (->markup-source-path (->path "foo.html")) (->path "foo.html.pm"))
(check-equal? (->markup-source-path "foo") (->path "foo.pm"))
(check-equal? (->markup-source-path 'foo) (->path "foo.pm")))
(check-equal? (->markup-source-paths 'foo) (list (->path "foo.pm"))))
(make-source-utility-functions markdown)
(module-test-external
(module-test-internal
(require sugar/coerce)
(check-true (markdown-source? "foo.html.pmd"))
(check-false (markdown-source? "foo.html"))
(check-false (markdown-source? #f))
(check-equal? (->markdown-source-paths (->path "foo.pmd")) (list (->path "foo.pmd")))
(check-equal? (->markdown-source-paths (->path "foo.html")) (list (->path "foo.html.pmd") (->path "foo_html.pmd")
(->path "foo.poly.pmd") (->path "foo_poly.pmd")))
(->path "foo.poly.pmd") (->path "foo_poly.pmd")))
(check-equal? (->markdown-source-paths "foo") (list (->path "foo.pmd")))
(check-equal? (->markdown-source-paths 'foo) (list (->path "foo.pmd")))
(check-equal? (->markdown-source-path (->path "foo.pmd")) (->path "foo.pmd"))
(check-equal? (->markdown-source-path (->path "foo.html")) (->path "foo.html.pmd"))
(check-equal? (->markdown-source-path "foo") (->path "foo.pmd"))
(check-equal? (->markdown-source-path 'foo) (->path "foo.pmd")))
(check-equal? (->markdown-source-paths 'foo) (list (->path "foo.pmd"))))
(make-source-utility-functions template)
(module-test-external
(check-true (template-source? "foo.html.pt"))
(check-false (template-source? "foo.html"))
(check-false (template-source? #f)))
(make-source-utility-functions scribble)
(define/contract+provide (get-source path)
(define+provide/contract (get-source path)
(coerce/path? . -> . (or/c #f path?))
(ormap (λ(proc) (proc path)) (list get-markup-source get-markdown-source get-preproc-source get-null-source get-scribble-source)))
@ -302,7 +269,7 @@
(define+provide/contract (->output-path x)
(coerce/path? . -> . coerce/path?)
(cond
[(or (markup-source? x) (preproc-source? x) (null-source? x) (markdown-source? x) (template-source? x))
[(or (markup-source? x) (preproc-source? x) (null-source? x) (markdown-source? x))
(define output-path (unescape-ext (remove-ext x)))
(if (has-poly-ext? output-path)
(add-ext (remove-ext output-path) (or (world:current-poly-target) (car (world:current-poly-targets))))
@ -310,28 +277,13 @@
[(scribble-source? x) (add-ext (remove-ext x) 'html)]
[else x]))
(module-test-external
(require sugar/coerce)
(check-equal? (->output-path (->path "foo.pmap")) (->path "foo.pmap"))
(check-equal? (->output-path "foo.html") (->path "foo.html"))
(check-equal? (->output-path 'foo.html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo.html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo.xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo.barml.p) (->path "foo.barml"))
(check-equal? (->output-path 'foo_html.p) (->path "foo.html"))
(check-equal? (->output-path (->path "/Users/mb/git/foo_html.p")) (->path "/Users/mb/git/foo.html"))
(check-equal? (->output-path "foo_xml.p") (->path "foo.xml"))
(check-equal? (->output-path 'foo_barml.p) (->path "foo.barml"))
(check-equal? (->output-path "foo.poly.pm") (->path "foo.html"))
(check-equal? (->output-path "foo_poly.pp") (->path "foo.html")))
(define+provide/contract (project-files-with-ext ext)
(coerce/symbol? . -> . complete-paths?)
(map ->complete-path (filter (λ(i) (has-ext? i ext)) (directory-list (world:current-project-root)))))
(define+provide (racket-source? x)
(define+provide (project-files-with-ext ext)
;(coerce/symbol? . -> . complete-paths?)
(map ->complete-path (filter (λ(i) (has-ext? i (->symbol ext))) (directory-list (world:current-project-root)))))
(define (racket-source? x)
(->boolean (and (pathish? x) (has-ext? (->path x) 'rkt))))
@ -354,7 +306,6 @@
preproc-source?
markup-source?
markdown-source?
template-source?
pagetree-source?
scribble-source?
null-source?

@ -3,5 +3,5 @@
(define (get-language-info top-here-path)
(λ(key default)
(case key
[(configure-runtime) `(#(pollen/runtime-config configure ,top-here-path))]
[(configure-runtime) `(#(pollen/private/runtime-config configure ,top-here-path))]
[else default])))

@ -1,25 +1,7 @@
#lang racket/base
(require (for-syntax racket/base syntax/strip-context racket/syntax pollen/world racket/list) pollen/decode pollen/pagetree racket/list pollen/world markdown)
(provide (all-defined-out) (all-from-out pollen/world))
(define-for-syntax (split-metas tree)
(define (meta-matcher x) ; meta has form (define-meta key value)
(and (list? x) (>= (length x) 3) (eq? (first x) (world:current-define-meta-name))))
(define matches empty)
(define rest
(let loop ([x tree])
(cond
[(meta-matcher x)
(set! matches (cons x matches))
(loop empty)]
[(list? x)
(define-values (new-matches rest) (partition meta-matcher x))
(set! matches (append new-matches matches))
(map loop rest)]
[else x])))
(let ([meta-key second][meta-value third])
(values (map meta-key matches) (map meta-value matches) rest)))
(require (for-syntax racket/base syntax/strip-context racket/syntax "../world.rkt" "split-metas.rkt")
"to-string.rkt" "../pagetree.rkt" "../world.rkt") ; need world here to resolve PARSER-MODE-ARG later
(provide (all-defined-out))
(define-syntax-rule (define+provide-module-begin-in-mode PARSER-MODE-ARG)
(begin
@ -28,39 +10,45 @@
(define-syntax (pollen-module-begin stx)
(syntax-case stx ()
[(_ EXPR (... ...))
(let-values ([(meta-keys meta-values expr-without-metas) (split-metas (syntax->datum #'(EXPR (... ...))))])
(let-values ([(meta-keys meta-values expr-without-metas) (split-metas (syntax->datum #'(EXPR (... ...))) (world:current-define-meta-name))])
(with-syntax ([(EXPR-WITHOUT-METAS (... ...)) (datum->syntax #'(EXPR (... ...)) expr-without-metas)]
[(KEY (... ...)) (datum->syntax #'(EXPR (... ...)) meta-keys)]
[(VALUE (... ...)) (datum->syntax #'(EXPR (... ...)) meta-values)]
[METAS (format-id #'(EXPR (... ...)) "~a" (world:current-meta-export))]
[META-MOD (format-symbol "~a" (world:current-meta-export))]
[ROOT (format-id #'(EXPR (... ...)) "~a" (world:current-main-root-node))]
[NEWLINE (datum->syntax #'(EXPR (... ...)) (world:current-newline))]
[MODE-PAGETREE (datum->syntax #'(EXPR (... ...)) world:mode-pagetree)]
[MODE-MARKUP (datum->syntax #'(EXPR (... ...)) world:mode-markup)]
[MODE-MARKDOWN (datum->syntax #'(EXPR (... ...)) world:mode-markdown)]
[DOC (format-id #'(EXPR (... ...)) "~a" (world:current-main-export))]
[DOC-RAW (generate-temporary)]); prevents conflicts with other imported Pollen sources
(replace-context #'(EXPR (... ...))
#'(#%module-begin
(module META-MOD racket/base
(provide (all-defined-out))
(define METAS (apply hash (append (list 'KEY VALUE) (... ...)))))
(define METAS (apply hasheq (append (list 'KEY VALUE) (... ...)))))
(module inner pollen/doclang-raw
(module inner pollen/private/doclang-raw
DOC-RAW ; positional arg for doclang-raw that sets name of export.
(require pollen/top pollen/world)
(require (submod ".." META-MOD))
(provide (all-defined-out) #%top (all-from-out pollen/world (submod ".." META-MOD)))
(provide (all-defined-out) #%top (all-from-out (submod ".." META-MOD)))
EXPR-WITHOUT-METAS (... ...))
(require 'inner)
(define DOC
(let* ([parser-mode-undefined? (procedure? inner:parser-mode)] ; if undefined, #%top makes it a procedure
[parser-mode (if parser-mode-undefined? PARSER-MODE-ARG inner:parser-mode)]
[proc (cond
[(eq? parser-mode world:mode-pagetree) (λ xs (decode-pagetree xs))]
[(eq? parser-mode world:mode-markup) root] ; if `root` undefined, it becomes a default tag function
[(eq? parser-mode world:mode-markdown)
(λ xs (apply root (apply (compose1 parse-markdown string-append) (map to-string xs))))]
[else ; for preprocessor output, just make a string
(λ xs (apply string-append (map to-string xs)))])]
[(eq? parser-mode 'MODE-PAGETREE) decode-pagetree]
[(eq? parser-mode 'MODE-MARKUP) (λ(xs) (apply ROOT xs))] ; if `root` undefined, it becomes a default tag function
[(eq? parser-mode 'MODE-MARKDOWN)
(λ(xs) (apply ROOT ((dynamic-require 'markdown 'parse-markdown) (apply string-append (map to-string xs)))))]
[else (λ(xs) (apply string-append (map to-string xs)))])] ; string output for preprocessor
;; drop leading newlines, as they're often the result of `defines` and `requires`
[doc-elements (dropf DOC-RAW (λ(ln) (equal? ln "\n")))])
(apply proc doc-elements)))
[doc-elements (or (memf (λ(ln) (not (equal? ln NEWLINE))) DOC-RAW) null)])
(proc doc-elements)))
(provide DOC METAS (except-out (all-from-out 'inner) DOC-RAW #%top))))))])))) ; hide internal exports

@ -0,0 +1,53 @@
#lang racket/base
(require "../world.rkt" "../file.rkt" racket/file "cache-utils.rkt" "debug.rkt" racket/path racket/place sugar/list)
(define (preheat-cache [starting-dir (world:current-project-root)])
(when (or (not (path-string? starting-dir)) (not (directory-exists? starting-dir)))
(error 'preheat-cache (format "~a is not a directory" starting-dir)))
(define max-places 8) ; number of parallel processes to spawn at a time
(define paths-that-should-be-cached (for/list ([path (in-directory starting-dir)]
#:when (or (preproc-source? path)
(markup-source? path)
(markdown-source? path)
(pagetree-source? path)))
path))
;; if a file is already in the cache, no need to hit it again.
;; this allows partially completed preheat jobs to resume.
(define uncached-paths (filter
(λ(path)
;; #t = not cached; #f = already cached
;; seems like it would be slow to load cache.rktd but it's not.
(define-values (_ private-cache-dir) (make-cache-dirs path))
(define cache-db-file (build-path private-cache-dir "cache.rktd"))
(cond
[(not (file-exists? cache-db-file)) #t]
[else (define cache-db (file->value cache-db-file))
(not (hash-has-key? cache-db (paths->key path)))])) paths-that-should-be-cached))
;; compile a path inside a place (= parallel processing)
(define (path-into-place path)
(message (format "caching: ~a" (find-relative-path starting-dir path)))
(define p (place ch
(define path (place-channel-get ch))
(define-values (path-dir path-name _) (split-path path))
(message (format "compiling: ~a" path-name))
;; use #f to signal compile error. Otherwise allow errors to pass.
(define result (with-handlers ([exn:fail? (λ _ (message (format "compile failed: ~a" path-name)) #f)])
(path->hash path)))
(place-channel-put ch result)))
(place-channel-put p path)
p)
;; compile the paths in groups, so they can be incrementally saved.
;; that way, if there's a failure, the progress is preserved.
;; but the slowest file in a group will prevent further progress.
(for ([path-group (in-list (slice-at uncached-paths max-places))])
(define path-places (map path-into-place path-group))
(for ([path (in-list path-group)]
[ppl (in-list path-places)])
(define result (place-channel-get ppl))
(when result ; #f is used to signal compile error
(cache-ref! (paths->key path) (λ _ result))))))

@ -5,7 +5,7 @@
(require web-server/http/request-structs)
(require web-server/http/response-structs)
(require 2htdp/image)
(require "world.rkt" "render.rkt" sugar txexpr "file.rkt" "debug.rkt" "pagetree.rkt" "cache.rkt")
(require "../world.rkt" "../render.rkt" sugar txexpr "file-utils.rkt" "debug.rkt" "../pagetree.rkt" "../cache.rkt")
(module+ test (require rackunit))
@ -203,7 +203,7 @@
(define (ineligible-path? x) (member x (world:current-paths-excluded-from-dashboard)))
(define directory-pagetree (with-handlers ([exn:fail:contract? (λ _ (directory->pagetree dashboard-dir))])
(cached-require (->path dashboard-ptree) (world:current-main-export))))
(cached-doc (->path dashboard-ptree))))
(define project-paths (filter-not ineligible-path? (map ->path (pagetree->list directory-pagetree))))

@ -3,11 +3,11 @@
(require racket/list
web-server/servlet-env
web-server/dispatch)
(require "server-routes.rkt"
(require "project-server-routes.rkt"
"debug.rkt"
"world.rkt"
"file.rkt"
"cache.rkt")
"../world.rkt"
"../file.rkt"
"../cache.rkt")
(provide start-server)
@ -19,7 +19,7 @@
[((string-arg) ... "out" (string-arg)) route-out]
[else route-default]))
(message (format "Welcome to Pollen ~a" (world:current-pollen-version)) (format "(Racket ~a)" (version)))
(message (format "Welcome to Pollen ~a" world:version) (format "(Racket ~a)" (version)))
(message (format "Project root is ~a" (world:current-project-root)))
(define server-name (format "http://localhost:~a" (world:current-server-port)))

@ -0,0 +1,32 @@
#lang racket/base
(require sugar/define
sugar/coerce
"../world.rkt"
"file-utils.rkt")
(define+provide/contract (get-directory-require-files source-arg)
(pathish? . -> . (or/c #f (λ(xs) (and (list? xs) (andmap complete-path? xs)))))
(define source-path (->path source-arg))
(define require-filenames (list world:directory-require))
(define identity (λ(x) x))
(define possible-requires (filter identity (map (λ(f) (find-upward-from source-path f)) require-filenames)))
(and (pair? possible-requires) possible-requires))
(define+provide/contract (require+provide-directory-require-files here-arg #:provide [provide #t])
(pathish? . -> . list?)
(define here-path (->path here-arg))
(define (put-file-in-require-form file) `(file ,(path->string file)))
(define directory-require-files (get-directory-require-files here-path))
(if directory-require-files
(let ([files-in-require-form (map put-file-in-require-form directory-require-files)])
`(begin
(require ,@files-in-require-form)
,@(if provide
(list `(provide (all-from-out ,@files-in-require-form)))
null)))
'(begin)))
(define+provide (require-directory-require-files here-path)
(require+provide-directory-require-files here-path #:provide #f))

@ -1,6 +1,6 @@
#lang racket/base
(require racket/syntax syntax/strip-context racket/class)
(require (only-in scribble/reader make-at-reader) pollen/world pollen/project racket/list)
(require (only-in scribble/reader make-at-reader) pollen/world "project.rkt" racket/list)
(provide define+provide-reader-in-mode (all-from-out pollen/world))
@ -51,12 +51,12 @@
(prefix-out inner: parser-mode)) ; avoids conflicts with importing modules
DIRECTORY-REQUIRES
SOURCE-LINE ...)
(require (submod pollen/runtime-config show) 'POLLEN-MOD)
(require (submod pollen/private/runtime-config show) 'POLLEN-MOD)
(provide (all-from-out 'POLLEN-MOD))
(show DOC inner:parser-mode HERE-PATH))))) ; HERE-PATH acts as "local" runtime config
(syntax-property post-parser-syntax
'module-language
`#(pollen/language-info get-language-info ,reader-here-path)))) ; reader-here-path acts as "top" runtime config
`#(pollen/private/language-info get-language-info ,reader-here-path)))) ; reader-here-path acts as "top" runtime config
(define-syntax-rule (define+provide-reader-in-mode mode)
(begin
@ -85,7 +85,7 @@
(my-make-scribble-inside-lexer #:command-char my-command-char)]
[else default])]
[(drracket:toolbar-buttons)
(define my-make-drracket-buttons (dynamic-require 'pollen/drracket-buttons 'make-drracket-buttons))
(define my-make-drracket-buttons (dynamic-require 'pollen/private/drracket-buttons 'make-drracket-buttons))
(my-make-drracket-buttons my-command-char)])]
[else default]))))
(provide (rename-out [custom-read read] [custom-read-syntax read-syntax]) get-info)))

@ -15,6 +15,7 @@
(if (or (eq? parser-mode world:mode-preproc)
(eq? parser-mode world:mode-template))
(display doc)
;; OK to use dynamic-require because runtime-config itself is dynamic-required
(print (with-handlers ([exn:fail? (λ(exn) ((error '|pollen markup error| ((dynamic-require 'racket/string 'string-join) (cdr ((dynamic-require 'racket/string 'string-split) (exn-message exn) ": ")) ": "))))])
((dynamic-require 'txexpr 'validate-txexpr) doc)))))))

Before

Width:  |  Height:  |  Size: 163 B

After

Width:  |  Height:  |  Size: 163 B

Before

Width:  |  Height:  |  Size: 218 B

After

Width:  |  Height:  |  Size: 218 B

Before

Width:  |  Height:  |  Size: 891 B

After

Width:  |  Height:  |  Size: 891 B

@ -0,0 +1,21 @@
#lang racket/base
(provide (all-defined-out))
(define (split-metas tree meta-key)
(define matches null)
(define (meta? x) ; meta has form (define-meta key value)
(and (list? x) (>= (length x) 3) (eq? (car x) meta-key)))
(define (non-meta?/gather x)
(or (not (meta? x))
(and (set! matches (cons x matches)) #f)))
(define rest
(let loop ([x (if (list? tree) tree (list tree))])
(if (list? x)
(map loop (filter non-meta?/gather x))
x)))
(let ([meta-key cadr][meta-value caddr])
(values (map meta-key matches) (map meta-value matches) rest)))

@ -0,0 +1,9 @@
#lang racket/base
(provide (all-defined-out))
(define (to-string x)
(cond
[(string? x) x]
[(or (null? x) (void? x)) ""]
[(or (symbol? x) (number? x) (path? x) (char? x)) (format "~a" x)]
[else (format "~v" x)]))

@ -0,0 +1,3 @@
#lang racket/base
(provide version)
(define version "1.0")

@ -0,0 +1,34 @@
#lang racket/base
(provide (all-defined-out))
(define (whitespace-base x #:nbsp-is-white? nbsp-white?)
(define pat (pregexp (format "^[\\s~a]+$" (if nbsp-white? #\u00A0 ""))))
(and (let loop ([x x])
(cond
[(string? x) (or (zero? (string-length x)) (regexp-match pat x))] ; empty string is deemed whitespace
[(symbol? x) (loop (symbol->string x))]
[(pair? x) (andmap loop x)]
[(vector? x) (loop (vector->list x))]
[else #f]))
#t))
(define (whitespace? x)
(whitespace-base x #:nbsp-is-white? #f))
(define not-whitespace? (λ(x) (not (whitespace? x))))
(define (whitespace/nbsp? x)
(whitespace-base x #:nbsp-is-white? #t))
(module+ test
(require rackunit racket/format)
(check-true (whitespace? " "))
(check-false (whitespace? (~a #\u00A0)))
(check-true (whitespace/nbsp? (~a #\u00A0)))
(check-true (whitespace/nbsp? (vector (~a #\u00A0))))
(check-false (whitespace? (format " ~a " #\u00A0)))
(check-true (whitespace/nbsp? (format " ~a " #\u00A0))))

@ -0,0 +1,8 @@
#lang racket/base
(require "private/main-base.rkt")
(define+provide-module-begin-in-mode world:mode-pagetree)
(module reader racket/base
(require pollen/private/reader-base)
(define+provide-reader-in-mode world:mode-pagetree))

@ -1,7 +1,15 @@
#lang racket/base
(require racket/file racket/path compiler/cm)
(require sugar/test sugar/define sugar/file)
(require "file.rkt" "cache.rkt" "debug.rkt" "pagetree.rkt" "project.rkt" "template.rkt" "rerequire.rkt" "world.rkt")
(require sugar/test sugar/define sugar/file sugar/coerce)
(require "private/file-utils.rkt"
"cache.rkt"
"private/debug.rkt"
"private/project.rkt"
"private/cache-utils.rkt"
"pagetree.rkt"
"template.rkt"
"private/rerequire.rkt"
"world.rkt")
;; used to track renders according to modification dates of component files
(define mod-date-hash (make-hash))
@ -11,20 +19,6 @@
(define (reset-mod-date-hash)
(set! mod-date-hash (make-hash)))
(module-test-internal
(check-pred hash? mod-date-hash))
;; using internal contracts to provide some extra safety (negligible performance hit)
(define/contract (valid-path-arg? x)
(any/c . -> . boolean?)
(or (equal? #f x) (complete-path? x)))
(define/contract (valid-path-args? x)
(any/c . -> . boolean?)
(and (list? x) (andmap valid-path-arg? x)))
(module-test-internal
(require racket/runtime-path)
@ -34,14 +28,6 @@
(define-values (sample-01 sample-02 sample-03) (apply values samples)))
(define/contract (path->mod-date-value path)
((or/c #f complete-path?) . -> . (or/c #f integer?))
(and path (file-exists? path) (file-or-directory-modify-seconds path)))
(module-test-internal
(check-false (path->mod-date-value (path->complete-path "garbage-path.zzz")))
(check-equal? (path->mod-date-value sample-01) (file-or-directory-modify-seconds sample-01)))
;; each key for mod-date-hash is a list of file / mod-date pairs (using pollen/cache keymaking function)
;; when a file is rendered, a new key is stored in the hash (with trivial value #t)
@ -58,7 +44,7 @@
(define (list-of-pathish? x) (and (list? x) (andmap pathish? x)))
(define/contract+provide (render-batch . xs)
(define+provide/contract (render* . xs)
(() #:rest list-of-pathish? . ->* . void?)
;; Why not just (map render ...)?
;; Because certain files will pass through multiple times (e.g., templates)
@ -66,64 +52,66 @@
;; Using reset-modification-dates is sort of like session control.
(reset-mod-date-hash)
(for-each (λ(x) ((if (pagetree-source? x)
render-pagetree
render-pagenodes
render-from-source-or-output-path) x)) xs))
(define/contract+provide (render-pagetree pagetree-or-path)
(define+provide/contract (render-pagenodes pagetree-or-path)
((or/c pagetree? pathish?) . -> . void?)
(define pagetree (if (pagetree? pagetree-or-path)
pagetree-or-path
(cached-require pagetree-or-path (world:current-main-export))))
(cached-doc pagetree-or-path)))
(parameterize ([current-directory (world:current-project-root)])
(for-each render-from-source-or-output-path (map ->complete-path (pagetree->list pagetree)))))
(define/contract+provide (render-from-source-or-output-path so-pathish)
(define+provide/contract (render-from-source-or-output-path so-pathish)
(pathish? . -> . void?)
(let ([so-path (->complete-path so-pathish)]) ; so-path = source or output path (could be either)
(cond
[(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?))
[(ormap (λ(test) (test so-path)) (list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source?))
(let-values ([(source-path output-path) (->source+output-paths so-path)])
(render-to-file-if-needed source-path #f output-path))]
[(pagetree-source? so-path) (render-pagetree so-path)]))
[(pagetree-source? so-path) (render-pagenodes so-path)]))
(void))
(define (validate-output-path op caller)
(unless op
(raise-argument-error caller "valid output path" op)))
(define/contract (render-needed? source-path template-path output-path)
(complete-path? (or/c #f complete-path?) complete-path? . -> . (or/c #f symbol?))
;; return symbol rather than boolean for extra debugging information
(cond
[(not (file-exists? output-path)) 'file-missing]
[(mod-date-missing-or-changed? source-path template-path) 'mod-key-missing-or-changed]
[(not (world:current-render-cache-active source-path)) 'render-cache-deactivated]
[else #f]))
(define/contract+provide (render-to-file-if-needed source-path [maybe-template-path #f] [maybe-output-path #f])
(define+provide/contract (render-to-file-if-needed source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?)
(define output-path (or maybe-output-path (->output-path source-path)))
(validate-output-path output-path 'render-to-file-if-needed)
(define template-path (or maybe-template-path (get-template-for source-path output-path)))
(when (render-needed? source-path template-path output-path)
(define render-needed?
(cond
[(not (file-exists? output-path)) 'file-missing]
[(mod-date-missing-or-changed? source-path template-path) 'mod-key-missing-or-changed]
[(not (world:current-render-cache-active source-path)) 'render-cache-deactivated]
[else #f]))
(when render-needed?
(render-to-file source-path template-path output-path)))
(define/contract+provide (render-to-file source-path [maybe-template-path #f] [maybe-output-path #f])
(define+provide/contract (render-to-file source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?)
(define output-path (or maybe-output-path (->output-path source-path)))
(validate-output-path output-path 'render-to-file)
(define template-path (or maybe-template-path (get-template-for source-path output-path)))
(define render-result (render source-path template-path output-path)) ; will either be string or bytes
(display-to-file render-result output-path #:exists 'replace
#:mode (if (string? render-result) 'text 'binary)))
(define/contract+provide (render source-path [maybe-template-path #f] [maybe-output-path #f])
(define+provide/contract (render source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . (or/c string? bytes?))
(define render-proc
(cond
[(ormap (λ(test render-proc) (and (test source-path) render-proc))
(list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source? has/is-template-source?)
(list render-null-source render-preproc-source render-markup-or-markdown-source render-scribble-source render-markup-or-markdown-source render-preproc-source))]
(list has/is-null-source? has/is-preproc-source? has/is-markup-source? has/is-scribble-source? has/is-markdown-source?)
(list render-null-source render-preproc-source render-markup-or-markdown-source render-scribble-source render-markup-or-markdown-source))]
[else (error (format "render: no rendering function found for ~a" source-path))]))
(define output-path (or maybe-output-path (->output-path source-path)))
@ -138,15 +126,15 @@
render-result)
(define/contract (render-null-source source-path . ignored-paths)
((complete-path?) #:rest any/c . ->* . bytes?)
(define (render-null-source source-path . ignored-paths)
;((complete-path?) #:rest any/c . ->* . bytes?)
;; All this does is copy the source. Hence, "null".
;; todo: add test to avoid copying if unnecessary (good idea in case the file is large)
(file->bytes source-path))
(define/contract (render-scribble-source source-path . ignored-paths)
((complete-path?) #:rest any/c . ->* . string?)
(define (render-scribble-source source-path . ignored-paths)
;((complete-path?) #:rest any/c . ->* . string?)
(define source-dir (dirname source-path))
(dynamic-rerequire source-path) ; to suppress namespace caching by dynamic-require below
(define scribble-render (dynamic-require 'scribble/render 'render))
@ -168,32 +156,33 @@
result)
(define/contract (render-preproc-source source-path . ignored-paths)
((complete-path?) #:rest any/c . ->* . (or/c string? bytes?))
(define (render-preproc-source source-path . ignored-paths)
;((complete-path?) #:rest any/c . ->* . (or/c string? bytes?))
(define source-dir (dirname source-path))
(time (parameterize ([current-directory (->complete-path source-dir)])
(render-through-eval `(begin (require pollen/cache)
(cached-require ,source-path ',(world:current-main-export)))))))
(cached-doc ,source-path))))))
(define/contract (render-markup-or-markdown-source source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?)(or/c #f complete-path?)) . ->* . (or/c string? bytes?))
(define (render-markup-or-markdown-source source-path [maybe-template-path #f] [maybe-output-path #f])
;((complete-path?) ((or/c #f complete-path?)(or/c #f complete-path?)) . ->* . (or/c string? bytes?))
(define source-dir (dirname source-path))
(define output-path (or maybe-output-path (->output-path source-path)))
(define template-path (or maybe-template-path (get-template-for source-path output-path)))
(when (not template-path)
(unless template-path
(raise-result-error 'render-markup-or-markdown-source "valid template path" template-path))
(render-from-source-or-output-path template-path) ; because template might have its own preprocessor source
(define expr-to-eval
`(begin
(require (for-syntax racket/base))
(require pollen/include-template pollen/cache pollen/debug pollen/pagetree)
(require pollen/private/include-template pollen/cache pollen/private/debug pollen/pagetree)
,(require-directory-require-files source-path)
(parameterize ([current-pagetree (make-project-pagetree ,(world:current-project-root))])
(let ([,(world:current-main-export) (cached-require ,(path->string source-path) ',(world:current-main-export))]
[,(world:current-meta-export) (cached-require ,(path->string source-path) ',(world:current-meta-export))])
(let ([,(world:current-main-export) (cached-doc ,(path->string source-path))]
[,(world:current-meta-export) (cached-metas ,(path->string source-path))])
(local-require pollen/template pollen/top)
(define here (metas->here ,(world:current-meta-export)))
(define here (path->pagenode
(or (select-from-metas ',(world:current-here-path-key) ,(world:current-meta-export)) 'unknown)))
(cond
[(bytes? ,(world:current-main-export)) ,(world:current-main-export)] ; if main export is binary, just pass it through
[else
@ -203,17 +192,17 @@
(render-through-eval expr-to-eval))))
(define/contract (templated-source? path)
(complete-path? . -> . boolean?)
(define (templated-source? path)
;(complete-path? . -> . boolean?)
(or (markup-source? path) (markdown-source? path)))
(define identity (λ(x) x))
(define/contract+provide (get-template-for source-path [maybe-output-path #f])
(define+provide/contract (get-template-for source-path [maybe-output-path #f])
((complete-path?)((or/c #f complete-path?)) . ->* . (or/c #f complete-path?))
(define (file-exists-or-has-source? p) ; p could be #f
(and p (ormap (λ(proc) (file-exists? (proc p))) (list identity ->template-source-path ->preproc-source-path ->null-source-path)) p))
(and p (ormap (λ(proc) (file-exists? (proc p))) (list identity ->preproc-source-path ->null-source-path)) p))
(define (get-template)
(define source-dir (dirname source-path))
@ -222,12 +211,12 @@
(define (get-template-from-metas)
(with-handlers ([exn:fail:contract? (λ _ #f)]) ; in case source-path doesn't work with cached-require
(parameterize ([current-directory (world:current-project-root)])
(let* ([source-metas (cached-require source-path (world:current-meta-export))]
(let* ([source-metas (cached-metas source-path)]
[template-name-or-names (select-from-metas (world:current-template-meta-key) source-metas)] ; #f or atom or list
[template-name (cond
[(list? template-name-or-names)
(define result
(memf (λ(tn) (equal? (get-ext tn) output-path-ext)) template-name-or-names)) ; #f or list
(memf (λ(tn) (eq? (get-ext tn) output-path-ext)) template-name-or-names)) ; #f or list
(and result (car result))]
[else template-name-or-names])])
(and template-name (build-path source-dir template-name))))))
@ -268,10 +257,10 @@
(check-false (get-template-for (->complete-path "foo.poly.pm")))
(check-equal? (get-template-for (->complete-path "foo.html.pm")) fallback.html)))
(define-namespace-anchor anchor-to-this-namespace)
(define/contract (render-through-eval expr-to-eval)
(list? . -> . (or/c string? bytes?))
(define-namespace-anchor render-module-ns)
(define (render-through-eval expr-to-eval)
;(list? . -> . (or/c string? bytes?))
(parameterize ([current-namespace (make-base-namespace)]
[current-output-port (current-error-port)])
(namespace-attach-module (namespace-anchor->namespace anchor-to-this-namespace) 'pollen/world) ; brings in params
(namespace-attach-module (namespace-anchor->namespace render-module-ns) 'pollen/world) ; brings in params
(eval expr-to-eval)))

@ -6,6 +6,8 @@ One curious aspect of free software is that you can appropriate the benefits of
Thank you to Greg Hendershott for his Markdown parser.
Thank you to Ahmed Fasih, Malcolm Still, Joel Dueck, and other early-stage Pollen users for their patience & suggestions.
The best software tools do more than get the job done. They create an incentive to undertake jobs you wouldn't have attempted before. Racket encouraged me to become a better programmer so I could create Pollen. Likewise, I hope that Pollen encourages you to make things you couldn't before.
MB

Before

Width:  |  Height:  |  Size: 96 KiB

After

Width:  |  Height:  |  Size: 96 KiB

@ -1,6 +1,6 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket pollen/world pollen/render pollen/file sugar txexpr))
@(require "mb-tools.rkt" scribble/eval pollen/cache pollen/world (for-label racket pollen/world pollen/render pollen/file sugar txexpr))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen))
@ -21,18 +21,18 @@ If you want to reset all the compile caches, use @exec{@seclink["raco_pollen_res
@section{Disabling the cache}
The compile cache is controlled by the @seclink["settable-values"]{settable value} @racket[world:current-compile-cache-active]. Thus, to disable the compile cache, add a @racket[config] submodule to your @filepath{pollen.rkt} like so:
The compile cache is controlled by the @seclink["world-overrides"]{overridable value} @racket[world:current-compile-cache-active]. Thus, to disable the compile cache, add a @racket[world] submodule to your @filepath{pollen.rkt} like so:
@codeblock|{
(module config racket/base
(module world racket/base
(provide (all-defined-out))
(define compile-cache-active #f))
}|
Pollen also caches rendered output files, so if you want to disable all caching — thus forcing everything to recompile, every time — you should also disable the render cache by setting @racket[world:current-render-cache-active]:
Pollen also caches rendered output files, so if you want to disable all caching — thus forcing everything to recompile, every time — you should also disable the render cache by overriding @racket[world:current-render-cache-active]:
@codeblock|{
(module config racket/base
(module world racket/base
(provide (all-defined-out))
(define compile-cache-active #f)
(define render-cache-active #f))
@ -45,30 +45,35 @@ Be warned that this will make your rendering much slower. But you will be guaran
The compile cache tracks the modification date of the source file, the current setting of @secref["The_POLLEN_environment_variable"], and the modification dates of the template and @filepath{pollen.rkt} (if they exist).
It does not, however, track every possible dependency. So in a complex project, it's possible to create ``deep'' dependencies that aren't noticed by the cache.
It does not, however, track every possible dependency. So in a complex project, it's possible to create deep dependencies that aren't noticed by the cache.
Unfortunately, there's no way around this problem. For the cache to be useful, there has to be a limit on the horizon of dependency checking. For the cache to be totally certain that something hadnt changed, it would have to compile afresh every time (which would be equivalent to not caching at all).
Unfortunately, there's no way around this problem. For the cache to be useful, there has to be a limit on the horizon of dependency checking. To capture every possible dependency, the cache would have to recompile every file, every time — which would be equivalent to not caching at all.
But those who need that kind of deep dynamism can disable the cache.
Those who need that kind of deep dynamism can disable the cache.
@section[#:tag-prefix "cache"]{Functions}
@deftogether[(
@defproc[
(cached-doc
[source-path pathish?])
txexpr?]
@defproc[
(cached-require
[source-path pathish?]
[key (or/c 'doc 'metas)])
(or/c txexpr? hash? integer?)]
Similar to @racket[(dynamic-require _source-path _key)], except that it first tries to retrieve the requested value out of the cache. If it's not there, or out of date, @racket[dynamic-require] is used to update the value.
(cached-metas
[source-path pathish?])
hash-eq?]
)]
Try to retrieve the requested value out of the cache. If it's not there, or out of date, @racket[dynamic-require] is used to update it from the source.
The only keys supported are @racket[doc] and @racket[metas] (or more precisely, the values of @racket[world:current-main-export] and @racket[world:current-meta-export], which default to @racket[doc] and @racket[metas]).
Despite their names, these functions actually rely on @racket[world:current-main-export] and @racket[world:current-meta-export] (which default to @id[world:main-export] and @id[world:meta-export]). Thus, if you override those names, everything will still work as expected.
If you want the speed benefit of the cache, you should @bold{always} use @racket[cached-require] to get data from Pollen source files. That doesn't mean you can't still use functions like @racket[require], @racket[local-require], and @racket[dynamic-require]. They'll just be slower.
If you want the speed benefit of the cache, you should @bold{always} use @racket[cached-doc] and @racket[cached-metas] to get data from Pollen source files. That doesn't mean you can't also use functions like @racket[require], @racket[local-require], and @racket[dynamic-require]. They'll just be slower.
@defproc[
(reset-cache)
void?]
Clears the cache. When only the nuclear option will do.

File diff suppressed because one or more lines are too long

@ -29,7 +29,7 @@ Here's how you type it:
@bold{Ubuntu}: ctrl + shift + U, then 25CA
Still, if you don't want to use the lozenge as your command character, you can set Pollen's @racket[world:command-char] value to whatever character you want (see also @seclink["settable-values"]).
Still, if you don't want to use the lozenge as your command character, you can set Pollen's @racket[world:command-char] value to whatever character you want (see also @seclink["world-overrides"]).
@margin-note{Scribble uses the @"@" sign as a delimiter. It's not a bad choice if you only work with Racket files. But as you use Pollen to work on other kinds of text-based files that commonly contain @"@" signs — HTML pages especially — it gets cumbersome. So I changed it.}
@ -371,13 +371,13 @@ For instance, suppose we want to use @code{map} as a tag even though Racket is u
@repl-output{'(my-map "How I would love this to be a map.")}
But @code{my-map} is not the tag we want. We need to define @code{my-map} to be a tag function for @code{map}. We can do this with the Pollen helper @racket[make-default-tag-function]. That function lives in @racket[pollen/tag], so we @racket[require] that too:
But @code{my-map} is not the tag we want. We need to define @code{my-map} to be a tag function for @code{map}. We can do this with the Pollen helper @racket[default-tag-function]. That function lives in @racket[pollen/tag], so we @racket[require] that too:
@codeblock|{
#lang pollen
◊(require pollen/tag)
◊(define my-map (make-default-tag-function 'map))
◊(define my-map (default-tag-function 'map))
◊my-map{How I would love this to be a map.}
}|
@ -546,7 +546,7 @@ Second, the metas are collected into a hash table that is exported with the name
@terminal{
> metas
'#hash((dog . "Roxy") (cat . "Chopper") (here-path . "unsaved-editor"))
'#hasheq((dog . "Roxy") (cat . "Chopper") (here-path . "unsaved-editor"))
}
The only key that's automatically defined in every meta table is @code{here-path}, which is the absolute path to the source file. (In this case, because the file hasn't been saved, you'll see the @code{unsaved-editor} name instead.)
@ -567,7 +567,7 @@ When you run this code, the result will be the same as before, but this time the
@terminal{
> metas
'#hash((dog . "Roxy") (cat . "Chopper") (here-path . "tesseract"))
'#hasheq((dog . "Roxy") (cat . "Chopper") (here-path . "tesseract"))
}
@ -583,7 +583,7 @@ In this case, though there are two metas named @racket[dog] (and they use differ
@terminal{
> metas
'#hash((dog . "Lex") (here-path . "unsaved-editor"))
'#hasheq((dog . "Lex") (here-path . "unsaved-editor"))
}
@bold{Pro tip}: the @racket[metas] hashtable is available when you import a Pollen source file in the usual way, but it's also made available through a submodule called, unsurprisingly, @racket[metas].
@ -643,7 +643,7 @@ The result of this file will be:
And the metas:
@terminal{
> metas
'#hash((title . "The Amazing Truth") (here-path . "unsaved-editor"))
'#hasheq((title . "The Amazing Truth") (here-path . "unsaved-editor"))
}
You cannot, however, use @racket[hash-set!] or other similar functions, because @racket[metas] is an immutable hash.
@ -921,7 +921,7 @@ You enable Pollen mode within your source file by adding @racketmodname[pollen/m
#lang pollen/mode racket/base
(require pollen/tag)
(define link (make-default-tag-function 'a))
(define link (default-tag-function 'a))
(define (home-link)
(link #:href "index.html" "Click to go home"))

Before

Width:  |  Height:  |  Size: 22 KiB

After

Width:  |  Height:  |  Size: 22 KiB

File diff suppressed because one or more lines are too long

@ -1,6 +1,6 @@
#lang scribble/manual
@(require scribble/eval pollen/decode pollen/world (prefix-in html: pollen/html) txexpr (for-label racket (except-in pollen #%module-begin) pollen/world pollen/cache pollen/decode txexpr xml pollen/html))
@(require "mb-tools.rkt" scribble/eval pollen/decode pollen/world txexpr racket/string (for-label racket(except-in pollen #%module-begin) pollen/world pollen/cache pollen/decode txexpr xml))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/decode xml racket/list txexpr))
@ -16,7 +16,7 @@ The decode step can happen separately from the compilation of the file. But you
You can, of course, embed function calls within Pollen markup. But since markup is optimized for authors, decoding is useful for operations that can or should be moved out of the authoring layer.
One example is presentation and layout. For instance, @racket[detect-paragraphs] is a decoder function that lets authors mark paragraphs in their source simply by using two carriage returns.
One example is presentation and layout. For instance, @racket[decode-paragraphs] is a decoder function that lets authors mark paragraphs in their source simply by using two carriage returns.
Another example is conversion of output into a particular data format. Most Pollen functions are optimized for HTML output, but one could write a decoder that targets another format.
@ -28,6 +28,7 @@ Another example is conversion of output into a particular data format. Most Poll
[#:txexpr-tag-proc txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) (λ(tag) tag)]
[#:txexpr-attrs-proc txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) (λ(attrs) attrs)]
[#:txexpr-elements-proc txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?) (λ(elements) elements)]
[#:txexpr-proc txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:block-txexpr-proc block-txexpr-proc (block-txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:inline-txexpr-proc inline-txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:string-proc string-proc (string? . -> . (or/c xexpr? (listof xexpr?))) (λ(str) str)]
@ -47,8 +48,8 @@ For instance, here's how @racket[decode] is attached to @racket[root] in @link["
@racketblock[
(define (root . items)
(decode (make-txexpr 'root '() items)
#:txexpr-elements-proc detect-paragraphs
(decode (txexpr 'root '() items)
#:txexpr-elements-proc decode-paragraphs
#:block-txexpr-proc (compose1 hyphenate wrap-hanging-quotes)
#:string-proc (compose1 smart-quotes smart-dashes)
#:exclude-tags '(style script)))
@ -78,7 +79,7 @@ The @racket[_txexpr-tag-proc] argument is a procedure that handles X-expression
The @racket[_txexpr-attrs-proc] argument is a procedure that handles lists of X-expression attributes. (The @racketmodname[txexpr] module, included at no extra charge with Pollen, includes useful helper functions for dealing with these attribute lists.)
@examples[#:eval my-eval
(define tx '(p [[id "first"]] "If I only had a brain."))
(define tx '(p ((id "first")) "If I only had a brain."))
(code:comment @#,t{Attrs is a list, so cons is OK for simple cases})
(decode tx #:txexpr-attrs-proc (λ(attrs) (cons '[class "PhD"] attrs )))
]
@ -86,7 +87,7 @@ The @racket[_txexpr-attrs-proc] argument is a procedure that handles lists of X-
Note that @racket[_txexpr-attrs-proc] will change the attributes of every tagged X-expression, even those that don't have attributes. This is useful, because sometimes you want to add attributes where none existed before. But be careful, because the behavior may make your processing function overinclusive.
@examples[#:eval my-eval
(define tx '(div (p [[id "first"]] "If I only had a brain.")
(define tx '(div (p ((id "first")) "If I only had a brain.")
(p "Me too.")))
(code:comment @#,t{This will insert the new attribute everywhere})
(decode tx #:txexpr-attrs-proc (λ(attrs) (cons '[class "PhD"] attrs )))
@ -107,10 +108,10 @@ The @racket[_txexpr-elements-proc] argument is a procedure that operates on the
#:string-proc (λ(s) (string-upcase s)))
]
So why do you need @racket[_txexpr-elements-proc]? Because some types of element decoding depend on context, thus it's necessary to handle the elements as a group. For instance, paragraph detection. The behavior is not merely a @racket[map] across each element, because elements are being removed and altered contextually:
So why do you need @racket[_txexpr-elements-proc]? Because some types of element decoding depend on context, thus it's necessary to handle the elements as a group. For instance, paragraph decodeion. The behavior is not merely a @racket[map] across each element, because elements are being removed and altered contextually:
@examples[#:eval my-eval
(define (paras tx) (decode tx #:txexpr-elements-proc detect-paragraphs))
(define (paras tx) (decode tx #:txexpr-elements-proc decode-paragraphs))
(code:comment @#,t{Context matters. Trailing whitespace is ignored ...})
(paras '(body "The first paragraph." "\n\n"))
(code:comment @#,t{... but whitespace between strings is converted to a break.})
@ -120,9 +121,7 @@ So why do you need @racket[_txexpr-elements-proc]? Because some types of element
]
The @racket[_block-txexpr-proc] argument and the @racket[_inline-txexpr-proc] arguments are procedures that operate on tagged X-expressions. If the X-expression meets the @racket[block-txexpr?] test, it's processed by @racket[_block-txexpr-proc]. Otherwise, it's inline, so it's processed by @racket[_inline-txexpr-proc]. (Careful, however — these aren't mutually exclusive, because @racket[_block-txexpr-proc] operates on all the elements of a block, including other tagged X-expressions within.)
Of course, if you want block and inline elements to be handled the same way, you can set @racket[_block-txexpr-proc] and @racket[_inline-txexpr-proc] to be the same procedure.
The @racket[_txexpr-proc], @racket[_block-txexpr-proc], and @racket[_inline-txexpr-proc] arguments are procedures that operate on tagged X-expressions. If the X-expression meets the @racket[block-txexpr?] test, it's processed by @racket[_block-txexpr-proc]. Otherwise, it's inline, so it's processed by @racket[_inline-txexpr-proc]. (Careful, however — these aren't mutually exclusive, because @racket[_block-txexpr-proc] operates on all the elements of a block, including other tagged X-expressions within.) Then both categories are processed by @racket[_txexpr-proc].
@examples[#:eval my-eval
(define tx '(div "Please" (em "mind the gap") (h1 "Tuesdays only")))
@ -136,6 +135,8 @@ Of course, if you want block and inline elements to be handled the same way, you
(decode tx #:inline-txexpr-proc add-ns)
(code:comment @#,t{this will affect all elements})
(decode tx #:block-txexpr-proc add-ns #:inline-txexpr-proc add-ns)
(code:comment @#,t{as will this})
(decode tx #:txexpr-proc add-ns)
]
The @racket[_string-proc], @racket[_entity-proc], and @racket[_cdata-proc] arguments are procedures that operate on X-expressions that are strings, entities, and CDATA, respectively. Deliberately, the output contracts for these procedures accept any kind of X-expression (meaning, the procedure can change the X-expression type).
@ -150,7 +151,7 @@ The @racket[_string-proc], @racket[_entity-proc], and @racket[_cdata-proc] argum
(print (decode tx #:cdata-proc rulify))
]
Note that entities come in two flavors — symbolic and numeric — and @racket[_entity-proc] affects both. If you only want to affect one or the other, you can add a test within @racket[_entity-proc]. Symbolic entities can be detected with @racket[symbol?], and numeric entities with @racket[valid-char?]:
Note that entities come in two flavors — symbolic and numeric — and @racket[_entity-proc] affects both. If you only want to affect one or the other, you can add a test within @racket[_entity-proc]. Symbolic entities can be decodeed with @racket[symbol?], and numeric entities with @racket[valid-char?]:
@examples[#:eval my-eval
(define tx `(div amp 62))
@ -202,9 +203,9 @@ The @racket[_tags-to-exclude] argument is a list of tags that will be exempted f
The @racket[_tags-to-exclude] argument is useful if you're decoding source that's destined to become HTML. According to the HTML spec, material within a @racket[<style>] or @racket[<script>] block needs to be preserved literally. In this example, if the CSS and JavaScript blocks are capitalized, they won't work. So exclude @racket['(style script)], and problem solved.
@examples[#:eval my-eval
(define tx '(body (h1 [[class "Red"]] "Let's visit Planet Telex.")
(style [[type "text/css"]] ".Red {color: green;}")
(script [[type "text/javascript"]] "var area = h * w;")))
(define tx '(body (h1 ((class "Red")) "Let's visit Planet Telex.")
(style ((type "text/css")) ".Red {color: green;}")
(script ((type "text/javascript")) "var area = h * w;")))
(decode tx #:string-proc string-upcase)
(decode tx #:string-proc string-upcase #:exclude-tags '(style script))
]
@ -223,6 +224,7 @@ Finally, the @racket[_attrs-to-exclude] argument works the same way as @racket[_
[#:txexpr-tag-proc txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) (λ(tag) tag)]
[#:txexpr-attrs-proc txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) (λ(attrs) attrs)]
[#:txexpr-elements-proc txexpr-elements-proc (txexpr-elements? . -> . txexpr-elements?) (λ(elements) elements)]
[#:txexpr-proc txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:block-txexpr-proc block-txexpr-proc (block-txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:inline-txexpr-proc inline-txexpr-proc (txexpr? . -> . (or/c xexpr? (listof xexpr?))) (λ(tx) tx)]
[#:string-proc string-proc (string? . -> . (or/c xexpr? (listof xexpr?))) (λ(str) str)]
@ -232,129 +234,45 @@ Finally, the @racket[_attrs-to-exclude] argument works the same way as @racket[_
[#:exclude-attrs attrs-to-exclude txexpr-attrs? null]
)
(or/c xexpr/c (listof xexpr/c))]
Identical to @racket[decode], but takes @racket[txexpr-elements?] as input rather than a whole tagged X-expression, and likewise returns @racket[txexpr-elements?] rather than a tagged X-expression. A convenience variant for use inside tag functions.
@section{Block}
Because it's convenient, Pollen puts tagged X-expressions into two categories: @italic{block} and @italic{inline}. Why is it convenient? When using @racket[decode], you often want to treat the two categories differently. Not that you have to. But this is how you can.
@defparam[project-block-tags block-tags (listof txexpr-tag?)]{
A parameter that defines the set of tags that @racket[decode] will treat as blocks. This parameter is initialized with the HTML block tags, namely:
@code[(format "~a" html:block-tags)]}
@defproc[
(register-block-tag
[tag txexpr-tag?])
void?]
Adds a tag to @racket[project-block-tags] so that @racket[block-txexpr?] will report it as a block, and @racket[decode] will process it with @racket[_block-txexpr-proc] rather than @racket[_inline-txexpr-proc].
Pollen tries to do the right thing without being told. But this is the rare case where you have to be explicit. If you introduce a tag into your markup that you want treated as a block, you @bold{must} use this function to identify it, or you will get spooky behavior later on.
For instance, @racket[detect-paragraphs] knows that block elements in the markup shouldn't be wrapped in a @racket[p] tag. So if you introduce a new block element called @racket[bloq] without registering it as a block, misbehavior will follow:
@examples[#:eval my-eval
(define (paras tx) (decode tx #:txexpr-elements-proc detect-paragraphs))
(paras '(body "I want to be a paragraph." "\n\n" (bloq "But not me.")))
(code:comment @#,t{Wrong: bloq should not be wrapped})
]
But once you register @racket[bloq] as a block, order is restored:
@examples[#:eval my-eval
(define (paras tx) (decode tx #:txexpr-elements-proc detect-paragraphs))
(register-block-tag 'bloq)
(paras '(body "I want to be a paragraph." "\n\n" (bloq "But not me.")))
(code:comment @#,t{Right: bloq is treated as a block})
]
If you find the idea of registering block tags unbearable, good news. The @racket[project-block-tags] include the standard HTML block tags by default. So if you just want to use things like @racket[div] and @racket[p] and @racket[h1h6], you'll get the right behavior for free.
@examples[#:eval my-eval
(define (paras tx) (decode tx #:txexpr-elements-proc detect-paragraphs))
(paras '(body "I want to be a paragraph." "\n\n" (div "But not me.")))
]
Identical to @racket[decode], but takes @racket[txexpr-elements?] as input rather than a whole tagged X-expression. A convenience variant for use inside tag functions.
@defproc[
(block-txexpr?
[v any/c])
boolean?]
Predicate that tests whether @racket[_v] is a tagged X-expression, and if so, whether the tag is among the @racket[project-block-tags]. If not, it is treated as inline. To adjust how this test works, use @racket[register-block-tag].
@section{Typography}
An assortment of typography & layout functions, designed to be used with @racket[decode]. These aren't hard to write. So if you like these, use them. If not, make your own.
@defproc[
(whitespace?
[v any/c])
boolean?]
A predicate that returns @racket[#t] for any stringlike @racket[_v] that's entirely whitespace, but also the empty string, as well as lists and vectors that are made only of @racket[whitespace?] members. Following the @racket[regexp-match] convention, @racket[whitespace?] does not return @racket[#t] for a nonbreaking space. If you prefer that behavior, use @racket[whitespace/nbsp?].
Predicate that tests whether @racket[_v] has a tag that is among the @racket[world:current-block-tags]. If not, it is treated as inline.
This predicate affects the behavior of other functions. For instance, @racket[decode-paragraphs] knows that block elements in the markup shouldn't be wrapped in a @racket[p] tag. So if you introduce a new block element called @racket[bloq] without configuring it as a block, misbehavior will follow:
@examples[#:eval my-eval
(whitespace? "\n\n ")
(whitespace? (string->symbol "\n\n "))
(whitespace? "")
(whitespace? '("" " " "\n\n\n" " \n"))
(define nonbreaking-space (format "~a" #\u00A0))
(whitespace? nonbreaking-space)
(define (paras tx) (decode tx #:txexpr-elements-proc decode-paragraphs))
(paras '(body "I want to be a paragraph." "\n\n" (bloq "But not me.")))
(code:comment @#,t{Wrong: bloq should not be wrapped})
]
@defproc[
(whitespace/nbsp?
[v any/c])
boolean?]
Like @racket[whitespace?], but also returns @racket[#t] for nonbreaking spaces.
@examples[#:eval my-eval
(whitespace/nbsp? "\n\n ")
(whitespace/nbsp? (string->symbol "\n\n "))
(whitespace/nbsp? "")
(whitespace/nbsp? '("" " " "\n\n\n" " \n"))
(define nonbreaking-space (format "~a" #\u00A0))
(whitespace/nbsp? nonbreaking-space)
]
To change how this test works, use a @racket[world] submodule as described in @secref["world-overrides"]:
@racketblock[
(module world racket/base
(provide (all-defined-out))
(require pollen/world)
(define block-tags (cons 'bloq world:block-tags)))]
@defproc[
(smart-quotes
[str string?])
string?]
Convert straight quotes in @racket[_str] to curly according to American English conventions.
After that change, the result will be:
@examples[#:eval my-eval
(define tricky-string
"\"Why,\" she could've asked, \"are we in Oahu watching 'Mame'?\"")
(display tricky-string)
(display (smart-quotes tricky-string))
]
@racketresultfont{'(body (p "I want to be a paragraph.") (bloq "But not me."))}
@defproc[
(smart-dashes
[str string?])
string?]
In @racket[_str], convert three hyphens to an em dash, and two hyphens to an en dash, and remove surrounding spaces.
The default block tags are:
@examples[#:eval my-eval
(define tricky-string "I had a few --- OK, like 6--8 --- thin mints.")
(display tricky-string)
(display (smart-dashes tricky-string))
(code:comment @#,t{Monospaced font not great for showing dashes, but you get the idea})
]
@racketidfont{@(string-join (map symbol->string world:block-tags) " ")}
@defproc[
(merge-newlines
[elements (listof xexpr?)])
(listof xexpr?)]
Within @racket[_elements], merge sequential newline characters (@racket["\n"]) into a single whitespace element. Helper function used by @racket[detect-paragraphs].
Within @racket[_elements], merge sequential newline characters into a single element. The newline string is controlled by @racket[world:current-newline], and defaults to @val[world:newline].
@examples[#:eval my-eval
(merge-newlines '(p "\n" "\n" "foo" "\n" "\n\n" "bar"
@ -362,92 +280,72 @@ Within @racket[_elements], merge sequential newline characters (@racket["\n"]) i
@defproc[
(detect-linebreaks
[tagged-xexpr-elements (listof xexpr?)]
[#:separator linebreak-sep string? (world:current-linebreak-separator)]
[#:insert linebreak xexpr? '(br)])
(decode-linebreaks
[elements (listof xexpr?)]
[linebreaker (or/c xexpr? (xexpr? xexpr? . -> . xexpr?)) '(br)])
(listof xexpr?)]
Within @racket[_tagged-xexpr-elements], convert occurrences of @racket[_linebreak-sep] (@racket["\n"] by default) to @racket[_linebreak], but only if @racket[_linebreak-sep] does not occur between blocks (see @racket[block-txexpr?]). Why? Because block-level elements automatically display on a new line, so adding @racket[_linebreak] would be superfluous. In that case, @racket[_linebreak-sep] just disappears.
Within @racket[_elements], convert occurrences of the linebreak separator to @racket[_linebreaker], but only if the separator does not occur between blocks (see @racket[block-txexpr?]). Why? Because block-level elements automatically display on a new line, so adding @racket[_linebreaker] would be superfluous. In that case, the linebreak separator just disappears.
The linebreak separator is controlled by @racket[world:current-linebreak-separator], and defaults to @val[world:linebreak-separator].
The @racket[_linebreaker] argument can either be an X-expression, or a function that takes two X-expressions and returns one. This function will receive the previous and next elements, to make contextual substitution possible.
@examples[#:eval my-eval
(detect-linebreaks '(div "Two items:" "\n" (em "Eggs") "\n" (em "Bacon")))
(detect-linebreaks '(div "Two items:" "\n" (div "Eggs") "\n" (div "Bacon")))
(decode-linebreaks '(div "Two items:" "\n" (em "Eggs") "\n" (em "Bacon")))
(decode-linebreaks '(div "Two items:" "\n" (div "Eggs") "\n" (div "Bacon")))
(decode-linebreaks '(div "Two items:" "\n" (em "Eggs") "\n" (em "Bacon"))
(λ(prev next) (if (and (txexpr? prev) (member "Eggs" prev)) '(egg-br) '(br))))
]
@defproc[
(detect-paragraphs
(decode-paragraphs
[elements (listof xexpr?)]
[#:separator paragraph-sep string? (world:current-paragraph-separator)]
[#:tag paragraph-tag symbol? 'p]
[#:linebreak-proc linebreak-proc ((listof xexpr?) . -> . (listof xexpr?)) detect-linebreaks]
[paragraph-wrapper (or/c txexpr-tag? ((listof xexpr?) . -> . txexpr?)) 'p]
[#:linebreak-proc linebreak-proc ((listof xexpr?) . -> . (listof xexpr?)) decode-linebreaks]
[#:force? force-paragraph? boolean? #f])
(listof xexpr?)]
Find paragraphs within @racket[_elements] and wrap them with @racket[_paragraph-tag]. Also handle linebreaks using @racket[detect-linebreaks].
Find paragraphs within @racket[_elements] and wrap them with @racket[_paragraph-wrapper]. Also handle linebreaks using @racket[decode-linebreaks].
What counts as a paragraph? Any @racket[_elements] that are either a) explicitly set apart with a paragraph separator, or b) adjacent to a @racket[block-txexpr?] (in which case the paragraph-ness is implied).
What counts as a paragraph? Any @racket[_elements] that are either a) explicitly set apart with @racket[_paragraph-sep], or b) adjacent to a @racket[block-txexpr?] (in which case the paragraph-ness is implied).
The paragraph separator is controlled by @racket[world:current-paragraph-separator], and defaults to @val[world:paragraph-separator].
@examples[#:eval my-eval
(detect-paragraphs '("Explicit para" "\n\n" "Explicit para"))
(detect-paragraphs '("Explicit para" "\n\n" "Explicit para" "\n" "Explicit line"))
(detect-paragraphs '("Implied para" (div "Block") "Implied para"))
(decode-paragraphs '("Explicit para" "\n\n" "Explicit para"))
(decode-paragraphs '("Explicit para" "\n\n" "Explicit para" "\n" "Explicit line"))
(decode-paragraphs '("Implied para" (div "Block") "Implied para"))
]
If @racket[_element] is already a block, it will not be wrapped as a paragraph (because in that case, the wrapping would be superfluous). Thus, as a consequence, if @racket[_paragraph-sep] occurs between two blocks, it will be ignored (as in the example below using two sequential @racket[div] blocks.) Likewise, @racket[_paragraph-sep] will also be ignored if it occurs between a block and a non-block (because a paragraph break is already implied).
@examples[#:eval my-eval
(code:comment @#,t{The explicit "\n\n" makes no difference in these cases})
(detect-paragraphs '((div "First block") "\n\n" (div "Second block")))
(detect-paragraphs '((div "First block") (div "Second block")))
(detect-paragraphs '("Para" "\n\n" (div "Block")))
(detect-paragraphs '("Para" (div "Block")))
(decode-paragraphs '((div "First block") "\n\n" (div "Second block")))
(decode-paragraphs '((div "First block") (div "Second block")))
(decode-paragraphs '("Para" "\n\n" (div "Block")))
(decode-paragraphs '("Para" (div "Block")))
]
The @racket[_paragraph-tag] argument sets the tag used to wrap paragraphs.
The @racket[_paragraph-wrapper] argument can either be an X-expression, or a function that takes a list of elements and returns one tagged X-expressions. This function will receive the elements of the paragraph, to make contextual wrapping possible.
@examples[#:eval my-eval
(detect-paragraphs '("First para" "\n\n" "Second para") #:tag 'ns:p)
(decode-paragraphs '("First para" "\n\n" "Second para") 'ns:p)
(decode-paragraphs '("First para" "\n\n" "Second para")
(λ(elems) `(ns:p ,@elems "!?!")))
]
The @racket[_linebreak-proc] argument allows you to use a different linebreaking procedure other than the usual @racket[detect-linebreaks].
The @racket[_linebreak-proc] argument allows you to use a different linebreaking procedure other than the usual @racket[decode-linebreaks].
@examples[#:eval my-eval
(detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (detect-linebreaks x #:insert '(newline))))
(decode-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
#:linebreak-proc (λ(x) (decode-linebreaks x '(newline))))
]
The @racket[#:force?] option will wrap a paragraph tag around @racket[_elements], even if no explicit or implicit paragraph breaks are found. The @racket[#:force?] option is useful for when you want to guarantee that you always get a list of blocks.
@examples[#:eval my-eval
(detect-paragraphs '("This" (span "will not be") "a paragraph"))
(detect-paragraphs '("But this" (span "will be") "a paragraph") #:force? #t)
]
@defproc[
(wrap-hanging-quotes
[tx txexpr?]
[#:single-preprend single-preprender txexpr-tag? 'squo]
[#:double-preprend double-preprender txexpr-tag? 'dquo]
)
txexpr?]
Find single or double quote marks at the beginning of @racket[_tx] and wrap them in an X-expression with the tag @racket[_single-preprender] or @racket[_double-preprender], respectively. The default values are @racket['squo] and @racket['dquo].
@examples[#:eval my-eval
(wrap-hanging-quotes '(p "No quote to hang."))
(wrap-hanging-quotes '(p "“What? We need to hang quotes?”"))
(decode-paragraphs '("This" (span "will not be") "a paragraph"))
(decode-paragraphs '("But this" (span "will be") "a paragraph") #:force? #t)
]
In pro typography, quotation marks at the beginning of a line or paragraph are often shifted into the margin slightly to make them appear more optically aligned with the left edge of the text. With a reflowable layout model like HTML, you don't know where your line breaks will be.
This function will simply insert the @racket['squo] and @racket['dquo] tags, which provide hooks that let you do the actual hanging via CSS, like so (actual measurement can be refined to taste):
@verbatim{squo {margin-left: -0.25em;}
dquo {margin-left: -0.50em;}
}
Be warned: there are many edge cases this function does not handle well.
@examples[#:eval my-eval
(code:comment @#,t{Argh: this edge case is not handled properly})
(wrap-hanging-quotes '(p "“" (em "What?") "We need to hang quotes?”"))
]

@ -0,0 +1,182 @@
#lang scribble/manual
@(require scribble/eval "mb-tools.rkt" pollen/render pollen/world (for-label racket (except-in pollen #%module-begin) pollen/world sugar pollen/file))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/file))
@title[#:tag "file-types"]{File}
@defmodule[pollen/file]
A utility module that provides functions for working with Pollen source and output files. In ordinary use, you probably won't need these. But if you want to do more elaborate Pollen hacking, here they are.
Pollen handles six kinds of source files:
@itemlist[
@item{@bold{Preprocessor}, with file extension @ext[world:preproc-source-ext]}
@item{@bold{Markup}, with file extension @ext[world:markup-source-ext]}
@item{@bold{Markdown}, with file extension @ext[world:markdown-source-ext]}
@item{@bold{Null}, with file extension @ext[world:null-source-ext]}
@item{@bold{Scribble}, with file extension @ext[world:scribble-source-ext]}
@item{@bold{Pagetree}, with file extension @ext[world:pagetree-source-ext]. This is the only source type that does not produce an output file.}
]
The functions in this module rely on file extensions specified in @racketmodname[pollen/world]. These extensions can be overridden within a project — see @secref["world-overrides"].
For each kind of Pollen source file, the corresponding output file name is derived by removing the extension from the name of the source file. So the preprocessor source file @filepath{default.css.pp} would become @filepath{default.css}. (See
@secref["Saving___naming_your_source_file"] if this rings no bells.)
Scribble files work differently — the corresponding output file is the source file but with an @filepath{html} extension rather than @filepath{scrbl}. So @filepath["pollen.scrbl"] would become @filepath["pollen.html"].
For more about Pollen's file model, see @secref["File_formats"].
@deftogether[
(@defproc[
(preproc-source?
[val any/c])
boolean?]
@defproc[
(markup-source?
[val any/c])
boolean?]
@defproc[
(markdown-source?
[val any/c])
boolean?]
@defproc[
(null-source?
[val any/c])
boolean?]
@defproc[
(scribble-source?
[val any/c])
boolean?]
@defproc[
(pagetree-source?
[val any/c])
boolean?]
)]
Test whether @racket[_val] is a path representing a source file of the specified type, based on its file extension. Does not check whether @racket[_val] exists.
@examples[#:eval my-eval
(preproc-source? "main.css.pp")
(markup-source? "default.html.pm")
(markdown-source? "default.html.pmd")
(null-source? "index.html.p")
(scribble-source? "file.scrbl")
(pagetree-source? "index.ptree")
]
@deftogether[
(@defproc[
(->preproc-source-path
[p pathish?])
path?]
@defproc[
(->markup-source-path
[p pathish?])
path?]
@defproc[
(->markdown-source-path
[p pathish?])
path?]
@defproc[
(->null-source-path
[p pathish?])
path?]
@defproc[
(->scribble-source-path
[p pathish?])
path?]
)]
Convert an output path @racket[_p] into the source path of the specified type that would produce this output path. This function simply generates a corresponding source path — it does not ask whether this source path exists. (If you want a guarantee that the file exists, use @racket[get-source].)
@examples[#:eval my-eval
(define name "default.html")
(->preproc-source-path name)
(->markup-source-path name)
(->markdown-source-path name)
(->scribble-source-path name)
(->null-source-path name)
]
@deftogether[(
@defproc[
(get-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-markup-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-markdown-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-preproc-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-null-source
[p pathish?])
(or/c #f path?)]
@defproc[
(get-scribble-source
[p pathish?])
(or/c #f path?)]
)]
Find an existing source path that would produce the output path @racket[_p].
The omnibus @racket[get-source] will check source formats in this order: @racket[get-markup-source], @racket[get-markdown-source], @racket[get-preproc-source], @racket[get-null-source], and @racket[get-scribble-source].
The type-specific variants will, of course, only return a source file of the specified type.
In all cases, if there is no corresponding source, return @racket[#f].
@defproc[
(->output-path
[p pathish?])
path?]
Convert a source path @racket[_p] into its corresponding output path. This function simply generates a path for a file — it does not ask whether the file exists.
If @racket[_p] has a @seclink["The_poly_output_type"]{@id[world:poly-source-ext] output type}, then @racket[->output-path] uses @racket[world:current-poly-target] as the output-path extension.
Otherwise, there are no type-specific variants for this function because the output path of a Pollen source file is @seclink["Saving___naming_your_source_file"]{determined by its name}.
@examples[#:eval my-eval
(->output-path "main.css.pp")
(->output-path "default.html.pm")
(->output-path "index.html.p")
(->output-path "file.scrbl")
]

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

@ -0,0 +1,319 @@
/* See the beginning of "manual.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk, .RktErr {
font-family: 'Source Code Pro', monospace;
white-space: inherit;
font-size: 1rem;
}
/* this selctor grabs the first linked Racket symbol
in a definition box (i.e., the symbol being defined) */
a.RktValDef, a.RktStxDef, a.RktSymDef,
span.RktValDef, span.RktStxDef, span.RktSymDef
{
font-size: 1.15rem;
color: black;
font-weight: 600;
}
.inheritedlbl {
font-family: 'Fira', sans;
}
.RBackgroundLabelInner {
font-family: inherit;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 95%;
margin-top: 0.5em;
text-align: left;
background-color: inherit;
}
.inherited td {
font-size: 82%;
padding-left: 0.5rem;
line-height: 1.3;
text-indent: 0;
padding-right: 0;
}
.inheritedlbl {
font-style: normal;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eee;
}
.RktInBG {
background-color: #eee;
}
.refcolumn .RktInBG {
background-color: white;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: inherit;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
font-weight: 400;
}
.RktVar {
position: relative;
left: -1px; font-style: italic;
color: #444;
}
.SVInsetFlow .RktVar {
font-weight: 400;
color: #444;
}
.RktSym {
color: inherit;
}
.RktValLink, .RktStxLink, .RktModLink {
text-decoration: none;
color: #07A;
font-weight: 500;
font-size: 1rem;
}
/* for syntax links within headings */
h2 a.RktStxLink, h3 a.RktStxLink, h4 a.RktStxLink, h5 a.RktStxLink,
h2 a.RktValLink, h3 a.RktValLink, h4 a.RktValLink, h5 a.RktValLink,
h2 .RktSym, h3 .RktSym, h4 .RktSym, h5 .RktSym,
h2 .RktMod, h3 .RktMod, h4 .RktMod, h5 .RktMod,
h2 .RktVal, h3 .RktVal, h4 .RktVal, h5 .RktVal,
h2 .RktPn, h3 .RktPn, h4 .RktPn, h5 .RktPn {
color: #333;
font-size: 1.65rem;
font-weight: 400;
}
.toptoclink .RktStxLink, .toclink .RktStxLink,
.toptoclink .RktValLink, .toclink .RktValLink,
.toptoclink .RktModLink, .toclink .RktModLink {
color: inherit;
}
.tocset .RktValLink, .tocset .RktStxLink, .tocset .RktModLink {
color: black;
font-weight: 400;
font-size: 0.9rem;
}
.tocset td a.tocviewselflink .RktValLink,
.tocset td a.tocviewselflink .RktStxLink,
.tocset td a.tocviewselflink .RktMod,
.tocset td a.tocviewselflink .RktSym {
font-weight: lighter;
color: white;
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together { /* for definitions grouped together in one box */
width: 100%;
border-top: 2px solid white;
}
tbody > tr:first-child > td > .together {
border-top: 0px; /* erase border on first instance of together */
}
.RktBlk {
white-space: pre;
text-align: left;
}
.highlighted {
font-size: 1rem;
background-color: #fee;
}
.defmodule {
font-family: 'Source Code Pro';
padding: 0.25rem 0.75rem 0.25rem 0.5rem;
margin-bottom: 1rem;
width: 100%;
background-color: hsl(60, 29%, 94%);
}
.defmodule a {
color: #444;
}
.defmodule td span.hspace:first-child {
position: absolute;
width: 0;
display: inline-block;
}
.defmodule .RpackageSpec .Smaller,
.defmodule .RpackageSpec .stt {
font-size: 1rem;
}
.specgrammar {
float: none;
padding-left: 1em;
}
.RBibliography td {
vertical-align: text-top;
padding-top: 1em;
}
.leftindent {
margin-left: 2rem;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.SCodeFlow .Rfilebox {
margin-left: -1em; /* see 17.2 of guide, module languages */
}
.Rfiletitle {
text-align: right;
background-color: #eee;
}
.SCodeFlow .Rfiletitle {
border-top: 1px dotted gray;
border-right: 1px dotted gray;
}
.Rfilename {
border-top: 0;
border-right: 0;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: inherit;
}
.Rfilecontent {
margin: 0.5em;
}
.RpackageSpec {
padding-right: 0;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0.20rem; /* sensitive to monospaced font choice */
text-align: right;
z-index: 0;
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
color: gray;
}
.RpackageSpec .Smaller {
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}
/* ---------------------------------------- */
/* For section source modules & tags */
.RPartExplain {
background: #eee;
font-size: 0.9rem;
margin-top: 0.2rem;
padding: 0.2rem;
text-align: left;
}

@ -0,0 +1,98 @@
/* For the Racket manual style */
AddOnLoad(function() {
/* Look for header elements that have x-source-module and x-part tag.
For those elements, add a hidden element that explains how to
link to the section, and set the element's onclick() to display
the explanation. */
var tag_names = ["h1", "h2", "h3", "h4", "h5"];
for (var j = 0; j < tag_names.length; j++) {
elems = document.getElementsByTagName(tag_names[j]);
for (var i = 0; i < elems.length; i++) {
var elem = elems.item(i);
AddPartTitleOnClick(elem);
}
}
})
function AddPartTitleOnClick(elem) {
var mod_path = elem.getAttribute("x-source-module");
var tag = elem.getAttribute("x-part-tag");
if (mod_path && tag) {
// Might not be present:
var prefixes = elem.getAttribute("x-part-prefixes");
var info = document.createElement("div");
info.className = "RPartExplain";
/* The "top" tag refers to a whole document: */
var is_top = (tag == "\"top\"");
info.appendChild(document.createTextNode("Link to this "
+ (is_top ? "document" : "section")
+ " with "));
/* Break `secref` into two lines if the module path and tag
are long enough: */
var is_long = (is_top ? false : ((mod_path.length
+ tag.length
+ (prefixes ? (16 + prefixes.length) : 0))
> 60));
var line1 = document.createElement("div");
var line1x = ((is_long && prefixes) ? document.createElement("div") : line1);
var line2 = (is_long ? document.createElement("div") : line1);
function add(dest, str, cn) {
var s = document.createElement("span");
s.className = cn;
s.style.whiteSpace = "nowrap";
s.appendChild(document.createTextNode(str));
dest.appendChild(s);
}
/* Construct a `secref` call with suitable syntax coloring: */
add(line1, "\xA0@", "RktRdr");
add(line1, (is_top ? "other-doc" : "secref"), "RktSym");
add(line1, "[", "RktPn");
if (!is_top)
add(line1, tag, "RktVal");
if (is_long) {
/* indent additional lines: */
if (prefixes)
add(line1x, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn");
add(line2, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn");
}
if (prefixes) {
add(line1x, " #:tag-prefixes ", "RktPn");
add(line1x, "'", "RktVal");
add(line1x, prefixes, "RktVal");
}
if (!is_top)
add(line2, " #:doc ", "RktPn");
add(line2, "'", "RktVal");
add(line2, mod_path, "RktVal");
add(line2, "]", "RktPn");
info.appendChild(line1);
if (is_long)
info.appendChild(line1x);
if (is_long)
info.appendChild(line2);
info.style.display = "none";
/* Add the new element afterthe header: */
var n = elem.nextSibling;
if (n)
elem.parentNode.insertBefore(info, n);
else
elem.parentNode.appendChild(info);
/* Clicking the header shows the explanation element: */
elem.onclick = function () {
if (info.style.display == "none")
info.style.display = "block";
else
info.style.display = "none";
}
}
}

@ -0,0 +1,743 @@
/* See the beginning of "scribble.css".
This file is used by the `scribble/manual` language, along with
"manual-racket.css". */
@import url("manual-fonts.css");
* {
margin: 0;
padding: 0;
}
@media all {html {font-size: 15px;}}
@media all and (max-width:940px){html {font-size: 14px;}}
@media all and (max-width:850px){html {font-size: 13px;}}
@media all and (max-width:830px){html {font-size: 12px;}}
@media all and (max-width:740px){html {font-size: 11px;}}
/* CSS seems backward: List all the classes for which we want a
particular font, so that the font can be changed in one place. (It
would be nicer to reference a font definition from all the places
that we want it.)
As you read the rest of the file, remember to double-check here to
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
font-family: 'Source Code Pro', monospace;
white-space: inherit;
font-size: 1rem;
}
.stt {
font-weight: 500;
}
h2 .stt {
font-size: 2.7rem;
}
.toptoclink .stt {
font-size: inherit;
}
.toclink .stt {
font-size: 90%;
}
.RpackageSpec .stt {
font-weight: 300;
font-family: 'Source Code Pro';
font-size: 0.9rem;
}
h3 .stt, h4 .stt, h5 .stt {
color: #333;
font-size: 1.65rem;
font-weight: 400;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .sroman, i {
font-family: 'Charter', serif;
font-size: 1.18rem;
}
/* Sans-serif: */
.version, .versionNoNav, .ssansserif {
font-family: 'Fira', sans-serif;
}
.ssansserif {
font-family: 'Fira';
font-weight: 500;
font-size: 0.9em;
}
.tocset .ssansserif {
font-size: 100%;
}
/* ---------------------------------------- */
p, .SIntrapara {
display: block;
margin: 0 0 1em 0;
line-height: 1.4;
}
.compact {
padding: 0 0 1em 0;
}
li {
list-style-position: outside;
margin-left: 1.2em;
}
h1, h2, h3, h4, h5, h6, h7, h8 {
font-family: 'Fira';
font-weight: 300;
font-size: 1.6rem;
color: #333;
margin-top: inherit;
margin-bottom: 1rem;
line-height: 1.25;
-moz-font-feature-settings: 'tnum=1';
-moz-font-feature-settings: 'tnum' 1;
-webkit-font-feature-settings: 'tnum' 1;
-o-font-feature-settings: 'tnum' 1;
-ms-font-feature-settings: 'tnum' 1;
font-feature-settings: 'tnum' 1;
}
h3, h4, h5, h6, h7, h8 {
border-top: 1px solid black;
}
h2 { /* per-page main title */
font-family: 'Miso';
font-weight: bold;
margin-top: 4rem;
font-size: 3rem;
line-height: 1.1;
width: 90%;
}
h3, h4, h5, h6, h7, h8 {
margin-top: 2em;
padding-top: 0.1em;
margin-bottom: 0.75em;
}
/* ---------------------------------------- */
/* Main */
body {
color: black;
background-color: white;
}
.maincolumn {
width: auto;
margin-top: 4rem;
margin-left: 17rem;
margin-right: 2rem;
margin-bottom: 10rem; /* to avoid fixed bottom nav bar */
max-width: 700px;
min-width: 370px; /* below this size, code samples don't fit */
}
a {
text-decoration: inherit;
}
a, .toclink, .toptoclink, .tocviewlink, .tocviewselflink, .tocviewtoggle, .plainlink,
.techinside, .techoutside:hover, .techinside:hover {
color: #07A;
}
a:hover {
text-decoration: underline;
}
/* ---------------------------------------- */
/* Navigation */
.navsettop, .navsetbottom {
left: 0;
width: 15rem;
height: 6rem;
font-family: 'Fira';
font-size: 0.9rem;
border-bottom: 0px solid hsl(216, 15%, 70%);
background-color: inherit;
padding: 0;
}
.navsettop {
position: absolute;
top: 0;
left: 0;
margin-bottom: 0;
border-bottom: 0;
}
.navsettop a, .navsetbottom a {
color: black;
}
.navsettop a:hover, .navsetbottom a:hover {
background: hsl(216, 78%, 95%);
text-decoration: none;
}
.navleft, .navright {
position: static;
float: none;
margin: 0;
white-space: normal;
}
.navleft a {
display: inline-block;
}
.navright a {
display: inline-block;
text-align: center;
}
.navleft a, .navright a, .navright span {
display: inline-block;
padding: 0.5rem;
min-width: 1rem;
}
.navright {
height: 2rem;
white-space: nowrap;
}
.navsetbottom {
display: none;
}
.nonavigation {
color: #889;
}
.searchform {
display: block;
margin: 0;
padding: 0;
border-bottom: 1px solid #eee;
height: 4rem;
}
.nosearchform {
margin: 0;
padding: 0;
height: 4rem;
}
.searchbox {
font-size: 1rem;
width: 12rem;
margin: 1rem;
padding: 0.25rem;
vertical-align: middle;
background-color: white;
}
#search_box {
font-size: 0.8rem;
}
/* ---------------------------------------- */
/* Version */
.versionbox {
position: absolute;
float: none;
top: 0.25rem;
left: 17rem;
z-index: 11000;
height: 2em;
font-size: 70%;
font-weight: lighter;
width: inherit;
margin: 0;
}
.version, .versionNoNav {
font-size: inherit;
}
.version:before, .versionNoNav:before {
content: "v.";
}
/* ---------------------------------------- */
/* Margin notes */
/* cancel scribble.css styles: */
.refpara, .refelem {
position: static;
float: none;
height: auto;
width: auto;
margin: 0;
}
.refcolumn {
position: static;
display: block;
width: auto;
font-size: inherit;
margin: 2rem;
margin-left: 2rem;
padding: 0.5em;
padding-left: 0.75em;
padding-right: 1em;
background: hsl(60, 29%, 94%);
border: 1px solid #ccb;
border-left: 0.4rem solid #ccb;
}
/* slightly different handling for margin-note* on narrow screens */
@media all and (max-width:1260px) {
span.refcolumn {
float: right;
width: 50%;
margin-left: 1rem;
margin-bottom: 0.8rem;
margin-top: 1.2rem;
}
}
.refcontent, .refcontent p {
line-height: 1.5;
margin: 0;
}
.refcontent p + p {
margin-top: 1em;
}
.refcontent a {
font-weight: 400;
}
.refpara, .refparaleft {
top: -1em;
}
@media all and (max-width:600px) {
.refcolumn {
margin-left: 0;
margin-right: 0;
}
}
@media all and (min-width:1260px) {
.refcolumn {
position: absolute;
left: 66rem; right: 3em;
margin: 0;
float: right;
max-width: 18rem;
}
}
.refcontent {
font-family: 'Fira';
font-size: 1rem;
line-height: 1.6;
margin: 0 0 0 0;
}
.refparaleft, .refelemleft {
position: relative;
float: left;
right: 2em;
height: 0em;
width: 13em;
margin: 0em 0em 0em -13em;
}
.refcolumnleft {
background-color: hsl(60, 29%, 94%);
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid hsl(60, 29%, 94%);
margin: 0 0 0 0;
}
/* ---------------------------------------- */
/* Table of contents, left margin */
.tocset {
position: absolute;
float: none;
left: 0;
top: 0rem;
width: 14rem;
padding: 7rem 0.5rem 0.5rem 0.5rem;
background-color: hsl(216, 15%, 70%);
margin: 0;
}
.tocset td {
vertical-align: text-top;
padding-bottom: 0.4rem;
padding-left: 0.2rem;
line-height: 1.1;
font-family: 'Fira';
-moz-font-feature-settings: 'tnum=1';
-moz-font-feature-settings: 'tnum' 1;
-webkit-font-feature-settings: 'tnum' 1;
-o-font-feature-settings: 'tnum' 1;
-ms-font-feature-settings: 'tnum' 1;
font-feature-settings: 'tnum' 1;
}
.tocset td a {
color: black;
font-weight: 400;
}
.tocview {
text-align: left;
background-color: inherit;
}
.tocview td, .tocsub td {
line-height: 1.3;
}
.tocview table, .tocsub table {
width: 90%;
}
.tocset td a.tocviewselflink {
font-weight: lighter;
font-size: 110%; /* monospaced styles below don't need to enlarge */
color: white;
}
.tocviewselflink {
text-decoration: none;
}
.tocsub {
text-align: left;
margin-top: 0.5em;
background-color: inherit;
}
.tocviewlist, .tocsublist {
margin-left: 0.2em;
margin-right: 0.2em;
padding-top: 0.2em;
padding-bottom: 0.2em;
}
.tocviewlist table {
font-size: 82%;
}
.tocviewlisttopspace {
margin-bottom: 1em;
}
.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
margin-left: 0.4em;
border-left: 1px solid #99a;
padding-left: 0.8em;
}
.tocviewsublist {
margin-bottom: 1em;
}
.tocviewsublist table,
.tocviewsublistonly table,
.tocviewsublisttop table,
.tocviewsublistbottom table,
table.tocsublist {
font-size: 1rem;
}
.tocviewsublist td, .tocviewsublistbottom td, .tocviewsublisttop td, .tocsub td,
.tocviewsublistonly td {
font-size: 90%;
}
.tocviewtoggle {
font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
}
.tocsublist td {
padding-left: 0.5rem;
padding-top: 0.25rem;
text-indent: 0;
}
.tocsublinknumber {
font-size: 100%;
}
.tocsublink {
font-size: 82%;
text-decoration: none;
}
.tocsubseclink {
font-size: 100%;
text-decoration: none;
}
.tocsubnonseclink {
font-size: 82%;
text-decoration: none;
margin-left: 1rem;
padding-left: 0;
display: inline-block;
}
/* the label "on this page" */
.tocsubtitle {
display: block;
font-size: 62%;
font-family: 'Fira';
font-weight: bolder;
font-style: normal;
letter-spacing: 2px;
text-transform: uppercase;
margin: 0.5em;
}
.toptoclink {
font-weight: bold;
font-size: 110%;
margin-bottom: 0.5rem;
margin-top: 1.5rem;
display: inline-block;
}
.toclink {
font-size: inherit;
}
/* ---------------------------------------- */
/* Some inline styles */
.indexlink {
text-decoration: none;
}
pre {
margin-left: 2em;
}
blockquote {
margin-left: 2em;
margin-right: 2em;
margin-bottom: 1em;
}
.SCodeFlow {
border-left: 1px dotted black;
padding-left: 1em;
padding-right: 1em;
margin-top: 1em;
margin-bottom: 1em;
margin-left: 0em;
margin-right: 2em;
white-space: nowrap;
line-height: 1.5;
}
.SCodeFlow img {
margin-top: 0.5em;
margin-bottom: 0.5em;
}
.boxed {
margin: 0;
margin-top: 2em;
padding: 0.25em;
padding-bottom: 0.5em;
background: #f3f3f3;
box-sizing:border-box;
border-top: 1px solid #99b;
background: hsl(216, 78%, 95%);
background: -moz-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -webkit-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -o-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: -ms-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
background: linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 78%, 95%) 100%);
}
blockquote > blockquote.SVInsetFlow {
/* resolves issue in e.g. /reference/notation.html */
margin-top: 0em;
}
.leftindent .SVInsetFlow { /* see e.g. section 4.5 of Racket Guide */
margin-top: 1em;
margin-bottom: 1em;
}
.SVInsetFlow a, .SCodeFlow a {
color: #07A;
font-weight: 500;
}
.SubFlow {
display: block;
margin: 0em;
}
.boxed {
width: 100%;
background-color: inherit;
}
.techoutside { text-decoration: none; }
.SAuthorListBox {
position: static;
float: none;
font-family: 'Fira';
font-weight: 300;
font-size: 110%;
margin-top: 1rem;
margin-bottom: 3rem;
width: 30rem;
height: auto;
}
.author > a { /* email links within author block */
font-weight: inherit;
color: inherit;
}
.SAuthorList {
font-size: 82%;
}
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}
/* phone + tablet styles */
@media all and (max-width:720px){
@media all and (max-width:720px){
@media all {html {font-size: 15px;}}
@media all and (max-width:700px){html {font-size: 14px;}}
@media all and (max-width:630px){html {font-size: 13px;}}
@media all and (max-width:610px){html {font-size: 12px;}}
@media all and (max-width:550px){html {font-size: 11px;}}
@media all and (max-width:520px){html {font-size: 10px;}}
.navsettop, .navsetbottom {
display: block;
position: absolute;
width: 100%;
height: 4rem;
border: 0;
background-color: hsl(216, 15%, 70%);
}
.searchform {
display: inline;
border: 0;
}
.navright {
position: absolute;
right: 1.5rem;
margin-top: 1rem;
border: 0px solid red;
}
.navsetbottom {
display: block;
margin-top: 8rem;
}
.tocset {
display: none;
}
.tocset table, .tocset tbody, .tocset tr, .tocset td {
display: inline;
}
.tocview {
display: none;
}
.tocsub .tocsubtitle {
display: none;
}
.versionbox {
top: 4.5rem;
left: 1rem; /* same distance as main-column */
z-index: 11000;
height: 2em;
font-size: 70%;
font-weight: lighter;
}
.maincolumn {
margin-left: 1em;
margin-top: 7rem;
margin-bottom: 0rem;
}
}
}
/* print styles : hide the navigation elements */
@media print {
.tocset,
.navsettop,
.navsetbottom { display: none; }
.maincolumn {
width: auto;
margin-right: 13em;
margin-left: 0;
}
}

@ -1,5 +1,5 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax) scribble/core scribble/base scribble/manual racket/list scribble/private/manual-sprop scribble/decode scribble/html-properties racket/runtime-path racket/string)
#lang at-exp racket/base
(require (for-syntax racket/base racket/syntax) scribble/core scribble/base scribble/manual racket/list scribble/private/manual-sprop scribble/decode scribble/html-properties racket/runtime-path racket/string racket/format)
(provide (all-defined-out) (all-from-out racket/runtime-path))
@ -13,15 +13,15 @@
(define (fileblock filename . inside)
(compound-paragraph
(style "fileblock" (list* (alt-tag "div") 'multicommand
(box-mode "RfileboxBoxT" "RfileboxBoxC" "RfileboxBoxB")
scheme-properties))
(box-mode "RfileboxBoxT" "RfileboxBoxC" "RfileboxBoxB")
scheme-properties))
(list
(paragraph (style "fileblock_filetitle" (list* (alt-tag "div") (box-mode* "RfiletitleBox") scheme-properties))
(list (make-element
(style "fileblock_filename" (list (css-style-addition mb-css)))
(if (string? filename)
(filepath filename)
filename))))
(list (make-element
(style "fileblock_filename" (list (css-style-addition mb-css)))
(if (string? filename)
(filepath filename)
filename))))
(compound-paragraph
(style "fileblock_filecontent" (list* (alt-tag "div") (box-mode* "RfilecontentBox") scheme-properties))
(decode-flow inside)))))
@ -47,16 +47,16 @@
(define (noskip-note)
(nested #:style (style "noskip" (list (css-style-addition mb-css) (alt-tag "div")))
(margin-note "Dont skip this section! It explains a concept that's essential to understanding how Pollen works.")))
(margin-note "Dont skip this section! It explains a concept that's essential to understanding how Pollen works.")))
(define-syntax (image/rp stx)
(syntax-case stx ()
[(_ name xs ...)
(with-syntax ([id (generate-temporary)])
#'(begin
(define-runtime-path id name)
(image id xs ...)))]))
(syntax-case stx ()
[(_ name xs ...)
(with-syntax ([id (generate-temporary)])
#'(begin
(define-runtime-path id name)
(image id xs ...)))]))
(require (for-syntax racket/syntax))
@ -69,3 +69,12 @@
#'(deftogether ((defthing world:name predicate?)
(defproc (world:current-name) predicate?))
desc ...))]))
(define (val . args)
(racketvalfont (element 'tt (map ~v args))))
(define (id . args)
(element 'tt (map ~a args)))
(define (ext expr)
@code[(format ".~a" expr)])

@ -8,9 +8,8 @@
@include-section["decode.scrbl"]
@include-section["file.scrbl"]
@include-section["pagetree.scrbl"]
@include-section["pygments.scrbl"]
@include-section["render.scrbl"]
@include-section["template.scrbl"]
@include-section["tag.scrbl"]
@include-section["template.scrbl"]
@include-section["top.scrbl"]
@include-section["world.scrbl"]

@ -103,7 +103,7 @@ conclusion.html
@section{Making pagetrees by hand}
Experienced programmers may want to know that because a pagetree is just an X-expression, you can synthesize a pagetree using any Pollen or Racket tools for making X-expressions. For example, here's some Racket code that generates the same pagetree as the @filepath{flat.ptree} source file above:
Because a pagetree is just an X-expression, you can synthesize a pagetree using any Pollen or Racket tools for making X-expressions. For example, here's some Racket code that generates the same pagetree as the @filepath{flat.ptree} source file above:
@fileblock["make-flat-ptree.rkt" @codeblock{
#lang racket
@ -273,7 +273,7 @@ Like @racket[pagetree?], but raises a descriptive error if @racket[_possible-pag
(pagenode?
[possible-pagenode any/c])
boolean?]
Test whether @racket[_possible-pagenode] is a valid pagenode. A pagenode can be any @racket[symbol?] that is not @racket[whitespace/nbsp?] Every leaf of a pagetree is a pagenode. In practice, your pagenodes will likely be names of output files.
Test whether @racket[_possible-pagenode] is a valid pagenode. A pagenode can be any @racket[symbol?] that is not whitespace. Every leaf of a pagetree is a pagenode. In practice, your pagenodes will likely be names of output files.
@margin-note{Pagenodes are symbols (rather than strings) so that pagetrees will be valid tagged X-expressions, which is a more convenient format for validation & processing.}
@ -313,7 +313,7 @@ Convert @racket[_v] to a pagenode.
@defparam[current-pagetree pagetree pagetree?]{
A parameter that defines the default pagetree used by pagetree navigation functions (e.g., @racket[parent-pagenode], @racket[chidren], et al.) if another is not explicitly specified. Initialized to @racket[#f].}
A parameter that defines the default pagetree used by pagetree navigation functions (e.g., @racket[parent], @racket[children], et al.) if another is not explicitly specified. Initialized to @racket[#f].}
@defproc[
@ -418,11 +418,11 @@ Return the pagenode immediately after @racket[_p]. For @racket[next*], return al
@defproc[
(load-pagetree
(get-pagetree
[pagetree-source pathish?])
pagetree?
]
Load a pagetree from a @filepath{ptree} source file, namely @racket[_pagetree-source].
Get a pagetree from a @ext[world:pagetree-source-ext] source file, namely @racket[_pagetree-source].
@defproc[
@ -432,6 +432,12 @@ list?
]
Convert @racket[_pagetree] to a simple list. Uses @racket[flatten], and is thus equivalent to a pre-order depth-first traversal of @racket[_pagetree].
@examples[#:eval my-eval
(current-pagetree '(root (mama.html son.html daughter.html) uncle.html))
(pagetree->list (current-pagetree))
]
@defproc[
(in-pagetree?
[pagenode pagenode?]
@ -440,10 +446,17 @@ boolean?
]
Report whether @racket[_pagenode] is in @racket[_pagetree].
@examples[#:eval my-eval
(current-pagetree '(root (mama.html son.html daughter.html) uncle.html))
(in-pagetree? 'son.html)
(in-pagetree? 'alcoholic-grandma.html)
]
@defproc[
(path->pagenode
[p pathish?]
[starting-path pathish? (world:current-project-root)])
pagenode?
]
Convert path @racket[_p] to a pagenode — meaning, make it relative to @racket[_starting-path], run it through @racket[->output-path], and convert it to a symbol. Does not tell you whether the resultant pagenode actually exists in the current pagetree (for that, use @racket[in-pagetree?]).
Convert path @racket[_p] to a pagenode — meaning, make it relative to @racket[_starting-path], run it through @racket[->output-path], and convert it to a symbol. Does not tell you whether the resulting pagenode actually exists in the current pagetree (for that, use @racket[in-pagetree?]).

@ -40,37 +40,22 @@ Or, if you can find a better digital-publishing tool, use that. But I'm never go
@include-section["installation.scrbl"]
@include-section["quick.scrbl"]
@include-section["story.scrbl"]
@include-section["big-picture.scrbl"]
@include-section["tutorial-first.scrbl"]
@include-section["tutorial-second.scrbl"]
@include-section["tutorial-third.scrbl"]
@include-section["tutorial-fourth.scrbl"]
@include-section["tutorial-mini.scrbl"]
@include-section["raco.scrbl"]
@include-section["formats.scrbl"]
@include-section["command.scrbl"]
@include-section["programming-pollen.scrbl"]
@include-section["module-reference.scrbl"]
@include-section["unstable-module-reference.scrbl"]
@include-section["more-help.scrbl"]
@include-section["acknowledgments.scrbl"]
@include-section["license.scrbl"]
@index-section[]

Before

Width:  |  Height:  |  Size: 38 KiB

After

Width:  |  Height:  |  Size: 38 KiB

Before

Width:  |  Height:  |  Size: 25 KiB

After

Width:  |  Height:  |  Size: 25 KiB

Before

Width:  |  Height:  |  Size: 37 KiB

After

Width:  |  Height:  |  Size: 37 KiB

@ -1,6 +1,5 @@
#lang scribble/manual
@(require scribble/eval (for-label pollen/pygments pollen/decode plot pollen/world pollen/tag racket/base pollen/template txexpr racket/list racket/string))
#lang scribble/manual
@(require scribble/eval (for-label pollen/unstable/pygments pollen/decode plot pollen/world pollen/tag racket/base pollen/template txexpr racket/list racket/string))
@(require "mb-tools.rkt")
@(define my-eval (make-base-eval))

Before

Width:  |  Height:  |  Size: 267 KiB

After

Width:  |  Height:  |  Size: 267 KiB

@ -1,15 +1,15 @@
#lang scribble/manual
@(require scribble/eval pollen/decode pollen/world (prefix-in html: pollen/html) txexpr (for-label txexpr racket (except-in pollen #%module-begin)))
@(require scribble/eval pollen/decode pollen/world txexpr (for-label txexpr racket (except-in pollen #%module-begin)))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/pygments))
@(my-eval `(require pollen pollen/unstable/pygments))
@(require "mb-tools.rkt")
@title{Pygments}
@defmodule[pollen/pygments]
@defmodule[pollen/unstable/pygments]
A simple interface to syntax highlighting using Pygments. @bold{You must already have Pygments installed to use this module.} See the mini-tutorial @seclink["pygments-with-pollen"].
@ -25,7 +25,7 @@ Sample input:
@codeblock{
#lang pollen
◊(require pollen/pygments)
◊(require pollen/unstable/pygments)
◊highlight['python]{
for x in range(3):
print x

@ -317,9 +317,9 @@ For that, we'll make a special file called @filepath{pollen.rkt}. This is a file
(require pollen/tag)
(provide (all-defined-out))
(define headline (make-default-tag-function 'h2))
(define items (make-default-tag-function 'ul))
(define item (make-default-tag-function 'li 'p))
(define headline (default-tag-function 'h2))
(define items (default-tag-function 'ul))
(define item (default-tag-function 'li 'p))
(define (link url text) `(a [[href ,url]] ,text))
}]

@ -0,0 +1,249 @@
/* See the beginning of "scribble.css". */
/* Monospace: */
.RktIn, .RktRdr, .RktPn, .RktMeta,
.RktMod, .RktKw, .RktVar, .RktSym,
.RktRes, .RktOut, .RktCmt, .RktVal,
.RktBlk {
font-family: monospace;
white-space: inherit;
}
/* Serif: */
.inheritedlbl {
font-family: serif;
}
/* Sans-serif: */
.RBackgroundLabelInner {
font-family: sans-serif;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 100%;
margin-top: 0.5em;
text-align: left;
background-color: #ECF5F5;
}
.inherited td {
font-size: 82%;
padding-left: 1em;
text-indent: -0.8em;
padding-right: 0.2em;
}
.inheritedlbl {
font-style: italic;
}
/* ---------------------------------------- */
/* Racket text styles */
.RktIn {
color: #cc6633;
background-color: #eeeeee;
}
.RktInBG {
background-color: #eeeeee;
}
.RktRdr {
}
.RktPn {
color: #843c24;
}
.RktMeta {
color: black;
}
.RktMod {
color: black;
}
.RktOpt {
color: black;
}
.RktKw {
color: black;
}
.RktErr {
color: red;
font-style: italic;
}
.RktVar {
color: #262680;
font-style: italic;
}
.RktSym {
color: #262680;
}
.RktSymDef { /* used with RktSym at def site */
}
.RktValLink {
text-decoration: none;
color: blue;
}
.RktValDef { /* used with RktValLink at def site */
}
.RktModLink {
text-decoration: none;
color: blue;
}
.RktStxLink {
text-decoration: none;
color: black;
}
.RktStxDef { /* used with RktStxLink at def site */
}
.RktRes {
color: #0000af;
}
.RktOut {
color: #960096;
}
.RktCmt {
color: #c2741f;
}
.RktVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together {
width: 100%;
}
.prototype, .argcontract, .RBoxed {
white-space: nowrap;
}
.prototype td {
vertical-align: text-top;
}
.RktBlk {
white-space: inherit;
text-align: left;
}
.RktBlk tr {
white-space: inherit;
}
.RktBlk td {
vertical-align: baseline;
white-space: inherit;
}
.argcontract td {
vertical-align: text-top;
}
.highlighted {
background-color: #ddddff;
}
.defmodule {
width: 100%;
background-color: #F5F5DC;
}
.specgrammar {
float: right;
}
.RBibliography td {
vertical-align: text-top;
}
.leftindent {
margin-left: 1em;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.Rfilebox {
}
.Rfiletitle {
text-align: right;
margin: 0em 0em 0em 0em;
}
.Rfilename {
border-top: 1px solid #6C8585;
border-right: 1px solid #6C8585;
padding-left: 0.5em;
padding-right: 0.5em;
background-color: #ECF5F5;
}
.Rfilecontent {
margin: 0em 0em 0em 0em;
}
.RpackageSpec {
padding-right: 0.5em;
}
/* ---------------------------------------- */
/* For background labels */
.RBackgroundLabel {
float: right;
width: 0px;
height: 0px;
}
.RBackgroundLabelInner {
position: relative;
width: 25em;
left: -25.5em;
top: 0px;
text-align: right;
color: white;
z-index: 0;
font-weight: bold;
}
.RForeground {
position: relative;
left: 0px;
top: 0px;
z-index: 1;
}
/* ---------------------------------------- */
/* History */
.SHistory {
font-size: 82%;
}

@ -38,18 +38,16 @@ Like @racket[render], but saves the file to @racket[_output-path], overwriting w
(render-to-file-if-needed
[source-path complete-path?]
[template-path (or/c #f complete-path?) #f]
[output-path (or/c #f complete-path?) #f]
[#:force force-render? boolean? #f])
[output-path (or/c #f complete-path?) #f])
void?]
Like @racket[render-to-file], but the render only happens if one of these conditions exist:
@itemlist[#:style 'ordered
@item{The @racket[_force-render?] flag — set with the @racket[#:force] keyword — is @racket[#t].}
@item{No file exists at @racket[_output-path]. (Thus, an easy way to force a render of a particular @racket[_output-path] is to delete it.)}
@item{Either @racket[_source-path] or @racket[_template-path] have changed since the last trip through @racket[render].}
@item{Either @racket[_source-path], @racket[_template-path], or the associated @filepath["pollen.rkt"] has changed since the last trip through @racket[render].}
@item{One or more of the project requires have changed.}]
@item{The render cache is deactivated.}]
If none of these conditions exist, @racket[_output-path] is deemed to be up to date, and the render is skipped.
@ -57,18 +55,18 @@ If none of these conditions exist, @racket[_output-path] is deemed to be up to d
@defproc[
(render-batch
[source-paths (listof pathish?)] ...)
(render*
[source-path pathish?] ...)
void?]
Render multiple @racket[_source-paths] in one go. This can be faster than @racket[(for-each render _source-paths)] if your @racket[_source-paths] rely on a common set of templates. Templates may have their own source files that need to be compiled. If you use @racket[render], the templates will be repeatedly (and needlessly) re-compiled. Whereas if you use @racket[render-batch], each template will only be compiled once.
Render multiple @racket[_source-paths] in one go. This can be faster than @racket[(for-each render _source-paths)] if your @racket[_source-paths] rely on a common set of templates. Templates may have their own source files that need to be compiled. If you use @racket[render], the templates will be repeatedly (and needlessly) re-compiled. Whereas if you use @racket[render*], each template will only be compiled once.
@defproc*[
(
[(render-pagetree [pagetree pagetree?]) void?]
[(render-pagetree [pagetree-source pathish?]) void?])]
Using @racket[_pagetree], or a pagetree loaded from @racket[_pagetree-source], render the pages in that pagetree using @racket[render-batch].
@defproc[
(render-pagenodes
[pt-or-pt-source (or/c pathish? pagetree?)])
void?]
Using @racket[_pt-or-pt-source], render the pagenodes in that pagetree using @racket[render*].
Note that @racket[_pagetree] or @racket[_pagetree_source] is used strictly as a list of files to render. It is not used, for instance, as the navigational pagetree for the rendered files.
Note that @racket[_pt-or-pt-source] is used strictly as a list of files to render, like a batch file. It is not used as the navigational pagetree for the rendered files.
@defproc[
(get-template-for

Before

Width:  |  Height:  |  Size: 22 KiB

After

Width:  |  Height:  |  Size: 22 KiB

@ -0,0 +1,170 @@
// Common functionality for PLT documentation pages
// Page Parameters ------------------------------------------------------------
var page_query_string = location.search.substring(1);
var page_args =
((function(){
if (!page_query_string) return [];
var args = page_query_string.split(/[&;]/);
for (var i=0; i<args.length; i++) {
var a = args[i];
var p = a.indexOf('=');
if (p >= 0) args[i] = [a.substring(0,p), a.substring(p+1)];
else args[i] = [a, false];
}
return args;
})());
function GetPageArg(key, def) {
for (var i=0; i<page_args.length; i++)
if (page_args[i][0] == key) return decodeURIComponent(page_args[i][1]);
return def;
}
function MergePageArgsIntoLink(a) {
if (page_args.length == 0 ||
(!a.attributes["data-pltdoc"]) || (a.attributes["data-pltdoc"].value == ""))
return;
a.href = MergePageArgsIntoUrl(a.href);
}
function MergePageArgsIntoUrl(href) {
var mtch = href.match(/^([^?#]*)(?:\?([^#]*))?(#.*)?$/);
if (mtch == undefined) { // I think this never happens
return "?" + page_query_string;
}
if (!mtch[2]) {
return mtch[1] + "?" + page_query_string + (mtch[3] || "");
}
// need to merge here, precedence to arguments that exist in `a'
var i, j;
var prefix = mtch[1], str = mtch[2] || "", suffix = mtch[3] || "";
var args = str.split(/[&;]/);
for (i=0; i<args.length; i++) {
j = args[i].indexOf('=');
if (j) args[i] = args[i].substring(0,j);
}
var additions = "";
for (i=0; i<page_args.length; i++) {
var exists = false;
for (j=0; j<args.length; j++)
if (args[j] == page_args[i][0]) { exists = true; break; }
if (!exists) str += "&" + page_args[i][0] + "=" + page_args[i][1];
}
return prefix + "?" + str + suffix;
}
// Cookies --------------------------------------------------------------------
// Actually, try localStorage (a la HTML 5), first.
function GetCookie(key, def) {
try {
var v = localStorage[key];
if (!v) v = def;
return v;
} catch (e) {
var i, cookiestrs;
try {
if (document.cookie.length <= 0) return def;
cookiestrs = document.cookie.split(/; */);
} catch (e) { return def; }
for (i = 0; i < cookiestrs.length; i++) {
var cur = cookiestrs[i];
var eql = cur.indexOf('=');
if (eql >= 0 && cur.substring(0,eql) == key)
return unescape(cur.substring(eql+1));
}
return def;
}
}
function SetCookie(key, val) {
try {
localStorage[key] = val;
} catch(e) {
var d = new Date();
d.setTime(d.getTime()+(365*24*60*60*1000));
try {
document.cookie =
key + "=" + escape(val) + "; expires="+ d.toGMTString() + "; path=/";
} catch (e) {}
}
}
// note that this always stores a directory name, ending with a "/"
function SetPLTRoot(ver, relative) {
var root = location.protocol + "//" + location.host
+ NormalizePath(location.pathname.replace(/[^\/]*$/, relative));
SetCookie("PLT_Root."+ver, root);
}
// adding index.html works because of the above
function GotoPLTRoot(ver, relative) {
var u = GetCookie("PLT_Root."+ver, null);
if (u == null) return true; // no cookie: use plain up link
// the relative path is optional, default goes to the toplevel start page
if (!relative) relative = "index.html";
location = u + relative;
return false;
}
// Utilities ------------------------------------------------------------------
var normalize_rxs = [/\/\/+/g, /\/\.(\/|$)/, /\/[^\/]*\/\.\.(\/|$)/];
function NormalizePath(path) {
var tmp, i;
for (i = 0; i < normalize_rxs.length; i++)
while ((tmp = path.replace(normalize_rxs[i], "/")) != path) path = tmp;
return path;
}
// `noscript' is problematic in some browsers (always renders as a
// block), use this hack instead (does not always work!)
// document.write("<style>mynoscript { display:none; }</style>");
// Interactions ---------------------------------------------------------------
function DoSearchKey(event, field, ver, top_path) {
var val = field.value;
if (event && event.keyCode == 13) {
var u = GetCookie("PLT_Root."+ver, null);
if (u == null) u = top_path; // default: go to the top path
u += "search/index.html?q=" + encodeURIComponent(val);
u = MergePageArgsIntoUrl(u);
location = u;
return false;
}
return true;
}
function TocviewToggle(glyph, id) {
var s = document.getElementById(id).style;
var expand = s.display == "none";
s.display = expand ? "block" : "none";
glyph.innerHTML = expand ? "&#9660;" : "&#9658;";
}
// Page Init ------------------------------------------------------------------
// Note: could make a function that inspects and uses window.onload to chain to
// a previous one, but this file needs to be required first anyway, since it
// contains utilities for all other files.
var on_load_funcs = [];
function AddOnLoad(fun) { on_load_funcs.push(fun); }
window.onload = function() {
for (var i=0; i<on_load_funcs.length; i++) on_load_funcs[i]();
};
AddOnLoad(function(){
var links = document.getElementsByTagName("a");
for (var i=0; i<links.length; i++) MergePageArgsIntoLink(links[i]);
var label = GetPageArg("ctxtname",false);
if (!label) return;
var indicator = document.getElementById("contextindicator");
if (!indicator) return;
indicator.innerHTML = label;
indicator.style.display = "block";
});

@ -0,0 +1,484 @@
/* This file is used by default by all Scribble documents.
See also "manual.css", which is added by default by the
`scribble/manual` language. */
/* CSS seems backward: List all the classes for which we want a
particular font, so that the font can be changed in one place. (It
would be nicer to reference a font definition from all the places
that we want it.)
As you read the rest of the file, remember to double-check here to
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
font-family: monospace;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .sroman, i {
font-family: serif;
}
/* Sans-serif: */
.version, .versionNoNav, .ssansserif {
font-family: sans-serif;
}
.ssansserif {
font-size: 80%;
font-weight: bold;
}
/* ---------------------------------------- */
p, .SIntrapara {
display: block;
margin: 1em 0;
}
h2 { /* per-page main title */
margin-top: 0;
}
h3, h4, h5, h6, h7, h8 {
margin-top: 1.75em;
margin-bottom: 0.5em;
}
.SSubSubSubSection {
font-weight: bold;
font-size: 0.83em; /* should match h5; from HTML 4 reference */
}
/* Needed for browsers like Opera, and eventually for HTML 4 conformance.
This means that multiple paragraphs in a table element do not have a space
between them. */
table p {
margin-top: 0;
margin-bottom: 0;
}
/* ---------------------------------------- */
/* Main */
body {
color: black;
background-color: #ffffff;
}
table td {
padding-left: 0;
padding-right: 0;
}
.maincolumn {
width: 43em;
margin-right: -40em;
margin-left: 15em;
}
.main {
text-align: left;
}
/* ---------------------------------------- */
/* Navigation */
.navsettop, .navsetbottom {
background-color: #f0f0e0;
padding: 0.25em 0 0.25em 0;
}
.navsettop {
margin-bottom: 1.5em;
border-bottom: 2px solid #e0e0c0;
}
.navsetbottom {
margin-top: 2em;
border-top: 2px solid #e0e0c0;
}
.navleft {
margin-left: 1ex;
position: relative;
float: left;
white-space: nowrap;
}
.navright {
margin-right: 1ex;
position: relative;
float: right;
white-space: nowrap;
}
.nonavigation {
color: #e0e0e0;
}
.searchform {
display: inline;
margin: 0;
padding: 0;
}
.nosearchform {
display: none;
}
.searchbox {
width: 16em;
margin: 0px;
padding: 0px;
background-color: #eee;
border: 1px solid #ddd;
text-align: center;
vertical-align: middle;
}
#contextindicator {
position: fixed;
background-color: #c6f;
color: #000;
font-family: monospace;
font-weight: bold;
padding: 2px 10px;
display: none;
right: 0;
bottom: 0;
}
/* ---------------------------------------- */
/* Version */
.versionbox {
position: relative;
float: right;
left: 2em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.version {
font-size: small;
}
.versionNoNav {
font-size: xx-small; /* avoid overlap with author */
}
.version:before, .versionNoNav:before {
content: "Version ";
}
/* ---------------------------------------- */
/* Margin notes */
.refpara, .refelem {
position: relative;
float: right;
left: 2em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.refpara, .refparaleft {
top: -1em;
}
.refcolumn {
background-color: #F5F5DC;
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid #F5F5DC;
margin: 0 0 0 0;
}
.refcontent {
margin: 0 0 0 0;
}
.refcontent p {
margin-top: 0;
margin-bottom: 0;
}
.refparaleft, .refelemleft {
position: relative;
float: left;
right: 2em;
height: 0em;
width: 13em;
margin: 0em 0em 0em -13em;
}
.refcolumnleft {
background-color: #F5F5DC;
display: block;
position: relative;
width: 13em;
font-size: 85%;
border: 0.5em solid #F5F5DC;
margin: 0 0 0 0;
}
/* ---------------------------------------- */
/* Table of contents, inline */
.toclink {
text-decoration: none;
color: blue;
font-size: 85%;
}
.toptoclink {
text-decoration: none;
color: blue;
font-weight: bold;
}
/* ---------------------------------------- */
/* Table of contents, left margin */
.tocset {
position: relative;
float: left;
width: 12.5em;
margin-right: 2em;
}
.tocset td {
vertical-align: text-top;
}
.tocview {
text-align: left;
background-color: #f0f0e0;
}
.tocsub {
text-align: left;
margin-top: 0.5em;
background-color: #f0f0e0;
}
.tocviewlist, .tocsublist {
margin-left: 0.2em;
margin-right: 0.2em;
padding-top: 0.2em;
padding-bottom: 0.2em;
}
.tocviewlist table {
font-size: 82%;
}
.tocviewlisttopspace {
margin-bottom: 1em;
}
.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
margin-left: 0.4em;
border-left: 1px solid #bbf;
padding-left: 0.8em;
}
.tocviewsublist {
margin-bottom: 1em;
}
.tocviewsublist table,
.tocviewsublistonly table,
.tocviewsublisttop table,
.tocviewsublistbottom table {
font-size: 75%;
}
.tocviewtitle * {
font-weight: bold;
}
.tocviewlink {
text-decoration: none;
color: blue;
}
.tocviewselflink {
text-decoration: underline;
color: blue;
}
.tocviewtoggle {
text-decoration: none;
color: blue;
font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
}
.tocsublist td {
padding-left: 1em;
text-indent: -1em;
}
.tocsublinknumber {
font-size: 82%;
}
.tocsublink {
font-size: 82%;
text-decoration: none;
}
.tocsubseclink {
font-size: 82%;
text-decoration: none;
}
.tocsubnonseclink {
font-size: 82%;
text-decoration: none;
padding-left: 0.5em;
}
.tocsubtitle {
font-size: 82%;
font-style: italic;
margin: 0.2em;
}
/* ---------------------------------------- */
/* Some inline styles */
.indexlink {
text-decoration: none;
}
.nobreak {
white-space: nowrap;
}
pre { margin-left: 2em; }
blockquote { margin-left: 2em; }
ol { list-style-type: decimal; }
ol ol { list-style-type: lower-alpha; }
ol ol ol { list-style-type: lower-roman; }
ol ol ol ol { list-style-type: upper-alpha; }
.SCodeFlow {
display: block;
margin-left: 1em;
margin-bottom: 0em;
margin-right: 1em;
margin-top: 0em;
white-space: nowrap;
}
.SVInsetFlow {
display: block;
margin-left: 0em;
margin-bottom: 0em;
margin-right: 0em;
margin-top: 0em;
}
.SubFlow {
display: block;
margin: 0em;
}
.boxed {
width: 100%;
background-color: #E8E8FF;
}
.hspace {
}
.slant {
font-style: oblique;
}
.badlink {
text-decoration: underline;
color: red;
}
.plainlink {
text-decoration: none;
color: blue;
}
.techoutside { text-decoration: underline; color: #b0b0b0; }
.techoutside:hover { text-decoration: underline; color: blue; }
/* .techinside:hover doesn't work with FF, .techinside:hover>
.techinside doesn't work with IE, so use both (and IE doesn't
work with inherit in the second one, so use blue directly) */
.techinside { color: black; }
.techinside:hover { color: blue; }
.techoutside:hover>.techinside { color: inherit; }
.SCentered {
text-align: center;
}
.imageleft {
float: left;
margin-right: 0.3em;
}
.Smaller {
font-size: 82%;
}
.Larger {
font-size: 122%;
}
/* A hack, inserted to break some Scheme ids: */
.mywbr {
display: inline-block;
height: 0;
width: 0;
font-size: 1px;
}
.compact li p {
margin: 0em;
padding: 0em;
}
.noborder img {
border: 0;
}
.SAuthorListBox {
position: relative;
float: right;
left: 2em;
top: -2.5em;
height: 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.SAuthorList {
font-size: 82%;
}
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}
/* print styles : hide the navigation elements */
@media print {
.tocset,
.navsettop,
.navsetbottom { display: none; }
.maincolumn {
width: auto;
margin-right: 13em;
margin-left: 0;
}
}

File diff suppressed because one or more lines are too long

@ -13,7 +13,7 @@ Convenience functions for working with tags.
@defproc[
(make-default-tag-function
(default-tag-function
[id txexpr-tag?]
[kw-attr-name keyword?]
[kw-attr-value string?] ... ...)
@ -22,7 +22,7 @@ Make a default tag function for @racket[_id]. The new tag function takes an opti
@examples[
(require pollen/tag)
(define beaucoup (make-default-tag-function 'em))
(define beaucoup (default-tag-function 'em))
(beaucoup "Bonjour")
(beaucoup '((id "greeting")) "Bonjour")
]
@ -31,15 +31,15 @@ Entering attributes this way can be cumbersome. So for convenience, the new tag
@examples[
(require pollen/tag)
(define beaucoup (make-default-tag-function 'em))
(define beaucoup (default-tag-function 'em))
(beaucoup #:id "greeting" #:class "large" "Bonjour")
]
You can also provide keyword arguments to @racket[make-default-tag-function] itself, and they will become default attributes for every use of the tag function.
You can also provide keyword arguments to @racket[default-tag-function] itself, and they will become default attributes for every use of the tag function.
@examples[
(require pollen/tag)
(define beaucoup-small (make-default-tag-function 'em #:class "small"))
(define beaucoup-small (default-tag-function 'em #:class "small"))
(beaucoup-small #:id "greeting" "Bonjour")
]
@ -49,7 +49,7 @@ Note that while default tag functions are typically used to generate tagged X-ex
@examples[
(require pollen/tag)
(define strange (make-default-tag-function 'div #:class "bizarre"))
(define strange (default-tag-function 'div #:class "bizarre"))
(code:comment @#,t{Invalid data types for elements})
(strange + *)
(code:comment @#,t{Double "class" attribute})
@ -61,7 +61,7 @@ Note that while default tag functions are typically used to generate tagged X-ex
@defform[
(define-tag-function
(tag-id attr-id elem-id) body ...)]
Helper function for making custom tag functions. Handles parsing chores, including conversion of keyword arguments into attributes (described in @racket[make-default-tag-function]), and parses other attributes and elements normally.
Helper function for making custom tag functions. Handles parsing chores, including conversion of keyword arguments into attributes (described in @racket[default-tag-function]), and parses other attributes and elements normally.
@examples[
(require pollen/tag)

@ -1,9 +1,9 @@
#lang scribble/manual
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/render txexpr xml pollen/pagetree sugar/coerce pollen/template pollen/world))
@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/render txexpr xml pollen/pagetree sugar/coerce pollen/template pollen/template/html pollen/world))
@(define my-eval (make-base-eval))
@(my-eval `(require pollen pollen/template xml))
@(my-eval `(require pollen pollen/template pollen/template/html xml))
@title{Template}
@ -11,78 +11,7 @@
Convenience functions for templates. These are automatically imported into the @racket[eval] environment when rendering with a template (see @racket[render]).
This module also provides everything from @racketmodname[sugar/coerce].
@defproc[
(->html
[xexpr-or-xexprs (or/c xexpr? (listof xexpr?))]
[#:tag html-tag (or/c #f txexpr-tag?) #f]
[#:attrs html-attrs (or/c #f txexpr-attrs?) #f]
[#:splice splice-html? boolean? #f])
string?]
Convert @racket[_xexpr-or-xexprs] to an HTML string. Similar to @racket[xexpr->string], but consistent with the HTML spec, text that appears within @code{script} or @code{style} blocks will not be escaped.
@examples[#:eval my-eval
(define tx '(root (script "3 > 2") "Why is 3 > 2?"))
(xexpr->string tx)
(->html tx)
]
The optional keyword arguments @racket[_html-tag] and @racket[_html-attrs] let you set the outer tag and attributes for the generated HTML. If @racket[_xexpr-or-xexprs] already has an outer tag or attributes, they will be replaced.
@examples[#:eval my-eval
(define tx '(root ((id "huff")) "Bunk beds"))
(->html tx)
(->html tx #:tag 'div)
(->html tx #:attrs '((id "doback")))
(->html tx #:tag 'div #:attrs '((id "doback")))
]
Whereas if @racket[_xexpr-or-xexprs] has no tag or attributes, they will be added. If you supply attributes without a tag, you'll get an error.
@examples[#:eval my-eval
(define x "Drum kit")
(->html x)
(->html x #:tag 'div)
(->html x #:tag 'div #:attrs '((id "doback")))
(->html x #:attrs '((id "doback")))
]
If the generated HTML has an outer tag, the @racket[_splice-html?] option will strip it off. Otherwise this option has no effect.
@examples[#:eval my-eval
(define tx '(root (p "Chicken nuggets")))
(->html tx)
(->html tx #:splice #t)
(define x "Fancy sauce")
(->html x)
(code:comment @#,t{This next one won't do anything})
(->html x #:splice #t)
(code:comment @#,t{Adds the outer tag, but then #:splice removes it})
(->html x #:tag 'div #:attrs '((id "doback")) #:splice #t)
]
Be careful not to pass existing HTML strings into this function, because the angle brackets will be escaped. Fine if that's what you want, but you probably don't.
@examples[#:eval my-eval
(define tx '(p "You did " (em "what?")))
(->html tx)
(->html (->html tx))
]
As the input contract suggests, this function can take either a single @racket[xexpr?] or a list of @racket[xexpr?], with the expected results.
@examples[#:eval my-eval
(define tx '(p "You did " (em "what?")))
(->html tx)
(define txs '("You " "did " (em "what?")))
(->html txs)
(->html #:tag 'p txs)
]
This module also re-exports everything from @racketmodname[pollen/template/html].
@defproc[
@ -93,7 +22,7 @@ Retrieve the @racket[doc] export from @racket[_doc-source], which can be either
If @racket[_doc-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
If @racket[world:current-main-export] is set to an identifier name other than @racket[doc], then that identifier is retrieved instead.
If @racket[world:current-main-export] has been overridden with a project-specific value, then that is retrieved instead.
@defproc[
@ -104,7 +33,7 @@ Retrieve the @racket[metas] export from @racket[_meta-source], which can be eith
If @racket[_meta-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
If @racket[world:current-meta-export] is set to an identifier name other than @racket[metas], then that identifier is retrieved instead.
If @racket[world:current-meta-export] has been overridden with a project-specific value, then that is retrieved instead.
@deftogether[(
@ -144,6 +73,27 @@ Note that if @racket[_value-source] is a relative path or pagenode, it is treate
]
@defproc[
(select-from-doc
[key symbolish?]
[doc-source (or/c txexpr? pagenodeish? pathish?)])
(or/c #f (listof xexpr?))]
Look up the value of @racket[_key] in @racket[_doc-source]. The @racket[_doc-source] argument can be either 1) a tagged X-expression representing a @racket[doc] or 2) a pagenode or source path that identifies a source file that provides @racket[doc]. If no value exists for @racket[_key], you get @racket[#f].
Note that if @racket[_doc-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
@examples[#:eval my-eval
(module gelato pollen/markup
'(div (question "Flavor?")
(answer "Nocciola") (answer "Pistachio")))
(code:comment @#,t{Import doc from 'gelato submodule})
(require 'gelato)
(select-from-doc 'question doc)
('answer . select-from-doc . doc)
(select-from-doc 'nonexistent-key doc)
]
@defproc[
(select-from-metas
@ -162,37 +112,80 @@ Note that if @racket[_meta-source] is a relative path or pagenode, it is treated
]
@section{HTML templates}
@defmodule[pollen/template/html]
Functions specific to HTML templates.
@defproc[
(select-from-doc
[key symbolish?]
[doc-source (or/c txexpr? pagenodeish? pathish?)])
(or/c #f (listof xexpr?))]
Look up the value of @racket[_key] in @racket[_doc-source]. The @racket[_doc-source] argument can be either 1) a tagged X-expression representing a @racket[doc] or 2) a pagenode or source path that identifies a source file that provides @racket[doc]. If no value exists for @racket[_key], you get @racket[#f].
(->html
[xexpr-or-xexprs (or/c xexpr? (listof xexpr?))]
[#:tag html-tag (or/c #f txexpr-tag?) #f]
[#:attrs html-attrs (or/c #f txexpr-attrs?) #f]
[#:splice splice-html? boolean? #f])
string?]
Convert @racket[_xexpr-or-xexprs] to an HTML string. Similar to @racket[xexpr->string], but consistent with the HTML spec, text that appears within @code{script} or @code{style} blocks will not be escaped.
Note that if @racket[_doc-source] is a relative path or pagenode, it is treated as being relative to @racket[world:current-project-root]. If that's not what you want, you'll need to convert it explicitly to a complete-path (e.g., with @racket[path->complete-path] or @racket[->complete-path]).
@examples[#:eval my-eval
(define tx '(root (script "3 > 2") "Why is 3 > 2?"))
(xexpr->string tx)
(->html tx)
]
The optional keyword arguments @racket[_html-tag] and @racket[_html-attrs] let you set the outer tag and attributes for the generated HTML. If @racket[_xexpr-or-xexprs] already has an outer tag or attributes, they will be replaced.
@examples[#:eval my-eval
(module gelato pollen/markup
'(div (question "Flavor?")
(answer "Nocciola") (answer "Pistachio")))
(code:comment @#,t{Import doc from 'gelato submodule})
(require 'gelato)
(select-from-doc 'question doc)
('answer . select-from-doc . doc)
(select-from-doc 'nonexistent-key doc)
(define tx '(root ((id "huff")) "Bunk beds"))
(->html tx)
(->html tx #:tag 'div)
(->html tx #:attrs '((id "doback")))
(->html tx #:tag 'div #:attrs '((id "doback")))
]
Whereas if @racket[_xexpr-or-xexprs] has no tag or attributes, they will be added. If you supply attributes without a tag, you'll get an error.
@examples[#:eval my-eval
(define x "Drum kit")
(->html x)
(->html x #:tag 'div)
(->html x #:tag 'div #:attrs '((id "doback")))
(->html x #:attrs '((id "doback")))
]
@defproc[
(when/block
[condition any/c]
[text-to-insert any/c])
string?]
Convenience function for templates that's simpler to use than plain @racket[when]. If @racket[_condition] is true, then put the @racket[_text-to-insert] into the template at the current location. Within a template file, usually invoked like so:
If the generated HTML has an outer tag, the @racket[_splice-html?] option will strip it off. Otherwise this option has no effect.
@examples[#:eval my-eval
(define tx '(root (p "Chicken nuggets")))
(->html tx)
(->html tx #:splice #t)
(define x "Fancy sauce")
(->html x)
(code:comment @#,t{This next one won't do anything})
(->html x #:splice #t)
(code:comment @#,t{Adds the outer tag, but then #:splice removes it})
(->html x #:tag 'div #:attrs '((id "doback")) #:splice #t)
]
@verbatim{◊when/block[@racketvarfont{condition}]{The text to insert.}}
The inserted text can contain its own nested Pollen commands.
Be careful not to pass existing HTML strings into this function, because the angle brackets will be escaped. Fine if that's what you want, but you probably don't.
@examples[#:eval my-eval
(define tx '(p "You did " (em "what?")))
(->html tx)
(->html (->html tx))
]
As the input contract suggests, this function can take either a single @racket[xexpr?] or a list of @racket[xexpr?], with the expected results.
@examples[#:eval my-eval
(define tx '(p "You did " (em "what?")))
(->html tx)
(define txs '("You " "did " (em "what?")))
(->html txs)
(->html #:tag 'p txs)
]

@ -0,0 +1,7 @@
#lang racket/base
(require pollen/decode pollen/misc/tutorial txexpr)
(define (root . elements)
(txexpr 'root null (decode-elements elements
#:txexpr-elements-proc decode-paragraphs
#:string-proc (compose smart-quotes smart-dashes))))
(provide root)

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save