`parent` returns #f for root of pagetree

pull/102/head
Matthew Butterick 9 years ago
parent ef7494ed83
commit 3d4e783dd1

@ -111,19 +111,28 @@
(load-pagetree pagetree-source)))
(define+provide/contract (parent pnish [pt (current-pagetree)])
(((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?))
(define+provide/contract (parent pnish [pt (current-pagetree)] #:allow-root [allow-root? #f])
(((or/c #f pagenodeish?)) (pagetree? #:allow-root boolean?) . ->* . (or/c #f pagenode?))
(define subtree? list?)
(define (topmost-node x) (if (subtree? x) (car x) x))
(define result
(and pt pnish
(let ([pagenode (->pagenode pnish)])
(if (member pagenode (map (λ(x) (if (list? x) (car x) x)) (cdr pt)))
(car pt)
(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))))

@ -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[

Loading…
Cancel
Save