From a8a94d0af96237658154534605417da8b0e17473 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 14 Oct 2015 12:33:22 -0700
Subject: [PATCH] add `load-pagetree` and improve `path->pagenode`

---
 pagetree.rkt               | 20 +++++++++++++++-----
 scribblings/pagetree.scrbl | 14 ++++++++++++--
 2 files changed, 27 insertions(+), 7 deletions(-)

diff --git a/pagetree.rkt b/pagetree.rkt
index 1dc6378..2bb6e6a 100644
--- a/pagetree.rkt
+++ b/pagetree.rkt
@@ -97,12 +97,19 @@
       (decode-pagetree (map ->symbol (unique-sorted-output-paths (filter not-pollen-cache? (directory-list dir)))))
       (error (format "directory->pagetree: directory ~a doesn't exist" dir)))) 
 
+
+(define+provide/contract (load-pagetree source-path)
+  (pathish? . -> . pagetree?)
+  (cached-require source-path (world:current-main-export)))
+
+
 ;; Try loading from pagetree file, or failing that, synthesize pagetree.
 (define+provide/contract (make-project-pagetree project-dir)
   (pathish? . -> . pagetree?)
   (with-handlers ([exn:fail? (λ(exn) (directory->pagetree project-dir))])
     (define pagetree-source (build-path project-dir (world:current-default-pagetree)))
-    (cached-require pagetree-source (world:current-main-export))))
+    (load-pagetree pagetree-source)))
+
 
 (define+provide/contract (parent pnish [pt (current-pagetree)])
   (((or/c #f pagenodeish?)) (pagetree?) . ->* . (or/c #f pagenode?)) 
@@ -220,10 +227,13 @@
  (check-false (next 'three test-pagetree)))
 
 
-
-(define/contract+provide (path->pagenode path)
-  (coerce/path? . -> . coerce/symbol?)
-  (->output-path (find-relative-path (world:current-project-root) (->complete-path path))))
+(define/contract+provide (path->pagenode path [starting-path (world:current-project-root)])
+  ((coerce/path?) (coerce/path?) . ->* . coerce/symbol?)
+  (define starting-dir
+    (if (directory-exists? starting-path)
+        starting-path
+        (get-enclosing-dir starting-path)))
+  (->output-path (find-relative-path (->complete-path starting-dir) (->complete-path path))))
 
 
 (define+provide/contract (in-pagetree? pnish [pt (current-pagetree)])
diff --git a/scribblings/pagetree.scrbl b/scribblings/pagetree.scrbl
index 17d4326..6cda564 100644
--- a/scribblings/pagetree.scrbl
+++ b/scribblings/pagetree.scrbl
@@ -416,6 +416,15 @@ Return the pagenode immediately after @racket[_p]. For @racket[next*], return al
 
 @subsection{Utilities}
 
+
+@defproc[
+(load-pagetree
+[pagetree-source pathish?])
+pagetree?
+]
+Load a pagetree from a @filepath{ptree} source file, namely @racket[_pagetree-source].
+
+
 @defproc[
 (pagetree->list
 [pagetree pagetree?])
@@ -433,7 +442,8 @@ Report whether @racket[_pagenode] is in @racket[_pagetree].
 
 @defproc[
 (path->pagenode
-[p pathish?])
+[p pathish?]
+[starting-path pathish? (world:current-project-root)])
 pagenode?
 ]
-Convert path @racket[_p] to a pagenode — meaning, make it relative to @racket[current-project-root], run it through @racket[->output-path], and convert it to a symbol. Does not tell you whether the resultant pagenode actually exists in the current pagetree (for that, use @racket[in-pagetree?]).
\ No newline at end of file
+Convert path @racket[_p] to a pagenode — meaning, make it relative to @racket[_starting-path], run it through @racket[->output-path], and convert it to a symbol. Does not tell you whether the resultant pagenode actually exists in the current pagetree (for that, use @racket[in-pagetree?]).
\ No newline at end of file