From 9edc619ab16a9e59c02577cc305e67d5f6e271ea Mon Sep 17 00:00:00 2001 From: eknauel Date: Thu, 23 Oct 2003 17:18:55 +0000 Subject: [PATCH] scx-xft-color-alloc-name --- scheme/libs/xft.scm | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/scheme/libs/xft.scm b/scheme/libs/xft.scm index 544d0ad..e89e085 100644 --- a/scheme/libs/xft.scm +++ b/scheme/libs/xft.scm @@ -141,7 +141,23 @@ (scx-xft-fontset-add-internal xft-fontset xft-pattern)) (define (scx-xft-color-alloc-name display visual colormap name) - (let ((xft-color (scx-xft-color-alloc-name-internal display visual colormap name))) + (call-with-values + (lambda () + (apply values + (scx-xft-color-alloc-name-internal display visual colormap name))) + (lambda (success? xft-color) + (if success? + (begin + (set-xft-color-display! xft-color display) + (set-xft-color-visual! xft-color visual) + (set-xft-color-colormap! xft-color colormap) + (add-finalizer! xft-color xft-color-finalizer) + xft-color) + ;;; FIXME: raise error + #f)))) + +(define (scx-xft-color-alloc-value display visual colormap xrendercolor) + (let ((xft-color (scx-xft-color-alloc-value-internal display visual colormap xrendercolor))) (set-xft-color-display! xft-color display) (set-xft-color-visual! xft-color visual) (set-xft-color-colormap! xft-color colormap) @@ -301,6 +317,10 @@ (display visual colormap name) "scx_XftColorAllocName") +(import-lambda-definition scx-xft-color-alloc-value-internal + (display visual colormap xrendercolor) + "scx_XftColorAllocValue") + (import-lambda-definition scx-xft-color-free (display visual colormap xft-color) "scx_XftColorFree")