From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Sun, 11 Mar 2018 22:34:01 +0000 (-0700)
Subject: cairo: Avoid locking glib by looking up color names elsewhere.
X-Git-Tag: mit-scheme-pucked-x11-0.2.2~53
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d8fbf4a6e139633cb91ef247cffd6c5177089d8b;p=mit-scheme.git

cairo: Avoid locking glib by looking up color names elsewhere.
---

diff --git a/src/cairo/cairo.scm b/src/cairo/cairo.scm
index 06ad9395d..e6bd01114 100644
--- a/src/cairo/cairo.scm
+++ b/src/cairo/cairo.scm
@@ -124,7 +124,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (cairo-pattern-add-color-stop pattern offset color)
   (guarantee-cairo-pattern pattern 'cairo-pattern-add-color-stop)
-  (let ((c (->color color 'cairo-pattern-add-color-stop)))
+  (let ((c (if (color? color)
+	       color
+	       (with-glib-lock
+		(lambda () (->color color 'cairo-pattern-add-color-stop))))))
     (C-call "cairo_pattern_add_color_stop_rgba" pattern (->flonum offset)
 	    (color-red c) (color-green c) (color-blue c) (color-alpha c))))
 
@@ -183,7 +186,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (cairo-set-source-color cairo color)
   (guarantee-cairo cairo 'cairo-set-source-color)
-  (let ((c (->color color 'cairo-set-source-color)))
+  (let ((c (if (color? color)
+	       color
+	       (with-glib-lock
+		(lambda () (->color color 'cairo-set-source-color))))))
     (C-call "cairo_set_source_rgba" cairo
 	    (color-red c) (color-green c) (color-blue c) (color-alpha c))))