+ Put Xft pattern objects into finite type xft-pattern-object

c/libs/xft.c

@@ -477,9 +477,9 @@ void scx_xft_init(void)
   XFT_GC_PROTECT_IMPORT_BINDING(scx_xftobjectset_record_type, "xft-objectset"); 
   XFT_GC_PROTECT_IMPORT_BINDING(scx_xftfontset_record_type, "xft-fontset"); 
 
-  SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-match", scx_XftResultMatch,
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-match", scx_XftResultMatch, 
 			    XftResultMatch);
-  SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-no-match", scx_XftResultNoMatch,
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-no-match", scx_XftResultNoMatch, 
 			    XftResultNoMatch);
   SCX_EXPORT_INTEGER_TO_S48("scx-xft-result-type-mismatch", scx_XftResultTypeMismatch,
 			    XftResultTypeMismatch);
@@ -490,6 +490,55 @@ void scx_xft_init(void)
   SCX_EXPORT_INTEGER_TO_S48("scx-xft-version-minor", scx_XftVersionMinor,
 			    SCX_XFT_VERSION_MINOR);
 
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-family", scx_xft_pattern_family,
+			    SCX_XFT_FAMILY);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-style", scx_xft_pattern_style,
+			    SCX_XFT_STYLE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-slant", scx_xft_pattern_slant,
+			    SCX_XFT_SLANT);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-weight", scx_xft_pattern_weight,
+			    SCX_XFT_WEIGHT);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-size", scx_xft_pattern_size,
+			    SCX_XFT_SIZE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-pixel-size", scx_xft_pattern_pixel_size,
+			    SCX_XFT_PIXEL_SIZE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-encoding", scx_xft_pattern_encoding,
+			    SCX_XFT_ENCODING);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-spacing", scx_xft_pattern_spacing,
+			    SCX_XFT_SPACING);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-foundry", scx_xft_pattern_foundry,
+			    SCX_XFT_FOUNDRY);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-core", scx_xft_pattern_core,
+			    SCX_XFT_CORE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-antialias", scx_xft_pattern_antialias,
+			    SCX_XFT_ANTIALIAS);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-xlfd", scx_xft_pattern_xlfd,
+			    SCX_XFT_XLFD);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-file", scx_xft_pattern_file,
+			    SCX_XFT_FILE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-index", scx_xft_pattern_index,
+			    SCX_XFT_INDEX);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-rasterizer", scx_xft_pattern_rasterizer,
+			    SCX_XFT_RASTERIZER);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-outline", scx_xft_pattern_outline,
+			    SCX_XFT_OUTLINE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-scalable", scx_xft_pattern_scalable,
+			    SCX_XFT_SCALABLE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-rgba", scx_xft_pattern_rgba,
+			    SCX_XFT_RGBA);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-scale", scx_xft_pattern_scale,
+			    SCX_XFT_SCALE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-render", scx_xft_pattern_render,
+			    SCX_XFT_RENDER);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-minspace", scx_xft_pattern_minspace,
+			    SCX_XFT_MINSPACE);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-dpi", scx_xft_pattern_dpi,
+			    SCX_XFT_DPI);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-char-width", scx_xft_pattern_char_width,
+			    SCX_XFT_CHAR_WIDTH);
+  SCX_EXPORT_INTEGER_TO_S48("scx-xft-pattern-char-height", scx_xft_pattern_char_height,
+			    SCX_XFT_CHAR_HEIGHT);
+
   S48_EXPORT_FUNCTION(scx_XftPatternCreate);
   S48_EXPORT_FUNCTION(scx_XftPatternDestroy);
   S48_EXPORT_FUNCTION(scx_XftPatternDuplicate);

c/libs/xft.h

@@ -94,25 +94,53 @@ static struct xft_pattern_property xft_pattern_property_tbl [] = {
   {NULL,			NULL,			SCX_XFT_INVALID}
 };
 
