+ fixed finalizer for xft-font

+ added XftDefaultSubstitute
+ added XftFontSet count/ref

c/libs/xft.c

@@ -10,15 +10,16 @@ XFT_REC_ACCESSOR_MAKER(scx_enter_xftobjectset, XftObjectSet, scx_xftobjectset_re
 
 XFT_REC_ACCESSOR_MAKER(scx_enter_xftfontset, XftFontSet, scx_xftfontset_record_type);
 
-s48_value scx_enter_xftfont(XftFont *xf)
+s48_value scx_enter_xftfont(XftFont *xf, s48_value dpy)
 {
   s48_value rec = S48_FALSE;
-  S48_DECLARE_GC_PROTECT(1);
+  S48_DECLARE_GC_PROTECT(2);
   
-  S48_GC_PROTECT_1(rec);
+  S48_GC_PROTECT_2(rec, dpy);
   rec = s48_make_record(scx_xftfont_record_type);
   S48_RECORD_SET(rec, 0, s48_enter_integer((long) xf));
   S48_RECORD_SET(rec, 1, scx_enter_xftpattern(xf->pattern));
+  S48_RECORD_SET(rec, 2, dpy);
   S48_GC_UNPROTECT();
   return rec;
 }
@@ -166,12 +167,15 @@ s48_value scx_XftFontMatch(s48_value sdpy, s48_value sscreenno, s48_value sxp)
 s48_value scx_XftFontOpenPattern(s48_value sdpy, s48_value sxp)
 {
   XftFont *xf;
+  XftPattern *p;
   S48_DECLARE_GC_PROTECT(2);
 
   S48_GC_PROTECT_2(sdpy, sxp);
-  xf = XftFontOpenPattern(scx_extract_display(sdpy), scx_extract_xftpattern(sxp));
+  p = scx_extract_xftpattern(sxp);
+  XftPatternPrint(p);
+  xf = XftFontOpenPattern(scx_extract_display(sdpy), p);
   S48_GC_UNPROTECT();
-  return scx_enter_xftfont(xf);
+  return xf == NULL ? S48_FALSE : scx_enter_xftfont(xf, sdpy);
 }
 
 s48_value scx_XftFontOpenName(s48_value sdpy, s48_value sscreenno, s48_value sname)
@@ -184,7 +188,7 @@ s48_value scx_XftFontOpenName(s48_value sdpy, s48_value sscreenno, s48_value sna
 		       s48_extract_string(sname));
   XftPatternPrint(xf->pattern);
   S48_GC_UNPROTECT();
-  return scx_enter_xftfont(xf);
+  return xf == NULL ? S48_FALSE : scx_enter_xftfont(xf, sdpy);
 }
 
 s48_value scx_XftFontOpenXlfd(s48_value sdpy, s48_value sscreenno, s48_value sxlfd)
@@ -196,7 +200,7 @@ s48_value scx_XftFontOpenXlfd(s48_value sdpy, s48_value sscreenno, s48_value sxl
   xf = XftFontOpenXlfd(scx_extract_display(sdpy), s48_extract_integer(sscreenno),
 		       s48_extract_string(sxlfd));
   S48_GC_UNPROTECT();
-  return scx_enter_xftfont(xf);
+  return xf == NULL ? S48_FALSE : scx_enter_xftfont(xf, sdpy);
 }
 
 s48_value scx_XftFontClose(s48_value sdpy, s48_value sxf)
@@ -478,6 +482,17 @@ s48_value scx_XftDefaultHasRender(s48_value sdpy)
   return XftDefaultHasRender(scx_extract_display(sdpy)) ? S48_TRUE : S48_FALSE;
 }
 
+s48_value scx_XftDefaultSubstitute(s48_value sdpy, s48_value sscreen, s48_value spat)
+{
+  S48_DECLARE_GC_PROTECT(3);
+
+  S48_GC_PROTECT_3(sdpy, sscreen, spat);
+  XftDefaultSubstitute(scx_extract_display(sdpy), s48_extract_integer(sscreen),
+		       scx_extract_xftpattern(spat));
+  S48_GC_UNPROTECT();
+  return S48_UNSPECIFIC;
+}
+
 #define XFTFONT_GET(FUN, FN)						\
 	s48_value FUN(s48_value sxf) {					\
 	  return s48_enter_integer(scx_extract_xftfont(sxf)->FN);	\
@@ -493,6 +508,28 @@ s48_value scx_xftfont_pattern_get_internal(s48_value sxf)
   return scx_enter_xftpattern(scx_extract_xftfont(sxf)->pattern);
 }
 
+s48_value scx_xftfontset_count_get(s48_value sxfs)
+{
+  return s48_enter_integer(scx_extract_xftfontset(sxfs)->nfont);
+}
+
+s48_value scx_xftfontset_pattern_ref(s48_value sxfs, s48_value index)
+{
+  int i;
+  XftFontSet *xfs;
+  S48_DECLARE_GC_PROTECT(2);
+
+  S48_GC_PROTECT_2(sxfs, index);
+  i = s48_extract_integer(index);
+  xfs = scx_extract_xftfontset(sxfs);
+  S48_GC_UNPROTECT();
+
+  if ((i >= 0) && (i <= xfs->nfont))
+    return scx_enter_xftpattern(xfs->fonts[i]);
+  else
+    return S48_FALSE;
+}
+
 void scx_xft_init(void)
 {
   XFT_GC_PROTECT_IMPORT_BINDING(scx_xftpattern_record_type, "xft-pattern"); 
@@ -642,10 +679,13 @@ void scx_xft_init(void)
   S48_EXPORT_FUNCTION(scx_XftFontSetPrint);
 
   S48_EXPORT_FUNCTION(scx_XftDefaultHasRender);
+  S48_EXPORT_FUNCTION(scx_XftDefaultSubstitute);
 
   S48_EXPORT_FUNCTION(scx_xftfont_ascent_get);
   S48_EXPORT_FUNCTION(scx_xftfont_descent_get);
   S48_EXPORT_FUNCTION(scx_xftfont_height_get);
   S48_EXPORT_FUNCTION(scx_xftfont_max_advance_width_get);
   S48_EXPORT_FUNCTION(scx_xftfont_pattern_get_internal);
+  S48_EXPORT_FUNCTION(scx_xftfontset_count_get);
+  S48_EXPORT_FUNCTION(scx_xftfontset_pattern_ref);  
 }

