fixed scx_XftColorAllocValue() and its scheme counterpart

This commit is contained in:
eknauel 2003-10-24 06:27:02 +00:00
parent 72010947aa
commit c6dcfb9fbc
2 changed files with 17 additions and 12 deletions

View File

@ -422,15 +422,16 @@ s48_value scx_XftColorAllocValue(s48_value sdpy, s48_value svisual,
s48_value scolormap, s48_value sxrendercolor)
{
s48_value res = S48_FALSE;
XftColor *xftcolor = NULL;
Bool b;
XftColor *xftcolor;
Bool b = False;
S48_DECLARE_GC_PROTECT(5);
S48_GC_PROTECT_5(res, sdpy, svisual, scolormap, sxrendercolor);
b = XftColorAllocValue(scx_extract_display(sdpy), scx_extract_visual(svisual),
scx_extract_colormap(scolormap),
scx_extract_xrendercolor(sxrendercolor),
xftcolor);
if ((xftcolor = (XftColor *) calloc(1, sizeof(XftColor))) != NULL)
b = XftColorAllocValue(scx_extract_display(sdpy), scx_extract_visual(svisual),
scx_extract_colormap(scolormap),
scx_extract_xrendercolor(sxrendercolor),
xftcolor);
res = s48_list_2(b ? S48_TRUE : S48_FALSE,
b ? scx_enter_xftcolor(xftcolor) : S48_FALSE);
S48_GC_UNPROTECT();

View File

@ -157,12 +157,16 @@
#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)
(add-finalizer! xft-color xft-color-finalizer)
xft-color))
(call-with-values
(lambda ()
(apply values
(scx-xft-color-alloc-value-internal display visual colormap xrendercolor)))
(lambda (success? xft-color)
(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)))
(define (xft-color-finalizer xft-color)
(scx-xft-color-free (xft-color-display xft-color)