-/* scheme record types */
+/* declare static s48_value initialized with S48_FALSE */
-static s48_value scx_xftpattern_record_type		= S48_FALSE;
+#define SCX_DECLARE_STATIC_S48VAL(NAME) static s48_value NAME = S48_FALSE
-static s48_value scx_xftfont_record_type		= S48_FALSE;
-static s48_value scx_xftdraw_record_type		= S48_FALSE;
-static s48_value scx_xftcolor_record_type		= S48_FALSE;
-static s48_value scx_xftobjectset_record_type		= S48_FALSE;
-static s48_value scx_xftfontset_record_type		= S48_FALSE;
 
 #define XFT_GC_PROTECT_IMPORT_BINDING(CN, SN)		\
 	S48_GC_PROTECT_GLOBAL(CN);			\
 	CN = s48_get_imported_binding(SN);
 
+/* scheme record types */
+SCX_DECLARE_STATIC_S48VAL(scx_xftpattern_record_type);
+SCX_DECLARE_STATIC_S48VAL(scx_xftfont_record_type);
+SCX_DECLARE_STATIC_S48VAL(scx_xftdraw_record_type);
+SCX_DECLARE_STATIC_S48VAL(scx_xftcolor_record_type);
+SCX_DECLARE_STATIC_S48VAL(scx_xftobjectset_record_type);
+SCX_DECLARE_STATIC_S48VAL(scx_xftfontset_record_type);
+
 /* C values exported to scheme */
-static s48_value scx_XftResultMatch		= S48_FALSE;
+SCX_DECLARE_STATIC_S48VAL(scx_XftResultMatch);
-static s48_value scx_XftResultNoMatch		= S48_FALSE;
+SCX_DECLARE_STATIC_S48VAL(scx_XftResultNoMatch);
-static s48_value scx_XftResultTypeMismatch	= S48_FALSE;
+SCX_DECLARE_STATIC_S48VAL(scx_XftResultTypeMismatch);
-static s48_value scx_XftResultNoId		= S48_FALSE;
+SCX_DECLARE_STATIC_S48VAL(scx_XftResultNoId);
-static s48_value scx_XftVersionMajor		= S48_FALSE;
+SCX_DECLARE_STATIC_S48VAL(scx_XftVersionMajor);
-static s48_value scx_XftVersionMinor		= S48_FALSE;
+SCX_DECLARE_STATIC_S48VAL(scx_XftVersionMinor);
+
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_family);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_style);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_slant);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_weight);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_size);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_pixel_size);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_encoding);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_spacing);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_foundry);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_core);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_antialias);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_xlfd);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_file);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_index);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_rasterizer);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_outline);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_scalable);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_rgba);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_scale);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_render);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_minspace);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_dpi);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_char_width);
+SCX_DECLARE_STATIC_S48VAL(scx_xft_pattern_char_height);
 
 #define XFT_REC_ACCESSOR_MAKER(FN, TN, RN) \
 	s48_value FN(TN *p)				\

scheme/libs/libs-interfaces.scm

@@ -41,7 +41,9 @@
    scx-xft-draw-display
    scx-xft-draw-drawable
    scx-xft-draw-colormap
-   scx-xft-draw-visual))
+   scx-xft-draw-visual
+   (xft-pattern-object :syntax)
+   xft-pattern-object-elements))
 
 (define-interface xrender-interface
   (export

scheme/libs/libs-packages.scm

@@ -11,6 +11,7 @@
 	xlib
 	signals
 	define-record-types
+	finite-types
 	srfi-1
 	external-calls)
   (files xft))

scheme/libs/xft.scm

@@ -45,6 +45,44 @@
 
 (define-exported-binding "xft-fontset" :xft-fontset)
 
