From 476d9e1d2342744e86544a0cc8b4145bf0044fd8 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 5 Feb 2014 18:55:31 -0800 Subject: [PATCH] updates --- main-imports.rkt | 2 +- main.rkt | 2 +- pollen-server-extras/error.css | 2 +- predicates.rkt | 6 ++---- ptree.rkt | 16 +++++++++++++--- render.rkt | 23 ++++++++++++----------- 6 files changed, 30 insertions(+), 21 deletions(-) diff --git a/main-imports.rkt b/main-imports.rkt index 72fa72d..b7732de 100644 --- a/main-imports.rkt +++ b/main-imports.rkt @@ -8,7 +8,7 @@ (require racket/list (planet mb/pollen/tools) (planet mb/pollen/main-helper) - (only-in (planet mb/pollen/ptree) ptree-source-decode) + (only-in (planet mb/pollen/ptree) ptree-source-decode path->ptree-name) (only-in (planet mb/pollen/predicates) ptree?)) (provide (all-from-out racket/list diff --git a/main.rkt b/main.rkt index c6c300f..cfc33ed 100644 --- a/main.rkt +++ b/main.rkt @@ -49,7 +49,7 @@ (require 'pollen-inner) ; provides doc & #%top, among other things - (define here inner-here-path) + (define here (path->ptree-name inner-here-path)) ;; prepare the elements, and append inner-here-path as meta. ;; put it first so it can be overridden by custom meta later on diff --git a/pollen-server-extras/error.css b/pollen-server-extras/error.css index 8a8717f..58a642f 100644 --- a/pollen-server-extras/error.css +++ b/pollen-server-extras/error.css @@ -26,7 +26,7 @@ pre { font-size: 80%; font-family: "Source Code Pro"; white-space: pre-wrap; - overflow: scroll; + overflow: auto; max-height: 240px; } diff --git a/predicates.rkt b/predicates.rkt index 4a6c735..9c579ee 100644 --- a/predicates.rkt +++ b/predicates.rkt @@ -184,20 +184,18 @@ ;; a valid base name for a file? ;; however, don't restrict it to existing files ;; (author may want to use ptree as wireframe) - (define result - (or (eq? x #f) ; OK for map-key to be #f - (and (not (list? x)) (not (whitespace? (->string x)))))) + (define result (and x (not (list? x)) (not (whitespace? (->string x))))) (if (and (not result) loud) (error "Not a valid ptree key:" x) result)) (module+ test - (check-true (ptree-name? #f)) (check-true (ptree-name? "foo-bar")) (check-true (ptree-name? "Foo_Bar_0123")) (check-true (ptree-name? 'foo-bar)) (check-true (ptree-name? "foo-bar.p")) (check-true (ptree-name? "/Users/MB/foo-bar")) + (check-false (ptree-name? #f)) (check-false (ptree-name? "")) (check-false (ptree-name? " "))) diff --git a/ptree.rkt b/ptree.rkt index 51a4d6a..d30293c 100644 --- a/ptree.rkt +++ b/ptree.rkt @@ -40,7 +40,7 @@ ;; return the parent of a given name (define/contract (parent name [ptree current-ptree]) - ((ptree-name?) (ptree?) . ->* . (or/c ptree-name? false?)) + (((or/c ptree-name? false?)) (ptree?) . ->* . (or/c ptree-name? false?)) (and name (if (member (->string name) (map (λ(x) (->string (if (list? x) (car x) x))) (cdr ptree))) (->string (car ptree)) @@ -52,12 +52,13 @@ (define test-ptree (ptree-root->ptree test-ptree-main)) (check-equal? (parent 'three test-ptree) "two") (check-equal? (parent "three" test-ptree) "two") + (check-false (parent #f test-ptree)) (check-false (parent 'nonexistent-name test-ptree))) ; get children of a particular name (define/contract (children name [ptree current-ptree]) - ((ptree-name?) (ptree?) . ->* . (or/c (listof ptree-name?) false?)) + (((or/c ptree-name? false?)) (ptree?) . ->* . (or/c (listof ptree-name?) false?)) (and name (if (equal? (->string name) (->string (car ptree))) (map (λ(x) (->string (if (list? x) (car x) x))) (cdr ptree)) @@ -67,6 +68,7 @@ (check-equal? (children 'one test-ptree) (list "two")) (check-equal? (children 'two test-ptree) (list "three")) (check-false (children 'three test-ptree)) + (check-false (children #f test-ptree)) (check-false (children 'fooburger test-ptree))) @@ -273,12 +275,14 @@ -(define current-ptree '(empty ((parent "")))) ;; simplest empty ptree that will meet ptree contract +(define current-ptree '()) (define/contract (set-current-ptree ptree) (ptree? . -> . void?) (set! current-ptree ptree)) +(set-current-ptree '(ptree-root)) + ;; create the state variable (define current-url-context '()) @@ -293,6 +297,12 @@ ;; set the state variable using the setter (set-current-url-context PROJECT_ROOT) +;; used to convert here-path into here +(define/contract (path->ptree-name path) + (pathish? . -> . ptree-name?) + (->string (->output-path (find-relative-path PROJECT_ROOT (->path path))))) + + #| (module+ main (displayln "Running module main") diff --git a/render.rkt b/render.rkt index 93ac210..7624e00 100644 --- a/render.rkt +++ b/render.rkt @@ -344,17 +344,18 @@ ;; Therefore no way to arbitrarily invoke template at run-time. ;; This routine creates a new namespace and compiles the template within it. - (render-through-eval source-dir - `(begin - ;; for include-template (used below) - (require web-server/templates) - ;; for ptree navigation functions, and template commands - (require (planet mb/pollen/debug) (planet mb/pollen/ptree) (planet mb/pollen/template)) - ;; import source into eval space. This sets up main & metas - (require ,(->string source-name)) - (set-current-ptree (make-project-ptree ,PROJECT_ROOT)) - (set-current-url-context ,PROJECT_ROOT) - (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name))))) + (render-through-eval + source-dir + `(begin + ;; for include-template (used below) + (require web-server/templates) + ;; for ptree navigation functions, and template commands + (require (planet mb/pollen/debug) (planet mb/pollen/ptree) (planet mb/pollen/template)) + ;; import source into eval space. This sets up main & metas + (require ,(->string source-name)) + (set-current-ptree (make-project-ptree ,PROJECT_ROOT)) + (set-current-url-context ,PROJECT_ROOT) + (include-template #:command-char ,TEMPLATE_FIELD_DELIMITER ,(->string template-name))))) ;; render files listed in a ptree file