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&gt; + * xft-fonts.c: throw away old code that was wrapped inside + comments + +2005-02-11 Eric Knauel <eric(a)xemacs.org&gt; + * 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