3:50 p.m.
User: eric
Date: 05/02/11 16:50:45
Modified: xemacs/src Tag: sjt-xft ChangeLog xft-fonts.c
Log:
throw away original code from xft reloaded #3
Revision Changes Path
No revision
No revision
1.758.2.8 +5 -0 XEmacs/xemacs/src/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.758.2.7
retrieving revision 1.758.2.8
diff -u -r1.758.2.7 -r1.758.2.8
--- ChangeLog 2005/02/11 15:39:04 1.758.2.7
+++ ChangeLog 2005/02/11 15:50:40 1.758.2.8
＠＠ -1,5 +1,10 ＠＠
2005-02-11 Eric Knauel <eric(a)xemacs.org>
+ * xft-fonts.c: throw away old code that was wrapped inside
+ comments
+
+2005-02-11 Eric Knauel <eric(a)xemacs.org>
+
* xft-fonts.h: New prototype
* xft-fonts.c (Ffc_name_parse, Ffc_pattern_add, Ffc_pattern_del)
1.1.2.6 +0 -841 XEmacs/xemacs/src/Attic/xft-fonts.c
Index: xft-fonts.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Attic/xft-fonts.c,v
retrieving revision 1.1.2.5
retrieving revision 1.1.2.6
diff -u -r1.1.2.5 -r1.1.2.6
--- xft-fonts.c 2005/02/11 15:39:07 1.1.2.5
+++ xft-fonts.c 2005/02/11 15:50:43 1.1.2.6
＠＠ -1106,844 +1106,3 ＠＠
);
Vxlfd_font_name_regexp = make_xlfd_font_regexp();
}
-
-
-/* Original code from xft reloaded #3 */
-/* #### throw this away soon */
-#if 0
-#include "xft-fonts.h"
-
-Lisp_Object Qfc_patternp; /* Do I really have to do this ??? */
-Lisp_Object Qfc_objectsetp;
-Lisp_Object Qfc_fontsetp;
-Lisp_Object Qfc_result_no_match; /* XftResultNoMatch */
-Lisp_Object Qfc_result_no_id; /* XftResultNoId */
-Lisp_Object Qfc_internal_error;
-Lisp_Object Qfc_unimplemented;
-Lisp_Object Vxft_xlfd_font_regexp;
-
-Lisp_Object Vxft_version;
-
-static const struct memory_description xftpattern_description [] = {
- { XD_LISP_OBJECT, offsetof (struct fc_pattern, fontset) },
- { XD_END }
-};
-
-DEFINE_LRECORD_IMPLEMENTATION("xft-pattern", fc_pattern,
- 0, 0, 0, 0, 0, 0,
- xftpattern_description,
- struct fc_pattern);
-
-static const struct memory_description xftobjset_description [] = {
- { XD_END }
-};
-
-DEFINE_LRECORD_IMPLEMENTATION("xft-objectset", fc_objectset,
- 0, 0, 0, 0, 0, 0,
- xftobjset_description,
- struct fc_objectset);
-
-static const struct memory_description xftfontset_description [] = {
- { XD_END }
-};
-
-DEFINE_LRECORD_IMPLEMENTATION("xft-fontset", fc_fontset,
- 0, 0, 0, 0, 0, 0,
- xftfontset_description,
- struct fc_fontset);
-
-DEFUN("xft-pattern-p", Fxft_pattern_p, 1, 1, 0, /*
-Returns t if OBJECT is of type xft-pattern, nil otherwise.
- */
- (object))
-{
- return XFTPATTERNP(object) ? Qt : Qnil;
-}
-
-DEFUN("xft-objectset-p", Fxft_objectset_p, 1, 1, 0, /*
-Returns t if OBJECT is of type xft-objectset, nil otherwise.
- */
- (object))
-{
- return XFTOBJECTSETP(object) ? Qt : Qnil;
-}
-
-DEFUN("xft-fontset-p", Fxft_fontset_p, 1, 1, 0, /*
-Returns t if OBJECT is of type xft-fontset, nil otherwise.
- */
- (object))
-{
- return XFTFONTSETP(object) ? Qt : Qnil;
-}
-
-DEFUN("xft-pattern-create", Fxft_pattern_create, 0, 0, 0, /*
- Create a fresh and empty xft-pattern object.
- */
- ())
-{
- fc_pattern *xftpat =
- alloc_lcrecord_type (struct fc_pattern, &lrecord_fc_pattern);
-
- xftpat->xftpatPtr = XftPatternCreate();
- xftpat->fontset = Qnil;
- return wrap_fcpattern(xftpat);
-}
-
-DEFUN("xft-name-parse", Fxft_name_parse, 1, 1, 0, /*
-Parse an Xft font name an return its representation as a xft pattern object.
- */
- (name))
-{
- struct fc_pattern *xftpat =
- alloc_lcrecord_type (struct fc_pattern, &lrecord_fc_pattern);
-
- CHECK_STRING(name);
-
- xftpat->xftpatPtr = XftNameParse(XSTRING_DATA(name));
- xftpat->fontset = Qnil;
- return wrap_fcpattern(xftpat);
-}
-
-DEFUN("xft-name-unparse", Fxft_name_unparse, 1, 1, 0, /*
-Unparse an xft pattern object to a string.
- */
- (xftpat))
- {
- char temp[XFTSTRLEN];
- Bool res;
-
- CHECK_XFTPATTERN(xftpat);
- res = XftNameUnparse(XXFTPATTERN(xftpat)->xftpatPtr, temp, XFTSTRLEN-1);
- return res ? make_string(temp, strlen(temp)) : Qnil;
- }
-
-DEFUN("xft-pattern-duplicate", Fxft_pattern_duplicate, 1, 1, 0, /*
-Make a copy of the xft pattern object XFTPAT an return it.
- */
- (xftpat))
-{
- struct fc_pattern *copy = NULL;
- CHECK_XFTPATTERN(xftpat);
-
- copy = alloc_lcrecord_type (struct fc_pattern, &lrecord_fc_pattern);
- copy->xftpatPtr = XftPatternDuplicate(XXFTPATTERN(xftpat)->xftpatPtr);
- XXFTPATTERN(xftpat)->fontset = Qnil;
- return wrap_fcpattern(copy);
-}
-
-DEFUN("xft-pattern-add", Fxft_pattern_add, 3, 3, 0, /*
-Add attributes to the xft pattern object XFTPAT. OBJECT is the name
-of the attribute to add, VALUE the value for this attribute.
- */
- (xftpat, object, value))
-{
- Bool res;
-
- CHECK_XFTPATTERN(xftpat);
- CHECK_STRING(object);
-
- if (STRINGP(value))
- {
- res = XftPatternAddString(XXFTPATTERN(xftpat)->xftpatPtr,
- XSTRING_DATA(object),
- XSTRING_DATA(value));
- return res ? Qt : Qnil;
- }
-
- if (INTP(value))
- {
- res = XftPatternAddInteger(XXFTPATTERN(xftpat)->xftpatPtr,
- XSTRING_DATA(object),
- XINT(value));
- return res ? Qt : Qnil;
- }
-
- if (FLOATP(value))
- {
- res = XftPatternAddDouble(XXFTPATTERN(xftpat)->xftpatPtr,
- XSTRING_DATA(object),
- (double) XFLOAT_DATA(value));
- return res ? Qt : Qnil;
- }
-
- if (SYMBOLP(value))
- {
- res = XftPatternAddBool(XXFTPATTERN(xftpat)->xftpatPtr,
- XSTRING_DATA(object),
- !NILP(value));
- return res ? Qt : Qnil;
- }
-
- return Qnil;
-}
-
-DEFUN("xft-pattern-del", Fxft_pattern_del, 2, 2, 0, /*
-Remove attribute OBJECT from xft pattern object OBJECT.
- */
- (xftpat, object))
-{
- Bool res;
-
- CHECK_XFTPATTERN(xftpat);
- CHECK_STRING(object);
-
- res = XftPatternDel(XXFTPATTERN(xftpat)->xftpatPtr, XSTRING_DATA(object));
- return res ? Qt : Qnil;
-}
-
-/****************************************************************************
- * generic property access for Lisp Xft pattern objects *
- ****************************************************************************/
-
-/* primitives for XftPatternGet() -- returning strings */
-static Lisp_Object
-xft_get_pattern_string(Lisp_Object xftpat, Lisp_Object id, const char* objid)
-{
- char *temp;
- XftResult res;
-
- CHECK_XFTPATTERN(xftpat);
-
- res = XftPatternGetString(XXFTPATTERN(xftpat)->xftpatPtr,
- objid, XINT(id), &temp);
- switch (res) {
- case XE_XFT_RESULT_MATCH:
- return make_string(temp, strlen(temp));
- case XE_XFT_RESULT_NOMATCH:
- return Qfc_result_no_match;
- case XE_XFT_RESULT_NOID:
- return Qfc_result_no_id;
- default:
- return Qfc_internal_error;
- }
-}
-
-/* primitives for XftPatternGet() -- returning doubles */
-static Lisp_Object
-xft_get_pattern_double(Lisp_Object xftpat, Lisp_Object id, const char* objid)
-{
- double d;
- XftResult res;
-
- CHECK_XFTPATTERN(xftpat);
- CHECK_INT(id);
-
-#if XFT_VERSION > 1
- res = FcPatternGetDouble(XXFTPATTERN(xftpat)->xftpatPtr, objid, XINT(id),
&d);
-#else
- res = XftPatternGetDouble(XXFTPATTERN(xftpat)->xftpatPtr, objid, XINT(id),
&d);
-#endif
-
- switch (res) {
- case XE_XFT_RESULT_MATCH:
- return make_float(d);
- case XE_XFT_RESULT_NOMATCH:
- return Qfc_result_no_match;
- case XE_XFT_RESULT_NOID:
- return Qfc_result_no_id;
- default:
- return Qfc_internal_error;
- }
-}
-
-/* primitives for XftPatternGet() -- returning integers */
-static Lisp_Object
-xft_get_pattern_integer(Lisp_Object xftpat, Lisp_Object id, const char* objid)
-{
- int i;
- XftResult res;
-
- CHECK_XFTPATTERN(xftpat);
- CHECK_INT(id);
-
-#if XFT_VERSION > 1
- res = FcPatternGetInteger(XXFTPATTERN(xftpat)->xftpatPtr, objid, XINT(id),
&i);
-#else
- res = XftPatternGetInteger(XXFTPATTERN(xftpat)->xftpatPtr, objid, XINT(id),
&i);
-#endif
-
- switch (res) {
- case XE_XFT_RESULT_MATCH:
- return make_int(i);
- case XE_XFT_RESULT_NOMATCH:
- return Qfc_result_no_match;
- case XE_XFT_RESULT_NOID:
- return Qfc_result_no_id;
- default:
- return Qfc_internal_error;
- }
-}
-
-/* primitives for XftPatternGet() -- returning bools */
-static Lisp_Object
-xft_get_pattern_bool(Lisp_Object xftpat, Lisp_Object id, const char* objid)
-{
- Bool b;
- XftResult res;
-
- CHECK_XFTPATTERN(xftpat);
- CHECK_INT(id);
-
- res = XftPatternGetBool(XXFTPATTERN(xftpat)->xftpatPtr, objid, XINT(id), &b);
- switch (res) {
- case XE_XFT_RESULT_MATCH:
- return b ? Qt : Qnil;
- case XE_XFT_RESULT_NOMATCH:
- return Qfc_result_no_match;
- case XE_XFT_RESULT_NOID:
- return Qfc_result_no_id;
- default:
- /* FIXME */
- return Fsignal(Qwrong_type_argument, Qnil);
- }
-}
-
-enum xft_pattern_get_return_type {
- XE_XFT_INVALID,
- XE_XFT_UNIMPLEMENTED,
- XE_XFT_STRING,
- XE_XFT_DOUBLE,
- XE_XFT_INTEGER,
- XE_XFT_BOOLEAN
-};
-
-struct xft_pattern_property {
- char *name;
- Lisp_Object symbol;
- enum xft_pattern_get_return_type type;
-};
-
-/* #### should these be updated for use of fontconfig? */
-static struct xft_pattern_property xft_pattern_property_tbl [] = {
- { XFT_FAMILY, (Lisp_Object) 0, XE_XFT_STRING },
- { XFT_STYLE, (Lisp_Object) 0, XE_XFT_STRING },
-#if XFT_VERSION < 2
- { XFT_ENCODING, (Lisp_Object) 0, XE_XFT_STRING },
-#else
- { XFT_ENCODING, (Lisp_Object) 0, XE_XFT_UNIMPLEMENTED },
-#endif
- { XFT_FOUNDRY, (Lisp_Object) 0, XE_XFT_STRING },
- { XFT_XLFD, (Lisp_Object) 0, XE_XFT_STRING },
- { XFT_FILE, (Lisp_Object) 0, XE_XFT_STRING },
- { XFT_RASTERIZER, (Lisp_Object) 0, XE_XFT_STRING },
- { XFT_SIZE, (Lisp_Object) 0, XE_XFT_DOUBLE },
- { XFT_PIXEL_SIZE, (Lisp_Object) 0, XE_XFT_DOUBLE },
- { XFT_SCALE, (Lisp_Object) 0, XE_XFT_DOUBLE },
- { XFT_DPI, (Lisp_Object) 0, XE_XFT_DOUBLE },
- { XFT_SLANT, (Lisp_Object) 0, XE_XFT_INTEGER },
- { XFT_WEIGHT, (Lisp_Object) 0, XE_XFT_INTEGER },
- { XFT_SPACING, (Lisp_Object) 0, XE_XFT_INTEGER },
- { XFT_INDEX, (Lisp_Object) 0, XE_XFT_INTEGER },
- { XFT_RGBA, (Lisp_Object) 0, XE_XFT_INTEGER },
-#if XFT_VERSION < 2
- { XFT_CHAR_WIDTH, (Lisp_Object) 0, XE_XFT_INTEGER },
- { XFT_CHAR_HEIGHT,(Lisp_Object) 0, XE_XFT_INTEGER },
- { XFT_CORE, (Lisp_Object) 0, XE_XFT_BOOLEAN },
-#else
- { XFT_CHAR_WIDTH, (Lisp_Object) 0, XE_XFT_UNIMPLEMENTED },
- { XFT_CHAR_HEIGHT,(Lisp_Object) 0, XE_XFT_UNIMPLEMENTED },
- { XFT_CORE, (Lisp_Object) 0, XE_XFT_UNIMPLEMENTED },
-#endif
- { XFT_ANTIALIAS, (Lisp_Object) 0, XE_XFT_BOOLEAN },
- { XFT_OUTLINE, (Lisp_Object) 0, XE_XFT_BOOLEAN },
- { XFT_SCALABLE, (Lisp_Object) 0, XE_XFT_BOOLEAN },
-#if XFT_VERSION < 2
- { XFT_RENDER, (Lisp_Object) 0, XE_XFT_BOOLEAN },
-#else
- { XFT_RENDER, (Lisp_Object) 0, XE_XFT_UNIMPLEMENTED },
-#endif
- { XFT_MINSPACE, (Lisp_Object) 0, XE_XFT_BOOLEAN },
- { NULL, (Lisp_Object) 0, XE_XFT_INVALID }
-};
-
-static char *xft_pattern_property_names[] = {
- "family", "style", "encoding", "foundry",
"xlfd", "file", "rasterizer",
- "size", "pixelsize", "scale", "dpi",
"slant", "weight", "spacing",
- "index", "rgba", "charwidth", "charheight",
"core", "antialias",
- "outline", "scalable", "render", "minspace",
NULL};
-
-DEFUN("xft-pattern-get", Fxft_pattern_get, 3, 3, 0, /*
-Return Xft pattern object XFTPAT's value in slot ID of PROPERTY.
-
-Normal returns are strings, floats, integers, or Boolean values, depending
-on the property.
-
-Error codes are symbols: `x-xft-result-no-match' if there is no such
-attribute associated with XFTPAT, `x-xft-result-no-id' if there is no
-value with number ID for this attribute, or `x-xft-internal-error' if
-Xft returns an unexpected value. (The value `x-xft-unimplemented' may
-be added for properties not implemented in all versions of Xft.)
-
-Implemented properties and their types are:
-
- family string
- style string
- encoding string (Xft1 only)
- foundry string
- xlfd string
- file string
- rasterizer string
- size double
- pixelsize double
- scale double
- dpi double
- slant integer
- weight integer
- spacing integer
- index integer
- rgba integer
- charwidth integer (Xft1 only)
- charheight integer (Xft1 only)
- core boolean (Xft1 only)
- antialias boolean
- outline boolean
- scalable boolean
- render boolean (Xft1 only)
- minspace boolean" */
- (xftpat, id, property))
-{
- struct xft_pattern_property *tbl;
- char *str = "Xft pattern property";
- int i;
-
- CHECK_XFTPATTERN(xftpat);
- CHECK_INT(id);
- CHECK_SYMBOL(property);
-
- /* FIXME: move me to a better place!!! */
- for (i = 0; xft_pattern_property_names[i] != NULL; i++)
- xft_pattern_property_tbl[i].symbol =
- Fintern(make_string(xft_pattern_property_names[i],
strlen(xft_pattern_property_names[i])), Qnil);
-
- for (tbl = &xft_pattern_property_tbl[0]; tbl->type != XE_XFT_INVALID; tbl++)
- {
- assert (tbl - xft_pattern_property_tbl
- < (ptrdiff_t) (sizeof(xft_pattern_property_tbl)
- / sizeof(struct xft_pattern_property)));
- if (EQ(tbl->symbol,property)) break;
- }
-
- switch (tbl->type) {
- case XE_XFT_STRING:
- return xft_get_pattern_string (xftpat, id, tbl->name);
- case XE_XFT_DOUBLE:
- return xft_get_pattern_double (xftpat, id, tbl->name);
- case XE_XFT_INTEGER:
- return xft_get_pattern_integer (xftpat, id, tbl->name);
- case XE_XFT_BOOLEAN:
- return xft_get_pattern_bool (xftpat, id, tbl->name);
- case XE_XFT_UNIMPLEMENTED:
- return Qfc_unimplemented;
- default:
- args_out_of_range (make_string (str, sizeof(str)), property);
- }
-}
-
-DEFUN("xft-pattern-destroy", Fxft_pattern_destroy, 1, 1, 0, /*
-This function is used internally to deallocate a xft pattern
-object. */
- (xftpat))
-{
- CHECK_XFTPATTERN(xftpat);
- XXFTPATTERN(xftpat)->fontset = Qnil;
-
- XftPatternDestroy(XXFTPATTERN(xftpat)->xftpatPtr);
- return Qnil;
-}
-
-DEFUN("xft-font-match", Fxft_font_match, 2, 2, 0, /*
-Check whether there are fonts available that match the xft pattern
-XFTPAT. DEVICE is X Windows device. Returns a xft pattern object
-representing the closest match to the given pattern or an error
-code. Error codes are `x-xft-result-no-match' and
-`x-xft-result-no-id'. */
- (device, xftpat))
-{
- Display *dpy;
- XftResult res;
-
- struct fc_pattern *res_xftpat =
- alloc_lcrecord_type (struct fc_pattern, &lrecord_fc_pattern);
-
- CHECK_XFTPATTERN(xftpat);
- if (NILP(device))
- return Qnil;
- CHECK_X_DEVICE(device);
- if (!DEVICE_LIVE_P(XDEVICE(device)))
- return Qnil;
-
- res_xftpat->fontset = Qnil;
- dpy = DEVICE_X_DISPLAY(XDEVICE(device));
- res_xftpat->xftpatPtr = XftFontMatch(dpy, DefaultScreen (dpy),
- XXFTPATTERN(xftpat)->xftpatPtr,
- &res);
-
- if (res_xftpat->xftpatPtr == NULL)
- switch (res) {
- case XE_XFT_RESULT_NOMATCH:
- return Qfc_result_no_match;
- case XE_XFT_RESULT_NOID:
- return Qfc_result_no_id;
- default:
- return Qfc_internal_error;
- }
- else
- return wrap_fcpattern(res_xftpat);
-}
-
-DEFUN("xft-objectset-create", Fxft_objectset_create, 0, 0, 0, /*
-Create a fresh and empty xft object set object. */
- ())
-{
- struct fc_objectset *objset =
- alloc_lcrecord_type(struct fc_objectset, &lrecord_fc_objectset);
-
- objset->objsetPtr = XftObjectSetCreate();
- return wrap_fcobjset(objset);
-}
-
-DEFUN("xft-objectset-add", Fxft_objectset_add, 2, 2, 0, /*
-Add OBJECT (a string) to the xft object set XFTOBJECTSET. Returns t on
-success, nil on failure. */
- (xftobjset, object))
-{
- Bool r;
-
- CHECK_XFTOBJECTSET(xftobjset);
- CHECK_STRING(object);
-
- r = XftObjectSetAdd(XXFTOBJECTSET(xftobjset)->objsetPtr,
- XSTRING_DATA(object));
- return r ? Qt : Qnil;
-}
-
-DEFUN("xft-objectset-destroy", Fxft_objectset_destroy, 1, 1, 0, /*
-Used internally to deallocate xft objectset objects. */
- (xftobjset))
-{
- CHECK_XFTOBJECTSET(xftobjset);
-
- XftObjectSetDestroy(XXFTOBJECTSET(xftobjset)->objsetPtr);
- return Qnil;
-}
-
-DEFUN("xft-list-fonts-pattern-objects", Fxft_list_fonts_pattern_objects,
- 3, 3, 0, /*
-Given a xft pattern object XFTPAT, a xft object set object XFTOBJSET
-and an X Windows device find all fonts that match XFTPAT. The result
-is a xft fontset object. */
- (device, xftpat, xftobjset))
-{
- Display *dpy;
- int screen;
- struct fc_fontset *fontset =
- alloc_lcrecord_type(struct fc_fontset, &lrecord_fc_fontset);
-
-#if XFT_VERSION > 1
- FcConfig *fcc;
-#endif
-
- CHECK_XFTPATTERN(xftpat);
- CHECK_XFTOBJECTSET(xftobjset);
- if (NILP(device))
- return Qnil;
- CHECK_X_DEVICE(device);
- if (!DEVICE_LIVE_P(XDEVICE(device)))
- return Qnil;
-
-#if XFT_VERSION > 1
- FcInit();
- fcc = FcConfigGetCurrent();
-
- fontset->fontsetPtr =
- FcFontList(fcc,
- XXFTPATTERN(xftpat)->xftpatPtr,
- XXFTOBJECTSET(xftobjset)->objsetPtr);
-#else
- dpy = DEVICE_X_DISPLAY(XDEVICE(device));
- screen = DefaultScreen(dpy);
-
- fontset->fontsetPtr =
- XftListFontsPatternObjects(dpy, screen,
- XXFTPATTERN(xftpat)->xftpatPtr,
- XXFTOBJECTSET(xftobjset)->objsetPtr);
-#endif
- return wrap_fcfontset(fontset);
-}
-
-DEFUN("xft-fontset-count", Fxft_fontset_count, 1, 1, 0, /*
-Counts the number of xft pattern objects stored in the xft fontset
-object XFTFONTSET. */
- (xftfontset))
-{
- CHECK_XFTFONTSET(xftfontset);
- return make_int(XXFTFONTSET(xftfontset)->fontsetPtr->nfont);
-}
-
-DEFUN("xft-fontset-ref", Fxft_fontset_ref, 2, 2, 0, /*
-Return the xft pattern object at index I in xft fontset object
-XFTFONTSET. Return nil if the index exceeds the bounds of
-XFTFONTSET. */
- (xftfontset, i))
-{
- int idx;
- fc_pattern *xftpat =
- alloc_lcrecord_type (struct fc_pattern, &lrecord_fc_pattern);
-
- CHECK_XFTFONTSET(xftfontset);
- CHECK_INT(i);
-
- idx = XINT(i);
- if ((idx >= 0) && (idx <
XXFTFONTSET(xftfontset)->fontsetPtr->nfont))
- {
- xftpat->xftpatPtr = XXFTFONTSET(xftfontset)->fontsetPtr->fonts[idx];
- xftpat->fontset = xftfontset;
- return wrap_fcpattern(xftpat);
- }
- else
- return Qnil;
-}
-
-DEFUN("xft-fontset-destroy", Fxft_fontset_destroy, 1, 1, 0, /*
-Used internally to deallocate xft fontset objects. */
- (xftfontset))
-{
- CHECK_XFTFONTSET(xftfontset);
-
- XftFontSetDestroy(XXFTFONTSET(xftfontset)->fontsetPtr);
- return Qnil;
-}
-
-DEFUN("xft-font-real-pattern", Fxft_font_real_pattern, 2, 2, 0, /*
-Open the fontname (a string) FONTNAME testwise an return the actual
-xft pattern matched by the Xft library. */
- (fontname, xdevice))
-{
- XftPattern *copy;
- Display *dpy;
- XftFont *font;
- struct fc_pattern *xftpat =
- alloc_lcrecord_type (struct fc_pattern, &lrecord_fc_pattern);
-
- CHECK_STRING (fontname);
- if (NILP(xdevice))
- return Qnil;
- CHECK_X_DEVICE (xdevice);
- if (!DEVICE_LIVE_P(XDEVICE(xdevice)))
- return Qnil;
-
- dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice));
- font = XftFontOpenName (dpy, DefaultScreen(dpy),
- XSTRING_DATA(fontname));
- if (font == NULL)
- return Qnil;
- copy = XftPatternDuplicate(font->pattern);
- XftFontClose(dpy, font);
- if (copy == NULL)
- return Qnil;
- xftpat->xftpatPtr = copy;
- xftpat->fontset = Qnil;
- return wrap_fcpattern(xftpat);
-}
-
-
-DEFUN("xft-xlfd-font-name-p", Fxft_xlfd_font_name_p, 1, 1, 0, /*
-Check whether the string FONTNAME is a XLFD font name. */
- (fontname))
-{
- CHECK_STRING(fontname);
- return Fstring_match(Vxft_xlfd_font_regexp, fontname, Qnil, Qnil);
-}
-
-Lisp_Object make_xlfd_font_regexp (void)
-{
- struct gcpro gcpro1;
- int i;
- Lisp_Object reg = Qnil;
- const char re[XFT_XLFD_RE_COUNT][XFTSTRLEN] =
- { XFT_XLFD_RE_PREFIX,
- XFT_XLFD_RE_FOUNDRY,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_FAMILY,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_WEIGHT,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_SLANT,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_SWIDTH,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_ADSTYLE,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_PIXELSIZE,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_POINTSIZE,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_RESX,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_RESY,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_SPACING,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_AVGWIDTH,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_REGISTRY,
- XFT_XLFD_RE_MINUS,
- XFT_XLFD_RE_ENCODING
- };
-
- GCPRO1 (reg);
- for (i = 0; i <= XFT_XLFD_RE_COUNT; i++)
- reg = concat2(reg, make_string(re[i], strlen((char *) re[i])));
-
- RETURN_UNGCPRO (reg);
-}
-
-/* for debugging purposes only */
-DEFUN("xft-pattern-print", Fxft_pattern_print, 1, 1, 0, /*
-Print a xft pattern object to stdout. For debugging only. */
- (xftpat))
-{
- CHECK_XFTPATTERN(xftpat);
-
-#if XFT_VERSION > 1
- FcPatternPrint(XXFTPATTERN(xftpat)->xftpatPtr);
-#else
- XftPatternPrint(XXFTPATTERN(xftpat)->xftpatPtr);
-#endif
- return Qnil;
-}
-
-/* #### NB the guts of this have moved to lwlib-fonts.c */
-/* helper function to correctly open Xft/core fonts by name */
-XftFont*
-xft_font_open_name (Display *dpy, char *name)
-{
- XftFont *res;
-
- if (NILP (Fxft_xlfd_font_name_p (make_string (name, strlen (name)))))
- res = XftFontOpenName (dpy, DefaultScreen (dpy), name);
- else
- {
- XftPattern *pat = XftPatternCreate ();
- /* This is the magic pattern to open core fonts ... */
- /* Dudes, I love Xft!!! */
- XftPatternAddString (pat, XFT_XLFD, name);
- XftPatternAddBool (pat, XFT_CORE, True);
- XftPatternAddBool (pat, XFT_SCALABLE, False);
- res = XftFontOpenPattern (dpy, pat);
- }
-
- if (res)
- return res;
- else
- {
- /* this is out last try ... */
- res = XftFontOpenName (dpy, DefaultScreen (dpy), "");
-
- if (res)
- return res;
- else
- {
- /* sorry folks ... */
- abort ();
- return 0;
- }
- }
-}
-
-/* color conversion to xft colors */
-/* XXX: is this the right place */
-#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \
- ? ((unsigned long) (x)) : ((unsigned long) (y)))
-
-XftColor
-xft_convert_color (Display *dpy, Colormap cmap, int c, int dim)
-{
- static XColor color;
- XftColor result;
-
- color.pixel = c;
- XQueryColor(dpy, cmap, &color);
-
- if (dim)
- {
- Screen *screen = DefaultScreenOfDisplay (dpy); /* XXX */
- Visual *visual = DefaultVisualOfScreen (screen);
- color.red = MINL (65535, color.red * 1.5);
- color.green = MINL (65535, color.green * 1.5);
- color.blue = MINL (65535, color.blue * 1.5);
- x_allocate_nearest_color (dpy, cmap, visual, &color);
- }
-
- result.pixel = color.pixel;
- result.color.red = color.red;
- result.color.green = color.green;
- result.color.blue = color.blue;
- result.color.alpha = 0xffff;
-
- return result;
-}
-
-XftColor
-xft_get_color (Display *dpy, Colormap cmap, Lisp_Object c, int dim)
-{
- if (COLOR_INSTANCEP (c))
- return COLOR_INSTANCE_FC_COLOR (XCOLOR_INSTANCE (c));
- else
- return xft_convert_color (dpy, cmap, XINT (c), dim);
-}
-
-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_no_match);
- DEFSYMBOL(Qfc_result_no_id);
- DEFSYMBOL(Qfc_internal_error);
- DEFSYMBOL(Qfc_unimplemented);
-
- DEFSUBR(Fxft_pattern_p);
- DEFSUBR(Fxft_objectset_p);
- DEFSUBR(Fxft_fontset_p);
- DEFSUBR(Fxft_pattern_create);
- DEFSUBR(Fxft_name_parse);
- DEFSUBR(Fxft_name_unparse);
- DEFSUBR(Fxft_pattern_duplicate);
- DEFSUBR(Fxft_pattern_add);
- DEFSUBR(Fxft_pattern_del);
- DEFSUBR(Fxft_pattern_get);
- DEFSUBR(Fxft_pattern_destroy);
- DEFSUBR(Fxft_objectset_create);
- DEFSUBR(Fxft_objectset_add);
- DEFSUBR(Fxft_objectset_destroy);
- DEFSUBR(Fxft_list_fonts_pattern_objects);
- DEFSUBR(Fxft_fontset_count);
- DEFSUBR(Fxft_fontset_ref);
- DEFSUBR(Fxft_fontset_destroy);
- DEFSUBR(Fxft_font_match);
- DEFSUBR(Fxft_font_real_pattern);
- DEFSUBR(Fxft_pattern_print);
- DEFSUBR(Fxft_xlfd_font_name_p);
-}
-
-void
-vars_of_xft_fonts (void)
-{
- DEFVAR_LISP("xft-xlfd-font-regexp", &Vxft_xlfd_font_regexp /*
-The regular expression used to match XLFD font names. */
- );
- Vxft_xlfd_font_regexp = make_xlfd_font_regexp();
-
- DEFVAR_LISP("xft-version", &Vxft_version /*
-The major version number of the Xft library being used */
- );
- Vxft_version = make_int(XFT_VERSION);
-}
-#endif