fix pagetree->path (closes #249)

Pagetree promises that its nodes will be resolved relative to the directory where the pagetree lives. For path-based pagetrees, make sure this directory is set correctly.
pull/253/head
Matthew Butterick 3 years ago
parent 7c348dde44
commit 63a92b2953

@ -48,9 +48,9 @@
(define pt-root-tag (setup:pagetree-root-node)) (define pt-root-tag (setup:pagetree-root-node))
(define (splice-nested-pagetree xs) (define (splice-nested-pagetree xs)
(apply append (for/list ([x (in-list xs)]) (apply append (for/list ([x (in-list xs)])
(if (and (txexpr? x) (eq? (get-tag x) pt-root-tag)) (if (and (txexpr? x) (eq? (get-tag x) pt-root-tag))
(get-elements x) (get-elements x)
(list x))))) (list x)))))
(validate-pagetree (validate-pagetree
(decode (cons pt-root-tag xs) (decode (cons pt-root-tag xs)
#:txexpr-elements-proc (compose1 splice-nested-pagetree (λ (xs) (filter-not whitespace? xs))) #:txexpr-elements-proc (compose1 splice-nested-pagetree (λ (xs) (filter-not whitespace? xs)))
@ -63,7 +63,7 @@
(define pagenodes (pagetree-strict->list x)) (define pagenodes (pagetree-strict->list x))
(for ([p (in-list pagenodes)] (for ([p (in-list pagenodes)]
#:unless (pagenode? p)) #: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)))]) (with-handlers ([exn:fail? (λ (e) (error 'validate-pagetree "~a" (exn-message e)))])
(members-unique?/error pagenodes)) (members-unique?/error pagenodes))
x))) x)))
@ -137,7 +137,7 @@
(if (memq pagenode (map topmost-node current-children)) (if (memq pagenode (map topmost-node current-children))
current-parent current-parent
(for/or ([st (in-list (filter list? current-children))]) (for/or ([st (in-list (filter list? current-children))])
(loop pagenode st)))))) (loop pagenode st))))))
(if (eq? result (first pt)) (if (eq? result (first pt))
(and allow-root? result) (and allow-root? result)
result)) result))
@ -159,7 +159,7 @@
(match pagenode (match pagenode
[(== (first pt) eq?) (map topmost-node (rest pt))] [(== (first pt) eq?) (map topmost-node (rest pt))]
[_ (for/or ([subtree (in-list (filter pair? pt))]) [_ (for/or ([subtree (in-list (filter pair? pt))])
(loop pagenode subtree))])))) (loop pagenode subtree))]))))
(module-test-external (module-test-external
@ -190,7 +190,7 @@
(((or/c #f pagenodeish?)) ((or/c pagetree? pathish?)) . ->* . (or/c #f pagenodes?)) (((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))] (match (for/list ([sib (in-list (or (siblings pnish pt-or-path) empty))]
#:unless (eq? sib (->pagenode pnish))) #:unless (eq? sib (->pagenode pnish)))
sib) sib)
[(? pair? sibs) sibs] [(? pair? sibs) sibs]
[_ #false])) [_ #false]))
@ -220,11 +220,12 @@
(define+provide/contract (pagetree->paths pt-or-path) (define+provide/contract (pagetree->paths pt-or-path)
((or/c pagetree? pathish?) . -> . (listof complete-path?)) ((or/c pagetree? pathish?) . -> . (listof complete-path?))
(parameterize ([current-directory (current-project-root)]) (define-values (dir-for-resolving-paths pt)
(map ->complete-path (pagetree->list (match pt-or-path (match pt-or-path
[(? pagetree? pt) pt] [(? pagetree?) (values (current-project-root) pt-or-path)]
[_ (cached-doc pt-or-path)]))))) [_ (values (dirname (->path pt-or-path)) (cached-doc pt-or-path))]))
(parameterize ([current-directory dir-for-resolving-paths])
(map ->complete-path (pagetree->list pt))))
(module-test-external (module-test-external
(define test-pagetree `(pagetree-main foo bar (one (two three)))) (define test-pagetree `(pagetree-main foo bar (one (two three))))

@ -1 +1 @@
1614969950 1615271301

Loading…
Cancel
Save