commit 5ae407aad4f2564fae7ddce077eb01aa8efa37fb (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Wed Apr 24 09:38:03 2019 +0300 Revert "Remove font.c code commented out for a decade" This reverts commit 64d0cd9810af6bd0c378fc6bc666c76ddfa97e40. Rationale: any font-related code and comments, even if unused for decades, serves as important source of useful information in an area of Emacs code that is notoriously under-documented. Please do NOT remove this stuff until we have an active expert in this are on board, who will then decide whether this can be retired. diff --git a/src/font.c b/src/font.c index e7686cf4bb..5ca89c97dc 100644 --- a/src/font.c +++ b/src/font.c @@ -1786,6 +1786,296 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec } +/* This part (through the next ^L) is still experimental and not + tested much. We may drastically change codes. */ + +/* OTF handler. */ + +#if 0 + +#define LGSTRING_HEADER_SIZE 6 +#define LGSTRING_GLYPH_SIZE 8 + +static int +check_gstring (Lisp_Object gstring) +{ + Lisp_Object val; + ptrdiff_t i; + int j; + + CHECK_VECTOR (gstring); + val = AREF (gstring, 0); + CHECK_VECTOR (val); + if (ASIZE (val) < LGSTRING_HEADER_SIZE) + goto err; + CHECK_FONT_OBJECT (LGSTRING_FONT (gstring)); + if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING))) + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)); + if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING))) + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)); + if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH))) + CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)); + if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT))) + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); + if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT))) + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); + + for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++) + { + val = LGSTRING_GLYPH (gstring, i); + CHECK_VECTOR (val); + if (ASIZE (val) < LGSTRING_GLYPH_SIZE) + goto err; + if (NILP (AREF (val, LGLYPH_IX_CHAR))) + break; + CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO)); + CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR)); + if (!NILP (AREF (val, LGLYPH_IX_CODE))) + CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE)); + if (!NILP (AREF (val, LGLYPH_IX_WIDTH))) + CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH)); + if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT))) + { + val = AREF (val, LGLYPH_IX_ADJUSTMENT); + CHECK_VECTOR (val); + if (ASIZE (val) < 3) + goto err; + for (j = 0; j < 3; j++) + CHECK_FIXNUM (AREF (val, j)); + } + } + return i; + err: + error ("Invalid glyph-string format"); + return -1; +} + +static void +check_otf_features (Lisp_Object otf_features) +{ + Lisp_Object val; + + CHECK_CONS (otf_features); + CHECK_SYMBOL (XCAR (otf_features)); + otf_features = XCDR (otf_features); + CHECK_CONS (otf_features); + CHECK_SYMBOL (XCAR (otf_features)); + otf_features = XCDR (otf_features); + for (val = Fcar (otf_features); CONSP (val); val = XCDR (val)) + { + CHECK_SYMBOL (XCAR (val)); + if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) + error ("Invalid OTF GSUB feature: %s", + SDATA (SYMBOL_NAME (XCAR (val)))); + } + otf_features = XCDR (otf_features); + for (val = Fcar (otf_features); CONSP (val); val = XCDR (val)) + { + CHECK_SYMBOL (XCAR (val)); + if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) + error ("Invalid OTF GPOS feature: %s", + SDATA (SYMBOL_NAME (XCAR (val)))); + } +} + +#ifdef HAVE_LIBOTF +#include + +Lisp_Object otf_list; + +static Lisp_Object +otf_tag_symbol (OTF_Tag tag) +{ + char name[5]; + + OTF_tag_name (tag, name); + return Fintern (make_unibyte_string (name, 4), Qnil); +} + +static OTF * +otf_open (Lisp_Object file) +{ + Lisp_Object val = Fassoc (file, otf_list, Qnil); + OTF *otf; + + if (! NILP (val)) + otf = xmint_pointer (XCDR (val)); + else + { + otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; + val = make_mint_ptr (otf); + otf_list = Fcons (Fcons (file, val), otf_list); + } + return otf; +} + + +/* Return a list describing which scripts/languages FONT supports by + which GSUB/GPOS features of OpenType tables. See the comment of + (struct font_driver).otf_capability. */ + +Lisp_Object +font_otf_capability (struct font *font) +{ + OTF *otf; + Lisp_Object capability = Fcons (Qnil, Qnil); + int i; + + otf = otf_open (font->props[FONT_FILE_INDEX]); + if (! otf) + return Qnil; + for (i = 0; i < 2; i++) + { + OTF_GSUB_GPOS *gsub_gpos; + Lisp_Object script_list = Qnil; + int j; + + if (OTF_get_features (otf, i == 0) < 0) + continue; + gsub_gpos = i == 0 ? otf->gsub : otf->gpos; + for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--) + { + OTF_Script *script = gsub_gpos->ScriptList.Script + j; + Lisp_Object langsys_list = Qnil; + Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag); + int k; + + for (k = script->LangSysCount; k >= 0; k--) + { + OTF_LangSys *langsys; + Lisp_Object feature_list = Qnil; + Lisp_Object langsys_tag; + int l; + + if (k == script->LangSysCount) + { + langsys = &script->DefaultLangSys; + langsys_tag = Qnil; + } + else + { + langsys = script->LangSys + k; + langsys_tag + = otf_tag_symbol (script->LangSysRecord[k].LangSysTag); + } + for (l = langsys->FeatureCount - 1; l >= 0; l--) + { + OTF_Feature *feature + = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l]; + Lisp_Object feature_tag + = otf_tag_symbol (feature->FeatureTag); + + feature_list = Fcons (feature_tag, feature_list); + } + langsys_list = Fcons (Fcons (langsys_tag, feature_list), + langsys_list); + } + script_list = Fcons (Fcons (script_tag, langsys_list), + script_list); + } + + if (i == 0) + XSETCAR (capability, script_list); + else + XSETCDR (capability, script_list); + } + + return capability; +} + +/* Parse OTF features in SPEC and write a proper features spec string + in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is + assured that the sufficient memory has already allocated for + FEATURES. */ + +static void +generate_otf_features (Lisp_Object spec, char *features) +{ + Lisp_Object val; + char *p; + bool asterisk; + + p = features; + *p = '\0'; + for (asterisk = 0; CONSP (spec); spec = XCDR (spec)) + { + val = XCAR (spec); + CHECK_SYMBOL (val); + if (p > features) + *p++ = ','; + if (SREF (SYMBOL_NAME (val), 0) == '*') + { + asterisk = 1; + *p++ = '*'; + } + else if (! asterisk) + { + val = SYMBOL_NAME (val); + p += esprintf (p, "%s", SDATA (val)); + } + else + { + val = SYMBOL_NAME (val); + p += esprintf (p, "~%s", SDATA (val)); + } + } + if (CONSP (spec)) + error ("OTF spec too long"); +} + +Lisp_Object +font_otf_DeviceTable (OTF_DeviceTable *device_table) +{ + int len = device_table->StartSize - device_table->EndSize + 1; + + return Fcons (make_fixnum (len), + make_unibyte_string (device_table->DeltaValue, len)); +} + +Lisp_Object +font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record) +{ + Lisp_Object val = make_nil_vector (8); + + if (value_format & OTF_XPlacement) + ASET (val, 0, make_fixnum (value_record->XPlacement)); + if (value_format & OTF_YPlacement) + ASET (val, 1, make_fixnum (value_record->YPlacement)); + if (value_format & OTF_XAdvance) + ASET (val, 2, make_fixnum (value_record->XAdvance)); + if (value_format & OTF_YAdvance) + ASET (val, 3, make_fixnum (value_record->YAdvance)); + if (value_format & OTF_XPlaDevice) + ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice)); + if (value_format & OTF_YPlaDevice) + ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice)); + if (value_format & OTF_XAdvDevice) + ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice)); + if (value_format & OTF_YAdvDevice) + ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice)); + return val; +} + +Lisp_Object +font_otf_Anchor (OTF_Anchor *anchor) +{ + Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1); + ASET (val, 0, make_fixnum (anchor->XCoordinate)); + ASET (val, 1, make_fixnum (anchor->YCoordinate)); + if (anchor->AnchorFormat == 2) + ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint)); + else + { + ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable)); + ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable)); + } + return val; +} +#endif /* HAVE_LIBOTF */ +#endif /* 0 */ + + /* Font sorting. */ static double @@ -4322,6 +4612,126 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, return Fcons (font_object, INT_TO_INTEGER (code)); } +#if 0 + +DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0, + doc: /* Apply OpenType features on glyph-string GSTRING-IN. +OTF-FEATURES specifies which features to apply in this format: + (SCRIPT LANGSYS GSUB GPOS) +where + SCRIPT is a symbol specifying a script tag of OpenType, + LANGSYS is a symbol specifying a langsys tag of OpenType, + GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags. + +If LANGSYS is nil, the default langsys is selected. + +The features are applied in the order they appear in the list. The +symbol `*' means to apply all available features not present in this +list, and the remaining features are ignored. For instance, (vatu +pstf * haln) is to apply vatu and pstf in this order, then to apply +all available features other than vatu, pstf, and haln. + +The features are applied to the glyphs in the range FROM and TO of +the glyph-string GSTRING-IN. + +If some feature is actually applicable, the resulting glyphs are +produced in the glyph-string GSTRING-OUT from the index INDEX. In +this case, the value is the number of produced glyphs. + +If no feature is applicable, no glyph is produced in GSTRING-OUT, and +the value is 0. + +If GSTRING-OUT is too short to hold produced glyphs, no glyphs are +produced in GSTRING-OUT, and the value is nil. + +See the documentation of `composition-get-gstring' for the format of +glyph-string. */) + (Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object index) +{ + Lisp_Object font_object = LGSTRING_FONT (gstring_in); + Lisp_Object val; + struct font *font; + int len, num; + + check_otf_features (otf_features); + CHECK_FONT_OBJECT (font_object); + font = XFONT_OBJECT (font_object); + if (! font->driver->otf_drive) + error ("Font backend %s can't drive OpenType GSUB table", + SDATA (SYMBOL_NAME (font->driver->type))); + CHECK_CONS (otf_features); + CHECK_SYMBOL (XCAR (otf_features)); + val = XCDR (otf_features); + CHECK_SYMBOL (XCAR (val)); + val = XCDR (otf_features); + if (! NILP (val)) + CHECK_CONS (val); + len = check_gstring (gstring_in); + CHECK_VECTOR (gstring_out); + CHECK_FIXNAT (from); + CHECK_FIXNAT (to); + CHECK_FIXNAT (index); + + if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len) + args_out_of_range_3 (from, to, make_fixnum (len)); + if (XFIXNUM (index) >= ASIZE (gstring_out)) + args_out_of_range (index, make_fixnum (ASIZE (gstring_out))); + num = font->driver->otf_drive (font, otf_features, + gstring_in, XFIXNUM (from), XFIXNUM (to), + gstring_out, XFIXNUM (index), 0); + if (num < 0) + return Qnil; + return make_fixnum (num); +} + +DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates, + 3, 3, 0, + doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT. +OTF-FEATURES specifies which features of the font FONT-OBJECT to apply +in this format: + (SCRIPT LANGSYS FEATURE ...) +See the documentation of `font-drive-otf' for more detail. + +The value is a list of cons cells of the format (GLYPH-ID . CHARACTER), +where GLYPH-ID is a glyph index of the font, and CHARACTER is a +character code corresponding to the glyph or nil if there's no +corresponding character. */) + (Lisp_Object font_object, Lisp_Object character, Lisp_Object otf_features) +{ + struct font *font = CHECK_FONT_GET_OBJECT (font_object); + Lisp_Object gstring_in, gstring_out, g; + Lisp_Object alternates; + int i, num; + + if (! font->driver->otf_drive) + error ("Font backend %s can't drive OpenType GSUB table", + SDATA (SYMBOL_NAME (font->driver->type))); + CHECK_CHARACTER (character); + CHECK_CONS (otf_features); + + gstring_in = Ffont_make_gstring (font_object, make_fixnum (1)); + g = LGSTRING_GLYPH (gstring_in, 0); + LGLYPH_SET_CHAR (g, XFIXNUM (character)); + gstring_out = Ffont_make_gstring (font_object, make_fixnum (10)); + while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1, + gstring_out, 0, 1)) < 0) + gstring_out = Ffont_make_gstring (font_object, + make_fixnum (ASIZE (gstring_out) * 2)); + alternates = Qnil; + for (i = 0; i < num; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring_out, i); + int c = LGLYPH_CHAR (g); + unsigned code = LGLYPH_CODE (g); + + alternates = Fcons (Fcons (make_fixnum (code), + c > 0 ? make_fixnum (c) : Qnil), + alternates); + } + return Fnreverse (alternates); +} +#endif /* 0 */ + #ifdef FONT_DEBUG DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, @@ -4586,6 +4996,47 @@ character at index specified by POSITION. */) return font_at (-1, XFIXNUM (position), NULL, w, string); } +#if 0 +DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0, + doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame. +The value is a number of glyphs drawn. +Type C-l to recover what previously shown. */) + (Lisp_Object font_object, Lisp_Object string) +{ + Lisp_Object frame = selected_frame; + struct frame *f = XFRAME (frame); + struct font *font; + struct face *face; + int i, len, width; + unsigned *code; + + CHECK_FONT_GET_OBJECT (font_object, font); + CHECK_STRING (string); + len = SCHARS (string); + code = alloca (sizeof (unsigned) * len); + for (i = 0; i < len; i++) + { + Lisp_Object ch = Faref (string, make_fixnum (i)); + Lisp_Object val; + int c = XFIXNUM (ch); + + code[i] = font->driver->encode_char (font, c); + if (code[i] == FONT_INVALID_CODE) + break; + } + face = FACE_FROM_ID (f, DEFAULT_FACE_ID); + face->fontp = font; + if (font->driver->prepare_face) + font->driver->prepare_face (f, face); + width = font->driver->text_extents (font, code, i, NULL); + len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width); + if (font->driver->done_face) + font->driver->done_face (f, face); + face->fontp = NULL; + return make_fixnum (len); +} +#endif + DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0, doc: /* Return FRAME's font cache. Mainly used for debugging. If FRAME is omitted or nil, use the selected frame. */) @@ -4908,6 +5359,13 @@ syms_of_font (void) Vfont_log_deferred = make_nil_vector (3); staticpro (&Vfont_log_deferred); +#if 0 +#ifdef HAVE_LIBOTF + staticpro (&otf_list); + otf_list = Qnil; +#endif /* HAVE_LIBOTF */ +#endif /* 0 */ + defsubr (&Sfontp); defsubr (&Sfont_spec); defsubr (&Sfont_get); @@ -4923,6 +5381,10 @@ syms_of_font (void) defsubr (&Sfont_shape_gstring); defsubr (&Sfont_variation_glyphs); defsubr (&Sinternal_char_font); +#if 0 + defsubr (&Sfont_drive_otf); + defsubr (&Sfont_otf_alternates); +#endif /* 0 */ #ifdef FONT_DEBUG defsubr (&Sopen_font); @@ -4931,6 +5393,9 @@ syms_of_font (void) defsubr (&Sfont_get_glyphs); defsubr (&Sfont_match_p); defsubr (&Sfont_at); +#if 0 + defsubr (&Sdraw_string); +#endif defsubr (&Sframe_font_cache); #endif /* FONT_DEBUG */ #ifdef HAVE_WINDOW_SYSTEM commit 5f4e8e2e088de9fb76cb631077c6eddd3219f594 Author: YAMAMOTO Mitsuharu Date: Wed Apr 24 12:31:37 2019 +0900 Don't link libXft when using cairo * configure.ac: Check cairo early. Don't try Xft if cairo is used. * lwlib/lwlib-utils.h [USE_CAIRO]: Include cairo.h and fontconfig.h. (XftFont, XftDraw, XftColor, XGlyphInfo) [USE_CAIRO]: New typedefs. (XftFontOpenName, XftFontClose, XftDrawCreate, XftDrawDestroy) (XftDrawRect, XftDrawStringUtf8, XftTextExtentsUtf8) [USE_CAIRO]: New macros. (crxft_font_open_name, crxft_font_close, crxft_draw_create) (crxft_draw_rect, crxft_draw_string, crxft_text_extents) [USE_CAIRO]: New externs. * lwlib/lwlib-utils.c [USE_CAIRO]: Include math.h, cairo-ft.h, and cairo-xlib.h. (crxft_font_open_name, crxft_font_close, crxft_draw_create) (crxft_set_source_color, crxft_draw_rect, crxft_draw_string) (crxft_text_extents) [USE_CAIRO]: New Xft compatibility functions. * lwlib/xlwmenuP.h [USE_CAIRO]: Include lwlib-utils.h. * lwlib/xlwmenu.c (display_menu_item) [USE_CAIRO]: Call cairo_surface_mark_dirty and cairo_surface_flush. * lwlib/lwlib-Xaw.c [USE_CAIRO]: Include stdlib.h and lwlib-utils.h. (draw_text) [USE_CAIRO]: Call cairo_surface_flush. * src/xsettings.c [USE_CAIRO]: Include fontconfig.h (apply_xft_settings) [!HAVE_XFT]: Don't call XftDefaultSubstitute or XftDefaultSet. * lwlib/lwlib-Xaw.c: * lwlib/lwlib-int.h: * lwlib/xlwmenu.c: * lwlib/xlwmenuP.h: * src/xrdb.c: * src/xsettings.c: * src/xterm.c: Replace all #ifdef HAVE_XFT with #if defined USE_CAIRO || defined HAVE_XFT. * src/xfns.c (x_default_font_parameter): Replace #ifdef HAVE_XFT with #if defined USE_CAIRO || defined HAVE_XFT. diff --git a/configure.ac b/configure.ac index 8b363c7fca..810c3219e4 100644 --- a/configure.ac +++ b/configure.ac @@ -3312,12 +3312,44 @@ if test "${HAVE_X11}" = "yes"; then fi fi +HAVE_CAIRO=no +if test "${HAVE_X11}" = "yes"; then + if test "${with_cairo}" != "no"; then + CAIRO_REQUIRED=1.12.0 + CAIRO_MODULE="cairo >= $CAIRO_REQUIRED" + EMACS_CHECK_MODULES(CAIRO, $CAIRO_MODULE) + if test $HAVE_CAIRO = yes; then + AC_DEFINE(USE_CAIRO, 1, [Define to 1 if using cairo.]) + else + AC_MSG_ERROR([cairo requested but not found.]) + fi + + CFLAGS="$CFLAGS $CAIRO_CFLAGS" + LIBS="$LIBS $CAIRO_LIBS" + AC_SUBST(CAIRO_CFLAGS) + AC_SUBST(CAIRO_LIBS) + fi +fi + ### Start of font-backend (under any platform) section. # (nothing here yet -- this is a placeholder) ### End of font-backend (under any platform) section. ### Start of font-backend (under X11) section. if test "${HAVE_X11}" = "yes"; then + if test $HAVE_CAIRO = yes; then + dnl Strict linkers fail with + dnl ftfont.o: undefined reference to symbol 'FT_New_Face' + dnl if -lfreetype is not specified. + dnl The following is needed to set FREETYPE_LIBS. + EMACS_CHECK_MODULES([FREETYPE], [freetype2]) + + test "$HAVE_FREETYPE" = "no" && AC_MSG_ERROR(cairo requires libfreetype) + + EMACS_CHECK_MODULES([FONTCONFIG], [fontconfig >= 2.2.0]) + + test "$HAVE_FONTCONFIG" = "no" && AC_MSG_ERROR(cairo requires libfontconfig) + else ## Use -lXft if available, unless '--with-xft=no'. HAVE_XFT=maybe if test "x${with_x}" = "xno"; then @@ -3374,6 +3406,7 @@ if test "${HAVE_X11}" = "yes"; then test "$HAVE_FREETYPE" = "no" && AC_MSG_ERROR(libxft requires libfreetype) fi + fi # $HAVE_CAIRO != yes HAVE_LIBOTF=no if test "${HAVE_FREETYPE}" = "yes"; then @@ -3427,25 +3460,6 @@ AC_SUBST(LIBOTF_LIBS) AC_SUBST(M17N_FLT_CFLAGS) AC_SUBST(M17N_FLT_LIBS) -HAVE_CAIRO=no -if test "${HAVE_X11}" = "yes"; then - if test "${with_cairo}" != "no"; then - CAIRO_REQUIRED=1.12.0 - CAIRO_MODULE="cairo >= $CAIRO_REQUIRED" - EMACS_CHECK_MODULES(CAIRO, $CAIRO_MODULE) - if test $HAVE_CAIRO = yes; then - AC_DEFINE(USE_CAIRO, 1, [Define to 1 if using cairo.]) - else - AC_MSG_ERROR([cairo requested but not found.]) - fi - - CFLAGS="$CFLAGS $CAIRO_CFLAGS" - LIBS="$LIBS $CAIRO_LIBS" - AC_SUBST(CAIRO_CFLAGS) - AC_SUBST(CAIRO_LIBS) - fi -fi - if test "${HAVE_X11}" = "yes"; then AC_CHECK_HEADER(X11/Xlib-xcb.h, AC_CHECK_LIB(xcb, xcb_translate_coordinates, HAVE_XCB=yes)) diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c index a00f8aa73f..0801c94400 100644 --- a/lwlib/lwlib-Xaw.c +++ b/lwlib/lwlib-Xaw.c @@ -50,8 +50,13 @@ along with GNU Emacs. If not, see . */ #include -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT +#ifdef USE_CAIRO +#include +#include "lwlib-utils.h" +#else /* HAVE_XFT */ #include +#endif struct widget_xft_data { @@ -79,7 +84,7 @@ lw_xaw_widget_p (Widget widget) } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT static void fill_xft_data (struct widget_xft_data *data, Widget widget, XftFont *font) { @@ -210,6 +215,9 @@ draw_text (struct widget_xft_data *data, char *lbl, int inverse) /* 1.2 gives reasonable line spacing. */ y += data->xft_font->height * 1.2; } +#ifdef USE_CAIRO + cairo_surface_flush (cairo_get_target (data->xft_draw)); +#endif } @@ -307,7 +315,7 @@ xaw_update_one_widget (widget_instance *instance, if (XtIsSubclass (widget, dialogWidgetClass)) { -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (instance->xft_data && instance->xft_data[0].xft_font) { set_text (&instance->xft_data[0], instance->parent, @@ -339,7 +347,7 @@ xaw_update_one_widget (widget_instance *instance, XtSetArg (al[ac], XtNlabel, val->value);ac++; /* Force centered button text. Se above. */ XtSetArg (al[ac], XtNjustify, XtJustifyCenter);ac++; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (instance->xft_data && instance->xft_data[0].xft_font) { int th; @@ -473,7 +481,7 @@ static XtActionsRec xaw_actions [] = { }; static Boolean actions_initted = False; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT static XtActionsRec button_actions[] = { { "my_reset", command_reset }, @@ -506,7 +514,7 @@ make_dialog (char* name, Widget dialog; Widget button; XtTranslations override; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT XftFont *xft_font = 0; XtTranslations button_override; #endif @@ -521,7 +529,7 @@ make_dialog (char* name, XtAppContext app = XtWidgetToApplicationContext (parent); XtAppAddActions (app, xaw_actions, sizeof (xaw_actions) / sizeof (xaw_actions[0])); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT XtAppAddActions (app, button_actions, sizeof (button_actions) / sizeof (button_actions[0])); #endif @@ -546,7 +554,7 @@ make_dialog (char* name, override = XtParseTranslationTable (dialogOverride); XtOverrideTranslations (dialog, override); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT { int num; Widget *ch = NULL; @@ -618,7 +626,7 @@ make_dialog (char* name, sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (xft_font) { fill_xft_data (&instance->xft_data[bc], button, xft_font); @@ -651,7 +659,7 @@ make_dialog (char* name, sprintf (button_name, "button%d", ++bc); button = XtCreateManagedWidget (button_name, commandWidgetClass, dialog, av, ac); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (xft_font) { fill_xft_data (&instance->xft_data[bc], button, xft_font); diff --git a/lwlib/lwlib-int.h b/lwlib/lwlib-int.h index 28b1fb9508..9f788e7c0c 100644 --- a/lwlib/lwlib-int.h +++ b/lwlib/lwlib-int.h @@ -30,7 +30,7 @@ typedef struct _widget_instance Widget widget; Widget parent; Boolean pop_up_p; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT struct widget_xft_data *xft_data; #endif struct _widget_info* info; diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c index 7c60bdb056..2c0a931f9c 100644 --- a/lwlib/lwlib-utils.c +++ b/lwlib/lwlib-utils.c @@ -137,3 +137,143 @@ XtWidgetBeingDestroyedP (Widget widget) { return widget->core.being_destroyed; } + +#ifdef USE_CAIRO +/* Xft emulation on cairo. */ +#include +#include +#include + +XftFont * +crxft_font_open_name (Display *dpy, int screen, const char *name) +{ + XftFont *pub = NULL; + FcPattern *pattern = FcNameParse ((FcChar8 *) name); + if (pattern) + { + FcConfigSubstitute (NULL, pattern, FcMatchPattern); + double dpi; + if (FcPatternGetDouble (pattern, FC_DPI, 0, &dpi) == FcResultNoMatch) + { + char *v = XGetDefault (dpy, "Xft", FC_DPI); + if (v == NULL || sscanf (v, "%lf", &dpi) != 1) + dpi = ((DisplayHeight (dpy, screen) * 25.4) + / DisplayHeightMM (dpy, screen)); + FcPatternAddDouble (pattern, FC_DPI, dpi); + } + FcDefaultSubstitute (pattern); + cairo_font_face_t *font_face + = cairo_ft_font_face_create_for_pattern (pattern); + if (font_face) + { + double pixel_size; + if ((FcPatternGetDouble (pattern, FC_PIXEL_SIZE, 0, &pixel_size) + != FcResultMatch) + || pixel_size < 1) + pixel_size = 10; + + pub = xmalloc (sizeof (*pub)); + cairo_matrix_t font_matrix, ctm; + cairo_matrix_init_scale (&font_matrix, pixel_size, pixel_size); + cairo_matrix_init_identity (&ctm); + cairo_font_options_t *options = cairo_font_options_create (); + cairo_ft_font_options_substitute (options, pattern); + pub->scaled_font = cairo_scaled_font_create (font_face, &font_matrix, + &ctm, options); + cairo_font_face_destroy (font_face); + cairo_font_options_destroy (options); + + cairo_font_extents_t extents; + cairo_scaled_font_extents (pub->scaled_font, &extents); + pub->ascent = lround (extents.ascent); + pub->descent = lround (extents.descent); + pub->height = lround (extents.height); + pub->max_advance_width = lround (extents.max_x_advance); + } + FcPatternDestroy (pattern); + } + return pub; +} + +void +crxft_font_close (XftFont *pub) +{ + cairo_scaled_font_destroy (pub->scaled_font); + xfree (pub); +} + +cairo_t * +crxft_draw_create (Display *dpy, Drawable drawable, Visual *visual) +{ + cairo_t *cr = NULL; + Window root; + int x, y; + unsigned int width, height, border_width, depth; + + if (!XGetGeometry (dpy, drawable, &root, &x, &y, &width, &height, + &border_width, &depth)) + return NULL; + + cairo_surface_t *surface = cairo_xlib_surface_create (dpy, drawable, visual, + width, height); + if (surface) + { + cr = cairo_create (surface); + cairo_surface_destroy (surface); + } + + return cr; +} + +static void +crxft_set_source_color (cairo_t *cr, const XftColor *color) +{ + cairo_set_source_rgba (cr, color->color.red / 65535.0, + color->color.green / 65535.0, + color->color.blue / 65535.0, + color->color.alpha / 65535.0); +} + +void +crxft_draw_rect (cairo_t *cr, const XftColor *color, int x, int y, + unsigned int width, unsigned int height) +{ + crxft_set_source_color (cr, color); + cairo_rectangle (cr, x, y, width, height); + cairo_fill (cr); +} + +void +crxft_draw_string (cairo_t *cr, const XftColor *color, XftFont *pub, + int x, int y, const FcChar8 *string, int len) +{ + char *buf = xmalloc (len + 1); + memcpy (buf, string, len); + buf[len] = '\0'; + crxft_set_source_color (cr, color); + cairo_set_scaled_font (cr, pub->scaled_font); + cairo_move_to (cr, x, y); + cairo_show_text (cr, buf); + xfree (buf); +} + +void +crxft_text_extents (XftFont *pub, const FcChar8 *string, int len, + XGlyphInfo *extents) +{ + char *buf = xmalloc (len + 1); + memcpy (buf, string, len); + buf[len] = '\0'; + cairo_text_extents_t text_extents; + cairo_scaled_font_text_extents (pub->scaled_font, buf, &text_extents); + xfree (buf); + extents->x = ceil (- text_extents.x_bearing); + extents->y = ceil (- text_extents.y_bearing); + extents->width = (ceil (text_extents.x_bearing + text_extents.width) + + extents->x); + extents->height = (ceil (text_extents.y_bearing + text_extents.height) + + extents->y); + extents->xOff = lround (text_extents.x_advance); + extents->yOff = lround (text_extents.y_advance); +} +#endif /* USE_CAIRO */ diff --git a/lwlib/lwlib-utils.h b/lwlib/lwlib-utils.h index ec3daab94e..64372f19ad 100644 --- a/lwlib/lwlib-utils.h +++ b/lwlib/lwlib-utils.h @@ -15,4 +15,49 @@ Widget *XtCompositeChildren (Widget, unsigned int *); Boolean XtWidgetBeingDestroyedP (Widget widget); +#ifdef USE_CAIRO + +#include +#include + +typedef struct { + cairo_scaled_font_t *scaled_font; + int ascent, descent, height, max_advance_width; +} XftFont; + +typedef cairo_t XftDraw; + +typedef struct { + unsigned long pixel; + struct {unsigned short red, green, blue, alpha;} color; +} XftColor; + +#ifdef HAVE_XRENDER +#include +#else +typedef struct { + unsigned short width, height; + short x, y, xOff, yOff; +} XGlyphInfo; +#endif + +#define XftFontOpenName crxft_font_open_name +extern XftFont *crxft_font_open_name (Display *, int, const char *); +#define XftFontClose(dpy, pub) crxft_font_close (pub) +extern void crxft_font_close (XftFont *); +#define XftDrawCreate(dpy, drawable, visual, colormap) \ + crxft_draw_create (dpy, drawable, visual) +extern cairo_t *crxft_draw_create (Display *, Drawable, Visual *); +#define XftDrawDestroy cairo_destroy +#define XftDrawRect crxft_draw_rect +extern void crxft_draw_rect (cairo_t *, const XftColor *, int, int, + unsigned int, unsigned int); +#define XftDrawStringUtf8 crxft_draw_string +extern void crxft_draw_string (cairo_t *, const XftColor *, XftFont *, + int, int, const FcChar8 *, int); +#define XftTextExtentsUtf8(dpy, pub, string, len, extents) \ + crxft_text_extents (pub, string, len, extents) +extern void crxft_text_extents (XftFont *, const FcChar8 *, int, XGlyphInfo *); + +#endif /* USE_CAIRO */ #endif /* _LWLIB_UTILS_H_ */ diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index a5704cbfb5..6292c840f5 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -107,7 +107,7 @@ xlwMenuResources[] = {XtNfontSet, XtCFontSet, XtRFontSet, sizeof(XFontSet), offset(menu.fontSet), XtRFontSet, NULL}, #endif -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT #define DEFAULT_FONTNAME "Sans-10" #else #define DEFAULT_FONTNAME "XtDefaultFont" @@ -325,7 +325,7 @@ string_width (XlwMenuWidget mw, char *s) { XCharStruct xcs; int drop; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (mw->menu.xft_font) { XGlyphInfo gi; @@ -349,7 +349,7 @@ string_width (XlwMenuWidget mw, char *s) } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT #define MENU_FONT_HEIGHT(mw) \ ((mw)->menu.xft_font != NULL \ ? (mw)->menu.xft_font->height \ @@ -965,7 +965,7 @@ display_menu_item (XlwMenuWidget mw, int width; enum menu_separator separator; int separator_p = lw_separator_p (val->name, &separator, 0); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT XftColor *xftfg; #endif @@ -1005,7 +1005,7 @@ display_menu_item (XlwMenuWidget mw, else text_gc = mw->menu.disabled_gc; deco_gc = mw->menu.foreground_gc; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT xftfg = val->enabled ? &mw->menu.xft_fg : &mw->menu.xft_disabled_fg; #endif @@ -1032,10 +1032,13 @@ display_menu_item (XlwMenuWidget mw, x_offset += ws->button_width; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (ws->xft_draw) { int draw_y = y + v_spacing + shadow; +#ifdef USE_CAIRO + cairo_surface_mark_dirty (cairo_get_target (ws->xft_draw)); +#endif XftDrawStringUtf8 (ws->xft_draw, xftfg, mw->menu.xft_font, x_offset, draw_y + font_ascent, @@ -1078,7 +1081,7 @@ display_menu_item (XlwMenuWidget mw, } else if (val->key) { -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (ws->xft_draw) { int draw_x = ws->width - ws->max_rest_width @@ -1119,6 +1122,10 @@ display_menu_item (XlwMenuWidget mw, draw_shadow_rectangle (mw, ws->pixmap, x, y, width, height, True, False); } +#ifdef USE_CAIRO + if (ws->xft_draw) + cairo_surface_flush (cairo_get_target (ws->xft_draw)); +#endif if (highlighted_p) draw_shadow_rectangle (mw, ws->pixmap, x, y, width, height, False, @@ -1320,7 +1327,7 @@ make_windows_if_needed (XlwMenuWidget mw, int n) XtAddEventHandler (windows [i].w, ExposureMask, False, expose_cb, mw); windows [i].window = XtWindow (windows [i].w); windows [i].pixmap = None; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT windows [i].xft_draw = 0; #endif set_window_type (windows [i].w, mw); @@ -1411,7 +1418,7 @@ create_pixmap_for_menu (window_state* ws, XlwMenuWidget mw) ws->pixmap = XCreatePixmap (XtDisplay (ws->w), ws->window, ws->width, ws->height, DefaultDepthOfScreen (XtScreen (ws->w))); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (ws->xft_draw) XftDrawDestroy (ws->xft_draw); if (mw->menu.xft_font) @@ -1831,7 +1838,7 @@ release_shadow_gcs (XlwMenuWidget mw) XtReleaseGC ((Widget) mw, mw->menu.shadow_bottom_gc); } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT static XftFont * getDefaultXftFont (XlwMenuWidget mw) { @@ -1887,7 +1894,7 @@ XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args) gray_width, gray_height, (unsigned long)1, (unsigned long)0, 1); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (openXftFont (mw)) ; else @@ -1933,7 +1940,7 @@ XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args) mw->menu.windows [0].height = 0; mw->menu.windows [0].max_rest_width = 0; mw->menu.windows [0].pixmap = None; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT mw->menu.windows [0].xft_draw = 0; #endif size_menu (mw, 0); @@ -1981,7 +1988,7 @@ XlwMenuRealize (Widget w, Mask *valueMask, XSetWindowAttributes *attributes) set_window_type (mw->menu.windows [0].w, mw); create_pixmap_for_menu (&mw->menu.windows [0], mw); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (mw->menu.xft_font) { XColor colors[3]; @@ -2078,7 +2085,7 @@ XlwMenuDestroy (Widget w) if (mw->menu.font) XFreeFont (XtDisplay (mw), mw->menu.font); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (mw->menu.windows [0].xft_draw) XftDrawDestroy (mw->menu.windows [0].xft_draw); if (mw->menu.xft_font) @@ -2092,7 +2099,7 @@ XlwMenuDestroy (Widget w) { if (mw->menu.windows [i].pixmap != None) XFreePixmap (XtDisplay (mw), mw->menu.windows [i].pixmap); -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (mw->menu.windows [i].xft_draw) XftDrawDestroy (mw->menu.windows [i].xft_draw); #endif @@ -2102,7 +2109,7 @@ XlwMenuDestroy (Widget w) XtFree ((char *) mw->menu.windows); } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT static int fontname_changed (XlwMenuWidget newmw, XlwMenuWidget oldmw) @@ -2134,7 +2141,7 @@ XlwMenuSetValues (Widget current, Widget request, Widget new, if (newmw->core.background_pixel != oldmw->core.background_pixel || newmw->menu.foreground != oldmw->menu.foreground -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT || fontname_changed (newmw, oldmw) #endif #ifdef HAVE_X_I18N @@ -2170,7 +2177,7 @@ XlwMenuSetValues (Widget current, Widget request, Widget new, } } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (fontname_changed (newmw, oldmw)) { int i; diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h index 610f83afe4..2a05d99354 100644 --- a/lwlib/xlwmenuP.h +++ b/lwlib/xlwmenuP.h @@ -23,9 +23,13 @@ along with GNU Emacs. If not, see . */ #include "xlwmenu.h" #include -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT +#ifdef USE_CAIRO +#include "lwlib-utils.h" +#else /* HAVE_XFT */ #include #endif +#endif /* Elements in the stack arrays. */ typedef struct _window_state @@ -42,7 +46,7 @@ typedef struct _window_state /* Width of toggle buttons or radio buttons. */ Dimension button_width; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT XftDraw* xft_draw; #endif } window_state; @@ -56,7 +60,7 @@ typedef struct _XlwMenu_part XFontSet fontSet; XFontSetExtents *font_extents; #endif -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT int default_face; XftFont* xft_font; XftColor xft_fg, xft_bg, xft_disabled_fg; diff --git a/src/menu.c b/src/menu.c index 7f46e68e73..e82c857059 100644 --- a/src/menu.c +++ b/src/menu.c @@ -687,7 +687,7 @@ digest_single_submenu (int start, int end, bool top_level_items) ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); } -#elif defined (USE_LUCID) && defined (HAVE_XFT) +#elif defined (USE_LUCID) && (defined USE_CAIRO || defined HAVE_XFT) if (STRINGP (pane_name)) { pane_name = ENCODE_UTF_8 (pane_name); diff --git a/src/xfns.c b/src/xfns.c index dbc5e10c41..9075491e97 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -3487,7 +3487,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms) { const char *names[] = { -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT /* This will find the normal Xft font. */ "monospace-10", #endif diff --git a/src/xrdb.c b/src/xrdb.c index 35de446cb7..0950b70669 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -383,7 +383,7 @@ x_load_resources (Display *display, const char *xrm_string, XrmDatabase db; char line[256]; -#if defined USE_MOTIF || !defined HAVE_XFT || !defined USE_LUCID +#if defined USE_MOTIF || !(defined USE_CAIRO || defined HAVE_XFT) || !defined USE_LUCID const char *helv = "-*-helvetica-medium-r-*--*-120-*-*-*-*-iso8859-1"; #endif @@ -456,7 +456,7 @@ x_load_resources (Display *display, const char *xrm_string, sprintf (line, "Emacs.dialog*.background: grey75"); XrmPutLineResource (&rdb, line); -#if !defined (HAVE_XFT) || !defined (USE_LUCID) +#if !(defined USE_CAIRO || defined HAVE_XFT) || !defined (USE_LUCID) sprintf (line, "Emacs.dialog*.font: %s", helv); XrmPutLineResource (&rdb, line); sprintf (line, "*XlwMenu*font: %s", helv); diff --git a/src/xsettings.c b/src/xsettings.c index 947d5cfb7b..3e9012e3ab 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -45,9 +45,13 @@ along with GNU Emacs. If not, see . */ #include #endif -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT +#ifdef USE_CAIRO +#include +#else /* HAVE_XFT */ #include #endif +#endif static char *current_mono_font; static char *current_font; @@ -83,7 +87,7 @@ dpyinfo_valid (struct x_display_info *dpyinfo) /* Store a monospace font change event if the monospaced font changed. */ -#if defined HAVE_XFT && (defined HAVE_GSETTINGS || defined HAVE_GCONF) +#if (defined USE_CAIRO || defined HAVE_XFT) && (defined HAVE_GSETTINGS || defined HAVE_GCONF) static void store_monospaced_changed (const char *newfont) { @@ -102,7 +106,7 @@ store_monospaced_changed (const char *newfont) /* Store a font name change event if the font name changed. */ -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT static void store_font_name_changed (const char *newfont) { @@ -117,7 +121,7 @@ store_font_name_changed (const char *newfont) XCAR (first_dpyinfo->name_list_element)); } } -#endif /* HAVE_XFT */ +#endif /* USE_CAIRO || HAVE_XFT */ /* Map TOOL_BAR_STYLE from a string to its corresponding Lisp value. Return Qnil if TOOL_BAR_STYLE is not known. */ @@ -157,7 +161,7 @@ store_tool_bar_style_changed (const char *newstyle, XCAR (dpyinfo->name_list_element)); } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT #define XSETTINGS_FONT_NAME "Gtk/FontName" #endif #define XSETTINGS_TOOL_BAR_STYLE "Gtk/ToolbarStyle" @@ -174,7 +178,7 @@ enum { }; struct xsettings { -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT FcBool aa, hinting; int rgba, lcdfilter, hintstyle; double dpi; @@ -191,7 +195,7 @@ struct xsettings #define GSETTINGS_SCHEMA "org.gnome.desktop.interface" #define GSETTINGS_TOOL_BAR_STYLE "toolbar-style" -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT #define GSETTINGS_MONO_FONT "monospace-font-name" #define GSETTINGS_FONT_NAME "font-name" #endif @@ -224,7 +228,7 @@ something_changed_gsettingsCB (GSettings *settings, g_variant_unref (val); } } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT else if (strcmp (key, GSETTINGS_MONO_FONT) == 0) { val = g_settings_get_value (settings, GSETTINGS_MONO_FONT); @@ -253,14 +257,14 @@ something_changed_gsettingsCB (GSettings *settings, g_variant_unref (val); } } -#endif /* HAVE_XFT */ +#endif /* USE_CAIRO || HAVE_XFT */ } #endif /* HAVE_GSETTINGS */ #ifdef HAVE_GCONF #define GCONF_TOOL_BAR_STYLE "/desktop/gnome/interface/toolbar_style" -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT #define GCONF_MONO_FONT "/desktop/gnome/interface/monospace_font_name" #define GCONF_FONT_NAME "/desktop/gnome/interface/font_name" #endif @@ -286,7 +290,7 @@ something_changed_gconfCB (GConfClient *client, const char *value = gconf_value_get_string (v); store_tool_bar_style_changed (value, first_dpyinfo); } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT else if (strcmp (key, GCONF_MONO_FONT) == 0) { const char *value = gconf_value_get_string (v); @@ -297,12 +301,12 @@ something_changed_gconfCB (GConfClient *client, const char *value = gconf_value_get_string (v); store_font_name_changed (value); } -#endif /* HAVE_XFT */ +#endif /* USE_CAIRO || HAVE_XFT */ } #endif /* HAVE_GCONF */ -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT /* Older fontconfig versions don't have FC_LCD_*. */ #ifndef FC_LCD_NONE @@ -315,7 +319,7 @@ something_changed_gconfCB (GConfClient *client, #define FC_LCD_FILTER "lcdfilter" #endif -#endif /* HAVE_XFT */ +#endif /* USE_CAIRO || HAVE_XFT */ /* Find the window that contains the XSETTINGS property values. */ @@ -440,7 +444,7 @@ parse_settings (unsigned char *prop, if (bytes_parsed > bytes) return settings_seen; want_this = strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if ((nlen > 6 && memcmp (name, "Xft/", 4) == 0) || strcmp (XSETTINGS_FONT_NAME, name) == 0) want_this = true; @@ -490,7 +494,7 @@ parse_settings (unsigned char *prop, dupstring (&settings->tb_style, sval); settings->seen |= SEEN_TB_STYLE; } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT else if (strcmp (name, XSETTINGS_FONT_NAME) == 0) { dupstring (&settings->font, sval); @@ -553,7 +557,7 @@ parse_settings (unsigned char *prop, else settings->seen &= ~SEEN_LCDFILTER; } -#endif /* HAVE_XFT */ +#endif /* USE_CAIRO || HAVE_XFT */ else want_this = false; settings_seen += want_this; @@ -604,16 +608,18 @@ static void apply_xft_settings (struct x_display_info *dpyinfo, struct xsettings *settings) { -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT FcPattern *pat; struct xsettings oldsettings; bool changed = false; memset (&oldsettings, 0, sizeof (oldsettings)); pat = FcPatternCreate (); +#ifdef HAVE_XFT XftDefaultSubstitute (dpyinfo->display, XScreenNumberOfScreen (dpyinfo->screen), pat); +#endif FcPatternGetBool (pat, FC_ANTIALIAS, 0, &oldsettings.aa); FcPatternGetBool (pat, FC_HINTING, 0, &oldsettings.hinting); #ifdef FC_HINT_STYLE @@ -713,7 +719,9 @@ apply_xft_settings (struct x_display_info *dpyinfo, }; char buf[sizeof format + d_formats * d_growth + lf_formats * lf_growth]; +#ifdef HAVE_XFT XftDefaultSet (dpyinfo->display, pat); +#endif store_config_changed_event (Qfont_render, XCAR (dpyinfo->name_list_element)); Vxft_settings @@ -725,7 +733,7 @@ apply_xft_settings (struct x_display_info *dpyinfo, } else FcPatternDestroy (pat); -#endif /* HAVE_XFT */ +#endif /* USE_CAIRO || HAVE_XFT */ } /* Read XSettings from the display for DPYINFO. @@ -748,7 +756,7 @@ read_and_apply_settings (struct x_display_info *dpyinfo, bool send_event_p) current_tool_bar_style = map_tool_bar_style (settings.tb_style); xfree (settings.tb_style); } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT if (settings.seen & SEEN_FONT) { if (send_event_p) @@ -850,7 +858,7 @@ init_gsettings (void) g_variant_unref (val); } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT val = g_settings_get_value (gsettings_client, GSETTINGS_MONO_FONT); if (val) { @@ -868,7 +876,7 @@ init_gsettings (void) dupstring (¤t_font, g_variant_get_string (val, NULL)); g_variant_unref (val); } -#endif /* HAVE_XFT */ +#endif /* USE_CAIRO || HAVE_XFT */ #endif /* HAVE_GSETTINGS */ } @@ -903,7 +911,7 @@ init_gconf (void) g_free (s); } -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT s = gconf_client_get_string (gconf_client, GCONF_MONO_FONT, NULL); if (s) { @@ -932,7 +940,7 @@ init_gconf (void) GCONF_FONT_NAME, something_changed_gconfCB, NULL, NULL, NULL); -#endif /* HAVE_XFT */ +#endif /* USE_CAIRO || HAVE_XFT */ #endif /* HAVE_GCONF */ } @@ -1055,7 +1063,7 @@ If this variable is nil, Emacs ignores system font changes. */); doc: /* Font settings applied to Xft. */); Vxft_settings = empty_unibyte_string; -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT Fprovide (intern_c_string ("font-render-setting"), Qnil); #if defined (HAVE_GCONF) || defined (HAVE_GSETTINGS) Fprovide (intern_c_string ("system-font-setting"), Qnil); diff --git a/src/xterm.c b/src/xterm.c index 0b83263a0e..e85e8e35d4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -12733,7 +12733,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->supports_xdbe = true; #endif -#ifdef HAVE_XFT +#if defined USE_CAIRO || defined HAVE_XFT { /* If we are using Xft, the following precautions should be made: commit 1828e9a9b7481572448284a8e5925bf97f2145f7 Author: Stefan Monnier Date: Tue Apr 23 17:54:13 2019 -0400 * lisp/emacs-lisp/timer-list.el: Fix header-line alignment Enable lexical-binding. (cl-print-compiled, cl-print-compiled-button): Declare. (timer-list-mode): Add spacing to align the header. diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 81e2f91c0e..55aa56b72e 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -1,4 +1,4 @@ -;;; timer-list.el --- list active timers in a buffer +;;; timer-list.el --- list active timers in a buffer -*- lexical-binding:t -*- ;; Copyright (C) 2016-2019 Free Software Foundation, Inc. @@ -24,6 +24,9 @@ ;;; Code: +(defvar cl-print-compiled) +(defvar cl-print-compiled-button) + ;;;###autoload (defun list-timers (&optional _ignore-auto _nonconfirm) "List all timers in a buffer." @@ -85,8 +88,9 @@ (setq-local revert-buffer-function #'list-timers) (setq buffer-read-only t) (setq header-line-format - (format "%4s %10s %8s %s" - "Idle" "Next" "Repeat" "Function"))) + (concat (propertize " " 'display '(space :align-to 0)) + (format "%4s %10s %8s %s" + "Idle" "Next" "Repeat" "Function")))) (defun timer-list-cancel () "Cancel the timer on the line under point." commit 3d30b651ca817ea7594f5ec00d20614aabedffc4 Author: Philipp Stephani Date: Tue Apr 23 23:39:35 2019 +0200 * src/emacs-module.c: Add an additional requirement for API changes. diff --git a/src/emacs-module.c b/src/emacs-module.c index d7704efcf6..b812fdc2df 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -32,6 +32,9 @@ If you want to change the module API, please abide to the following - Don't change the types of structure fields. +- Likewise, the presence, order, and type of structure fields may not + depend on preprocessor macros. + - Add structure fields only at the end of structures. - For every Emacs major version there is a new fragment file commit 51595f5340d141e5f1e7b2a4d858abfa9b12c43e Author: Paul Eggert Date: Tue Apr 23 13:51:07 2019 -0700 Remove some unnecessary #ifdef directives These directives are in files that are compiled only if the symbols are defined. * src/gfilenotify.c: Remove unnecessary ‘#ifdef HAVE_GFILENOTIFY’. * src/inotify.c: Remove unnecessary ‘#ifdef HAVE_INOTIFY’. * src/kqueue.c: Remove unnecessary ‘#ifdef HAVE_KQUEUE’. diff --git a/src/gfilenotify.c b/src/gfilenotify.c index a9f33c9900..ddb19770c3 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -18,7 +18,6 @@ along with GNU Emacs. If not, see . */ #include -#ifdef HAVE_GFILENOTIFY #include #include #include "lisp.h" @@ -333,7 +332,4 @@ syms_of_gfilenotify (void) staticpro (&watch_list); Fprovide (intern_c_string ("gfilenotify"), Qnil); - } - -#endif /* HAVE_GFILENOTIFY */ diff --git a/src/inotify.c b/src/inotify.c index ecbe31c168..9a7dbb8f41 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -19,8 +19,6 @@ along with GNU Emacs. If not, see . */ #include -#ifdef HAVE_INOTIFY - #include "lisp.h" #include "coding.h" #include "process.h" @@ -550,5 +548,3 @@ syms_of_inotify (void) Fprovide (intern_c_string ("inotify"), Qnil); } - -#endif /* HAVE_INOTIFY */ diff --git a/src/kqueue.c b/src/kqueue.c index 48121bd663..42391f8467 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -19,7 +19,6 @@ along with GNU Emacs. If not, see . */ #include -#ifdef HAVE_KQUEUE #include #include #include @@ -533,8 +532,6 @@ syms_of_kqueue (void) Fprovide (intern_c_string ("kqueue"), Qnil); } -#endif /* HAVE_KQUEUE */ - /* PROBLEMS * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837 prevents tests on Ubuntu. */ commit 26f9a77f2478fb73bc82f12b3285c5f8cd7eb9f3 Author: Stefan Monnier Date: Tue Apr 23 16:36:59 2019 -0400 * etc/package-keyring.gpg: Add the 2019 key diff --git a/etc/package-keyring.gpg b/etc/package-keyring.gpg index e76e68522f..490dee41a9 100644 Binary files a/etc/package-keyring.gpg and b/etc/package-keyring.gpg differ commit 64d0cd9810af6bd0c378fc6bc666c76ddfa97e40 Author: Paul Eggert Date: Tue Apr 23 13:29:42 2019 -0700 Remove font.c code commented out for a decade * src/font.c (LSTRING_HEADER_SIZE, LSTRING_GLYPH_SIZE, check_gstring) (check_otf_features, otf_list, otf_tag_symbol, otf_open) (font_otf_capability, generate_otf_features) (font_otf_DeviceTable, font_otf_ValueRecord) (font_otf_Anchor, Ffont_drive_otf, Ffont_otf_alternates) (Fdraw_string, syms_of_font): Remove "experimental and not tested much" code that has been "#if 0"-ed out for more than a decade and which was getting in the way of maintenance. diff --git a/src/font.c b/src/font.c index 5ca89c97dc..e7686cf4bb 100644 --- a/src/font.c +++ b/src/font.c @@ -1786,296 +1786,6 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec } -/* This part (through the next ^L) is still experimental and not - tested much. We may drastically change codes. */ - -/* OTF handler. */ - -#if 0 - -#define LGSTRING_HEADER_SIZE 6 -#define LGSTRING_GLYPH_SIZE 8 - -static int -check_gstring (Lisp_Object gstring) -{ - Lisp_Object val; - ptrdiff_t i; - int j; - - CHECK_VECTOR (gstring); - val = AREF (gstring, 0); - CHECK_VECTOR (val); - if (ASIZE (val) < LGSTRING_HEADER_SIZE) - goto err; - CHECK_FONT_OBJECT (LGSTRING_FONT (gstring)); - if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING))) - CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)); - if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING))) - CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)); - if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH))) - CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)); - if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT))) - CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); - if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT))) - CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); - - for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++) - { - val = LGSTRING_GLYPH (gstring, i); - CHECK_VECTOR (val); - if (ASIZE (val) < LGSTRING_GLYPH_SIZE) - goto err; - if (NILP (AREF (val, LGLYPH_IX_CHAR))) - break; - CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM)); - CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO)); - CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR)); - if (!NILP (AREF (val, LGLYPH_IX_CODE))) - CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE)); - if (!NILP (AREF (val, LGLYPH_IX_WIDTH))) - CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH)); - if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT))) - { - val = AREF (val, LGLYPH_IX_ADJUSTMENT); - CHECK_VECTOR (val); - if (ASIZE (val) < 3) - goto err; - for (j = 0; j < 3; j++) - CHECK_FIXNUM (AREF (val, j)); - } - } - return i; - err: - error ("Invalid glyph-string format"); - return -1; -} - -static void -check_otf_features (Lisp_Object otf_features) -{ - Lisp_Object val; - - CHECK_CONS (otf_features); - CHECK_SYMBOL (XCAR (otf_features)); - otf_features = XCDR (otf_features); - CHECK_CONS (otf_features); - CHECK_SYMBOL (XCAR (otf_features)); - otf_features = XCDR (otf_features); - for (val = Fcar (otf_features); CONSP (val); val = XCDR (val)) - { - CHECK_SYMBOL (XCAR (val)); - if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) - error ("Invalid OTF GSUB feature: %s", - SDATA (SYMBOL_NAME (XCAR (val)))); - } - otf_features = XCDR (otf_features); - for (val = Fcar (otf_features); CONSP (val); val = XCDR (val)) - { - CHECK_SYMBOL (XCAR (val)); - if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) - error ("Invalid OTF GPOS feature: %s", - SDATA (SYMBOL_NAME (XCAR (val)))); - } -} - -#ifdef HAVE_LIBOTF -#include - -Lisp_Object otf_list; - -static Lisp_Object -otf_tag_symbol (OTF_Tag tag) -{ - char name[5]; - - OTF_tag_name (tag, name); - return Fintern (make_unibyte_string (name, 4), Qnil); -} - -static OTF * -otf_open (Lisp_Object file) -{ - Lisp_Object val = Fassoc (file, otf_list, Qnil); - OTF *otf; - - if (! NILP (val)) - otf = xmint_pointer (XCDR (val)); - else - { - otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; - val = make_mint_ptr (otf); - otf_list = Fcons (Fcons (file, val), otf_list); - } - return otf; -} - - -/* Return a list describing which scripts/languages FONT supports by - which GSUB/GPOS features of OpenType tables. See the comment of - (struct font_driver).otf_capability. */ - -Lisp_Object -font_otf_capability (struct font *font) -{ - OTF *otf; - Lisp_Object capability = Fcons (Qnil, Qnil); - int i; - - otf = otf_open (font->props[FONT_FILE_INDEX]); - if (! otf) - return Qnil; - for (i = 0; i < 2; i++) - { - OTF_GSUB_GPOS *gsub_gpos; - Lisp_Object script_list = Qnil; - int j; - - if (OTF_get_features (otf, i == 0) < 0) - continue; - gsub_gpos = i == 0 ? otf->gsub : otf->gpos; - for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--) - { - OTF_Script *script = gsub_gpos->ScriptList.Script + j; - Lisp_Object langsys_list = Qnil; - Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag); - int k; - - for (k = script->LangSysCount; k >= 0; k--) - { - OTF_LangSys *langsys; - Lisp_Object feature_list = Qnil; - Lisp_Object langsys_tag; - int l; - - if (k == script->LangSysCount) - { - langsys = &script->DefaultLangSys; - langsys_tag = Qnil; - } - else - { - langsys = script->LangSys + k; - langsys_tag - = otf_tag_symbol (script->LangSysRecord[k].LangSysTag); - } - for (l = langsys->FeatureCount - 1; l >= 0; l--) - { - OTF_Feature *feature - = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l]; - Lisp_Object feature_tag - = otf_tag_symbol (feature->FeatureTag); - - feature_list = Fcons (feature_tag, feature_list); - } - langsys_list = Fcons (Fcons (langsys_tag, feature_list), - langsys_list); - } - script_list = Fcons (Fcons (script_tag, langsys_list), - script_list); - } - - if (i == 0) - XSETCAR (capability, script_list); - else - XSETCDR (capability, script_list); - } - - return capability; -} - -/* Parse OTF features in SPEC and write a proper features spec string - in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is - assured that the sufficient memory has already allocated for - FEATURES. */ - -static void -generate_otf_features (Lisp_Object spec, char *features) -{ - Lisp_Object val; - char *p; - bool asterisk; - - p = features; - *p = '\0'; - for (asterisk = 0; CONSP (spec); spec = XCDR (spec)) - { - val = XCAR (spec); - CHECK_SYMBOL (val); - if (p > features) - *p++ = ','; - if (SREF (SYMBOL_NAME (val), 0) == '*') - { - asterisk = 1; - *p++ = '*'; - } - else if (! asterisk) - { - val = SYMBOL_NAME (val); - p += esprintf (p, "%s", SDATA (val)); - } - else - { - val = SYMBOL_NAME (val); - p += esprintf (p, "~%s", SDATA (val)); - } - } - if (CONSP (spec)) - error ("OTF spec too long"); -} - -Lisp_Object -font_otf_DeviceTable (OTF_DeviceTable *device_table) -{ - int len = device_table->StartSize - device_table->EndSize + 1; - - return Fcons (make_fixnum (len), - make_unibyte_string (device_table->DeltaValue, len)); -} - -Lisp_Object -font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record) -{ - Lisp_Object val = make_nil_vector (8); - - if (value_format & OTF_XPlacement) - ASET (val, 0, make_fixnum (value_record->XPlacement)); - if (value_format & OTF_YPlacement) - ASET (val, 1, make_fixnum (value_record->YPlacement)); - if (value_format & OTF_XAdvance) - ASET (val, 2, make_fixnum (value_record->XAdvance)); - if (value_format & OTF_YAdvance) - ASET (val, 3, make_fixnum (value_record->YAdvance)); - if (value_format & OTF_XPlaDevice) - ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice)); - if (value_format & OTF_YPlaDevice) - ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice)); - if (value_format & OTF_XAdvDevice) - ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice)); - if (value_format & OTF_YAdvDevice) - ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice)); - return val; -} - -Lisp_Object -font_otf_Anchor (OTF_Anchor *anchor) -{ - Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1); - ASET (val, 0, make_fixnum (anchor->XCoordinate)); - ASET (val, 1, make_fixnum (anchor->YCoordinate)); - if (anchor->AnchorFormat == 2) - ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint)); - else - { - ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable)); - ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable)); - } - return val; -} -#endif /* HAVE_LIBOTF */ -#endif /* 0 */ - - /* Font sorting. */ static double @@ -4612,126 +4322,6 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, return Fcons (font_object, INT_TO_INTEGER (code)); } -#if 0 - -DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0, - doc: /* Apply OpenType features on glyph-string GSTRING-IN. -OTF-FEATURES specifies which features to apply in this format: - (SCRIPT LANGSYS GSUB GPOS) -where - SCRIPT is a symbol specifying a script tag of OpenType, - LANGSYS is a symbol specifying a langsys tag of OpenType, - GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags. - -If LANGSYS is nil, the default langsys is selected. - -The features are applied in the order they appear in the list. The -symbol `*' means to apply all available features not present in this -list, and the remaining features are ignored. For instance, (vatu -pstf * haln) is to apply vatu and pstf in this order, then to apply -all available features other than vatu, pstf, and haln. - -The features are applied to the glyphs in the range FROM and TO of -the glyph-string GSTRING-IN. - -If some feature is actually applicable, the resulting glyphs are -produced in the glyph-string GSTRING-OUT from the index INDEX. In -this case, the value is the number of produced glyphs. - -If no feature is applicable, no glyph is produced in GSTRING-OUT, and -the value is 0. - -If GSTRING-OUT is too short to hold produced glyphs, no glyphs are -produced in GSTRING-OUT, and the value is nil. - -See the documentation of `composition-get-gstring' for the format of -glyph-string. */) - (Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object index) -{ - Lisp_Object font_object = LGSTRING_FONT (gstring_in); - Lisp_Object val; - struct font *font; - int len, num; - - check_otf_features (otf_features); - CHECK_FONT_OBJECT (font_object); - font = XFONT_OBJECT (font_object); - if (! font->driver->otf_drive) - error ("Font backend %s can't drive OpenType GSUB table", - SDATA (SYMBOL_NAME (font->driver->type))); - CHECK_CONS (otf_features); - CHECK_SYMBOL (XCAR (otf_features)); - val = XCDR (otf_features); - CHECK_SYMBOL (XCAR (val)); - val = XCDR (otf_features); - if (! NILP (val)) - CHECK_CONS (val); - len = check_gstring (gstring_in); - CHECK_VECTOR (gstring_out); - CHECK_FIXNAT (from); - CHECK_FIXNAT (to); - CHECK_FIXNAT (index); - - if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len) - args_out_of_range_3 (from, to, make_fixnum (len)); - if (XFIXNUM (index) >= ASIZE (gstring_out)) - args_out_of_range (index, make_fixnum (ASIZE (gstring_out))); - num = font->driver->otf_drive (font, otf_features, - gstring_in, XFIXNUM (from), XFIXNUM (to), - gstring_out, XFIXNUM (index), 0); - if (num < 0) - return Qnil; - return make_fixnum (num); -} - -DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates, - 3, 3, 0, - doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT. -OTF-FEATURES specifies which features of the font FONT-OBJECT to apply -in this format: - (SCRIPT LANGSYS FEATURE ...) -See the documentation of `font-drive-otf' for more detail. - -The value is a list of cons cells of the format (GLYPH-ID . CHARACTER), -where GLYPH-ID is a glyph index of the font, and CHARACTER is a -character code corresponding to the glyph or nil if there's no -corresponding character. */) - (Lisp_Object font_object, Lisp_Object character, Lisp_Object otf_features) -{ - struct font *font = CHECK_FONT_GET_OBJECT (font_object); - Lisp_Object gstring_in, gstring_out, g; - Lisp_Object alternates; - int i, num; - - if (! font->driver->otf_drive) - error ("Font backend %s can't drive OpenType GSUB table", - SDATA (SYMBOL_NAME (font->driver->type))); - CHECK_CHARACTER (character); - CHECK_CONS (otf_features); - - gstring_in = Ffont_make_gstring (font_object, make_fixnum (1)); - g = LGSTRING_GLYPH (gstring_in, 0); - LGLYPH_SET_CHAR (g, XFIXNUM (character)); - gstring_out = Ffont_make_gstring (font_object, make_fixnum (10)); - while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1, - gstring_out, 0, 1)) < 0) - gstring_out = Ffont_make_gstring (font_object, - make_fixnum (ASIZE (gstring_out) * 2)); - alternates = Qnil; - for (i = 0; i < num; i++) - { - Lisp_Object g = LGSTRING_GLYPH (gstring_out, i); - int c = LGLYPH_CHAR (g); - unsigned code = LGLYPH_CODE (g); - - alternates = Fcons (Fcons (make_fixnum (code), - c > 0 ? make_fixnum (c) : Qnil), - alternates); - } - return Fnreverse (alternates); -} -#endif /* 0 */ - #ifdef FONT_DEBUG DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, @@ -4996,47 +4586,6 @@ character at index specified by POSITION. */) return font_at (-1, XFIXNUM (position), NULL, w, string); } -#if 0 -DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0, - doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame. -The value is a number of glyphs drawn. -Type C-l to recover what previously shown. */) - (Lisp_Object font_object, Lisp_Object string) -{ - Lisp_Object frame = selected_frame; - struct frame *f = XFRAME (frame); - struct font *font; - struct face *face; - int i, len, width; - unsigned *code; - - CHECK_FONT_GET_OBJECT (font_object, font); - CHECK_STRING (string); - len = SCHARS (string); - code = alloca (sizeof (unsigned) * len); - for (i = 0; i < len; i++) - { - Lisp_Object ch = Faref (string, make_fixnum (i)); - Lisp_Object val; - int c = XFIXNUM (ch); - - code[i] = font->driver->encode_char (font, c); - if (code[i] == FONT_INVALID_CODE) - break; - } - face = FACE_FROM_ID (f, DEFAULT_FACE_ID); - face->fontp = font; - if (font->driver->prepare_face) - font->driver->prepare_face (f, face); - width = font->driver->text_extents (font, code, i, NULL); - len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width); - if (font->driver->done_face) - font->driver->done_face (f, face); - face->fontp = NULL; - return make_fixnum (len); -} -#endif - DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0, doc: /* Return FRAME's font cache. Mainly used for debugging. If FRAME is omitted or nil, use the selected frame. */) @@ -5359,13 +4908,6 @@ syms_of_font (void) Vfont_log_deferred = make_nil_vector (3); staticpro (&Vfont_log_deferred); -#if 0 -#ifdef HAVE_LIBOTF - staticpro (&otf_list); - otf_list = Qnil; -#endif /* HAVE_LIBOTF */ -#endif /* 0 */ - defsubr (&Sfontp); defsubr (&Sfont_spec); defsubr (&Sfont_get); @@ -5381,10 +4923,6 @@ syms_of_font (void) defsubr (&Sfont_shape_gstring); defsubr (&Sfont_variation_glyphs); defsubr (&Sinternal_char_font); -#if 0 - defsubr (&Sfont_drive_otf); - defsubr (&Sfont_otf_alternates); -#endif /* 0 */ #ifdef FONT_DEBUG defsubr (&Sopen_font); @@ -5393,9 +4931,6 @@ syms_of_font (void) defsubr (&Sfont_get_glyphs); defsubr (&Sfont_match_p); defsubr (&Sfont_at); -#if 0 - defsubr (&Sdraw_string); -#endif defsubr (&Sframe_font_cache); #endif /* FONT_DEBUG */ #ifdef HAVE_WINDOW_SYSTEM commit 259dfd20b9f835e701edef569795198ff7cf68cb Author: Philipp Stephani Date: Tue Apr 23 16:59:46 2019 +0200 Use three-argument form for out-of-range errors. This provides more debugging hints for callers. * src/emacs-module.c (module_copy_string_contents): Use three-argument form of args-out-of-range. diff --git a/src/emacs-module.c b/src/emacs-module.c index 20dcff2b67..d7704efcf6 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -614,8 +614,11 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, if (*length < required_buf_size) { + ptrdiff_t actual = *length; *length = required_buf_size; - xsignal0 (Qargs_out_of_range); + args_out_of_range_3 (INT_TO_INTEGER (actual), + INT_TO_INTEGER (required_buf_size), + INT_TO_INTEGER (PTRDIFF_MAX)); } *length = required_buf_size; commit eaea40b33721513d4c0228af92d5c32400fda0e7 Author: Philipp Stephani Date: Tue Apr 23 16:48:49 2019 +0200 Use high-level integer conversion macro in a few cases. INT_TO_INTEGER is more obviously correct and means we don’t have to worry about data type sizes and signedness. * src/json.c (json_parse_error): Use INT_TO_INTEGER. The tiny performance gain of make_fixed_natnum isn’t worth the trouble then signaling an error. diff --git a/src/json.c b/src/json.c index 7d6d531427..03468e9f33 100644 --- a/src/json.c +++ b/src/json.c @@ -304,8 +304,8 @@ json_parse_error (const json_error_t *error) #endif xsignal (symbol, list5 (json_build_string (error->text), - json_build_string (error->source), make_fixed_natnum (error->line), - make_fixed_natnum (error->column), make_fixed_natnum (error->position))); + json_build_string (error->source), INT_TO_INTEGER (error->line), + INT_TO_INTEGER (error->column), INT_TO_INTEGER (error->position))); } static void commit ecab8835a03fdeeea755fa222a326f1ea376ccc4 Author: Mattias Engdegård Date: Tue Apr 23 14:31:22 2019 +0200 Rename auto-revert-notify-watch-descriptor-hash-list * lisp/autorevert.el (auto-revert-notify-watch-descriptor-hash-list): Rename to auto-revert--buffers-by-watch-descriptor. Improved doc string. (auto-revert-notify-rm-watch, auto-revert-notify-add-watch, auto-revert-notify-handler): Use new name. diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 2d148d6095..1d20896c83 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -326,12 +326,12 @@ the list of old buffers.") (add-hook 'find-file-hook #'auto-revert-find-file-function) -(defvar auto-revert-notify-watch-descriptor-hash-list +(defvar auto-revert--buffers-by-watch-descriptor (make-hash-table :test 'equal) - "A hash table collecting all file watch descriptors. -Hash key is a watch descriptor, hash value is a list of buffers -which are related to files being watched and carrying the same -default directory.") + "A hash table mapping notification descriptors to lists of buffers. +The buffers use that descriptor for auto-revert notifications. +The key is equal to `auto-revert-notify-watch-descriptor' in each +buffer.") (defvar-local auto-revert-notify-watch-descriptor nil "The file watch descriptor active for the current buffer.") @@ -500,7 +500,7 @@ will use an up-to-date value of `auto-revert-interval'" (defun auto-revert-notify-rm-watch () "Disable file notification for current buffer's associated file." (let ((desc auto-revert-notify-watch-descriptor) - (table auto-revert-notify-watch-descriptor-hash-list)) + (table auto-revert--buffers-by-watch-descriptor)) (when desc (let ((buffers (delq (current-buffer) (gethash desc table)))) (if buffers @@ -534,7 +534,7 @@ will use an up-to-date value of `auto-revert-interval'" (gethash key file-notify-descriptors)) 'auto-revert-notify-handler)) (setq auto-revert-notify-watch-descriptor key))) - auto-revert-notify-watch-descriptor-hash-list) + auto-revert--buffers-by-watch-descriptor) ;; Create a new watch if needed. (unless auto-revert-notify-watch-descriptor (setq auto-revert-notify-watch-descriptor @@ -549,8 +549,8 @@ will use an up-to-date value of `auto-revert-interval'" auto-revert-notify-watch-descriptor (cons (current-buffer) (gethash auto-revert-notify-watch-descriptor - auto-revert-notify-watch-descriptor-hash-list)) - auto-revert-notify-watch-descriptor-hash-list) + auto-revert--buffers-by-watch-descriptor)) + auto-revert--buffers-by-watch-descriptor) (add-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch nil t))))) ;; If we have file notifications, we want to update the auto-revert buffers @@ -585,7 +585,7 @@ no more reverts are possible until the next call of (file (nth 2 event)) (file1 (nth 3 event)) ;; Target of `renamed'. (buffers (gethash descriptor - auto-revert-notify-watch-descriptor-hash-list))) + auto-revert--buffers-by-watch-descriptor))) ;; Check, that event is meant for us. (cl-assert descriptor) ;; Since we watch a directory, a file name must be returned. commit e8c07cae5faca34c64568a393cdc2da59a295c86 Author: Michael Albinus Date: Tue Apr 23 16:07:38 2019 +0200 Remote processes cannot use a pipe process for stderr * doc/lispref/processes.texi (Asynchronous Processes): (Accepting Output): Remote processes cannot use a pipe process for stderr. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index c08b14c72c..69f781e3a9 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -734,7 +734,11 @@ current working directory is the local name component of Depending on the implementation of the file name handler, it might not be possible to apply @var{filter} or @var{sentinel} to the resulting -process object. @xref{Filter Functions}, and @ref{Sentinels}. +process object. The @code{:stderr} argument cannot be a pipe process, +file name handlers do not support pipe processes for this. A buffer +as @code{:stderr} argument is accepted, its contents is shown without +the use of pipe processes. @xref{Filter Functions}, @ref{Sentinels}, +and @ref{Accepting Output}. Some file name handlers may not support @code{make-process}. In such cases, this function does nothing and returns @code{nil}. @@ -1908,6 +1912,9 @@ code: (while (accept-process-output stderr-process)) @end example +Reading pending standard error from a process running on a remote host +is not possible this way. + @node Processes and Threads @subsection Processes and Threads @cindex processes, threads commit d9d592dd44f5782bb66da528d223085a863ab1e2 Author: Philipp Stephani Date: Tue Apr 23 15:31:04 2019 +0200 * src/json.c (json_make_string): Add missing cast. diff --git a/src/json.c b/src/json.c index 33e8125f98..7d6d531427 100644 --- a/src/json.c +++ b/src/json.c @@ -237,7 +237,7 @@ json_make_string (const char *data, ptrdiff_t size) struct coding_system coding; setup_coding_system (Qutf_8_unix, &coding); coding.mode |= CODING_MODE_LAST_BLOCK; - coding.source = data; + coding.source = (const unsigned char *) data; decode_coding_object (&coding, Qnil, 0, 0, size, size, Qt); return coding.dst_object; } commit db2c9308492a158b9fa97aa9280a7897885f7760 Author: Eli Zaretskii Date: Tue Apr 23 13:20:46 2019 +0300 Speed up JSON parsing Thanks to Dmitry Gutov for running many benchmarks and for useful discussions. * src/json.c (json_make_string): Speed up parsing of JSON strings by optimizing the normal case of a valid UTF-8 string being returned from libjansson. (Bug#31138) diff --git a/src/json.c b/src/json.c index 256d485eea..33e8125f98 100644 --- a/src/json.c +++ b/src/json.c @@ -217,7 +217,8 @@ json_has_suffix (const char *string, const char *suffix) /* Create a multibyte Lisp string from the UTF-8 string in [DATA, DATA + SIZE). If the range [DATA, DATA + SIZE) does not - contain a valid UTF-8 string, an unspecified string is returned. + contain a valid UTF-8 string, the returned string will include raw + bytes. Note that all callers below either pass only value UTF-8 strings or use this function for formatting error messages; in the latter case correctness isn't critical. */ @@ -225,8 +226,21 @@ json_has_suffix (const char *string, const char *suffix) static Lisp_Object json_make_string (const char *data, ptrdiff_t size) { - return code_convert_string (make_specified_string (data, -1, size, false), - Qutf_8_unix, Qt, false, true, true); + ptrdiff_t chars, bytes; + parse_str_as_multibyte ((const unsigned char *) data, size, &chars, &bytes); + /* If DATA is a valid UTF-8 string, we can convert it to a Lisp + string directly. Otherwise, we need to decode it. */ + if (chars == size || bytes == size) + return make_specified_string (data, chars, size, true); + else + { + struct coding_system coding; + setup_coding_system (Qutf_8_unix, &coding); + coding.mode |= CODING_MODE_LAST_BLOCK; + coding.source = data; + decode_coding_object (&coding, Qnil, 0, 0, size, size, Qt); + return coding.dst_object; + } } /* Create a multibyte Lisp string from the NUL-terminated UTF-8 commit b59429a43ebe96b3882b237440ac79ad95e636c8 Author: Philipp Stephani Date: Tue Apr 23 11:59:29 2019 +0200 Small fix for a JSON unit test. * test/src/json-tests.el (json-parse-string/null): Make JSON object syntactically valid. This test is supposed to check whether an escaped null character causes an error, but without quoting the string it would be syntactically invalid in any case. diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 542eec11bf..7d824b5c95 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -159,7 +159,7 @@ (skip-unless (fboundp 'json-parse-string)) (should-error (json-parse-string "\x00") :type 'wrong-type-argument) ;; FIXME: Reconsider whether this is the right behavior. - (should-error (json-parse-string "[a\\u0000b]") :type 'json-parse-error)) + (should-error (json-parse-string "[\"a\\u0000b\"]") :type 'json-parse-error)) (ert-deftest json-parse-string/invalid-unicode () "Some examples from commit 0d5caa9a0c668d06ab650392bd52ad03a4dfbd1a Author: Alan Mackenzie Date: Tue Apr 23 09:16:05 2019 +0000 Optimize for typing characters into long C++ raw strings. * lisp/progmodes/cc-fonts.el (c-font-lock-complex-decl-prepare) (c-font-lock-objc-methods) (c-font-lock-declarations, c-font-lock-enum-tail) (c-font-lock-cut-off-declarators, c-font-lock-enclosing-decls): If the chunk been fontified consists entirely of comments and strings, don't attempt to perform the function's action. * lisp/progmodes/cc-mode.el (c-before-change-check-unbalanced-strings): Don't expand (c-new-BEG c-new-END) unnecessarily to the entire raw string being fontified. (c-fl-decl-start, c-fl-decl-end): When in a (raw or otherwise) string, don't return a position outside of the string (which used to cause unneeded fontification). diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 5832f1f451..4a5cf5719b 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -880,48 +880,51 @@ casts and declarations are fontified. Used on level 2 and higher." (when (bobp) (c-clear-found-types)) - ;; Clear the c-type char properties which mark the region, to recalculate - ;; them properly. The most interesting properties are those put on the - ;; closest token before the region. - (save-excursion - (let ((pos (point))) - (c-backward-syntactic-ws) - (c-clear-char-properties - (if (and (not (bobp)) - (memq (c-get-char-property (1- (point)) 'c-type) - '(c-decl-arg-start - c-decl-end - c-decl-id-start - c-decl-type-start))) - (1- (point)) - pos) - limit 'c-type))) - - ;; Update `c-state-cache' to the beginning of the region. This will - ;; make `c-beginning-of-syntax' go faster when it's used later on, - ;; and it's near the point most of the time. - (c-parse-state) - - ;; Check if the fontified region starts inside a declarator list so - ;; that `c-font-lock-declarators' should be called at the start. - ;; The declared identifiers are font-locked correctly as types, if - ;; that is what they are. - (let ((prop (save-excursion - (c-backward-syntactic-ws) - (unless (bobp) - (c-get-char-property (1- (point)) 'c-type))))) - (when (memq prop '(c-decl-id-start c-decl-type-start)) - (c-forward-syntactic-ws limit) - (c-font-lock-declarators limit t (eq prop 'c-decl-type-start) - (not (c-bs-at-toplevel-p (point)))))) - - (setq c-font-lock-context ;; (c-guess-font-lock-context) - (save-excursion - (if (and c-cpp-expr-intro-re - (c-beginning-of-macro) - (looking-at c-cpp-expr-intro-re)) - 'in-cpp-expr))) - nil) + (c-skip-comments-and-strings limit) + (when (< (point) limit) + + ;; Clear the c-type char properties which mark the region, to recalculate + ;; them properly. The most interesting properties are those put on the + ;; closest token before the region. + (save-excursion + (let ((pos (point))) + (c-backward-syntactic-ws) + (c-clear-char-properties + (if (and (not (bobp)) + (memq (c-get-char-property (1- (point)) 'c-type) + '(c-decl-arg-start + c-decl-end + c-decl-id-start + c-decl-type-start))) + (1- (point)) + pos) + limit 'c-type))) + + ;; Update `c-state-cache' to the beginning of the region. This will + ;; make `c-beginning-of-syntax' go faster when it's used later on, + ;; and it's near the point most of the time. + (c-parse-state) + + ;; Check if the fontified region starts inside a declarator list so + ;; that `c-font-lock-declarators' should be called at the start. + ;; The declared identifiers are font-locked correctly as types, if + ;; that is what they are. + (let ((prop (save-excursion + (c-backward-syntactic-ws) + (unless (bobp) + (c-get-char-property (1- (point)) 'c-type))))) + (when (memq prop '(c-decl-id-start c-decl-type-start)) + (c-forward-syntactic-ws limit) + (c-font-lock-declarators limit t (eq prop 'c-decl-type-start) + (not (c-bs-at-toplevel-p (point)))))) + + (setq c-font-lock-context ;; (c-guess-font-lock-context) + (save-excursion + (if (and c-cpp-expr-intro-re + (c-beginning-of-macro) + (looking-at c-cpp-expr-intro-re)) + 'in-cpp-expr))) + nil)) (defun c-font-lock-<>-arglists (limit) ;; This function will be called from font-lock for a region bounded by POINT @@ -936,73 +939,76 @@ casts and declarations are fontified. Used on level 2 and higher." ;; ;; This function might do hidden buffer changes. - (let (;; The font-lock package in Emacs is known to clobber - ;; `parse-sexp-lookup-properties' (when it exists). - (parse-sexp-lookup-properties - (cc-eval-when-compile - (boundp 'parse-sexp-lookup-properties))) - (c-parse-and-markup-<>-arglists t) - c-restricted-<>-arglists - id-start id-end id-face pos kwd-sym) + (c-skip-comments-and-strings limit) + (when (< (point) limit) - (while (and (< (point) limit) - (re-search-forward c-opt-<>-arglist-start limit t)) + (let (;; The font-lock package in Emacs is known to clobber + ;; `parse-sexp-lookup-properties' (when it exists). + (parse-sexp-lookup-properties + (cc-eval-when-compile + (boundp 'parse-sexp-lookup-properties))) + (c-parse-and-markup-<>-arglists t) + c-restricted-<>-arglists + id-start id-end id-face pos kwd-sym) - (setq id-start (match-beginning 1) - id-end (match-end 1) - pos (point)) + (while (and (< (point) limit) + (re-search-forward c-opt-<>-arglist-start limit t)) - (goto-char id-start) - (unless (c-skip-comments-and-strings limit) - (setq kwd-sym nil - c-restricted-<>-arglists nil - id-face (get-text-property id-start 'face)) - - (if (cond - ((eq id-face 'font-lock-type-face) - ;; The identifier got the type face so it has already been - ;; handled in `c-font-lock-declarations'. - nil) - - ((eq id-face 'font-lock-keyword-face) - (when (looking-at c-opt-<>-sexp-key) - ;; There's a special keyword before the "<" that tells - ;; that it's an angle bracket arglist. - (setq kwd-sym (c-keyword-sym (match-string 1))))) - - (t - ;; There's a normal identifier before the "<". If we're not in - ;; a declaration context then we set `c-restricted-<>-arglists' - ;; to avoid recognizing templates in function calls like "foo (a - ;; < b, c > d)". - (c-backward-syntactic-ws) - (when (and (memq (char-before) '(?\( ?,)) - (not (eq (get-text-property (1- (point)) 'c-type) - 'c-decl-arg-start))) - (setq c-restricted-<>-arglists t)) - t)) + (setq id-start (match-beginning 1) + id-end (match-end 1) + pos (point)) - (progn - (goto-char (1- pos)) - ;; Check for comment/string both at the identifier and - ;; at the "<". - (unless (c-skip-comments-and-strings limit) - - (c-fontify-types-and-refs () - (when (c-forward-<>-arglist (c-keyword-member - kwd-sym 'c-<>-type-kwds)) - (when (and c-opt-identifier-concat-key - (not (get-text-property id-start 'face))) - (c-forward-syntactic-ws) - (cond ((looking-at c-opt-identifier-concat-key) - (c-put-font-lock-face id-start id-end - c-reference-face-name)) - ((eq (char-after) ?\()) - (t (c-put-font-lock-face id-start id-end - 'font-lock-type-face)))))) - - (goto-char pos))) - (goto-char pos))))) + (goto-char id-start) + (unless (c-skip-comments-and-strings limit) + (setq kwd-sym nil + c-restricted-<>-arglists nil + id-face (get-text-property id-start 'face)) + + (if (cond + ((eq id-face 'font-lock-type-face) + ;; The identifier got the type face so it has already been + ;; handled in `c-font-lock-declarations'. + nil) + + ((eq id-face 'font-lock-keyword-face) + (when (looking-at c-opt-<>-sexp-key) + ;; There's a special keyword before the "<" that tells + ;; that it's an angle bracket arglist. + (setq kwd-sym (c-keyword-sym (match-string 1))))) + + (t + ;; There's a normal identifier before the "<". If we're not in + ;; a declaration context then we set `c-restricted-<>-arglists' + ;; to avoid recognizing templates in function calls like "foo (a + ;; < b, c > d)". + (c-backward-syntactic-ws) + (when (and (memq (char-before) '(?\( ?,)) + (not (eq (get-text-property (1- (point)) 'c-type) + 'c-decl-arg-start))) + (setq c-restricted-<>-arglists t)) + t)) + + (progn + (goto-char (1- pos)) + ;; Check for comment/string both at the identifier and + ;; at the "<". + (unless (c-skip-comments-and-strings limit) + + (c-fontify-types-and-refs () + (when (c-forward-<>-arglist (c-keyword-member + kwd-sym 'c-<>-type-kwds)) + (when (and c-opt-identifier-concat-key + (not (get-text-property id-start 'face))) + (c-forward-syntactic-ws) + (cond ((looking-at c-opt-identifier-concat-key) + (c-put-font-lock-face id-start id-end + c-reference-face-name)) + ((eq (char-after) ?\()) + (t (c-put-font-lock-face id-start id-end + 'font-lock-type-face)))))) + + (goto-char pos))) + (goto-char pos)))))) nil) (defun c-font-lock-declarators (limit list types not-top @@ -1311,227 +1317,229 @@ casts and declarations are fontified. Used on level 2 and higher." ;; This function might do hidden buffer changes. ;;(message "c-font-lock-declarations search from %s to %s" (point) limit) + (c-skip-comments-and-strings limit) + (when (< (point) limit) + + (save-restriction + (let (;; The position where `c-find-decl-spots' last stopped. + start-pos + ;; o - 'decl if we're in an arglist containing declarations + ;; (but if `c-recognize-paren-inits' is set it might also be + ;; an initializer arglist); + ;; o - '<> if the arglist is of angle bracket type; + ;; o - 'arglist if it's some other arglist; + ;; o - nil, if not in an arglist at all. This includes the + ;; parenthesized condition which follows "if", "while", etc. + context + ;; A list of starting positions of possible type declarations, or of + ;; the typedef preceding one, if any. + last-cast-end + ;; The result from `c-forward-decl-or-cast-1'. + decl-or-cast + ;; The maximum of the end positions of all the checked type + ;; decl expressions in the successfully identified + ;; declarations. The position might be either before or + ;; after the syntactic whitespace following the last token + ;; in the type decl expression. + (max-type-decl-end 0) + ;; Same as `max-type-decl-*', but used when we're before + ;; `token-pos'. + (max-type-decl-end-before-token 0) + ;; End of <..> construct which has had c-<>-arg-sep c-type + ;; properties set within it. + (max-<>-end 0) + ;; Set according to the context to direct the heuristics for + ;; recognizing C++ templates. + c-restricted-<>-arglists + ;; Turn on recording of identifier ranges in + ;; `c-forward-decl-or-cast-1' and `c-forward-label' for + ;; later fontification. + (c-record-type-identifiers t) + label-type + c-record-ref-identifiers + ;; Make `c-forward-type' calls mark up template arglists if + ;; it finds any. That's necessary so that we later will + ;; stop inside them to fontify types there. + (c-parse-and-markup-<>-arglists t) + ;; The font-lock package in Emacs is known to clobber + ;; `parse-sexp-lookup-properties' (when it exists). + (parse-sexp-lookup-properties + (cc-eval-when-compile + (boundp 'parse-sexp-lookup-properties)) + )) + + ;; Below we fontify a whole declaration even when it crosses the limit, + ;; to avoid gaps when jit/lazy-lock fontifies the file a block at a + ;; time. That is however annoying during editing, e.g. the following is + ;; a common situation while the first line is being written: + ;; + ;; my_variable + ;; some_other_variable = 0; + ;; + ;; font-lock will put the limit at the beginning of the second line + ;; here, and if we go past it we'll fontify "my_variable" as a type and + ;; "some_other_variable" as an identifier, and the latter will not + ;; correct itself until the second line is changed. To avoid that we + ;; narrow to the limit if the region to fontify is a single line. + (if (<= limit (c-point 'bonl)) + (narrow-to-region + (point-min) + (save-excursion + ;; Narrow after any operator chars following the limit though, + ;; since those characters can be useful in recognizing a + ;; declaration (in particular the '{' that opens a function body + ;; after the header). + (goto-char limit) + (skip-chars-forward c-nonsymbol-chars) + (point)))) + + (c-find-decl-spots + limit + c-decl-start-re + (eval c-maybe-decl-faces) + + (lambda (match-pos inside-macro &optional toplev) + ;; Note to maintainers: don't use `limit' inside this lambda form; + ;; c-find-decl-spots sometimes narrows to less than `limit'. + (setq start-pos (point)) + (when + ;; The result of the form below is true when we don't recognize a + ;; declaration or cast, and we don't recognize a "non-decl", + ;; typically a brace list. + (if (or (and (eq (get-text-property (point) 'face) + 'font-lock-keyword-face) + (looking-at c-not-decl-init-keywords)) + (and c-macro-with-semi-re + (looking-at c-macro-with-semi-re))) ; 2008-11-04 + ;; Don't do anything more if we're looking at a keyword that + ;; can't start a declaration. + t + + ;; Set `context' and `c-restricted-<>-arglists'. Look for + ;; "<" for the sake of C++-style template arglists. + ;; Ignore "(" when it's part of a control flow construct + ;; (e.g. "for ("). + (let ((got-context + (c-get-fontification-context + match-pos + (< match-pos (if inside-macro + max-type-decl-end-before-token + max-type-decl-end)) + toplev))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) + + ;; Check we haven't missed a preceding "typedef". + (when (not (looking-at c-typedef-key)) + (c-backward-syntactic-ws) + (c-backward-token-2) + (or (looking-at c-typedef-key) + (goto-char start-pos))) + + ;; In QT, "more" is an irritating keyword that expands to nothing. + ;; We skip over it to prevent recognition of "more slots: " + ;; as a bitfield declaration. + (when (and (c-major-mode-is 'c++-mode) + (looking-at + (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) + (goto-char (match-end 1)) + (c-forward-syntactic-ws)) - (save-restriction - (let (;; The position where `c-find-decl-spots' last stopped. - start-pos - ;; o - 'decl if we're in an arglist containing declarations - ;; (but if `c-recognize-paren-inits' is set it might also be - ;; an initializer arglist); - ;; o - '<> if the arglist is of angle bracket type; - ;; o - 'arglist if it's some other arglist; - ;; o - nil, if not in an arglist at all. This includes the - ;; parenthesized condition which follows "if", "while", etc. - context - ;; A list of starting positions of possible type declarations, or of - ;; the typedef preceding one, if any. - last-cast-end - ;; The result from `c-forward-decl-or-cast-1'. - decl-or-cast - ;; The maximum of the end positions of all the checked type - ;; decl expressions in the successfully identified - ;; declarations. The position might be either before or - ;; after the syntactic whitespace following the last token - ;; in the type decl expression. - (max-type-decl-end 0) - ;; Same as `max-type-decl-*', but used when we're before - ;; `token-pos'. - (max-type-decl-end-before-token 0) - ;; End of <..> construct which has had c-<>-arg-sep c-type - ;; properties set within it. - (max-<>-end 0) - ;; Set according to the context to direct the heuristics for - ;; recognizing C++ templates. - c-restricted-<>-arglists - ;; Turn on recording of identifier ranges in - ;; `c-forward-decl-or-cast-1' and `c-forward-label' for - ;; later fontification. - (c-record-type-identifiers t) - label-type - c-record-ref-identifiers - ;; Make `c-forward-type' calls mark up template arglists if - ;; it finds any. That's necessary so that we later will - ;; stop inside them to fontify types there. - (c-parse-and-markup-<>-arglists t) - ;; The font-lock package in Emacs is known to clobber - ;; `parse-sexp-lookup-properties' (when it exists). - (parse-sexp-lookup-properties - (cc-eval-when-compile - (boundp 'parse-sexp-lookup-properties)) - )) - - ;; Below we fontify a whole declaration even when it crosses the limit, - ;; to avoid gaps when jit/lazy-lock fontifies the file a block at a - ;; time. That is however annoying during editing, e.g. the following is - ;; a common situation while the first line is being written: - ;; - ;; my_variable - ;; some_other_variable = 0; - ;; - ;; font-lock will put the limit at the beginning of the second line - ;; here, and if we go past it we'll fontify "my_variable" as a type and - ;; "some_other_variable" as an identifier, and the latter will not - ;; correct itself until the second line is changed. To avoid that we - ;; narrow to the limit if the region to fontify is a single line. - (if (<= limit (c-point 'bonl)) - (narrow-to-region - (point-min) - (save-excursion - ;; Narrow after any operator chars following the limit though, - ;; since those characters can be useful in recognizing a - ;; declaration (in particular the '{' that opens a function body - ;; after the header). - (goto-char limit) - (skip-chars-forward c-nonsymbol-chars) - (point)))) - - (c-find-decl-spots - limit - c-decl-start-re - (eval c-maybe-decl-faces) - - (lambda (match-pos inside-macro &optional toplev) - ;; Note to maintainers: don't use `limit' inside this lambda form; - ;; c-find-decl-spots sometimes narrows to less than `limit'. - (setq start-pos (point)) - (when - ;; The result of the form below is true when we don't recognize a - ;; declaration or cast, and we don't recognize a "non-decl", - ;; typically a brace list. - (if (or (and (eq (get-text-property (point) 'face) - 'font-lock-keyword-face) - (looking-at c-not-decl-init-keywords)) - (and c-macro-with-semi-re - (looking-at c-macro-with-semi-re))) ; 2008-11-04 - ;; Don't do anything more if we're looking at a keyword that - ;; can't start a declaration. - t - - ;; Set `context' and `c-restricted-<>-arglists'. Look for - ;; "<" for the sake of C++-style template arglists. - ;; Ignore "(" when it's part of a control flow construct - ;; (e.g. "for ("). - (let ((got-context - (c-get-fontification-context - match-pos - (< match-pos (if inside-macro - max-type-decl-end-before-token - max-type-decl-end)) - toplev))) - (setq context (car got-context) - c-restricted-<>-arglists (cdr got-context))) - - ;; Check we haven't missed a preceding "typedef". - (when (not (looking-at c-typedef-key)) - (c-backward-syntactic-ws) - (c-backward-token-2) - (or (looking-at c-typedef-key) - (goto-char start-pos))) - - ;; In QT, "more" is an irritating keyword that expands to nothing. - ;; We skip over it to prevent recognition of "more slots: " - ;; as a bitfield declaration. - (when (and (c-major-mode-is 'c++-mode) - (looking-at - (concat "\\(more\\)\\([^" c-symbol-chars "]\\|$\\)"))) - (goto-char (match-end 1)) - (c-forward-syntactic-ws)) - - ;; Now analyze the construct. - (if (eq context 'not-decl) - (progn - (setq decl-or-cast nil) - (if (c-syntactic-re-search-forward - "," (min limit (point-max)) 'at-limit t) - (c-put-char-property (1- (point)) 'c-type 'c-not-decl)) - nil) - (setq decl-or-cast - (c-forward-decl-or-cast-1 - match-pos context last-cast-end)) - - ;; Ensure that c-<>-arg-sep c-type properties are in place on the - ;; commas separating the arguments inside template/generic <..>s. - (when (and (eq (char-before match-pos) ?<) - (> match-pos max-<>-end)) - (save-excursion - (goto-char match-pos) - (c-backward-token-2) - (if (and - (eq (char-after) ?<) - (let ((c-restricted-<>-arglists - (save-excursion - (c-backward-token-2) - (and - (not (looking-at c-opt-<>-sexp-key)) - (progn (c-backward-syntactic-ws) - (memq (char-before) '(?\( ?,))) - (not (eq (c-get-char-property (1- (point)) - 'c-type) - 'c-decl-arg-start)))))) - (c-forward-<>-arglist nil))) - (setq max-<>-end (point))))) - - (cond - ((eq decl-or-cast 'cast) - ;; Save the position after the previous cast so we can feed - ;; it to `c-forward-decl-or-cast-1' in the next round. That - ;; helps it discover cast chains like "(a) (b) c". - (setq last-cast-end (point)) - (c-fontify-recorded-types-and-refs) - nil) - - (decl-or-cast - ;; We've found a declaration. - - ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' - ;; under the assumption that we're after the first type decl - ;; expression in the declaration now. That's not really true; - ;; we could also be after a parenthesized initializer - ;; expression in C++, but this is only used as a last resort - ;; to slant ambiguous expression/declarations, and overall - ;; it's worth the risk to occasionally fontify an expression - ;; as a declaration in an initializer expression compared to - ;; getting ambiguous things in normal function prototypes - ;; fontified as expressions. - (if inside-macro - (when (> (point) max-type-decl-end-before-token) - (setq max-type-decl-end-before-token (point))) - (when (> (point) max-type-decl-end) - (setq max-type-decl-end (point)))) - (goto-char start-pos) - (c-font-lock-single-decl limit decl-or-cast match-pos - context - (or toplev (nth 4 decl-or-cast)))) - - (t t)))) - - ;; It was a false alarm. Check if we're in a label (or other - ;; construct with `:' except bitfield) instead. - (goto-char start-pos) - (when (setq label-type (c-forward-label t match-pos nil)) - ;; Can't use `c-fontify-types-and-refs' here since we - ;; use the label face at times. - (cond ((eq label-type 'goto-target) - (c-put-font-lock-face (caar c-record-ref-identifiers) - (cdar c-record-ref-identifiers) - c-label-face-name)) - ((eq label-type 'qt-1kwd-colon) - (c-put-font-lock-face (caar c-record-ref-identifiers) - (cdar c-record-ref-identifiers) - 'font-lock-keyword-face)) - ((eq label-type 'qt-2kwds-colon) - (mapc - (lambda (kwd) - (c-put-font-lock-face (car kwd) (cdr kwd) + ;; Now analyze the construct. + (if (eq context 'not-decl) + (progn + (setq decl-or-cast nil) + (if (c-syntactic-re-search-forward + "," (min limit (point-max)) 'at-limit t) + (c-put-char-property (1- (point)) 'c-type 'c-not-decl)) + nil) + (setq decl-or-cast + (c-forward-decl-or-cast-1 + match-pos context last-cast-end)) + + ;; Ensure that c-<>-arg-sep c-type properties are in place on the + ;; commas separating the arguments inside template/generic <..>s. + (when (and (eq (char-before match-pos) ?<) + (> match-pos max-<>-end)) + (save-excursion + (goto-char match-pos) + (c-backward-token-2) + (if (and + (eq (char-after) ?<) + (let ((c-restricted-<>-arglists + (save-excursion + (c-backward-token-2) + (and + (not (looking-at c-opt-<>-sexp-key)) + (progn (c-backward-syntactic-ws) + (memq (char-before) '(?\( ?,))) + (not (eq (c-get-char-property (1- (point)) + 'c-type) + 'c-decl-arg-start)))))) + (c-forward-<>-arglist nil))) + (setq max-<>-end (point))))) + + (cond + ((eq decl-or-cast 'cast) + ;; Save the position after the previous cast so we can feed + ;; it to `c-forward-decl-or-cast-1' in the next round. That + ;; helps it discover cast chains like "(a) (b) c". + (setq last-cast-end (point)) + (c-fontify-recorded-types-and-refs) + nil) + + (decl-or-cast + ;; We've found a declaration. + + ;; Set `max-type-decl-end' or `max-type-decl-end-before-token' + ;; under the assumption that we're after the first type decl + ;; expression in the declaration now. That's not really true; + ;; we could also be after a parenthesized initializer + ;; expression in C++, but this is only used as a last resort + ;; to slant ambiguous expression/declarations, and overall + ;; it's worth the risk to occasionally fontify an expression + ;; as a declaration in an initializer expression compared to + ;; getting ambiguous things in normal function prototypes + ;; fontified as expressions. + (if inside-macro + (when (> (point) max-type-decl-end-before-token) + (setq max-type-decl-end-before-token (point))) + (when (> (point) max-type-decl-end) + (setq max-type-decl-end (point)))) + (goto-char start-pos) + (c-font-lock-single-decl limit decl-or-cast match-pos + context + (or toplev (nth 4 decl-or-cast)))) + + (t t)))) + + ;; It was a false alarm. Check if we're in a label (or other + ;; construct with `:' except bitfield) instead. + (goto-char start-pos) + (when (setq label-type (c-forward-label t match-pos nil)) + ;; Can't use `c-fontify-types-and-refs' here since we + ;; use the label face at times. + (cond ((eq label-type 'goto-target) + (c-put-font-lock-face (caar c-record-ref-identifiers) + (cdar c-record-ref-identifiers) + c-label-face-name)) + ((eq label-type 'qt-1kwd-colon) + (c-put-font-lock-face (caar c-record-ref-identifiers) + (cdar c-record-ref-identifiers) 'font-lock-keyword-face)) - c-record-ref-identifiers))) - (setq c-record-ref-identifiers nil) - ;; `c-forward-label' has probably added a `c-decl-end' - ;; marker, so return t to `c-find-decl-spots' to signal - ;; that. - t)))) - - nil))) + ((eq label-type 'qt-2kwds-colon) + (mapc + (lambda (kwd) + (c-put-font-lock-face (car kwd) (cdr kwd) + 'font-lock-keyword-face)) + c-record-ref-identifiers))) + (setq c-record-ref-identifiers nil) + ;; `c-forward-label' has probably added a `c-decl-end' + ;; marker, so return t to `c-find-decl-spots' to signal + ;; that. + t)))) + + nil)))) (defun c-font-lock-enum-body (limit) ;; Fontify the identifiers of each enum we find by searching forward. @@ -1561,19 +1569,21 @@ casts and declarations are fontified. Used on level 2 and higher." ;; ;; Note that this function won't attempt to fontify beyond the end of the ;; current enum block, if any. - (let* ((paren-state (c-parse-state)) - (encl-pos (c-most-enclosing-brace paren-state))) - (when (and - encl-pos - (eq (char-after encl-pos) ?\{) - (save-excursion - (goto-char encl-pos) - (c-backward-over-enum-header))) - (c-syntactic-skip-backward "^{," nil t) - (c-put-char-property (1- (point)) 'c-type 'c-decl-id-start) + (c-skip-comments-and-strings limit) + (when (< (point) limit) + (let* ((paren-state (c-parse-state)) + (encl-pos (c-most-enclosing-brace paren-state))) + (when (and + encl-pos + (eq (char-after encl-pos) ?\{) + (save-excursion + (goto-char encl-pos) + (c-backward-over-enum-header))) + (c-syntactic-skip-backward "^{," nil t) + (c-put-char-property (1- (point)) 'c-type 'c-decl-id-start) - (c-forward-syntactic-ws) - (c-font-lock-declarators limit t nil t))) + (c-forward-syntactic-ws) + (c-font-lock-declarators limit t nil t)))) nil) (defun c-font-lock-cut-off-declarators (limit) @@ -1585,46 +1595,48 @@ casts and declarations are fontified. Used on level 2 and higher." ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; fontification". - (let ((here (point)) - (decl-search-lim (c-determine-limit 1000)) - paren-state encl-pos token-end context decl-or-cast - start-pos top-level c-restricted-<>-arglists - c-recognize-knr-p) ; Strictly speaking, bogus, but it + (c-skip-comments-and-strings limit) + (when (< (point) limit) + (let ((here (point)) + (decl-search-lim (c-determine-limit 1000)) + paren-state encl-pos token-end context decl-or-cast + start-pos top-level c-restricted-<>-arglists + c-recognize-knr-p) ; Strictly speaking, bogus, but it ; speeds up lisp.h tremendously. - (save-excursion - (when (not (c-back-over-member-initializers)) - (unless (or (eobp) - (looking-at "\\s(\\|\\s)")) - (forward-char)) - (c-syntactic-skip-backward "^;{}" decl-search-lim t) - (when (eq (char-before) ?}) - (c-go-list-backward) ; brace block of struct, etc.? - (c-syntactic-skip-backward "^;{}" decl-search-lim t)) - (when (or (bobp) - (memq (char-before) '(?\; ?{ ?}))) - (setq token-end (point)) - (c-forward-syntactic-ws here) - (when (< (point) here) - ;; We're now putatively at the declaration. - (setq start-pos (point)) - (setq paren-state (c-parse-state)) - ;; At top level or inside a "{"? - (if (or (not (setq encl-pos - (c-most-enclosing-brace paren-state))) - (eq (char-after encl-pos) ?\{)) - (progn - (setq top-level (c-at-toplevel-p)) - (let ((got-context (c-get-fontification-context - token-end nil top-level))) - (setq context (car got-context) - c-restricted-<>-arglists (cdr got-context))) - (setq decl-or-cast - (c-forward-decl-or-cast-1 token-end context nil)) - (when (consp decl-or-cast) - (goto-char start-pos) - (c-font-lock-single-decl limit decl-or-cast token-end - context top-level)))))))) - nil)) + (save-excursion + (when (not (c-back-over-member-initializers)) + (unless (or (eobp) + (looking-at "\\s(\\|\\s)")) + (forward-char)) + (c-syntactic-skip-backward "^;{}" decl-search-lim t) + (when (eq (char-before) ?}) + (c-go-list-backward) ; brace block of struct, etc.? + (c-syntactic-skip-backward "^;{}" decl-search-lim t)) + (when (or (bobp) + (memq (char-before) '(?\; ?{ ?}))) + (setq token-end (point)) + (c-forward-syntactic-ws here) + (when (< (point) here) + ;; We're now putatively at the declaration. + (setq start-pos (point)) + (setq paren-state (c-parse-state)) + ;; At top level or inside a "{"? + (if (or (not (setq encl-pos + (c-most-enclosing-brace paren-state))) + (eq (char-after encl-pos) ?\{)) + (progn + (setq top-level (c-at-toplevel-p)) + (let ((got-context (c-get-fontification-context + token-end nil top-level))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) + (setq decl-or-cast + (c-forward-decl-or-cast-1 token-end context nil)) + (when (consp decl-or-cast) + (goto-char start-pos) + (c-font-lock-single-decl limit decl-or-cast token-end + context top-level)))))))) + nil))) (defun c-font-lock-enclosing-decls (limit) ;; Fontify the declarators of (nested) declarations we're in the middle of. @@ -1636,27 +1648,29 @@ casts and declarations are fontified. Used on level 2 and higher." ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; Fontification". - (let* ((paren-state (c-parse-state)) - (decl-search-lim (c-determine-limit 1000)) - in-typedef ps-elt) - ;; Are we in any nested struct/union/class/etc. braces? - (while paren-state - (setq ps-elt (car paren-state) - paren-state (cdr paren-state)) - (when (and (atom ps-elt) - (eq (char-after ps-elt) ?\{)) - (goto-char ps-elt) - (c-syntactic-skip-backward "^;{}" decl-search-lim) - (c-forward-syntactic-ws) - (setq in-typedef (looking-at c-typedef-key)) - (if in-typedef (c-forward-over-token-and-ws)) - (when (and c-opt-block-decls-with-vars-key - (looking-at c-opt-block-decls-with-vars-key)) + (c-skip-comments-and-strings limit) + (when (< (point) limit) + (let* ((paren-state (c-parse-state)) + (decl-search-lim (c-determine-limit 1000)) + in-typedef ps-elt) + ;; Are we in any nested struct/union/class/etc. braces? + (while paren-state + (setq ps-elt (car paren-state) + paren-state (cdr paren-state)) + (when (and (atom ps-elt) + (eq (char-after ps-elt) ?\{)) (goto-char ps-elt) - (when (c-safe (c-forward-sexp)) - (c-forward-syntactic-ws) - (c-font-lock-declarators limit t in-typedef - (not (c-bs-at-toplevel-p (point)))))))))) + (c-syntactic-skip-backward "^;{}" decl-search-lim) + (c-forward-syntactic-ws) + (setq in-typedef (looking-at c-typedef-key)) + (if in-typedef (c-forward-over-token-and-ws)) + (when (and c-opt-block-decls-with-vars-key + (looking-at c-opt-block-decls-with-vars-key)) + (goto-char ps-elt) + (when (c-safe (c-forward-sexp)) + (c-forward-syntactic-ws) + (c-font-lock-declarators limit t in-typedef + (not (c-bs-at-toplevel-p (point))))))))))) (defun c-font-lock-raw-strings (limit) ;; Fontify C++ raw strings. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 35de7566c7..27ed04fea5 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1192,8 +1192,6 @@ Note that the style variables are always made local to the buffer." (beg-literal-type (and beg-limits (c-literal-type beg-limits)))) - (when (eq end-literal-type 'string) - (setq c-new-END (max c-new-END (cdr end-limits)))) ;; It is possible the buffer change will include inserting a string quote. ;; This could have the effect of flipping the meaning of any following ;; quotes up until the next unescaped EOL. Also guard against the change @@ -1282,7 +1280,6 @@ Note that the style variables are always made local to the buffer." (when (and (eq beg-literal-type 'string) (memq (char-after (car beg-limits)) c-string-delims)) - (setq c-new-BEG (min c-new-BEG (car beg-limits))) (c-clear-char-property (car beg-limits) 'syntax-table) (c-truncate-semi-nonlit-pos-cache (car beg-limits)))))) @@ -1832,6 +1829,9 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; declaration is one which does not start outside of struct braces (and ;; similar) enclosing POS. Brace list braces here are not "similar". ;; + ;; POS being in a literal does not count as being in a declaration (on + ;; pragmatic grounds). + ;; ;; This function is called indirectly from font locking stuff - either from ;; c-after-change (to prepare for after-change font-locking) or from font ;; lock context (etc.) fontification. @@ -1842,92 +1842,92 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") capture-opener bod-lim bo-decl) (goto-char (c-point 'bol new-pos)) - (when lit-start ; Comment or string. - (goto-char lit-start)) - (setq bod-lim (c-determine-limit 500)) - - ;; In C++ Mode, first check if we are within a (possibly nested) lambda - ;; form capture list. - (when (c-major-mode-is 'c++-mode) - (let ((paren-state (c-parse-state)) - opener) - (save-excursion - (while (setq opener (c-pull-open-brace paren-state)) - (goto-char opener) - (if (c-looking-at-c++-lambda-capture-list) - (setq capture-opener (point))))))) - - (while - ;; Go to a less nested declaration each time round this loop. - (and - (setq old-pos (point)) - (let (pseudo) - (while - (progn - (c-syntactic-skip-backward "^;{}" bod-lim t) - (and (eq (char-before) ?}) - (save-excursion - (backward-char) - (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state)))))) - (goto-char pseudo)) - t) - (> (point) bod-lim) - (progn (c-forward-syntactic-ws) - ;; Have we got stuck in a comment at EOB? - (not (and (eobp) - (c-literal-start)))) - (< (point) old-pos) - (progn (setq bo-decl (point)) - (or (not (looking-at c-protection-key)) - (c-forward-keyword-clause 1))) - (progn - ;; Are we looking at a keyword such as "template" or - ;; "typedef" which can decorate a type, or the type itself? - (when (or (looking-at c-prefix-spec-kwds-re) - (c-forward-type t)) - ;; We've found another candidate position. - (setq new-pos (min new-pos bo-decl)) - (goto-char bo-decl)) - t) - ;; Try and go out a level to search again. - (progn - (c-backward-syntactic-ws bod-lim) - (and (> (point) bod-lim) - (or (memq (char-before) '(?\( ?\[)) - (and (eq (char-before) ?\<) - (eq (c-get-char-property - (1- (point)) 'syntax-table) - c-<-as-paren-syntax)) - (and (eq (char-before) ?{) - (save-excursion - (backward-char) - (consp (c-looking-at-or-maybe-in-bracelist)))) - ))) - (not (bobp))) - (backward-char)) ; back over (, [, <. - (when (and capture-opener (< capture-opener new-pos)) - (setq new-pos capture-opener)) - (and (/= new-pos pos) new-pos))) + (unless lit-start + (setq bod-lim (c-determine-limit 500)) + + ;; In C++ Mode, first check if we are within a (possibly nested) lambda + ;; form capture list. + (when (c-major-mode-is 'c++-mode) + (let ((paren-state (c-parse-state)) + opener) + (save-excursion + (while (setq opener (c-pull-open-brace paren-state)) + (goto-char opener) + (if (c-looking-at-c++-lambda-capture-list) + (setq capture-opener (point))))))) + + (while + ;; Go to a less nested declaration each time round this loop. + (and + (setq old-pos (point)) + (let (pseudo) + (while + (progn + (c-syntactic-skip-backward "^;{}" bod-lim t) + (and (eq (char-before) ?}) + (save-excursion + (backward-char) + (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state)))))) + (goto-char pseudo)) + t) + (> (point) bod-lim) + (progn (c-forward-syntactic-ws) + ;; Have we got stuck in a comment at EOB? + (not (and (eobp) + (c-literal-start)))) + (< (point) old-pos) + (progn (setq bo-decl (point)) + (or (not (looking-at c-protection-key)) + (c-forward-keyword-clause 1))) + (progn + ;; Are we looking at a keyword such as "template" or + ;; "typedef" which can decorate a type, or the type itself? + (when (or (looking-at c-prefix-spec-kwds-re) + (c-forward-type t)) + ;; We've found another candidate position. + (setq new-pos (min new-pos bo-decl)) + (goto-char bo-decl)) + t) + ;; Try and go out a level to search again. + (progn + (c-backward-syntactic-ws bod-lim) + (and (> (point) bod-lim) + (or (memq (char-before) '(?\( ?\[)) + (and (eq (char-before) ?\<) + (eq (c-get-char-property + (1- (point)) 'syntax-table) + c-<-as-paren-syntax)) + (and (eq (char-before) ?{) + (save-excursion + (backward-char) + (consp (c-looking-at-or-maybe-in-bracelist)))) + ))) + (not (bobp))) + (backward-char)) ; back over (, [, <. + (when (and capture-opener (< capture-opener new-pos)) + (setq new-pos capture-opener)) + (and (/= new-pos pos) new-pos)))) (defun c-fl-decl-end (pos) ;; If POS is inside a declarator, return the end of the token that follows - ;; the declarator, otherwise return nil. + ;; the declarator, otherwise return nil. POS being in a literal does not + ;; count as being in a declarator (on pragmatic grounds). (goto-char pos) (let ((lit-start (c-literal-start)) pos1) - (if lit-start (goto-char lit-start)) - (c-backward-syntactic-ws) - (when (setq pos1 (c-on-identifier)) - (goto-char pos1) - (let ((lim (save-excursion - (and (c-beginning-of-macro) - (progn (c-end-of-macro) (point)))))) - (when (and (c-forward-declarator lim) - (or (not (eq (char-after) ?\()) - (c-go-list-forward nil lim)) - (eq (c-forward-token-2 1 nil lim) 0)) - (c-backward-syntactic-ws) - (point)))))) + (unless lit-start + (c-backward-syntactic-ws) + (when (setq pos1 (c-on-identifier)) + (goto-char pos1) + (let ((lim (save-excursion + (and (c-beginning-of-macro) + (progn (c-end-of-macro) (point)))))) + (when (and (c-forward-declarator lim) + (or (not (eq (char-after) ?\()) + (c-go-list-forward nil lim)) + (eq (c-forward-token-2 1 nil lim) 0)) + (c-backward-syntactic-ws) + (point))))))) (defun c-change-expand-fl-region (_beg _end _old-len) ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock