From 63a92b2953395f8543a708c35fff4cdb686d0706 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Mon, 8 Mar 2021 22:28:21 -0800
Subject: [PATCH] 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.
---
 pollen/pagetree.rkt    | 25 +++++++++++++------------
 pollen/private/ts.rktd |  2 +-
 2 files changed, 14 insertions(+), 13 deletions(-)

diff --git a/pollen/pagetree.rkt b/pollen/pagetree.rkt
index dbcb9cf..409d17d 100644
--- a/pollen/pagetree.rkt
+++ b/pollen/pagetree.rkt
@@ -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)))
@@ -137,7 +137,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))
@@ -159,7 +159,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
@@ -190,7 +190,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]))
 
@@ -220,11 +220,12 @@
 
 (define+provide/contract (pagetree->paths pt-or-path)
   ((or/c pagetree? pathish?) . -> . (listof complete-path?))
-  (parameterize ([current-directory (current-project-root)])
-    (map ->complete-path (pagetree->list (match pt-or-path
-                                           [(? pagetree? pt) pt]
-                                           [_ (cached-doc pt-or-path)])))))
-
+  (define-values (dir-for-resolving-paths pt)
+    (match pt-or-path
+      [(? pagetree?) (values (current-project-root) 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
  (define test-pagetree `(pagetree-main foo bar (one (two three))))
diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd
index b554676..de65aa5 100644
--- a/pollen/private/ts.rktd
+++ b/pollen/private/ts.rktd
@@ -1 +1 @@
-1614969950
+1615271301