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.