From 67088229c993aff549a1328d778a51ecfa345dd2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 11 Jul 2016 12:52:58 -0700 Subject: [PATCH] allow `pollen/pagetree` funcs to take pagetree paths as input --- pollen/pagetree.rkt | 63 +++++++++++++++++-------------- pollen/private/ts.rktd | 2 +- pollen/scribblings/pagetree.scrbl | 24 ++++++------ 3 files changed, 47 insertions(+), 42 deletions(-) diff --git a/pollen/pagetree.rkt b/pollen/pagetree.rkt index 99f8a01..fc9b05c 100644 --- a/pollen/pagetree.rkt +++ b/pollen/pagetree.rkt @@ -103,8 +103,8 @@ (define+provide/contract (get-pagetree source-path) - (pathish? . -> . pagetree?) - (cached-doc source-path)) + ((or/c pagetree? pathish?) . -> . pagetree?) + (if (pagetree? source-path) source-path (cached-doc source-path))) (define+provide load-pagetree get-pagetree) ; bw compat @@ -117,12 +117,13 @@ (load-pagetree pagetree-source))) -(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+provide/contract (parent pnish [pt-or-path (current-pagetree)] #:allow-root [allow-root? #f]) + (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?) #:allow-root boolean?) . ->* . (or/c #f pagenode?)) (define subtree? list?) (define (topmost-node x) (if (subtree? x) (car x) x)) + (define pt (get-pagetree pt-or-path)) (define result - (and pt pnish + (and pnish (let loop ([pagenode (->pagenode pnish)][subtree pt]) (define current-parent (car subtree)) (define current-children (cdr subtree)) @@ -142,10 +143,11 @@ (check-false (parent 'nonexistent-name test-pagetree))) -(define+provide/contract (children p [pt (current-pagetree)]) - (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?)) - (and pt p - (let ([pagenode (->pagenode p)]) +(define+provide/contract (children p [pt-or-path (current-pagetree)]) + (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?)) + (and pt-or-path p + (let ([pagenode (->pagenode p)] + [pt (get-pagetree pt-or-path)]) (if (eq? pagenode (car pt)) (map (λ(x) (if (list? x) (car x) x)) (cdr pt)) (ormap (λ(x) (children pagenode x)) (filter list? pt)))))) @@ -159,8 +161,9 @@ (check-false (children 'fooburger test-pagetree))) -(define+provide/contract (siblings pnish [pt (current-pagetree)]) - (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?)) +(define+provide/contract (siblings pnish [pt-or-path (current-pagetree)]) + (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?)) + (define pt (get-pagetree pt-or-path)) (children (parent #:allow-root #t pnish pt) pt)) (module-test-external @@ -183,12 +186,12 @@ (check-equal? (pagetree->list test-pagetree) '(foo bar one two three))) -(define (adjacents side pnish [pt (current-pagetree)]) +(define (adjacents side pnish [pt-or-path (current-pagetree)]) #;(symbol? pagenodeish? pagetree? . -> . pagenodes?) - (and pt pnish + (and pt-or-path pnish (let* ([pagenode (->pagenode pnish)] [proc (if (eq? side 'left) takef takef-right)] - [pagetree-nodes (pagetree->list pt)] + [pagetree-nodes (pagetree->list (get-pagetree pt-or-path))] ;; 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)))))]) @@ -200,9 +203,9 @@ (check-false (adjacents 'right 'node-not-in-pagetree '(pagetree-index one two three)))) -(define+provide/contract (previous* pnish [pt (current-pagetree)]) - (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?)) - (adjacents 'left pnish pt)) +(define+provide/contract (previous* pnish [pt-or-path (current-pagetree)]) + (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?)) + (adjacents 'left pnish (get-pagetree pt-or-path))) (module-test-external (define test-pagetree `(pagetree-main foo bar (one (two three)))) @@ -211,14 +214,15 @@ (check-false (previous* 'foo test-pagetree))) -(define+provide/contract (next* pnish [pt (current-pagetree)]) - (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenodes?)) - (adjacents 'right pnish pt)) +(define+provide/contract (next* pnish [pt-or-path (current-pagetree)]) + (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?)) + (adjacents 'right pnish (get-pagetree pt-or-path))) -(define+provide/contract (previous pnish [pt (current-pagetree)]) - (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?)) - (let ([result (previous* pnish pt)]) +(define+provide/contract (previous pnish [pt-or-path (current-pagetree)]) + (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenode?)) + (let* ([pt (get-pagetree pt-or-path)] + [result (previous* pnish pt)]) (and result (last result)))) (module-test-external @@ -230,9 +234,10 @@ -(define+provide/contract (next pnish [pt (current-pagetree)]) - (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?)) - (let ([result (next* pnish pt)]) +(define+provide/contract (next pnish [pt-or-path (current-pagetree)]) + (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenode?)) + (let* ([pt (get-pagetree pt-or-path)] + [result (next* pnish pt)]) (and result (first result)))) (module-test-external @@ -251,6 +256,6 @@ (->output-path (find-relative-path (->complete-path starting-dir) (->complete-path path)))) -(define+provide/contract (in-pagetree? pnish [pt (current-pagetree)]) - (((or/c #f pagenodeish?)) (pagetree?) . ->* . boolean?) - (and pnish (memq pnish (pagetree->list pt)) #t)) \ No newline at end of file +(define+provide/contract (in-pagetree? pnish [pt-or-path (current-pagetree)]) + (((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . boolean?) + (and pnish (memq pnish (pagetree->list (get-pagetree pt-or-path))) #t)) \ No newline at end of file diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index acf31a9..60d5e17 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1468003549 +1468266778 diff --git a/pollen/scribblings/pagetree.scrbl b/pollen/scribblings/pagetree.scrbl index 505c739..e6f0578 100644 --- a/pollen/scribblings/pagetree.scrbl +++ b/pollen/scribblings/pagetree.scrbl @@ -319,7 +319,7 @@ A parameter that defines the default pagetree used by pagetree navigation functi @defproc[ (parent [p (or/c #f pagenodeish?)] -[pagetree pagetree? (current-pagetree)]) +[pagetree (or/c pagetree? pathish?) (current-pagetree)]) (or/c #f pagenode?)] 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. @@ -334,7 +334,7 @@ Find the parent pagenode of @racket[_p] within @racket[_pagetree]. Return @racke @defproc[ (children [p (or/c #f pagenodeish?)] -[pagetree pagetree? (current-pagetree)]) +[pagetree (or/c pagetree? pathish?) (current-pagetree)]) (or/c #f pagenode?)] Find the child pagenodes of @racket[_p] within @racket[_pagetree]. Return @racket[#f] if there aren't any. @@ -350,7 +350,7 @@ Find the child pagenodes of @racket[_p] within @racket[_pagetree]. Return @racke @defproc[ (siblings [p (or/c #f pagenodeish?)] -[pagetree pagetree? (current-pagetree)]) +[pagetree (or/c pagetree? pathish?) (current-pagetree)]) (or/c #f pagenode?)] Find the sibling pagenodes of @racket[_p] within @racket[_pagetree]. The list will include @racket[_p] itself. But the function will still return @racket[#f] if @racket[_pagetree] is @racket[#f]. @@ -367,13 +367,13 @@ Find the sibling pagenodes of @racket[_p] within @racket[_pagetree]. The list wi @defproc[ (previous [p (or/c #f pagenodeish?)] -[pagetree pagetree? (current-pagetree)]) +[pagetree (or/c pagetree? pathish?) (current-pagetree)]) (or/c #f pagenode?)] @defproc[ (previous* [p (or/c #f pagenodeish?)] -[pagetree pagetree? (current-pagetree)]) +[pagetree (or/c pagetree? pathish?) (current-pagetree)]) (or/c #f (listof pagenode?))] )] Return the pagenode immediately before @racket[_p]. For @racket[previous*], return all the pagenodes before @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any pagenodes. The root pagenode is ignored. @@ -393,13 +393,13 @@ Return the pagenode immediately before @racket[_p]. For @racket[previous*], retu @defproc[ (next [p (or/c #f pagenodeish?)] -[pagetree pagetree? (current-pagetree)]) +[pagetree (or/c pagetree? pathish?) (current-pagetree)]) (or/c #f pagenode?)] @defproc[ (next* [p (or/c #f pagenodeish?)] -[pagetree pagetree? (current-pagetree)]) +[pagetree (or/c pagetree? pathish?) (current-pagetree)]) (or/c #f (listof pagenode?))] )] Return the pagenode immediately after @racket[_p]. For @racket[next*], return all the pagenodes after @racket[_p], in sequence. In both cases, return @racket[#f] if there aren't any pagenodes. The root pagenode is ignored. @@ -419,15 +419,15 @@ Return the pagenode immediately after @racket[_p]. For @racket[next*], return al @defproc[ (get-pagetree -[pagetree-source pathish?]) +[pagetree-source (or/c pagetree? pathish?)]) pagetree? ] -Get a pagetree from a @ext[default-pagetree-source-ext] source file, namely @racket[_pagetree-source]. +Get a pagetree from a @ext[default-pagetree-source-ext] source file, namely @racket[_pagetree-source]. If @racket[_pagetree-source] is already a pagetree, just pass it through. @defproc[ (pagetree->list -[pagetree pagetree?]) +[pagetree (or/c pagetree? pathish?)]) 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]. @@ -440,8 +440,8 @@ Convert @racket[_pagetree] to a simple list. Uses @racket[flatten], and is thus @defproc[ (in-pagetree? -[pagenode pagenode?] -[pagetree pagetree? (current-pagetree)]) +[pagenode pagenodeish?] +[pagetree (or/c pagetree? pathish?) (current-pagetree)]) boolean? ] Report whether @racket[_pagenode] is in @racket[_pagetree].