From 6fc555947fa400af68af342dde14d579bdc894da Mon Sep 17 00:00:00 2001
From: nixo <nicolo@nixo.xyz>
Date: Mon, 18 Jan 2021 22:46:53 +0100
Subject: [PATCH] fontconfig/pattern.scm (make-pattern): Refactor.

Refactored according to Leo Prikler review.
---
 examples/example.scm   |  2 +-
 fontconfig/pattern.scm | 66 ++++++++++++++++++++++--------------------
 2 files changed, 36 insertions(+), 32 deletions(-)

diff --git a/examples/example.scm b/examples/example.scm
index 3c8498f..81ebd3c 100644
--- a/examples/example.scm
+++ b/examples/example.scm
@@ -16,5 +16,5 @@ Fc Match String: ~A
              (pattern->format pat "%{=fcmatch}")))
    (pattern-list pattern)))
 
-(let ((pattern (make-pattern '())))
+(let ((pattern (make-pattern)))
   (format #t "There are a total of ~A fonts!\n" (length (pattern-list pattern))))
diff --git a/fontconfig/pattern.scm b/fontconfig/pattern.scm
index 7eb1164..68427b5 100644
--- a/fontconfig/pattern.scm
+++ b/fontconfig/pattern.scm
@@ -56,49 +56,53 @@
   (%make-pattern
    (make-pointer (pointer-address ptr) ffi:fontconfig-pattern-destroy)))
 
-(define symbol->pointer
-  (compose string->pointer symbol->string))
+(define keyword->pointer
+  (compose string->pointer symbol->string keyword->symbol))
 
 (define (pattern-add-string pattern attr value)
   (ffi:fontconfig-pattern-add-string
-   (unwrap-pattern pattern) (symbol->pointer attr) (string->pointer value)))
+   (unwrap-pattern pattern) (keyword->pointer attr) (string->pointer value)))
+
 (define (pattern-add-double pattern attr value)
   (ffi:fontconfig-pattern-add-double
-   (unwrap-pattern pattern) (symbol->pointer attr) value))
+   (unwrap-pattern pattern) (keyword->pointer attr) value))
 (define (pattern-add-integer pattern attr value)
   (ffi:fontconfig-pattern-add-integer
-   (unwrap-pattern pattern) (symbol->pointer attr) value))
+   (unwrap-pattern pattern) (keyword->pointer attr) value))
 (define (pattern-add-bool pattern attr value)
   (ffi:fontconfig-pattern-add-bool
-   (unwrap-pattern pattern) (symbol->pointer attr) (if value 1 0)))
-
-(define* (keywords->symbols args #:optional (out '()))
-  (if (>= (length args) 2)
-      (keywords->symbols
-       (cddr args)
-       (cons (list (keyword->symbol (car args)) (cadr args))
-             out))
-      out))
+   (unwrap-pattern pattern) (keyword->pointer attr) (if value 1 0)))
 
 (define (make-pattern . args)
-  (define bool? (cute member <> %bool-attrs))
-  (define int? (cute member <> %integer-attrs))
-  (define double? (cute member <> %double-attrs))
-  (define string? (cute member <> %string-attrs))
+  (define (attr? list)
+    (compose (cute member <> list) keyword->symbol))
+  (define bool-attr? (attr? %bool-attrs))
+  (define integer-attr? (attr? %integer-attrs))
+  (define double-attr? (attr? %double-attrs))
+  (define string-attr? (attr? %string-attrs))
+
   (let* ((ptr (ffi:fontconfig-pattern-create))
-         (pattern
-          (if (null-pointer? ptr)
-              (error "make-pattern" "failed to create pattern")
-              (wrap-pattern ptr))))
-    (map (lambda (args)
-           (apply (match args
-                    (((? bool? attr) value) pattern-add-bool)
-                    (((? int? attr) value) pattern-add-integer)
-                    (((? double? attr) value) pattern-add-double)
-                    (((? string? attr) value) pattern-add-string))
-                  pattern args))
-         (keywords->symbols args))
-    pattern))
+         (pattern (if (null-pointer? ptr)
+                      (error "make-pattern" "failed to create pattern")
+                      (wrap-pattern ptr))))
+    (let loop ((args args))
+      (match args
+        (() pattern)
+        (((? string-attr? kwd) value . rest)
+         (pattern-add-string pattern kwd value)
+         (loop rest))
+        (((? integer-attr? kwd) value . rest)
+         (pattern-add-integer pattern kwd value)
+         (loop rest))
+        (((? bool-attr? kwd) value . rest)
+         (pattern-add-bool pattern kwd value)
+         (loop rest))
+        (((? double-attr? kwd) value . rest)
+         (pattern-add-double pattern kwd value)
+         (loop rest))
+        (((? string-attr? kwd) value . rest)
+         (pattern-add-integer pattern kwd value)
+         (loop rest))))))
 
 (define (font-list pattern os)
   (ffi:fontconfig-font-list