[COMMIT] Change Lisp representation of FcObjectSets

NOTE: This patch has been committed. APPROVE COMMIT sjt-xft Simplify Fontconfig bindings part I: Representing FcObjectSets as a new lrecord type has no advantages. This patch removes this lrecord type. 2005-02-03 Eric Knauel <knauel(a)informatik.uni-tuebingen.de&gt; * fontconfig.el (fc-try-font): (fc-find-available-font-families): (fc-find-available-weights-for-family): adapt to new representation of FcObjectSets 2005-02-03 Eric Knauel <eric(a)xemacs.org&gt; * lrecord.h (enum lrecord_type): remove lrecord for FcObjectSets * xft-fonts.h (struct fc_fontset): remove lrecord for FcObjectSets * xft-fonts.c (DEFINE_LRECORD_IMPLEMENTATION): (Ffc_objectset_create, Ffc_objectset_p, Ffc_objectset_add) (Ffc_objectset_destroy): remove lrecord for FcObjectSets (Ffc_list_fonts_pattern_objects): adapt for new representation of FcObjectSets (string_list_to_fcobjectset): New utility function XEmacs Xft branch source patch: Diff command: cvs -q diff -u Files affected: src/lrecord.h src/xft-fonts.h src/xft-fonts.c lisp/fontconfig.el Index: lisp/fontconfig.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/Attic/fontconfig.el,v retrieving revision 1.1.2.1 diff -u -p -u -r1.1.2.1 fontconfig.el --- lisp/fontconfig.el 2004/11/25 12:44:01 1.1.2.1 +++ lisp/fontconfig.el 2005/02/04 15:56:43 ＠＠ -268,26 +268,19 ＠＠ corresponding Xft font slant constant." (add-finalizer pattern 'fc-pattern-destroy) pattern)) -(defun make-fc-objectset () - "Make a Xft objectset record." - (let ((objectset (fc-objectset-create))) - (add-finalizer objectset 'fc-objectset-destroy) - objectset)) - (defun fc-try-font (font &optional device) "Query for a font matching FONT on DEVICE. FONT may be a fontconfig pattern object or a string (typically an XLFD). Optional DEVICE is the device object to query, defaulting to the currently selected device." - (let ((objectset (make-fc-objectset)) - (device (or device (default-x-device))) + (let ((device (or device (default-x-device))) (pattern (if (fc-pattern-p font) font (fc-name-parse font)))) (not (zerop (fc-fontset-count - (fc-list-fonts-pattern-objects device pattern objectset)))))) + (fc-list-fonts-pattern-objects device pattern nil)))))) (defun fc-copy-pattern-partial (pattern attribute-list) "Return a copy of PATTERN restricted to ATTRIBUTE-LIST. ＠＠ -320,13 +313,11 ＠＠ A new object is allocated and returned." "Find all available font families." (let ((device (or device (default-x-device))) (pattern (make-fc-pattern)) - (objectset (make-fc-objectset))) + (objectset '("family" "style"))) ; Xft2: does not work anymore ; (if (not fc-find-available-font-families-fc-fonts-only) ; (fc-pattern-add pattern fc-font-name-property-core t)) ; (fc-objectset-add objectset fc-font-name-property-encoding) - (fc-objectset-add objectset fc-font-name-property-family) - (fc-objectset-add objectset fc-font-name-property-style) (let* ((all-fonts (fc-fontset-list (fc-list-fonts-pattern-objects device pattern objectset)))) ＠＠ -352,18 +343,17 ＠＠ A new object is allocated and returned." "Find available weights for font FAMILY." (let* ((device (or device (default-x-device))) (pattern (make-fc-pattern)) - (objecset (make-fc-objectset))) + (objectset '("weight"))) (fc-pattern-add pattern fc-font-name-property-family family) (if style (fc-pattern-add pattern fc-font-name-property-style style)) - (fc-objectset-add objecset fc-font-name-property-weight) (mapcar '(lambda (pattern) (let ((fc-weight-constant (fc-pattern-get-weight pattern 0))) (if fc-weight-constant (fc-font-weight-translate-from-constant fc-weight-constant)))) (fc-fontset-list - (fc-list-fonts-pattern-objects device pattern objecset))))) + (fc-list-fonts-pattern-objects device pattern objectset))))) ;;; DELETE-DUPLICATES and REMOVE-DUPLICATES from cl-seq.el do not ;;; seem to work on list of strings... Index: src/xft-fonts.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/xft-fonts.c,v retrieving revision 1.1.2.2 diff -u -p -u -r1.1.2.2 xft-fonts.c --- src/xft-fonts.c 2004/12/03 07:41:09 1.1.2.2 +++ src/xft-fonts.c 2005/02/04 15:56:43 ＠＠ -70,7 +70,6 ＠＠ int debug_xft = 1; /* This enables lots Lisp_Object Qxft_font; Lisp_Object Qfc_patternp; /* Do I really have to do this ??? */ -Lisp_Object Qfc_objectsetp; Lisp_Object Qfc_fontsetp; /* Lisp_Object Qfc_result_match; */ /* FcResultMatch */ Lisp_Object Qfc_result_type_mismatch; /* FcResultTypeMismatch */ ＠＠ -92,15 +91,6 ＠＠ DEFINE_LRECORD_IMPLEMENTATION("fc-patter fcpattern_description, struct fc_pattern); -static const struct memory_description fcobjset_description [] = { - { XD_END } -}; - -DEFINE_LRECORD_IMPLEMENTATION("fc-objectset", fc_objectset, - 0, 0, 0, 0, 0, 0, - fcobjset_description, - struct fc_objectset); - static const struct memory_description fcfontset_description [] = { { XD_END } }; ＠＠ -118,14 +108,6 ＠＠ Returns t if OBJECT is of type fc-patter return FCPATTERNP(object) ? Qt : Qnil; } -DEFUN("fc-objectset-p", Ffc_objectset_p, 1, 1, 0, /* -Returns t if OBJECT is of type fc-objectset, nil otherwise. -*/ - (object)) -{ - return FCOBJECTSETP(object) ? Qt : Qnil; -} - DEFUN("fc-fontset-p", Ffc_fontset_p, 1, 1, 0, /* Returns t if OBJECT is of type fc-fontset, nil otherwise. */ ＠＠ -761,69 +743,37 ＠＠ given pattern, or an error code. Poosib return wrap_fcpattern(res_fcpat); } -DEFUN("fc-objectset-create", Ffc_objectset_create, 0, 0, 0, /* -Create a fresh and empty fc object set object. */ - ()) -{ - struct fc_objectset *objset = - alloc_lcrecord_type(struct fc_objectset, &lrecord_fc_objectset); - - objset->objsetPtr = FcObjectSetCreate(); - return wrap_fcobjset(objset); -} - -DEFUN("fc-objectset-add", Ffc_objectset_add, 2, 2, 0, /* -Add OBJECT (a string) to the fc object set FCOBJECTSET. Returns t on -success, nil on failure. */ - (fcobjset, object)) -{ - Bool r; - - CHECK_FCOBJECTSET(fcobjset); - CHECK_STRING(object); - - r = FcObjectSetAdd(XFCOBJECTSET_PTR(fcobjset), - XSTRING_DATA(object)); - return r ? Qt : Qnil; -} - -DEFUN("fc-objectset-destroy", Ffc_objectset_destroy, 1, 1, 0, /* -Used internally to deallocate fc objectset objects. */ - (fcobjset)) -{ - CHECK_FCOBJECTSET(fcobjset); - FcObjectSetDestroy(XFCOBJECTSET_PTR(fcobjset)); - return Qnil; -} - DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects, 3, 3, 0, /* List the fonts on DEVICE that match FCPAT for the properties in FCOBJSET. DEVICE is an X11 device. FCPAT is a fontconfig pattern to be matched. -FCOBJSET is a set of property names that should match. +PROPERTIES is a list of property names (strings) that should match. The result is a fontconfig fontset object. */ - (device, fcpat, fcobjset)) + (device, fcpat, properties)) { + FcObjectSet *os; struct fc_fontset *fontset = - alloc_lcrecord_type(struct fc_fontset, &lrecord_fc_fontset); + alloc_lcrecord_type (struct fc_fontset, &lrecord_fc_fontset); FcConfig *fcc; - CHECK_FCPATTERN(fcpat); - CHECK_FCOBJECTSET(fcobjset); - if (NILP(device)) + CHECK_FCPATTERN (fcpat); + CHECK_LIST (properties); + + if (NILP (device)) return Qnil; - CHECK_X_DEVICE(device); - if (!DEVICE_LIVE_P(XDEVICE(device))) + CHECK_X_DEVICE (device); + if (!DEVICE_LIVE_P (XDEVICE (device))) return Qnil; - FcInit(); + FcInit (); fcc = FcConfigGetCurrent(); + os = FcObjectSetCreate (); + string_list_to_fcobjectset (properties, os); fontset->fontsetPtr = - FcFontList(fcc, - XFCPATTERN_PTR(fcpat), - XFCOBJECTSET_PTR(fcobjset)); - return wrap_fcfontset(fontset); + FcFontList (fcc, XFCPATTERN_PTR (fcpat), os); + FcObjectSetDestroy (os); + return wrap_fcfontset (fontset); } DEFUN("fc-fontset-count", Ffc_fontset_count, 1, 1, 0, /* ＠＠ -1049,16 +999,26 ＠＠ xft_get_color (Display *dpy, Colormap cm else return xft_convert_color (dpy, cmap, visual, XINT (c), dim); } - + +static void +string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os) +{ + Lisp_Object i; + + for (i = list; !NILP (i); i = XCDR (i)) + { + CHECK_STRING (XCAR (i)); + FcObjectSetAdd (os, XSTRING_DATA (XCAR (i))); + } +} + void syms_of_xft_fonts (void) { INIT_LRECORD_IMPLEMENTATION(fc_pattern); - INIT_LRECORD_IMPLEMENTATION(fc_objectset); INIT_LRECORD_IMPLEMENTATION(fc_fontset); DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp); - DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_objectsetp); DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_fontsetp); DEFSYMBOL(Qfc_result_type_mismatch); ＠＠ -1068,7 +1028,6 ＠＠ syms_of_xft_fonts (void) DEFSYMBOL(Qxft_font); DEFSUBR(Ffc_pattern_p); - DEFSUBR(Ffc_objectset_p); DEFSUBR(Ffc_fontset_p); DEFSUBR(Ffc_pattern_create); DEFSUBR(Ffc_name_parse); ＠＠ -1100,9 +1059,6 ＠＠ syms_of_xft_fonts (void) DEFSUBR(Ffc_pattern_get_minspace); #endif DEFSUBR(Ffc_pattern_destroy); - DEFSUBR(Ffc_objectset_create); - DEFSUBR(Ffc_objectset_add); - DEFSUBR(Ffc_objectset_destroy); DEFSUBR(Ffc_list_fonts_pattern_objects); DEFSUBR(Ffc_fontset_count); DEFSUBR(Ffc_fontset_ref); Index: src/xft-fonts.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/xft-fonts.h,v retrieving revision 1.1.2.2 diff -u -p -u -r1.1.2.2 xft-fonts.h --- src/xft-fonts.h 2004/11/27 05:56:02 1.1.2.2 +++ src/xft-fonts.h 2005/02/04 15:56:43 ＠＠ -69,22 +69,6 ＠＠ DECLARE_LRECORD(fc_pattern, struct fc_pa #define XFCPATTERN_PTR(x) (XFCPATTERN(x)->fcpatPtr) #define XFCPATTERN_FONTSET(x) (XFCPATTERN(x)->fontset) -struct fc_objectset -{ - struct lcrecord_header header; - FcObjectSet *objsetPtr; -}; - -typedef struct fc_objectset fc_objectset; - -DECLARE_LRECORD(fc_objectset, struct fc_objectset); -#define XFCOBJECTSET(x) XRECORD(x, fc_objectset, struct fc_objectset) -#define wrap_fcobjset(p) wrap_record (p, fc_objectset) -#define FCOBJECTSETP(x) RECORDP(x, fc_objectset) -#define CHECK_FCOBJECTSET(x) CHECK_RECORD(x, fc_objectset) -#define CONCHECK_FCOBJECTSET(x) CONCHECK_RECORD(x, fc_objectset) -#define XFCOBJECTSET_PTR(x) (XFCOBJECTSET(x)->objsetPtr) - struct fc_fontset { struct lcrecord_header header; ＠＠ -105,5 +89,8 ＠＠ Lisp_Object fc_get_pattern_double(Lisp_O Lisp_Object fc_get_pattern_integer(Lisp_Object fcpat, Lisp_Object id, const char* objid); Lisp_Object fc_get_pattern_bool(Lisp_Object fcpat, Lisp_Object id, const char* objid); Lisp_Object fc_get_pattern_string(Lisp_Object fcpat, Lisp_Object id, const char* objid); + +static void +string_list_to_fcobjectset (Lisp_Object, FcObjectSet*); #endif /* INCLUDED_xft_fonts_h_ */ Index: src/lrecord.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lrecord.h,v retrieving revision 1.34.2.1 diff -u -p -u -r1.34.2.1 lrecord.h --- src/lrecord.h 2004/11/25 12:44:14 1.34.2.1 +++ src/lrecord.h 2005/02/04 15:56:43 ＠＠ -221,7 +221,6 ＠＠ enum lrecord_type lrecord_type_ratio, lrecord_type_bigfloat, lrecord_type_fc_pattern, - lrecord_type_fc_objectset, lrecord_type_fc_fontset, lrecord_type_free, /* only used for "free" lrecords */ lrecord_type_undefined, /* only used for debugging */ -Eric -- "Excuse me --- Di Du Du Duuuuh Di Dii --- Huh Weeeheeee" (Albert King)