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

scx-xft-color-alloc-name

This commit is contained in:
eknauel 2003-10-23 17:18:55 +00:00
parent 98b492b00d
commit 9edc619ab1
1 changed files with 21 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
scheme/libs/xft.scm
View File

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