diff --git a/quad/fontproof/command.rkt b/quad/fontproof/command.rkt index 99a5c38a..969b7847 100755 --- a/quad/fontproof/command.rkt +++ b/quad/fontproof/command.rkt @@ -1,5 +1,6 @@ #lang debug racket (require racket/logging + racket/match "main.rkt") (module+ raco @@ -25,6 +26,7 @@ (define output-qml? #false) (define make-bold? #false) (define make-italic? #false) + (define query-mode? #false) (define families (command-line #:program "fontproof" @@ -53,26 +55,40 @@ (set! make-italic? #true)] [("-q" "--qml") "output QML file" (set! output-qml? #true)] + [("--query") "resolve each family name and font path and show status" + (set! query-mode? #true)] #:args font-family-names-or-font-paths font-family-names-or-font-paths)) (match families - [(? null?) (raise-user-error "no font to proof; exiting")] + [(? null?) (raise-user-error "no fonts to proof; exiting")] [_ (for ([family (in-list families)]) - (make-proof family - (or doc (match (current-input-port) - ;; pull text out of stdin, if any - ;; use `terminal-port?` to distinguish piped input from tty input - [(not (? terminal-port?)) - (string-join (for/list ([t (in-port read)]) - (format "~a" t)) " ")] - [_ #false])) - #:page-size page-size - #:bold make-bold? - #:italic make-italic? - #:font-sizes font-sizes - #:line-heights line-heights - #:output-file-path output-file-path - #:replace replace - #:qml output-qml?))])) + (cond + [query-mode? + (define status + (match family + [(? font-path-string? ps) + (format (if (file-exists? ps) "found at ~v" "not found at ~v") (path->string (path->complete-path ps)))] + [_ (match-define-values (trimmed-family bold? italic?) (resolve-family-bold-italic family)) + (match ((dynamic-require 'fontland/font-path 'family->path) trimmed-family #:bold bold? #:italic italic?) + [#false "not found among installed fonts"] + [pth (format "found installed at ~v" pth)])])) + (log-info (format "family ~v ~a" family status))] + [else + (make-proof family + (or doc (match (current-input-port) + ;; pull text out of stdin, if any + ;; use `terminal-port?` to distinguish piped input from tty input + [(not (? terminal-port?)) + (string-join (for/list ([t (in-port read)]) + (format "~a" t)) " ")] + [_ #false])) + #:page-size page-size + #:bold make-bold? + #:italic make-italic? + #:font-sizes font-sizes + #:line-heights line-heights + #:output-file-path output-file-path + #:replace replace + #:qml output-qml?)]))])) diff --git a/quad/fontproof/main.rkt b/quad/fontproof/main.rkt index 6b3f2652..9ec4fd46 100755 --- a/quad/fontproof/main.rkt +++ b/quad/fontproof/main.rkt @@ -23,6 +23,17 @@ (define (boolean->string bool) (if bool "true" "false")) +(define font-file-extensions '(#".otf" #".ttf" #".woff")) +(define (font-path-string? x) + (and (path-string? x) + (member (path-get-extension (string->path x)) font-file-extensions) + #true)) + +(define (resolve-family-bold-italic font-name-arg) + (define bi-suffix-pat #px"\\s*((?i:bold))?\\s*((?i:italic))?$") + (match-define (list suffix bold? italic?) (regexp-match bi-suffix-pat font-name-arg)) + (values (string-trim font-name-arg suffix #:left? #false) bold? italic?)) + (define (make-proof font-or-qml [sample-text #f] #:bold [make-bold #false] #:italic [make-italic #false] @@ -40,14 +51,11 @@ (values doc output-file-path)] [font-name-arg (unless (and sample-text (non-empty-string? sample-text)) - (raise-user-error "nothing to proof; exiting")) + (raise-user-error "no text to proof; exiting")) (define-values (initial-font-family initial-font-bold initial-font-italic) (match font-name-arg - [(? path-string? ps) (values (path->string (path->complete-path ps)) #f #f)] - [_ - (let ([bi-suffix-pat #px"\\s*((?i:bold))?\\s*((?i:italic))?$"]) - (match-define (list suffix bold? italic?) (regexp-match bi-suffix-pat font-name-arg)) - (values (string-trim font-name-arg suffix #:left? #false) bold? italic?))])) + [(? font-path-string? ps) (values (path->string (path->complete-path ps)) #f #f)] + [_ (resolve-family-bold-italic font-name-arg)])) (log-fontproof-info (format "generating proof for ~a" font-name-arg)) (define page-size (or page-size-arg "letter")) (define font-sizes (string-split (or font-sizes-arg "12 10.5 9")))