From 6422f04ad9f730ec64a5f758838a82c9ff9fdb1e Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 8 Nov 2019 17:07:24 -0800
Subject: [PATCH] behave correctly around dir

---
 quad/quadwriter/font.rkt | 35 ++++++++++++++++++-----------------
 1 file changed, 18 insertions(+), 17 deletions(-)

diff --git a/quad/quadwriter/font.rkt b/quad/quadwriter/font.rkt
index 96789c34..3a57da11 100644
--- a/quad/quadwriter/font.rkt
+++ b/quad/quadwriter/font.rkt
@@ -26,8 +26,9 @@
   ;; this makes it possible to give font families generic names (e.g., "body-text")
   ;; and change the font files without disturbing anything else.
   (hash-clear! font-paths)
-  (define-values (dir path _) (split-path base-path))
-  (define doc-fonts-dir (build-path dir top-font-directory))
+  (define doc-fonts-dir (build-path (match/values (split-path base-path)
+                                                  [(base name #true) (build-path base name)]
+                                                  [(dir _ _) dir]) top-font-directory))
   ;; run doc-fonts-dir first because earlier fonts take precedence (using hash-ref! below)
   (for* ([fonts-dir (in-list (list doc-fonts-dir quadwriter-fonts-dir))]
          #:when (directory-exists? fonts-dir)
@@ -35,21 +36,21 @@
          #:when (directory-exists? font-family-subdir)
          [font-path (in-directory font-family-subdir)]
          #:when (member (path-get-extension font-path) font-file-extensions))
-    (match-define (list font-path-string family-name)
-      (for/list ([x (list font-path font-family-subdir)])
-        (path->string (find-relative-path fonts-dir x))))
-    (define path-parts (for/list ([part (in-list (explode-path (string->path (string-downcase font-path-string))))])
-                         (path->string part)))
-    (define key
-      (cons (string-downcase family-name)
-            (cond
-              [(member "bold-italic" path-parts) 'bi]
-              [(member "bold" path-parts) 'b]
-              [(member "italic" path-parts) 'i]
-              [else 'r])))
-    ;; only set value if there's not one there already.
-    ;; this means that we only use the first eligible font we find.
-    (hash-ref! font-paths key font-path)))
+        (match-define (list font-path-string family-name)
+          (for/list ([x (list font-path font-family-subdir)])
+                    (path->string (find-relative-path fonts-dir x))))
+        (define path-parts (for/list ([part (in-list (explode-path (string->path (string-downcase font-path-string))))])
+                                     (path->string part)))
+        (define key
+          (cons (string-downcase family-name)
+                (cond
+                  [(member "bold-italic" path-parts) 'bi]
+                  [(member "bold" path-parts) 'b]
+                  [(member "italic" path-parts) 'i]
+                  [else 'r])))
+        ;; only set value if there's not one there already.
+        ;; this means that we only use the first eligible font we find.
+        (hash-ref! font-paths key font-path)))
 
 (define (font-attrs->path font-family bold italic)
   ;; find the font-path corresponding to a certain family name and style.