correct next* return value (fixes #187)

candidate-v2.0
Matthew Butterick 6 years ago
parent 4a55c98a0c
commit 8c27ed5406

@ -48,9 +48,9 @@
(define pt-root-tag (setup:pagetree-root-node))
(define (splice-nested-pagetree xs)
(apply append (for/list ([x (in-list xs)])
(if (and (txexpr? x) (eq? (get-tag x) pt-root-tag))
(get-elements x)
(list x)))))
(if (and (txexpr? x) (eq? (get-tag x) pt-root-tag))
(get-elements x)
(list x)))))
(validate-pagetree
(decode (cons pt-root-tag xs)
#:txexpr-elements-proc (compose1 splice-nested-pagetree (λ (xs) (filter-not whitespace? xs)))
@ -63,7 +63,7 @@
(define pagenodes (pagetree-strict->list x))
(for ([p (in-list pagenodes)]
#:unless (pagenode? p))
(raise-argument-error 'validate-pagetree "valid pagenodes" p))
(raise-argument-error 'validate-pagetree "valid pagenodes" p))
(with-handlers ([exn:fail? (λ (e) (error 'validate-pagetree "~a" (exn-message e)))])
(members-unique?/error pagenodes))
x)))
@ -138,7 +138,7 @@
(if (memq pagenode (map topmost-node current-children))
current-parent
(for/or ([st (in-list (filter list? current-children))])
(loop pagenode st))))))
(loop pagenode st))))))
(if (eq? result (first pt))
(and allow-root? result)
result))
@ -160,7 +160,7 @@
(match pagenode
[(== (first pt) eq?) (map topmost-node (rest pt))]
[_ (for/or ([subtree (in-list (filter pair? pt))])
(loop pagenode subtree))]))))
(loop pagenode subtree))]))))
(module-test-external
@ -191,7 +191,7 @@
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?))
(match (for/list ([sib (in-list (or (siblings pnish pt-or-path) empty))]
#:unless (eq? sib (->pagenode pnish)))
sib)
sib)
[(? pair? sibs) sibs]
[_ #false]))
@ -231,7 +231,7 @@
[pagetree-nodes (pagetree->list (get-pagetree pt-or-path))])
(case side
[(right) (match (memq pagenode pagetree-nodes)
[(list _ rest ...) rest]
[(list _ rest ..1) rest]
[_ #false])]
[else (match (loop 'right pagenode (reverse pagetree-nodes))
[(? pair? result) (reverse result)]
@ -254,11 +254,15 @@
(check-equal? (previous* 'three test-pagetree) '(foo bar one two))
(check-false (previous* 'foo test-pagetree)))
(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 pt-or-path))
(module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three))))
(check-equal? (next* 'foo test-pagetree) '(bar one two three))
(check-equal? (next* 'one test-pagetree) '(two three))
(check-false (next* 'three test-pagetree)))
(define+provide/contract (previous pnish [pt-or-path (current-pagetree)])
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenode?))

@ -1 +1 @@
1543680907
1544914993

Loading…
Cancel
Save