updates

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

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

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;
 }
 

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? " ")))
 

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")

render.rkt

@@ -344,7 +344,8 @@
   ;; 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
+  (render-through-eval 
+   source-dir
    `(begin 
       ;; for include-template (used below)
       (require web-server/templates)