+(define-syntax lookup-shared-valued
+  (syntax-rules ()
+    ((lookup-shared-valued str)
+     (shared-binding-ref
+      (lookup-imported-binding str)))))
+ 
+(define-finite-type xft-pattern-object :xft-pattern-object
+  (id)
+  xft-pattern-object?
+  xft-pattern-object-elements
+  xft-pattern-object-name
+  xft-pattern-object-index
+  (id xft-pattern-object-id)
+  ((family	(lookup-shared-valued "scx-xft-pattern-family"))
+   (style	(lookup-shared-valued "scx-xft-pattern-style"))
+   (slant	(lookup-shared-valued "scx-xft-pattern-slant"))
+   (weight	(lookup-shared-valued "scx-xft-pattern-weight"))
+   (size	(lookup-shared-valued "scx-xft-pattern-size"))
+   (pixel-size	(lookup-shared-valued "scx-xft-pattern-pixel-size"))
+   (encoding	(lookup-shared-valued "scx-xft-pattern-encoding"))
+   (spacing	(lookup-shared-valued "scx-xft-pattern-spacing"))
+   (foundry	(lookup-shared-valued "scx-xft-pattern-foundry"))
+   (core	(lookup-shared-valued "scx-xft-pattern-core"))
+   (antialias	(lookup-shared-valued "scx-xft-pattern-antialias"))
+   (xlfd	(lookup-shared-valued "scx-xft-pattern-xlfd"))
+   (file	(lookup-shared-valued "scx-xft-pattern-file"))
+   (index	(lookup-shared-valued "scx-xft-pattern-index"))
+   (rasterizer	(lookup-shared-valued "scx-xft-pattern-rasterizer"))
+   (outline	(lookup-shared-valued "scx-xft-pattern-outline"))
+   (scalable	(lookup-shared-valued "scx-xft-pattern-scalable"))
+   (rgba	(lookup-shared-valued "scx-xft-pattern-rgba"))
+   (scale	(lookup-shared-valued "scx-xft-pattern-scale"))
+   (render	(lookup-shared-valued "scx-xft-pattern-render"))
+   (minspace	(lookup-shared-valued "scx-xft-pattern-minspace"))
+   (dpi		(lookup-shared-valued "scx-xft-pattern-dpi"))
+   (char-width	(lookup-shared-valued "scx-xft-pattern-char-width"))
+   (char-height (lookup-shared-valued "scx-xft-pattern-char-height"))))
+
 ;;; add finalizers
 
 (define (make-xft-pattern)
@@ -57,6 +95,14 @@
     (add-finalizer! copy scx-xft-pattern-destroy)
     copy))
 
+(define (scx-xft-pattern-get xft-pattern xft-pattern-object id)
+  (scx-xft-pattern-get-internal
+   xft-pattern (xft-pattern-object-id xft-pattern-object) id))
+
+(define (scx-xft-pattern-add xft-pattern xft-pattern-object value append?)
+  (scx-xft-pattern-add-internal
+   xft-pattern (xft-pattern-object-id xft-pattern-object) value append?))
+
 (define (scx-xft-font-match display screen xft-pattern)
   (call-with-values
    (lambda ()
@@ -98,6 +144,10 @@
     (add-finalizer! xft-objectset scx-xft-objectset-destroy)
     xft-objectset))
 
+(define (scx-xft-objectset-add xft-objectset xft-pattern-object)
+  (scx-xft-objectset-add-internal 
+   xft-objectset (xft-pattern-object-id xft-pattern-object)))
+
 (define (scx-xft-draw-display xft-draw)
   (let ((display (scx-xft-draw-display-internal xft-draw)))
     (if display
@@ -213,11 +263,11 @@
 			  (xft-pattern)
 			  "scx_XftPatternDuplicate")
 
-(import-lambda-definition scx-xft-pattern-get
+(import-lambda-definition scx-xft-pattern-get-internal
 			  (xft-pattern object id)
 			  "scx_XftPatternGet")
 
-(import-lambda-definition scx-xft-pattern-add
+(import-lambda-definition scx-xft-pattern-add-internal
 			  (xft-pattern object value append?)
 			  "scx_XftPatternAdd")
 
@@ -297,7 +347,7 @@
 			  (xft-objectset)
 			  "scx_XftObjectSetDestroy")
 
-(import-lambda-definition scx-xft-objectset-add
+(import-lambda-definition scx-xft-objectset-add-internal
 			  (xft-objectset object)
 			  "scx_XftObjectSetAdd")