fontconfig/pattern.scm (make-pattern): Refactor.

Refactored according to Leo Prikler review.

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))))

fontconfig/pattern.scm

@@ -56,49 +56,53 @@
   (%make-pattern
    (make-pointer (pointer-address ptr) ffi:fontconfig-pattern-destroy)))
 
-(define symbol->pointer
+(define keyword->pointer
-  (compose string->pointer symbol->string))
+  (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)))
+   (unwrap-pattern pattern) (keyword->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))
 
 (define (make-pattern . args)
-  (define bool? (cute member <> %bool-attrs))
+  (define (attr? list)
-  (define int? (cute member <> %integer-attrs))
+    (compose (cute member <> list) keyword->symbol))
-  (define double? (cute member <> %double-attrs))
+  (define bool-attr? (attr? %bool-attrs))
-  (define string? (cute member <> %string-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
+         (pattern (if (null-pointer? ptr)
-          (if (null-pointer? ptr)
+                      (error "make-pattern" "failed to create pattern")
-              (error "make-pattern" "failed to create pattern")
+                      (wrap-pattern ptr))))
-              (wrap-pattern ptr))))
+    (let loop ((args args))
-    (map (lambda (args)
+      (match args
-           (apply (match args
+        (() pattern)
-                    (((? bool? attr) value) pattern-add-bool)
+        (((? string-attr? kwd) value . rest)
-                    (((? int? attr) value) pattern-add-integer)
+         (pattern-add-string pattern kwd value)
-                    (((? double? attr) value) pattern-add-double)
+         (loop rest))
-                    (((? string? attr) value) pattern-add-string))
+        (((? integer-attr? kwd) value . rest)
-                  pattern args))
+         (pattern-add-integer pattern kwd value)
-         (keywords->symbols args))
+         (loop rest))
-    pattern))
+        (((? 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