`parent` returns #f for root of pagetree

pagetree.rkt

@@ -111,19 +111,28 @@
     (load-pagetree pagetree-source)))
 
 
-(define+provide/contract (parent pnish [pt (current-pagetree)])
+(define+provide/contract (parent pnish [pt (current-pagetree)] #:allow-root [allow-root? #f])
-  (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?)) 
+  (((or/c #f pagenodeish?)) (pagetree? #:allow-root boolean?) . ->* . (or/c #f pagenode?))
-  (and pt pnish
+  (define subtree? list?)
-       (let ([pagenode (->pagenode pnish)])
+  (define (topmost-node x) (if (subtree? x) (car x) x))
-         (if (member pagenode (map (λ(x) (if (list? x) (car x) x)) (cdr pt)))
+  (define result
-             (car pt)
+    (and pt pnish
-             (ormap (λ(x) (parent pagenode x)) (filter list? pt))))))
+         (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))
+               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)
  (check-equal? (parent "three" test-pagetree) 'two)
+ (check-false (parent 'foo test-pagetree))
  (check-false (parent #f test-pagetree))
  (check-false (parent 'nonexistent-name test-pagetree)))
 
@@ -147,7 +156,7 @@
 
 (define+provide/contract (siblings pnish [pt (current-pagetree)])
   (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?))  
-  (children (parent pnish pt) pt))
+  (children (parent #:allow-root #t pnish pt) pt))
 
 (module-test-external
  (define test-pagetree `(pagetree-main foo bar (one (two three))))

scribblings/pagetree.scrbl

@@ -321,14 +321,14 @@ A parameter that defines the default pagetree used by pagetree navigation functi
 [p (or/c #f pagenodeish?)]
 [pagetree pagetree? (current-pagetree)])
 (or/c #f pagenode?)]
-Find the parent pagenode of @racket[_p] within @racket[_pagetree]. Return @racket[#f] if there isn't one.
+Find the parent pagenode of @racket[_p] within @racket[_pagetree]. Return @racket[#f] if there isn't one, or if you reach the root of the pagetree.
 
 @examples[#:eval my-eval
 (current-pagetree '(root (mama.html son.html daughter.html) uncle.html))
 (parent 'son.html)
-(parent "mama.html")
+(parent 'daughter.html)
+(parent "uncle.html")
 (parent (parent 'son.html))
-(parent (parent (parent 'son.html)))
 ]
 
 @defproc[