c/libs/xft.h

@@ -165,7 +165,7 @@ SCX_DECLARE_STATIC_S48VAL(scx_xft_rgba_vbgr);
 #define XFT_REC_ACCESSOR_MAKER(FN, TN, RN) \
 	s48_value FN(TN *p)				\
 	{						\
-	  s48_value xftrec = S48_UNSPECIFIC;		\
+	  s48_value xftrec = S48_FALSE;			\
 	  S48_DECLARE_GC_PROTECT(1);			\
 							\
 	  S48_GC_PROTECT_1(xftrec);			\
@@ -185,7 +185,7 @@ s48_value scx_enter_xftpattern(XftPattern *p);
 #define scx_extract_xftpattern(x) \
 	((XftPattern *) s48_extract_integer(s48_checked_record_ref(x, 0, scx_xftpattern_record_type)))
 
-s48_value scx_enter_xftfont(XftFont *f);
+s48_value scx_enter_xftfont(XftFont *f, s48_value dpy);
 #define scx_extract_xftfont(x) \
 	((XftFont *) s48_extract_integer(s48_checked_record_ref(x, 0, scx_xftfont_record_type)))
 

scheme/libs/libs-interfaces.scm

@@ -37,7 +37,10 @@
    scx-xft-color-alloc-name
    scx-xft-pattern-print
    scx-xft-fontset-print
+   scx-xft-fontset-count
+   scx-xft-fontset-ref
    scx-xft-default-has-render?
+   scx-xft-default-substitute
    ;; Xft version 2
    scx-xft-draw-display
    scx-xft-draw-drawable

scheme/libs/xft.scm

@@ -10,7 +10,8 @@
   (make-xft-font c-pointer pattern)
   xft-font?
   (c-pointer xft-font-c-pointer)
-  (pattern xft-font-pattern))
+  (pattern xft-font-pattern)
+  (display xft-font-display))
 
 (define-exported-binding "xft-font" :xft-font)
 
@@ -231,21 +232,24 @@
      (add-finalizer! xft-pattern scx-xft-pattern-destroy)
      (values result xft-pattern))))
 
+(define (scx-xft-font-close font)
+  (scx-xft-font-close (xft-font-display font) font))
+
 (define (scx-xft-font-open-pattern display pattern)
   (let ((font (scx-xft-font-open-pattern-internal display pattern)))
-    (add-finalizer! font scx-xft-font-close)
+    (if font (add-finalizer! font scx-xft-font-close))
     font))
 
 (define (scx-xft-font-open-name display screen name)
   (let* ((screen-number (screen:number screen))
 	 (font (scx-xft-font-open-name-internal display screen-number name)))
-    (add-finalizer! font scx-xft-font-close)
+    (if font (add-finalizer! font scx-xft-font-close))
     font))
 
 (define (scx-xft-font-open-xlfd display screen name)
   (let* ((screen-numer (screen:number screen))
 	 (font (scx-xft-font-open-xlfd-internal display screen-numer name)))
-    (add-finalizer! font scx-xft-font-close)
+    (if font (add-finalizer! font scx-xft-font-close))
     font))
 
 (define (scx-xft-draw-create display drawable visual colormap)
@@ -343,6 +347,10 @@
 		      (xft-color-colormap xft-color)
 		      xft-color))
 
+(define (scx-xft-default-substitute display screen pattern)
+  (scx-xft-default-substitute-internal
+   display (screen:number screen) pattern))
+
 ;;; import values from C code
 (define scx-xft-version-major
   (shared-binding-ref
@@ -414,7 +422,7 @@
 			  (display screen-number xlfd-name)
 			  "scx_XftFontOpenXlfd")
 
-(import-lambda-definition scx-xft-font-close
+(import-lambda-definition scx-xft-font-close-internal
 			  (display xft-font)
 			  "scx_XftFontClose")
 
@@ -518,6 +526,10 @@
 			  (display)
 			  "scx_XftDefaultHasRender")
 
+(import-lambda-definition scx-xft-default-substitute-internal
+			  (display screen-number pattern)
+			  "scx_XftDefaultSubstitute")
+
 (import-lambda-definition scx-xft-xft-font-ascent
 			  (xft-font)
 			  "scx_xftfont_ascent_get")
@@ -533,3 +545,11 @@
 (import-lambda-definition scx-xft-xft-font-max-advance-width
 			  (xft-font)
 			  "scx_xftfont_max_advance_width_get")
+
+(import-lambda-definition scx-xft-fontset-count
+			  (xft-fontset)
+			  "scx_xftfontset_count_get")
+
+(import-lambda-definition scx-xft-fontset-ref
+			  (xft-fontset index)
+			  "scx_xftfontset_pattern_ref")