scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
c/libs/xft.c
View File

@ -422,11 +422,12 @@ 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);
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),

8
scheme/libs/xft.scm
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)))
(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))
xft-color)))
(define (xft-color-finalizer xft-color)
(scx-xft-color-free (xft-color-display xft-color)