commit c662e2d4fc3678d1ea6eda16541b82bc88f0890b (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Thu Dec 1 22:45:07 2016 -0800 Fix type typo on Solaris * src/sysdep.c (system_process_attributes) [SOLARIS2 && HAVE_PROCFS]: Fix type mismatch, caught by --enable-check-lisp-object-type. diff --git a/src/sysdep.c b/src/sysdep.c index 892e976..2576342 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -3371,7 +3371,7 @@ system_process_attributes (Lisp_Object pid) nread = 0; else { - record_unwind_protect (close_file_unwind, fd); + record_unwind_protect_int (close_file_unwind, fd); nread = emacs_read (fd, &pinfo, sizeof pinfo); } commit f3fa5d7e229f88e6f83dc24757b33e9b17bf10ae Author: Paul Eggert Date: Thu Dec 1 21:56:49 2016 -0800 Merge from gnulib This incorporates: 2016-11-27 md4,md5,sha*: tune for recent glibc _STRING_INLINE_unaligned 2016-11-21 snippet/c++defs: Simplify _GL_CXXALIAS_* macros. * build-aux/snippet/c++defs.h: * lib/md5.c, lib/sha1.c, lib/sha256.c, lib/sha512.c: Copy from gnulib. diff --git a/build-aux/snippet/c++defs.h b/build-aux/snippet/c++defs.h index d42ea25..2b819da 100644 --- a/build-aux/snippet/c++defs.h +++ b/build-aux/snippet/c++defs.h @@ -133,8 +133,11 @@ static const struct _gl_ ## func ## _wrapper \ { \ typedef rettype (*type) parameters; \ - inline type rpl () const { return ::rpl_func; } \ - inline operator type () const { return rpl (); } \ + \ + inline operator type () const \ + { \ + return ::rpl_func; \ + } \ } func = {}; \ } \ _GL_EXTERN_C int _gl_cxxalias_dummy @@ -155,9 +158,11 @@ static const struct _gl_ ## func ## _wrapper \ { \ typedef rettype (*type) parameters; \ - inline type rpl () const \ - { return reinterpret_cast(::rpl_func); } \ - inline operator type () const { return rpl (); } \ + \ + inline operator type () const \ + { \ + return reinterpret_cast(::rpl_func); \ + } \ } func = {}; \ } \ _GL_EXTERN_C int _gl_cxxalias_dummy @@ -183,10 +188,13 @@ static const struct _gl_ ## func ## _wrapper \ { \ typedef rettype (*type) parameters; \ - inline type rpl () const { return ::func; } \ - inline operator type () const { return rpl (); } \ + \ + inline operator type () const \ + { \ + return ::func; \ + } \ } func = {}; \ - } \ + } \ _GL_EXTERN_C int _gl_cxxalias_dummy #else # define _GL_CXXALIAS_SYS(func,rettype,parameters) \ @@ -205,9 +213,11 @@ static const struct _gl_ ## func ## _wrapper \ { \ typedef rettype (*type) parameters; \ - inline type rpl () const \ - { return reinterpret_cast(::func); } \ - inline operator type () const { return rpl (); }\ + \ + inline operator type () const \ + { \ + return reinterpret_cast(::func); \ + } \ } func = {}; \ } \ _GL_EXTERN_C int _gl_cxxalias_dummy @@ -235,10 +245,10 @@ { \ typedef rettype (*type) parameters; \ \ - inline type rpl () const \ - { return reinterpret_cast((rettype2 (*) parameters2)(::func)); }\ - \ - inline operator type () const { return rpl (); } \ + inline operator type () const \ + { \ + return reinterpret_cast((rettype2 (*) parameters2)(::func)); \ + } \ } func = {}; \ } \ _GL_EXTERN_C int _gl_cxxalias_dummy diff --git a/lib/md5.c b/lib/md5.c index 62d247e..cec62339 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -259,7 +259,7 @@ md5_process_bytes (const void *buffer, size_t len, struct md5_ctx *ctx) /* Process available complete blocks. */ if (len >= 64) { -#if !_STRING_ARCH_unaligned +#if !(_STRING_ARCH_unaligned || _STRING_INLINE_unaligned) # define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0) if (UNALIGNED_P (buffer)) while (len > 64) diff --git a/lib/sha1.c b/lib/sha1.c index 45f1cbe..753c088 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -246,7 +246,7 @@ sha1_process_bytes (const void *buffer, size_t len, struct sha1_ctx *ctx) /* Process available complete blocks. */ if (len >= 64) { -#if !_STRING_ARCH_unaligned +#if !(_STRING_ARCH_unaligned || _STRING_INLINE_unaligned) # define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0) if (UNALIGNED_P (buffer)) while (len > 64) diff --git a/lib/sha256.c b/lib/sha256.c index 0be8fd2..5251e8d 100644 --- a/lib/sha256.c +++ b/lib/sha256.c @@ -379,7 +379,7 @@ sha256_process_bytes (const void *buffer, size_t len, struct sha256_ctx *ctx) /* Process available complete blocks. */ if (len >= 64) { -#if !_STRING_ARCH_unaligned +#if !(_STRING_ARCH_unaligned || _STRING_INLINE_unaligned) # define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (uint32_t) != 0) if (UNALIGNED_P (buffer)) while (len > 64) diff --git a/lib/sha512.c b/lib/sha512.c index 5494dcb..71a7eca 100644 --- a/lib/sha512.c +++ b/lib/sha512.c @@ -387,7 +387,7 @@ sha512_process_bytes (const void *buffer, size_t len, struct sha512_ctx *ctx) /* Process available complete blocks. */ if (len >= 128) { -#if !_STRING_ARCH_unaligned +#if !(_STRING_ARCH_unaligned || _STRING_INLINE_unaligned) # define UNALIGNED_P(p) ((uintptr_t) (p) % alignof (u64) != 0) if (UNALIGNED_P (buffer)) while (len > 128) commit ebb96114d88af64cbb72f42052cb359ba8010aa2 Author: Paul Eggert Date: Thu Dec 1 21:47:12 2016 -0800 Make struct font_drivers read-only This simplifies the code a bit, and makes the structs more shareable and less likely to become corrupt. * src/alloc.c (cleanup_vector): * src/font.c (valid_font_driver, font_prepare_cache) (font_finish_cache, font_get_cache, font_clear_cache) (register_font_driver, font_update_drivers): * src/font.h (struct font, struct font_driver_list) (valid_font_driver): struct font_drivers are now const. * src/font.c, src/ftcrfont.c, src/ftfont.c, src/nsfont.m, src/xfont.c: Omit no-longer-necessary decls. * src/ftcrfont.c (syms_of_ftcrfont): * src/ftxfont.c (syms_of_ftxfont): * src/xftfont.c (syms_of_xftfont): Omit no-longer-necessary initialization code. * src/ftcrfont.c (ftcrfont_driver): * src/ftfont.c (ftfont_driver): * src/ftxfont.c (ftxfont_driver): * src/macfont.m (macfont_driver): * src/nsfont.m (nsfont_driver): * src/xfont.c (xfont_driver): * src/xftfont.c (xftfont_driver): Use C99-style initializer for ease of maintenance, and make it const. * src/ftcrfont.c, src/ftxfont.c, src/xftfont.c: Refer to functions like ftfont_text_extents directly. * src/ftfont.c (ftfont_get_cache, ftfont_list, ftfont_list_family) (ftfont_has_char, ftfont_encode_char, ftfont_text_extents) (ftfont_get_bitmap, ftfont_anchor_point, ftfont_otf_capability) (ftfont_variation_glyphs, ftfont_filter_properties) (ftfont_combining_capability): * src/xfont.c (xfont_get_cache): Now extern, so that other modules’ struct font_drivers can use them directly. * src/macfont.m (macfont_descriptor_entity): * src/nsfont.m (nsfont_open): Use constant directly; this is clearer. diff --git a/src/alloc.c b/src/alloc.c index 175dcab..ae32400 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3201,7 +3201,7 @@ cleanup_vector (struct Lisp_Vector *vector) && ((vector->header.size & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX)) { - struct font_driver *drv = ((struct font *) vector)->driver; + struct font_driver const *drv = ((struct font *) vector)->driver; /* The font driver might sometimes be NULL, e.g. if Emacs was interrupted before it had time to set it up. */ diff --git a/src/font.c b/src/font.c index ce63233..9fe7c26 100644 --- a/src/font.c +++ b/src/font.c @@ -132,7 +132,7 @@ static struct font_driver_list *font_driver_list; /* Used to catch bogus pointers in font objects. */ bool -valid_font_driver (struct font_driver *drv) +valid_font_driver (struct font_driver const *drv) { Lisp_Object tail, frame; struct font_driver_list *fdl; @@ -2543,14 +2543,11 @@ font_match_p (Lisp_Object spec, Lisp_Object font) is a number frames sharing this cache, and FONT-CACHE-DATA is a cons (FONT-SPEC . [FONT-ENTITY ...]). */ -static void font_prepare_cache (struct frame *, struct font_driver *); -static void font_finish_cache (struct frame *, struct font_driver *); -static Lisp_Object font_get_cache (struct frame *, struct font_driver *); static void font_clear_cache (struct frame *, Lisp_Object, - struct font_driver *); + struct font_driver const *); static void -font_prepare_cache (struct frame *f, struct font_driver *driver) +font_prepare_cache (struct frame *f, struct font_driver const *driver) { Lisp_Object cache, val; @@ -2572,7 +2569,7 @@ font_prepare_cache (struct frame *f, struct font_driver *driver) static void -font_finish_cache (struct frame *f, struct font_driver *driver) +font_finish_cache (struct frame *f, struct font_driver const *driver) { Lisp_Object cache, val, tmp; @@ -2593,7 +2590,7 @@ font_finish_cache (struct frame *f, struct font_driver *driver) static Lisp_Object -font_get_cache (struct frame *f, struct font_driver *driver) +font_get_cache (struct frame *f, struct font_driver const *driver) { Lisp_Object val = driver->get_cache (f); Lisp_Object type = driver->type; @@ -2608,7 +2605,8 @@ font_get_cache (struct frame *f, struct font_driver *driver) static void -font_clear_cache (struct frame *f, Lisp_Object cache, struct font_driver *driver) +font_clear_cache (struct frame *f, Lisp_Object cache, + struct font_driver const *driver) { Lisp_Object tail, elt; Lisp_Object entity; @@ -3463,7 +3461,7 @@ font_open_by_name (struct frame *f, Lisp_Object name) (e.g. syms_of_xfont). */ void -register_font_driver (struct font_driver *driver, struct frame *f) +register_font_driver (struct font_driver const *driver, struct frame *f) { struct font_driver_list *root = f ? f->font_driver_list : font_driver_list; struct font_driver_list *prev, *list; @@ -3524,7 +3522,7 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers) drivers. */ for (list = f->font_driver_list; list; list = list->next) { - struct font_driver *driver = list->driver; + struct font_driver const *driver = list->driver; if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers))) != list->on) { @@ -3587,7 +3585,7 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers) and then use it under w32 or ns. */ for (list = f->font_driver_list; list; list = list->next) { - struct font_driver *driver = list->driver; + struct font_driver const *driver = list->driver; eassert (! list->on); if (! driver->start_for_frame || driver->start_for_frame (f) == 0) diff --git a/src/font.h b/src/font.h index c14823b..af0214c 100644 --- a/src/font.h +++ b/src/font.h @@ -380,7 +380,7 @@ struct font #endif /* HAVE_WINDOW_SYSTEM */ /* Font-driver for the font. */ - struct font_driver *driver; + struct font_driver const *driver; /* There are more members in this structure, but they are private to the font-driver. */ @@ -783,7 +783,7 @@ struct font_driver_list font driver list.*/ bool on; /* Pointer to the font driver. */ - struct font_driver *driver; + struct font_driver const *driver; /* Pointer to the next element of the chain. */ struct font_driver_list *next; }; @@ -841,13 +841,13 @@ extern void font_parse_family_registry (Lisp_Object family, extern int font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font); extern ptrdiff_t font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int bytes); -extern void register_font_driver (struct font_driver *driver, struct frame *f); +extern void register_font_driver (struct font_driver const *, struct frame *); extern void free_font_driver_list (struct frame *f); #ifdef ENABLE_CHECKING -extern bool valid_font_driver (struct font_driver *); +extern bool valid_font_driver (struct font_driver const *); #else INLINE bool -valid_font_driver (struct font_driver *d) +valid_font_driver (struct font_driver const *d) { return true; } @@ -874,18 +874,37 @@ extern void font_filter_properties (Lisp_Object font, extern void font_drop_xrender_surfaces (struct frame *f); #ifdef HAVE_FREETYPE -extern struct font_driver ftfont_driver; +extern int ftfont_anchor_point (struct font *, unsigned int, int, + int *, int *); +extern int ftfont_get_bitmap (struct font *, unsigned int, + struct font_bitmap *, int); +extern int ftfont_has_char (Lisp_Object, int); +extern int ftfont_variation_glyphs (struct font *, int, unsigned[256]); +extern Lisp_Object ftfont_combining_capability (struct font *); +extern Lisp_Object ftfont_get_cache (struct frame *); +extern Lisp_Object ftfont_list (struct frame *, Lisp_Object); +extern Lisp_Object ftfont_list_family (struct frame *); +extern Lisp_Object ftfont_match (struct frame *, Lisp_Object); +extern Lisp_Object ftfont_open (struct frame *, Lisp_Object, int); +extern Lisp_Object ftfont_otf_capability (struct font *); +extern Lisp_Object ftfont_shape (Lisp_Object); +extern unsigned ftfont_encode_char (struct font *, int); +extern void ftfont_close (struct font *); +extern void ftfont_filter_properties (Lisp_Object, Lisp_Object); +extern void ftfont_text_extents (struct font *, unsigned *, int, + struct font_metrics *); extern void syms_of_ftfont (void); #endif /* HAVE_FREETYPE */ #ifdef HAVE_X_WINDOWS -extern struct font_driver xfont_driver; +extern struct font_driver const xfont_driver; +extern Lisp_Object xfont_get_cache (struct frame *); extern void syms_of_xfont (void); extern void syms_of_ftxfont (void); #ifdef HAVE_XFT -extern struct font_driver xftfont_driver; +extern struct font_driver const xftfont_driver; #endif #if defined HAVE_FREETYPE || defined HAVE_XFT -extern struct font_driver ftxfont_driver; +extern struct font_driver const ftxfont_driver; extern void syms_of_xftfont (void); #endif #ifdef HAVE_BDFFONT @@ -898,12 +917,12 @@ extern struct font_driver uniscribe_font_driver; extern void syms_of_w32font (void); #endif /* HAVE_NTGUI */ #ifdef HAVE_NS -extern struct font_driver nsfont_driver; +extern struct font_driver const nsfont_driver; extern void syms_of_nsfont (void); extern void syms_of_macfont (void); #endif /* HAVE_NS */ #ifdef USE_CAIRO -extern struct font_driver ftcrfont_driver; +extern struct font_driver const ftcrfont_driver; extern void syms_of_ftcrfont (void); #endif diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 2676502..f62b40f 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -65,8 +65,6 @@ enum metrics_status #define METRICS_SET_STATUS(metrics, status) \ ((metrics)->ascent = 0, (metrics)->descent = (status)) -struct font_driver ftcrfont_driver; - static int ftcrfont_glyph_extents (struct font *font, unsigned glyph, @@ -101,7 +99,7 @@ ftcrfont_glyph_extents (struct font *font, cache = ftcrfont_info->metrics[row] + col; if (METRICS_STATUS (cache) == METRICS_INVALID) - ftfont_driver.text_extents (font, &glyph, 1, cache); + ftfont_text_extents (font, &glyph, 1, cache); if (metrics) *metrics = *cache; @@ -112,7 +110,7 @@ ftcrfont_glyph_extents (struct font *font, static Lisp_Object ftcrfont_list (struct frame *f, Lisp_Object spec) { - Lisp_Object list = ftfont_driver.list (f, spec), tail; + Lisp_Object list = ftfont_list (f, spec), tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) ASET (XCAR (tail), FONT_TYPE_INDEX, Qftcr); @@ -122,15 +120,13 @@ ftcrfont_list (struct frame *f, Lisp_Object spec) static Lisp_Object ftcrfont_match (struct frame *f, Lisp_Object spec) { - Lisp_Object entity = ftfont_driver.match (f, spec); + Lisp_Object entity = ftfont_match (f, spec); if (VECTORP (entity)) ASET (entity, FONT_TYPE_INDEX, Qftcr); return entity; } -extern FT_Face ftfont_get_ft_face (Lisp_Object); - static Lisp_Object ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { @@ -181,7 +177,7 @@ ftcrfont_close (struct font *font) cairo_font_face_destroy (ftcrfont_info->cr_font_face); unblock_input (); - ftfont_driver.close (font); + ftfont_close (font); } static void @@ -282,6 +278,34 @@ ftcrfont_draw (struct glyph_string *s, +struct font_driver const ftcrfont_driver = + { + type: LISPSYM_INITIALLY (Qftcr), + get_cache: ftfont_get_cache, + list: ftcrfont_list, + match: ftcrfont_match, + list_family: ftfont_list_family, + open: ftcrfont_open, + close: ftcrfont_close, + has_char: ftfont_has_char, + encode_char: ftfont_encode_char, + text_extents: ftcrfont_text_extents, + draw: ftcrfont_draw, + get_bitmap: ftfont_get_bitmap, + anchor_point: ftfont_anchor_point, +#ifdef HAVE_LIBOTF + otf_capability: ftfont_otf_capability, +#endif +#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF + shape: ftfont_shape, +#endif +#ifdef HAVE_OTF_GET_VARIATION_GLYPHS + get_variation_glyphs: ftfont_variation_glyphs, +#endif + filter_properties: ftfont_filter_properties, + combining_capability: ftfont_combining_capability, + }; + void syms_of_ftcrfont (void) { @@ -289,14 +313,5 @@ syms_of_ftcrfont (void) abort (); DEFSYM (Qftcr, "ftcr"); - - ftcrfont_driver = ftfont_driver; - ftcrfont_driver.type = Qftcr; - ftcrfont_driver.list = ftcrfont_list; - ftcrfont_driver.match = ftcrfont_match; - ftcrfont_driver.open = ftcrfont_open; - ftcrfont_driver.close = ftcrfont_close; - ftcrfont_driver.text_extents = ftcrfont_text_extents; - ftcrfont_driver.draw = ftcrfont_draw; register_font_driver (&ftcrfont_driver, NULL); } diff --git a/src/ftfont.c b/src/ftfont.c index 17fe668..768b524 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -35,6 +35,8 @@ along with GNU Emacs. If not, see . */ #include "font.h" #include "ftfont.h" +static struct font_driver const ftfont_driver; + /* Flag to tell if FcInit is already called or not. */ static bool fc_initialized; @@ -73,17 +75,9 @@ enum ftfont_cache_for FTFONT_CACHE_FOR_ENTITY }; -static Lisp_Object ftfont_pattern_entity (FcPattern *, Lisp_Object); - -static Lisp_Object ftfont_resolve_generic_family (Lisp_Object, - FcPattern *); static Lisp_Object ftfont_lookup_cache (Lisp_Object, enum ftfont_cache_for); -static void ftfont_filter_properties (Lisp_Object font, Lisp_Object alist); - -static Lisp_Object ftfont_combining_capability (struct font *); - #define SYMBOL_FcChar8(SYM) (FcChar8 *) SDATA (SYMBOL_NAME (SYM)) static struct @@ -480,83 +474,7 @@ ftfont_get_otf (struct ftfont_info *ftfont_info) } #endif /* HAVE_LIBOTF */ -static Lisp_Object ftfont_get_cache (struct frame *); -static Lisp_Object ftfont_list (struct frame *, Lisp_Object); -static Lisp_Object ftfont_match (struct frame *, Lisp_Object); -static Lisp_Object ftfont_list_family (struct frame *); -static Lisp_Object ftfont_open (struct frame *, Lisp_Object, int); -static void ftfont_close (struct font *); -static int ftfont_has_char (Lisp_Object, int); -static unsigned ftfont_encode_char (struct font *, int); -static void ftfont_text_extents (struct font *, unsigned *, int, - struct font_metrics *); -static int ftfont_get_bitmap (struct font *, unsigned, - struct font_bitmap *, int); -static int ftfont_anchor_point (struct font *, unsigned, int, - int *, int *); -#ifdef HAVE_LIBOTF -static Lisp_Object ftfont_otf_capability (struct font *); -# ifdef HAVE_M17N_FLT -static Lisp_Object ftfont_shape (Lisp_Object); -# endif -#endif - -#ifdef HAVE_OTF_GET_VARIATION_GLYPHS -static int ftfont_variation_glyphs (struct font *, int c, - unsigned variations[256]); -#endif /* HAVE_OTF_GET_VARIATION_GLYPHS */ - -struct font_driver ftfont_driver = - { - LISPSYM_INITIALLY (Qfreetype), - 0, /* case insensitive */ - ftfont_get_cache, - ftfont_list, - ftfont_match, - ftfont_list_family, - NULL, /* free_entity */ - ftfont_open, - ftfont_close, - /* We can't draw a text without device dependent functions. */ - NULL, /* prepare_face */ - NULL, /* done_face */ - ftfont_has_char, - ftfont_encode_char, - ftfont_text_extents, - /* We can't draw a text without device dependent functions. */ - NULL, /* draw */ - ftfont_get_bitmap, - NULL, /* free_bitmap */ - ftfont_anchor_point, -#ifdef HAVE_LIBOTF - ftfont_otf_capability, -#else /* not HAVE_LIBOTF */ - NULL, -#endif /* not HAVE_LIBOTF */ - NULL, /* otf_drive */ - NULL, /* start_for_frame */ - NULL, /* end_for_frame */ -#if defined (HAVE_M17N_FLT) && defined (HAVE_LIBOTF) - ftfont_shape, -#else /* not (HAVE_M17N_FLT && HAVE_LIBOTF) */ - NULL, -#endif /* not (HAVE_M17N_FLT && HAVE_LIBOTF) */ - NULL, /* check */ - -#ifdef HAVE_OTF_GET_VARIATION_GLYPHS - ftfont_variation_glyphs, -#else - NULL, -#endif - - ftfont_filter_properties, /* filter_properties */ - - NULL, /* cached_font_ok */ - - ftfont_combining_capability, - }; - -static Lisp_Object +Lisp_Object ftfont_get_cache (struct frame *f) { return freetype_font_cache; @@ -873,7 +791,7 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots return pattern; } -static Lisp_Object +Lisp_Object ftfont_list (struct frame *f, Lisp_Object spec) { Lisp_Object val = Qnil, family, adstyle; @@ -1072,7 +990,7 @@ ftfont_list (struct frame *f, Lisp_Object spec) return val; } -static Lisp_Object +Lisp_Object ftfont_match (struct frame *f, Lisp_Object spec) { Lisp_Object entity = Qnil; @@ -1122,7 +1040,7 @@ ftfont_match (struct frame *f, Lisp_Object spec) return entity; } -static Lisp_Object +Lisp_Object ftfont_list_family (struct frame *f) { Lisp_Object list = Qnil; @@ -1301,7 +1219,7 @@ ftfont_open2 (struct frame *f, return font_object; } -static Lisp_Object +Lisp_Object ftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { Lisp_Object font_object; @@ -1314,7 +1232,7 @@ ftfont_open (struct frame *f, Lisp_Object entity, int pixel_size) return ftfont_open2 (f, entity, pixel_size, font_object); } -static void +void ftfont_close (struct font *font) { /* FIXME: Although this function can be called while garbage-collecting, @@ -1344,7 +1262,7 @@ ftfont_close (struct font *font) FT_Done_Size (ftfont_info->ft_size); } -static int +int ftfont_has_char (Lisp_Object font, int c) { struct charset *cs = NULL; @@ -1374,7 +1292,7 @@ ftfont_has_char (Lisp_Object font, int c) } } -static unsigned +unsigned ftfont_encode_char (struct font *font, int c) { struct ftfont_info *ftfont_info = (struct ftfont_info *) font; @@ -1385,7 +1303,7 @@ ftfont_encode_char (struct font *font, int c) return (code > 0 ? code : FONT_INVALID_CODE); } -static void +void ftfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct font_metrics *metrics) { @@ -1429,7 +1347,7 @@ ftfont_text_extents (struct font *font, unsigned int *code, metrics->width = width; } -static int +int ftfont_get_bitmap (struct font *font, unsigned int code, struct font_bitmap *bitmap, int bits_per_pixel) { struct ftfont_info *ftfont_info = (struct ftfont_info *) font; @@ -1472,7 +1390,7 @@ ftfont_get_bitmap (struct font *font, unsigned int code, struct font_bitmap *bit return 0; } -static int +int ftfont_anchor_point (struct font *font, unsigned int code, int idx, int *x, int *y) { @@ -1538,7 +1456,7 @@ ftfont_otf_features (OTF_GSUB_GPOS *gsub_gpos) } -static Lisp_Object +Lisp_Object ftfont_otf_capability (struct font *font) { struct ftfont_info *ftfont_info = (struct ftfont_info *) font; @@ -2701,7 +2619,7 @@ ftfont_shape (Lisp_Object lgstring) #ifdef HAVE_OTF_GET_VARIATION_GLYPHS -static int +int ftfont_variation_glyphs (struct font *font, int c, unsigned variations[256]) { struct ftfont_info *ftfont_info = (struct ftfont_info *) font; @@ -2759,14 +2677,14 @@ static const char *const ftfont_non_booleans [] = { NULL, }; -static void +void ftfont_filter_properties (Lisp_Object font, Lisp_Object alist) { font_filter_properties (font, alist, ftfont_booleans, ftfont_non_booleans); } -static Lisp_Object +Lisp_Object ftfont_combining_capability (struct font *font) { #ifdef HAVE_M17N_FLT @@ -2776,6 +2694,34 @@ ftfont_combining_capability (struct font *font) #endif } +static struct font_driver const ftfont_driver = + { + /* We can't draw a text without device dependent functions. */ + type: LISPSYM_INITIALLY (Qfreetype), + get_cache: ftfont_get_cache, + list: ftfont_list, + match: ftfont_match, + list_family: ftfont_list_family, + open: ftfont_open, + close: ftfont_close, + has_char: ftfont_has_char, + encode_char: ftfont_encode_char, + text_extents: ftfont_text_extents, + get_bitmap: ftfont_get_bitmap, + anchor_point: ftfont_anchor_point, +#ifdef HAVE_LIBOTF + otf_capability: ftfont_otf_capability, +#endif +#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF + shape: ftfont_shape, +#endif +#ifdef HAVE_OTF_GET_VARIATION_GLYPHS + get_variation_glyphs: ftfont_variation_glyphs, +#endif + filter_properties: ftfont_filter_properties, + combining_capability: ftfont_combining_capability, + }; + void syms_of_ftfont (void) { diff --git a/src/ftxfont.c b/src/ftxfont.c index bfdeb40..d8792ac 100644 --- a/src/ftxfont.c +++ b/src/ftxfont.c @@ -31,8 +31,6 @@ along with GNU Emacs. If not, see . */ /* FTX font driver. */ -struct font_driver ftxfont_driver; - struct ftxfont_frame_data { /* Background and foreground colors. */ @@ -125,7 +123,7 @@ ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font, unsigned char *b; int i, j; - if (ftfont_driver.get_bitmap (font, code, &bitmap, size > 0x100 ? 1 : 8) < 0) + if (ftfont_get_bitmap (font, code, &bitmap, size > 0x100 ? 1 : 8) < 0) return 0; if (size > 0x100) { @@ -188,8 +186,7 @@ ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font, } } - if (ftfont_driver.free_bitmap) - ftfont_driver.free_bitmap (font, &bitmap); + /* There is no ftfont_free_bitmap, so do not try to free BITMAP. */ return bitmap.advance; } @@ -211,7 +208,7 @@ ftxfont_draw_background (struct frame *f, struct font *font, GC gc, int x, int y static Lisp_Object ftxfont_list (struct frame *f, Lisp_Object spec) { - Lisp_Object list = ftfont_driver.list (f, spec), tail; + Lisp_Object list = ftfont_list (f, spec), tail; for (tail = list; CONSP (tail); tail = XCDR (tail)) ASET (XCAR (tail), FONT_TYPE_INDEX, Qftx); @@ -221,7 +218,7 @@ ftxfont_list (struct frame *f, Lisp_Object spec) static Lisp_Object ftxfont_match (struct frame *f, Lisp_Object spec) { - Lisp_Object entity = ftfont_driver.match (f, spec); + Lisp_Object entity = ftfont_match (f, spec); if (VECTORP (entity)) ASET (entity, FONT_TYPE_INDEX, Qftx); @@ -231,13 +228,10 @@ ftxfont_match (struct frame *f, Lisp_Object spec) static Lisp_Object ftxfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { - Lisp_Object font_object; - struct font *font; - - font_object = ftfont_driver.open (f, entity, pixel_size); + Lisp_Object font_object = ftfont_open (f, entity, pixel_size); if (NILP (font_object)) return Qnil; - font = XFONT_OBJECT (font_object); + struct font *font = XFONT_OBJECT (font_object); font->driver = &ftxfont_driver; return font_object; } @@ -245,7 +239,7 @@ ftxfont_open (struct frame *f, Lisp_Object entity, int pixel_size) static void ftxfont_close (struct font *font) { - ftfont_driver.close (font); + ftfont_close (font); } static int @@ -345,18 +339,39 @@ ftxfont_end_for_frame (struct frame *f) +struct font_driver const ftxfont_driver = + { + /* We can't draw a text without device dependent functions. */ + type: LISPSYM_INITIALLY (Qftx), + get_cache: ftfont_get_cache, + list: ftxfont_list, + match: ftxfont_match, + list_family: ftfont_list_family, + open: ftxfont_open, + close: ftxfont_close, + has_char: ftfont_has_char, + encode_char: ftfont_encode_char, + text_extents: ftfont_text_extents, + draw: ftxfont_draw, + get_bitmap: ftfont_get_bitmap, + anchor_point: ftfont_anchor_point, +#ifdef HAVE_LIBOTF + otf_capability: ftfont_otf_capability, +#endif + end_for_frame: ftxfont_end_for_frame, +#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF + shape: ftfont_shape, +#endif +#ifdef HAVE_OTF_GET_VARIATION_GLYPHS + get_variation_glyphs: ftfont_variation_glyphs, +#endif + filter_properties: ftfont_filter_properties, + combining_capability: ftfont_combining_capability, + }; + void syms_of_ftxfont (void) { DEFSYM (Qftx, "ftx"); - - ftxfont_driver = ftfont_driver; - ftxfont_driver.type = Qftx; - ftxfont_driver.list = ftxfont_list; - ftxfont_driver.match = ftxfont_match; - ftxfont_driver.open = ftxfont_open; - ftxfont_driver.close = ftxfont_close; - ftxfont_driver.draw = ftxfont_draw; - ftxfont_driver.end_for_frame = ftxfont_end_for_frame; register_font_driver (&ftxfont_driver, NULL); } diff --git a/src/macfont.m b/src/macfont.m index b3a2fb8..b2f3dff 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -38,8 +38,6 @@ #include -static struct font_driver macfont_driver; - static double mac_font_get_advance_width_for_glyph (CTFontRef, CGGlyph); static CGRect mac_font_get_bounding_rect_for_glyph (CTFontRef, CGGlyph); static CFArrayRef mac_font_create_available_families (void); @@ -893,7 +891,7 @@ static void mac_font_get_glyphs_for_variants (CFDataRef, UTF32Char, entity = font_make_entity (); - ASET (entity, FONT_TYPE_INDEX, macfont_driver.type); + ASET (entity, FONT_TYPE_INDEX, Qmac_ct); ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1); macfont_store_descriptor_attributes (desc, entity); @@ -1663,34 +1661,23 @@ static int macfont_variation_glyphs (struct font *, int c, unsigned variations[256]); static void macfont_filter_properties (Lisp_Object, Lisp_Object); -static struct font_driver macfont_driver = +static struct font_driver const macfont_driver = { - LISPSYM_INITIALLY (Qmac_ct), - 0, /* case insensitive */ - macfont_get_cache, - macfont_list, - macfont_match, - macfont_list_family, - macfont_free_entity, - macfont_open, - macfont_close, - NULL, /* prepare_face */ - NULL, /* done_face */ - macfont_has_char, - macfont_encode_char, - macfont_text_extents, - macfont_draw, - NULL, /* get_bitmap */ - NULL, /* free_bitmap */ - NULL, /* anchor_point */ - NULL, /* otf_capability */ - NULL, /* otf_drive */ - NULL, /* start_for_frame */ - NULL, /* end_for_frame */ - macfont_shape, - NULL, /* check */ - macfont_variation_glyphs, - macfont_filter_properties, + type: LISPSYM_INITIALLY (Qmac_ct), + get_cache: macfont_get_cache, + list: macfont_list, + match: macfont_match, + list_family: macfont_list_family, + free_entity: macfont_free_entity, + open: macfont_open, + close: macfont_close, + has_char: macfont_has_char, + encode_char: macfont_encode_char, + text_extents: macfont_text_extents, + draw: macfont_draw, + shape: macfont_shape, + get_variation_glyphs: macfont_variation_glyphs, + filter_properties: macfont_filter_properties, }; static Lisp_Object diff --git a/src/nsfont.m b/src/nsfont.m index c4c3c8d..d14c362 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -610,43 +610,6 @@ but also for ascii (which causes unnecessary font substitution). */ ========================================================================== */ -static Lisp_Object nsfont_get_cache (struct frame *frame); -static Lisp_Object nsfont_list (struct frame *, Lisp_Object); -static Lisp_Object nsfont_match (struct frame *, Lisp_Object); -static Lisp_Object nsfont_list_family (struct frame *); -static Lisp_Object nsfont_open (struct frame *f, Lisp_Object font_entity, - int pixel_size); -static void nsfont_close (struct font *font); -static int nsfont_has_char (Lisp_Object entity, int c); -static unsigned int nsfont_encode_char (struct font *font, int c); -static void nsfont_text_extents (struct font *font, unsigned int *code, - int nglyphs, struct font_metrics *metrics); -static int nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, - bool with_background); - -struct font_driver nsfont_driver = - { - LISPSYM_INITIALLY (Qns), - 1, /* case sensitive */ - nsfont_get_cache, - nsfont_list, - nsfont_match, - nsfont_list_family, - NULL, /*free_entity */ - nsfont_open, - nsfont_close, - NULL, /* prepare_face */ - NULL, /* done_face */ - nsfont_has_char, - nsfont_encode_char, - nsfont_text_extents, - nsfont_draw, - /* excluded: get_bitmap, free_bitmap, - anchor_point, otf_capability, otf_driver, - start_for_frame, end_for_frame, shape */ - }; - - /* Return a cache of font-entities on FRAME. The cache must be a cons whose cdr part is the actual cache area. */ static Lisp_Object @@ -788,7 +751,7 @@ when setting family in ns_spec_to_descriptor(). */ font_object = font_make_object (VECSIZE (struct nsfont_info), font_entity, pixel_size); - ASET (font_object, FONT_TYPE_INDEX, nsfont_driver.type); + ASET (font_object, FONT_TYPE_INDEX, Qns); font_info = (struct nsfont_info *) XFONT_OBJECT (font_object); font = (struct font *) font_info; if (!font) @@ -1520,6 +1483,21 @@ - (void)setIntAttribute: (NSInteger)attributeTag value: (NSInteger)val fprintf (stderr, "\n"); } +struct font_driver const nsfont_driver = + { + type: LISPSYM_INITIALLY (Qns), + case_sensitive: true, + get_cache: nsfont_get_cache, + list: nsfont_list, + match: nsfont_match, + list_family: nsfont_list_family, + open: nsfont_open, + close: nsfont_close, + has_char: nsfont_has_char, + encode_char: nsfont_encode_char, + text_extents: nsfont_text_extents, + draw: nsfont_draw, + }; void syms_of_nsfont (void) diff --git a/src/xfont.c b/src/xfont.c index ccb8f07..5999f67 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -113,44 +113,7 @@ xfont_get_pcm (XFontStruct *xfont, XChar2b *char2b) ? NULL : pcm); } -static Lisp_Object xfont_get_cache (struct frame *); -static Lisp_Object xfont_list (struct frame *, Lisp_Object); -static Lisp_Object xfont_match (struct frame *, Lisp_Object); -static Lisp_Object xfont_list_family (struct frame *); -static Lisp_Object xfont_open (struct frame *, Lisp_Object, int); -static void xfont_close (struct font *); -static void xfont_prepare_face (struct frame *, struct face *); -static int xfont_has_char (Lisp_Object, int); -static unsigned xfont_encode_char (struct font *, int); -static void xfont_text_extents (struct font *, unsigned *, int, - struct font_metrics *); -static int xfont_draw (struct glyph_string *, int, int, int, int, bool); -static int xfont_check (struct frame *, struct font *); - -struct font_driver xfont_driver = - { - LISPSYM_INITIALLY (Qx), - false, /* case insensitive */ - xfont_get_cache, - xfont_list, - xfont_match, - xfont_list_family, - NULL, - xfont_open, - xfont_close, - xfont_prepare_face, - NULL, - xfont_has_char, - xfont_encode_char, - xfont_text_extents, - xfont_draw, - NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, - xfont_check, - NULL, /* get_variation_glyphs */ - NULL, /* filter_properties */ - }; - -static Lisp_Object +Lisp_Object xfont_get_cache (struct frame *f) { Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); @@ -1113,6 +1076,24 @@ xfont_check (struct frame *f, struct font *font) } + +struct font_driver const xfont_driver = + { + type: LISPSYM_INITIALLY (Qx), + get_cache: xfont_get_cache, + list: xfont_list, + match: xfont_match, + list_family: xfont_list_family, + open: xfont_open, + close: xfont_close, + prepare_face: xfont_prepare_face, + has_char: xfont_has_char, + encode_char: xfont_encode_char, + text_extents: xfont_text_extents, + draw: xfont_draw, + check: xfont_check, + }; + void syms_of_xfont (void) { diff --git a/src/xftfont.c b/src/xftfont.c index 861ad80..74f5ec6 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -125,15 +125,12 @@ xftfont_get_colors (struct frame *f, struct face *face, GC gc, } } - -struct font_driver xftfont_driver; - static Lisp_Object xftfont_list (struct frame *f, Lisp_Object spec) { - Lisp_Object list = ftfont_driver.list (f, spec), tail; + Lisp_Object list = ftfont_list (f, spec); - for (tail = list; CONSP (tail); tail = XCDR (tail)) + for (Lisp_Object tail = list; CONSP (tail); tail = XCDR (tail)) ASET (XCAR (tail), FONT_TYPE_INDEX, Qxft); return list; } @@ -141,7 +138,7 @@ xftfont_list (struct frame *f, Lisp_Object spec) static Lisp_Object xftfont_match (struct frame *f, Lisp_Object spec) { - Lisp_Object entity = ftfont_driver.match (f, spec); + Lisp_Object entity = ftfont_match (f, spec); if (! NILP (entity)) ASET (entity, FONT_TYPE_INDEX, Qxft); @@ -542,7 +539,7 @@ xftfont_has_char (Lisp_Object font, int c) return (ENCODE_CHAR (cs, c) != CHARSET_INVALID_CODE (cs)); if (FONT_ENTITY_P (font)) - return ftfont_driver.has_char (font, c); + return ftfont_has_char (font, c); xftfont_info = (struct xftfont_info *) XFONT_OBJECT (font); return (XftCharExists (xftfont_info->display, xftfont_info->xftfont, (FcChar32) c) == FcTrue); @@ -668,12 +665,9 @@ xftfont_shape (Lisp_Object lgstring) { struct font *font = CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring)); struct xftfont_info *xftfont_info = (struct xftfont_info *) font; - FT_Face ft_face; - Lisp_Object val; - - ft_face = XftLockFace (xftfont_info->xftfont); + FT_Face ft_face = XftLockFace (xftfont_info->xftfont); xftfont_info->ft_size = ft_face->size; - val = ftfont_driver.shape (lgstring); + Lisp_Object val = ftfont_shape (lgstring); XftUnlockFace (xftfont_info->xftfont); return val; } @@ -697,6 +691,10 @@ xftfont_end_for_frame (struct frame *f) return 0; } +/* When using X double buffering, the XftDraw structure we build + seems to be useless once a frame is resized, so recreate it on + ConfigureNotify and in some other cases. */ + static void xftfont_drop_xrender_surfaces (struct frame *f) { @@ -751,6 +749,40 @@ xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object, return ok; } +struct font_driver const xftfont_driver = + { + /* We can't draw a text without device dependent functions. */ + type: LISPSYM_INITIALLY (Qxft), + get_cache: xfont_get_cache, + list: xftfont_list, + match: xftfont_match, + list_family: ftfont_list_family, + open: xftfont_open, + close: xftfont_close, + prepare_face: xftfont_prepare_face, + done_face: xftfont_done_face, + has_char: xftfont_has_char, + encode_char: xftfont_encode_char, + text_extents: xftfont_text_extents, + draw: xftfont_draw, + get_bitmap: ftfont_get_bitmap, + anchor_point: ftfont_anchor_point, +#ifdef HAVE_LIBOTF + otf_capability: ftfont_otf_capability, +#endif + end_for_frame: xftfont_end_for_frame, +#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF + shape: xftfont_shape, +#endif +#ifdef HAVE_OTF_GET_VARIATION_GLYPHS + get_variation_glyphs: ftfont_variation_glyphs, +#endif + filter_properties: ftfont_filter_properties, + cached_font_ok: xftfont_cached_font_ok, + combining_capability: ftfont_combining_capability, + drop_xrender_surfaces: xftfont_drop_xrender_surfaces, + }; + void syms_of_xftfont (void) { @@ -770,28 +802,5 @@ This is needed with some fonts to correct vertical overlap of glyphs. */); ascii_printable[0] = 0; - xftfont_driver = ftfont_driver; - xftfont_driver.type = Qxft; - xftfont_driver.get_cache = xfont_driver.get_cache; - xftfont_driver.list = xftfont_list; - xftfont_driver.match = xftfont_match; - xftfont_driver.open = xftfont_open; - xftfont_driver.close = xftfont_close; - xftfont_driver.prepare_face = xftfont_prepare_face; - xftfont_driver.done_face = xftfont_done_face; - xftfont_driver.has_char = xftfont_has_char; - xftfont_driver.encode_char = xftfont_encode_char; - xftfont_driver.text_extents = xftfont_text_extents; - xftfont_driver.draw = xftfont_draw; - xftfont_driver.end_for_frame = xftfont_end_for_frame; - xftfont_driver.cached_font_ok = xftfont_cached_font_ok; -#if defined (HAVE_M17N_FLT) && defined (HAVE_LIBOTF) - xftfont_driver.shape = xftfont_shape; -#endif - /* When using X double buffering, the XftDraw structure we build - seems to be useless once a frame is resized, so recreate it on - ConfigureNotify and in some other cases. */ - xftfont_driver.drop_xrender_surfaces = xftfont_drop_xrender_surfaces; - register_font_driver (&xftfont_driver, NULL); } commit dd4b913153a818dbd42cb395d2c36f216e09a8ec Author: Eli Zaretskii Date: Thu Dec 1 20:26:54 2016 +0200 ; * test/lisp/progmodes/compile-tests.el: Fix a typo in a comment. diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 8961576..265baf2 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -1,4 +1,4 @@ -;;; compile-tests.el --- Test suite for font parsing. +;;; compile-tests.el --- Test suite for compile.el. ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. commit bb8e38273e701ad5c65e747e8eda3bd8f3aa4adb Author: Helmut Eller Date: Thu Dec 1 18:58:08 2016 +0200 Forth related improvements for etags Generate correct tags names for things like "(foo)". Previously "(foo" created. Fix a bug where a tag for "-bar" was created when encountering things like "create-bar". Recognize more words from the Forth-2012 Standard. * lib-src/etags.c (Forth_words): Check for whitespace after defining words. Create tag with make_tag instead of get_tag to avoid notiname which isn't appropriate for Forth. * test/manual/etags/forth-src/test-forth.fth: Add some test cases. * test/manual/etags/ETAGS.good_1: * test/manual/etags/ETAGS.good_2: * test/manual/etags/ETAGS.good_3: * test/manual/etags/ETAGS.good_4: * test/manual/etags/ETAGS.good_5: * test/manual/etags/ETAGS.good_6: * test/manual/etags/CTAGS.good: Adapt to the changes in etags.c and new test cases. diff --git a/lib-src/etags.c b/lib-src/etags.c index 6a722e0..7baa2a3 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -5469,16 +5469,37 @@ Forth_words (FILE *inf) do /* skip to ) or eol */ bp++; while (*bp != ')' && *bp != '\0'); - else if ((bp[0] == ':' && c_isspace (bp[1]) && bp++) - || LOOKING_AT_NOCASE (bp, "constant") - || LOOKING_AT_NOCASE (bp, "code") - || LOOKING_AT_NOCASE (bp, "create") - || LOOKING_AT_NOCASE (bp, "defer") - || LOOKING_AT_NOCASE (bp, "value") - || LOOKING_AT_NOCASE (bp, "variable") - || LOOKING_AT_NOCASE (bp, "buffer:") - || LOOKING_AT_NOCASE (bp, "field")) - get_tag (skip_spaces (bp), NULL); /* Yay! A definition! */ + else if (((bp[0] == ':' && c_isspace (bp[1]) && bp++) + || LOOKING_AT_NOCASE (bp, "constant") + || LOOKING_AT_NOCASE (bp, "2constant") + || LOOKING_AT_NOCASE (bp, "fconstant") + || LOOKING_AT_NOCASE (bp, "code") + || LOOKING_AT_NOCASE (bp, "create") + || LOOKING_AT_NOCASE (bp, "defer") + || LOOKING_AT_NOCASE (bp, "value") + || LOOKING_AT_NOCASE (bp, "2value") + || LOOKING_AT_NOCASE (bp, "fvalue") + || LOOKING_AT_NOCASE (bp, "variable") + || LOOKING_AT_NOCASE (bp, "2variable") + || LOOKING_AT_NOCASE (bp, "fvariable") + || LOOKING_AT_NOCASE (bp, "buffer:") + || LOOKING_AT_NOCASE (bp, "field:") + || LOOKING_AT_NOCASE (bp, "+field") + || LOOKING_AT_NOCASE (bp, "field") /* not standard? */ + || LOOKING_AT_NOCASE (bp, "begin-structure") + || LOOKING_AT_NOCASE (bp, "synonym") + ) + && c_isspace (bp[0])) + { + /* Yay! A definition! */ + char* name_start = skip_spaces (bp); + char* name_end = skip_non_spaces (name_start); + if (name_start < name_end) + make_tag (name_start, name_end - name_start, + true, lb.buffer, name_end - lb.buffer, + lineno, linecharno); + bp = name_end; + } else bp = skip_non_spaces (bp); } diff --git a/test/manual/etags/CTAGS.good b/test/manual/etags/CTAGS.good index e652989..6f9df19 100644 --- a/test/manual/etags/CTAGS.good +++ b/test/manual/etags/CTAGS.good @@ -36,7 +36,8 @@ ${CHECKOBJS} make-src/Makefile /^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/ ($prog,$_,@list perl-src/yagrip.pl 39 ($string,$flag,@string,@temp,@last perl-src/yagrip.pl 40 (a-forth-constant forth-src/test-forth.fth /^constant (a-forth-constant$/ -(another-forth-word forth-src/test-forth.fth /^: (another-forth-word) ( -- )$/ +(another-forth-word) forth-src/test-forth.fth /^: (another-forth-word) ( -- )$/ +(foo) forth-src/test-forth.fth /^: (foo) 1 ;$/ + ruby-src/test.rb /^ def +(y)$/ + tex-src/texinfo.tex /^\\def+{{\\tt \\char 43}}$/ .PRECIOUS make-src/Makefile /^.PRECIOUS: ETAGS CTAGS ETAGS16 CTAGS16 ETAGS17 CTA/ @@ -170,6 +171,9 @@ ${CHECKOBJS} make-src/Makefile /^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/ /wbytes ps-src/rfc1245.ps /^\/wbytes { $/ /wh ps-src/rfc1245.ps /^\/wh { $/ /yen ps-src/rfc1245.ps /^\/yen \/.notdef \/.notdef \/.notdef \/.notdef \/.notdef / +2const forth-src/test-forth.fth /^3 4 2constant 2const$/ +2val forth-src/test-forth.fth /^2const 2value 2val$/ +2var forth-src/test-forth.fth /^2variable 2var$/ :a-forth-dictionary-entry forth-src/test-forth.fth /^create :a-forth-dictionary-entry$/ < tex-src/texinfo.tex /^\\def<{{\\tt \\less}}$/ << ruby-src/test.rb /^ def <<(y)$/ @@ -2725,6 +2729,7 @@ counter cp-src/c.C 36 cow cp-src/c.C 127 cow cp-src/c.C 131 cplpl c-src/etags.c 2935 +create-bar forth-src/test-forth.fth /^: create-bar foo ;$/ createPOEntries php-src/lce_functions.php /^ function createPOEntries()$/ createWidgets pyt-src/server.py /^ def createWidgets(self, host):$/ createWidgets pyt-src/server.py /^ def createWidgets(self):$/ @@ -2944,6 +2949,7 @@ fastmap c-src/emacs/src/regex.h 355 fastmap_accurate c-src/emacs/src/regex.h 383 fatal c-src/etags.c /^fatal (const char *s1, const char *s2)$/ fatala c.c /^void fatala () __attribute__ ((noreturn));$/ +fconst forth-src/test-forth.fth /^3.1415e fconstant fconst$/ fdHandler objc-src/Subprocess.m /^- fdHandler:(int)theFd$/ fdHandler objc-src/Subprocess.m /^fdHandler (int theFd, id self)$/ fdefunkey c-src/etags.c 2409 @@ -3015,6 +3021,7 @@ foo cp-src/x.cc /^XX::foo()$/ foo f-src/entry.for /^ character*(*) function foo()$/ foo f-src/entry.strange_suffix /^ character*(*) function foo()$/ foo f-src/entry.strange /^ character*(*) function foo()$/ +foo forth-src/test-forth.fth /^: foo (foo) ;$/ foo php-src/ptest.php /^foo()$/ foo ruby-src/test1.ru /^ attr_reader :foo$/ foo! ruby-src/test1.ru /^ def foo!$/ @@ -3057,6 +3064,8 @@ function c-src/emacs/src/lisp.h 694 function c-src/emacs/src/lisp.h 1685 function c-src/emacs/src/lisp.h 2197 functionp c-src/emacs/src/lisp.h /^functionp (Lisp_Object object)$/ +fval forth-src/test-forth.fth /^fconst fvalue fval$/ +fvar forth-src/test-forth.fth /^fvariable fvar$/ fvdef c-src/etags.c 2418 fvextern c-src/etags.c 2420 fvnameseen c-src/etags.c 2412 @@ -3515,6 +3524,7 @@ my_struct c.c 226 my_struct c-src/h.h 91 my_typedef c.c 228 my_typedef c-src/h.h 93 +mypi forth-src/test-forth.fth /^synonym mypi fconst$/ n c-src/exit.c 28 n c-src/exit.strange_suffix 28 name c-src/getopt.h 76 @@ -3719,6 +3729,8 @@ outputtable html-src/algrthms.html /^Output$/ outsyn prol-src/natded.prolog /^outsyn(['Any'],_).$/ p c-src/emacs/src/lisp.h 4673 p c-src/emacs/src/lisp.h 4679 +p.x forth-src/test-forth.fth /^ 1 CELLS +FIELD p.x \\ A single cell filed name/ +p.y forth-src/test-forth.fth /^ 1 CELLS +FIELD p.y \\ A single cell field name/ p/f ada-src/etags-test-for.ada /^ function p pragma Import (C,$/ p/f ada-src/etags-test-for.ada /^function p ("p");$/ pD c-src/emacs/src/lisp.h 165 @@ -3767,6 +3779,7 @@ plist c-src/emacs/src/lisp.h 697 plus cp-src/functions.cpp /^void Date::plus ( int days , int month , int year / plus go-src/test1.go 5 plusvalseq prol-src/natded.prolog /^plusvalseq([]) --> [].$/ +point forth-src/test-forth.fth /^BEGIN-STRUCTURE point \\ create the named structure/ pointer c-src/emacs/src/lisp.h 2125 poll_for_input c-src/emacs/src/keyboard.c /^poll_for_input (struct atimer *timer)$/ poll_for_input_1 c-src/emacs/src/keyboard.c /^poll_for_input_1 (void)$/ diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1 index 374692c..b3bd241 100644 --- a/test/manual/etags/ETAGS.good_1 +++ b/test/manual/etags/ETAGS.good_1 @@ -2311,19 +2311,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2 index a21717a..170d845 100644 --- a/test/manual/etags/ETAGS.good_2 +++ b/test/manual/etags/ETAGS.good_2 @@ -2880,19 +2880,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3 index 33bf110..1d75314 100644 --- a/test/manual/etags/ETAGS.good_3 +++ b/test/manual/etags/ETAGS.good_3 @@ -2628,19 +2628,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4 index 3d9d626..e74db28 100644 --- a/test/manual/etags/ETAGS.good_4 +++ b/test/manual/etags/ETAGS.good_4 @@ -2475,19 +2475,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5 index 1dff768..e278678 100644 --- a/test/manual/etags/ETAGS.good_5 +++ b/test/manual/etags/ETAGS.good_5 @@ -3361,19 +3361,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6 index fdcbd57..68e474d 100644 --- a/test/manual/etags/ETAGS.good_6 +++ b/test/manual/etags/ETAGS.good_6 @@ -3361,19 +3361,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 diff --git a/test/manual/etags/forth-src/test-forth.fth b/test/manual/etags/forth-src/test-forth.fth index ce4069d..4521d32 100644 --- a/test/manual/etags/forth-src/test-forth.fth +++ b/test/manual/etags/forth-src/test-forth.fth @@ -51,3 +51,24 @@ c; a-forth-word dup 200 > abort" Eek. The number is too big" ." Result is " . cr ; + +: (foo) 1 ; +: foo (foo) ; + +: create-bar foo ; +create-bar \ Do NOT create a tag here + +3 4 2constant 2const +2const 2value 2val +2variable 2var + +3.1415e fconstant fconst +fconst fvalue fval +fvariable fvar + +synonym mypi fconst + +BEGIN-STRUCTURE point \ create the named structure + 1 CELLS +FIELD p.x \ A single cell filed named p.x + 1 CELLS +FIELD p.y \ A single cell field named p.y +END-STRUCTURE commit 2f68cb3e0502a9dc69613e97a5a5079ebf9249fb Author: Eli Zaretskii Date: Thu Dec 1 18:49:51 2016 +0200 Fix bugs with buffer-local tags tables * lisp/progmodes/etags.el (visit-tags-table): After 'visit-tags-table-buffer' returns, retrieve the value of 'tags-file-name' from the buffer we started in. Force recomputation of 'tags-completion-table' next time it is used, since the list of tags table has changed. (visit-tags-table-buffer): Accept an additional optional argument CBUF, the buffer in which to start processing, and switch to that buffer if CBUF is non-nil. All callers changed to supply a non-nil CBUF when they call 'visit-tags-table-buffer' in a loop. Doc fix. (tags-completion-table): Accept an optional argument, the buffer for which to build 'tags-completion-table', and build that buffer's completion table. (tags-lazy-completion-table): Pass the current buffer to 'tags-completion-table'. (tags-file-name): Don't say in the doc string that setting this variable directly is enough; say that 'visit-tags-table' should be used for that. (Bug#158) (Bug#17326) (Bug#23164) * doc/emacs/maintaining.texi (Select Tags Table): Delete the advice to set 'tags-file-name' directly. * test/lisp/progmodes/etags-tests.el: New tests. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 13668cc..de4fb43 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2552,10 +2552,10 @@ directory as the default. @vindex tags-file-name Emacs does not actually read in the tags table contents until you try to use them; all @code{visit-tags-table} does is store the file -name in the variable @code{tags-file-name}, and setting the variable -yourself is just as good. The variable's initial value is @code{nil}; -that value tells all the commands for working with tags tables that -they must ask for a tags table file name to use. +name in the variable @code{tags-file-name}, and not much more. The +variable's initial value is @code{nil}; that value tells all the +commands for working with tags tables that they must ask for a tags +table file name to use. Using @code{visit-tags-table} when a tags table is already loaded gives you a choice: you can add the new tags table to the current list diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 7d4521c..c72f061 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -33,8 +33,9 @@ ;;;###autoload (defvar tags-file-name nil "File name of tags table. -To switch to a new tags table, setting this variable is sufficient. -If you set this variable, do not also set `tags-table-list'. +To switch to a new tags table, do not set this variable; instead, +invoke `visit-tags-table', which is the only reliable way of +setting the value of this variable, whether buffer-local or global. Use the `etags' program to make a tags table file.") ;; Make M-x set-variable tags-file-name like M-x visit-tags-table. ;;;###autoload (put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: ")) @@ -288,7 +289,8 @@ FILE should be the name of a file created with the `etags' program. A directory name is ok too; it means file TAGS in that directory. Normally \\[visit-tags-table] sets the global value of `tags-file-name'. -With a prefix arg, set the buffer-local value instead. +With a prefix arg, set the buffer-local value instead. When called +from Lisp, if the optional arg LOCAL is non-nil, set the local value. When you find a tag with \\[find-tag], the buffer it finds the tag in is given a local value of this variable which is the name of the tags file the tag was in." @@ -304,19 +306,28 @@ file the tag was in." ;; Calling visit-tags-table-buffer with tags-file-name set to FILE will ;; initialize a buffer for FILE and set tags-file-name to the ;; fully-expanded name. - (let ((tags-file-name file)) + (let ((tags-file-name file) + (cbuf (current-buffer))) (save-excursion (or (visit-tags-table-buffer file) (signal 'file-missing (list "Visiting tags table" "No such file or directory" file))) - ;; Set FILE to the expanded name. - (setq file tags-file-name))) + ;; Set FILE to the expanded name. Do that in the buffer we + ;; started from, because visit-tags-table-buffer switches + ;; buffers after updating tags-file-name, so if tags-file-name + ;; is local in the buffer we started, that value is only visible + ;; in that buffer. + (setq file (with-current-buffer cbuf tags-file-name)))) (if local - ;; Set the local value of tags-file-name. - (set (make-local-variable 'tags-file-name) file) + (progn + ;; Force recomputation of tags-completion-table. + (setq-local tags-completion-table nil) + ;; Set the local value of tags-file-name. + (setq-local tags-file-name file)) ;; Set the global value of tags-file-name. - (setq-default tags-file-name file))) + (setq-default tags-file-name file) + (setq tags-completion-table nil))) (defun tags-table-check-computed-list () "Compute `tags-table-computed-list' from `tags-table-list' if necessary." @@ -540,17 +551,21 @@ Returns nil when out of tables." (setq tags-file-name (car tags-table-list-pointer)))) ;;;###autoload -(defun visit-tags-table-buffer (&optional cont) +(defun visit-tags-table-buffer (&optional cont cbuf) "Select the buffer containing the current tags table. -If optional arg is a string, visit that file as a tags table. -If optional arg is t, visit the next table in `tags-table-list'. -If optional arg is the atom `same', don't look for a new table; +Optional arg CONT specifies which tags table to visit. +If CONT is a string, visit that file as a tags table. +If CONT is t, visit the next table in `tags-table-list'. +If CONT is the atom `same', don't look for a new table; just select the buffer visiting `tags-file-name'. -If arg is nil or absent, choose a first buffer from information in +If CONT is nil or absent, choose a first buffer from information in `tags-file-name', `tags-table-list', `tags-table-list-pointer'. +Optional second arg CBUF, if non-nil, specifies the initial buffer, +which is important if that buffer has a local value of `tags-file-name'. Returns t if it visits a tags table, or nil if there are no more in the list." ;; Set tags-file-name to the tags table file we want to visit. + (if cbuf (set-buffer cbuf)) (cond ((eq cont 'same) ;; Use the ambient value of tags-file-name. (or tags-file-name @@ -752,28 +767,33 @@ Assumes the tags table is the current buffer." (or tags-included-tables (setq tags-included-tables (funcall tags-included-tables-function)))) -(defun tags-completion-table () - "Build `tags-completion-table' on demand. +(defun tags-completion-table (&optional buf) + "Build `tags-completion-table' on demand for a buffer's tags tables. +Optional argument BUF specifies the buffer for which to build +\`tags-completion-table', and defaults to the current buffer. The tags included in the completion table are those in the current -tags table and its (recursively) included tags tables." - (or tags-completion-table - ;; No cached value for this buffer. - (condition-case () - (let (tables cont) - (message "Making tags completion table for %s..." buffer-file-name) - (save-excursion - ;; Iterate over the current list of tags tables. - (while (visit-tags-table-buffer cont) - ;; Find possible completions in this table. - (push (funcall tags-completion-table-function) tables) - (setq cont t))) - (message "Making tags completion table for %s...done" - buffer-file-name) - ;; Cache the result in a buffer-local variable. - (setq tags-completion-table - (nreverse (delete-dups (apply #'nconc tables))))) - (quit (message "Tags completion table construction aborted.") - (setq tags-completion-table nil))))) +tags table for BUF and its (recursively) included tags tables." + (if (not buf) (setq buf (current-buffer))) + (with-current-buffer buf + (or tags-completion-table + ;; No cached value for this buffer. + (condition-case () + (let (tables cont) + (message "Making tags completion table for %s..." + buffer-file-name) + (save-excursion + ;; Iterate over the current list of tags tables. + (while (visit-tags-table-buffer cont buf) + ;; Find possible completions in this table. + (push (funcall tags-completion-table-function) tables) + (setq cont t))) + (message "Making tags completion table for %s...done" + buffer-file-name) + ;; Cache the result in a variable. + (setq tags-completion-table + (nreverse (delete-dups (apply #'nconc tables))))) + (quit (message "Tags completion table construction aborted.") + (setq tags-completion-table nil)))))) ;;;###autoload (defun tags-lazy-completion-table () @@ -784,7 +804,9 @@ tags table and its (recursively) included tags tables." ;; If we need to ask for the tag table, allow that. (let ((enable-recursive-minibuffers t)) (visit-tags-table-buffer)) - (complete-with-action action (tags-completion-table) string pred)))))) + (complete-with-action action + (tags-completion-table buf) + string pred)))))) ;;;###autoload (defun tags-completion-at-point-function () ;;;###autoload (if (or tags-table-list tags-file-name) @@ -1084,6 +1106,7 @@ error message." (case-fold-search (if (memq tags-case-fold-search '(nil t)) tags-case-fold-search case-fold-search)) + (cbuf (current-buffer)) ) (save-excursion @@ -1104,8 +1127,7 @@ error message." (catch 'qualified-match-found ;; Iterate over the list of tags tables. - (while (or first-table - (visit-tags-table-buffer t)) + (while (or first-table (visit-tags-table-buffer t cbuf)) (and first-search first-table ;; Start at beginning of tags file. @@ -1707,25 +1729,26 @@ if the file was newly read in, the value is the filename." ((eq initialize t) ;; Initialize the list from the tags table. (save-excursion - ;; Visit the tags table buffer to get its list of files. - (visit-tags-table-buffer) - ;; Copy the list so we can setcdr below, and expand the file - ;; names while we are at it, in this buffer's default directory. - (setq next-file-list (mapcar 'expand-file-name (tags-table-files))) - ;; Iterate over all the tags table files, collecting - ;; a complete list of referenced file names. - (while (visit-tags-table-buffer t) - ;; Find the tail of the working list and chain on the new - ;; sublist for this tags table. - (let ((tail next-file-list)) - (while (cdr tail) - (setq tail (cdr tail))) - ;; Use a copy so the next loop iteration will not modify the - ;; list later returned by (tags-table-files). - (if tail - (setcdr tail (mapcar 'expand-file-name (tags-table-files))) - (setq next-file-list (mapcar 'expand-file-name - (tags-table-files)))))))) + (let ((cbuf (current-buffer))) + ;; Visit the tags table buffer to get its list of files. + (visit-tags-table-buffer) + ;; Copy the list so we can setcdr below, and expand the file + ;; names while we are at it, in this buffer's default directory. + (setq next-file-list (mapcar 'expand-file-name (tags-table-files))) + ;; Iterate over all the tags table files, collecting + ;; a complete list of referenced file names. + (while (visit-tags-table-buffer t cbuf) + ;; Find the tail of the working list and chain on the new + ;; sublist for this tags table. + (let ((tail next-file-list)) + (while (cdr tail) + (setq tail (cdr tail))) + ;; Use a copy so the next loop iteration will not modify the + ;; list later returned by (tags-table-files). + (if tail + (setcdr tail (mapcar 'expand-file-name (tags-table-files))) + (setq next-file-list (mapcar 'expand-file-name + (tags-table-files))))))))) (t ;; Initialize the list by evalling the argument. (setq next-file-list (eval initialize)))) @@ -1921,8 +1944,9 @@ directory specification." (princ (substitute-command-keys "':\n\n")) (save-excursion (let ((first-time t) - (gotany nil)) - (while (visit-tags-table-buffer (not first-time)) + (gotany nil) + (cbuf (current-buffer))) + (while (visit-tags-table-buffer (not first-time) cbuf) (setq first-time nil) (if (funcall list-tags-function file) (setq gotany t))) @@ -1945,8 +1969,9 @@ directory specification." (tags-with-face 'highlight (princ regexp)) (princ (substitute-command-keys "':\n\n")) (save-excursion - (let ((first-time t)) - (while (visit-tags-table-buffer (not first-time)) + (let ((first-time t) + (cbuf (current-buffer))) + (while (visit-tags-table-buffer (not first-time) cbuf) (setq first-time nil) (funcall tags-apropos-function regexp)))) (etags-tags-apropos-additional regexp)) @@ -2107,9 +2132,10 @@ for \\[find-tag] (which see)." (marks (make-hash-table :test 'equal)) (case-fold-search (if (memq tags-case-fold-search '(nil t)) tags-case-fold-search - case-fold-search))) + case-fold-search)) + (cbuf (current-buffer))) (save-excursion - (while (visit-tags-table-buffer (not first-time)) + (while (visit-tags-table-buffer (not first-time) cbuf) (setq first-time nil) (dolist (order-fun (cond (regexp? find-tag-regexp-tag-order) (t etags-xref-find-definitions-tag-order))) diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el new file mode 100644 index 0000000..a715bba --- /dev/null +++ b/test/lisp/progmodes/etags-tests.el @@ -0,0 +1,83 @@ +;;; etags-tests.el --- Test suite for etags.el. + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Eli Zaretskii + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'etags) + +(defvar his-masters-voice t) + +(defun y-or-n-p (_prompt) + "Replacement for `y-or-n-p' that returns what we tell it to." + his-masters-voice) + +(ert-deftest etags-bug-158 () + "Test finding tags with local and global tags tables." + (let ((buf-with-global-tags (get-buffer-create "*buf-global*")) + (buf-with-local-tags (get-buffer-create "*buf-local*")) + xref-buf) + (set-buffer buf-with-global-tags) + (setq default-directory (expand-file-name ".")) + (visit-tags-table "./manual/etags/ETAGS.good_1") + ;; Check that tags in ETAGS.good_1 are recognized. + (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t")) + (should (bufferp xref-buf)) + (kill-buffer xref-buf) + (setq xref-buf (xref-find-definitions "PrintAdd")) + (should (bufferp xref-buf)) + (kill-buffer xref-buf) + ;; Check that tags not in ETAGS.good_1, but in ETAGS.good_3, are + ;; NOT recognized. + (should-error (xref-find-definitions "intNumber") :type 'user-error) + (kill-buffer xref-buf) + (set-buffer buf-with-local-tags) + (setq default-directory (expand-file-name ".")) + (let (his-masters-voice) + (visit-tags-table "./manual/etags/ETAGS.good_3" t)) + ;; Check that tags in ETAGS.good_1 are recognized. + (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t")) + (should (bufferp xref-buf)) + (kill-buffer xref-buf) + (setq xref-buf (xref-find-definitions "PrintAdd")) + (should (bufferp xref-buf)) + (kill-buffer xref-buf) + ;; Check that tags in ETAGS.good_3 are recognized. This is a test + ;; for bug#158. + (setq xref-buf (xref-find-definitions "intNumber")) + (should (or (null xref-buf) + (bufferp xref-buf))) + ;; Bug #17326 + (should (string= (file-name-nondirectory + (buffer-local-value 'tags-file-name buf-with-local-tags)) + "ETAGS.good_3")) + (should (string= (file-name-nondirectory + (default-value 'tags-file-name)) + "ETAGS.good_1")) + (if (bufferp xref-buf) (kill-buffer xref-buf)))) + +(ert-deftest etags-bug-23164 () + "Test that setting a local value of tags table doesn't signal errors." + (set-buffer (get-buffer-create "*foobar*")) + (fundamental-mode) + (visit-tags-table "./manual/etags/ETAGS.good_3" t) + (should (equal (should-error (xref-find-definitions "foobar123")) + '(user-error "No definitions found for: foobar123")))) commit 7d35b3d33da641b462d22df005266225e799d27f Author: Glenn Morris Date: Thu Dec 1 06:20:43 2016 -0500 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 97a941b..406f045 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -4725,7 +4725,7 @@ editing and the result is evaluated. \(fn &optional PATTERN)" t nil) (autoload 'list-command-history "chistory" "\ -List history of commands typed to minibuffer. +List history of commands that used the minibuffer. The number of commands listed is controlled by `list-command-history-max'. Calls value of `list-command-history-filter' (if non-nil) on each history element to judge if that element should be excluded from the list. @@ -6383,7 +6383,10 @@ Expands to the most recent, preceding word for which this is a prefix. If no suitable preceding word is found, words following point are considered. If still no suitable word is found, then look in the buffers accepted by the function pointed out by variable -`dabbrev-friend-buffer-function'. +`dabbrev-friend-buffer-function', if `dabbrev-check-other-buffers' +says so. Then, if `dabbrev-check-all-buffers' is non-nil, look in +all the other buffers, subject to constraints specified +by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-regexps'. A positive prefix argument, N, says to take the Nth backward *distinct* possibility. A negative argument says search forward. @@ -8520,6 +8523,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. \\[Buffer-menu-save] -- mark that buffer to be saved. \\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted. \\[Buffer-menu-unmark] -- remove all kinds of marks from current line. +\\[Buffer-menu-unmark-all] -- remove all kinds of marks from all lines. \\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done. \\[Buffer-menu-backup-unmark] -- back up a line and remove marks. @@ -12356,7 +12360,54 @@ Copy directory-local variables to the -*- line. \(fn)" t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("modify-" "read-file-local-variable"))) +(defvar enable-connection-local-variables t "\ +Non-nil means enable use of connection-local variables.") + +(autoload 'connection-local-set-classes "files-x" "\ +Add CLASSES for remote servers. +CRITERIA is either a regular expression identifying a remote +server, or a function with one argument IDENTIFICATION, which +returns non-nil when a remote server shall apply CLASS'es +variables. If CRITERIA is nil, it always applies. +CLASSES are the names of a variable class (a symbol). + +When a connection to a remote server is opened and CRITERIA +matches to that server, the connection-local variables from CLASSES +are applied to the corresponding process buffer. The variables +for a class are defined using `connection-local-set-class-variables'. + +\(fn CRITERIA &rest CLASSES)" nil nil) + +(autoload 'connection-local-set-class-variables "files-x" "\ +Map the symbol CLASS to a list of variable settings. +VARIABLES is a list that declares connection-local variables for +the class. An element in VARIABLES is an alist whose elements +are of the form (VAR . VALUE). + +When a connection to a remote server is opened, the server's +classes are found. A server may be assigned a class using +`connection-local-set-class'. Then variables are set in the +server's process buffer according to the VARIABLES list of the +class. The list is processed in order. + +\(fn CLASS VARIABLES)" nil nil) + +(autoload 'hack-connection-local-variables-apply "files-x" "\ +Apply connection-local variables identified by `default-directory'. +Other local variables, like file-local and dir-local variables, +will not be changed. + +\(fn)" nil nil) + +(autoload 'with-connection-local-classes "files-x" "\ +Apply connection-local variables according to CLASSES in current buffer. +Execute BODY, and unwind connection local variables. + +\(fn CLASSES &rest BODY)" nil t) + +(function-put 'with-connection-local-classes 'lisp-indent-function '1) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "files-x" '("hack-connection-local-variables" "connection-local-" "modify-" "read-file-local-variable"))) ;;;*** @@ -24287,9 +24338,9 @@ any kind of error. (function-put 'pcase-let 'lisp-indent-function '1) (autoload 'pcase-dolist "pcase" "\ +Like `dolist' but where the binding can be a `pcase' pattern. - -\(fn SPEC &rest BODY)" nil t) +\(fn (PATTERN LIST) BODY...)" nil t) (function-put 'pcase-dolist 'lisp-indent-function '1) @@ -27686,7 +27737,10 @@ Start using robin package NAME, which is a string. ;;; Generated autoloads from rot13.el (autoload 'rot13 "rot13" "\ -Return ROT13 encryption of OBJECT, a buffer or string. +ROT13 encrypt OBJECT, a buffer or string. +If OBJECT is a buffer, encrypt the region between START and END. +If OBJECT is a string, encrypt it in its entirety, ignoring START +and END, and return the encrypted string. \(fn OBJECT &optional START END)" nil nil) @@ -33173,7 +33227,7 @@ TIME should be either a time value or a date-time string. \(fn TIME)" nil nil) -(define-obsolete-function-alias 'subtract-time 'time-subtract "25.2") +(define-obsolete-function-alias 'subtract-time 'time-subtract "26.1") (autoload 'date-to-day "time-date" "\ Return the number of days between year 1 and DATE. @@ -33735,21 +33789,11 @@ On W32 systems, the volume letter must be ignored.") Value for `tramp-file-name-regexp' for separate remoting. See `tramp-file-name-structure' for more explanations.") -(defconst tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) (t (error "Wrong `tramp-syntax' defined"))) "\ +(defvar tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) (t (error "Wrong `tramp-syntax' defined"))) "\ Regular expression matching file names handled by Tramp. -This regexp should match Tramp file names but no other file names. -When tramp.el is loaded, this regular expression is prepended to -`file-name-handler-alist', and that is searched sequentially. Thus, -if the Tramp entry appears rather early in the `file-name-handler-alist' -and is a bit too general, then some files might be considered Tramp -files which are not really Tramp files. - -Please note that the entry in `file-name-handler-alist' is made when -this file (tramp.el) is loaded. This means that this variable must be set -before loading tramp.el. Alternatively, `file-name-handler-alist' can be -updated after changing this variable. - -Also see `tramp-file-name-structure'.") +This regexp should match Tramp file names but no other file +names. When calling `tramp-register-file-name-handlers', the +initial value is overwritten by the car of `tramp-file-name-structure'.") (defconst tramp-completion-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/[^/]\\{2,\\}\\'" "\\`/[^/]*\\'") "\ Value for `tramp-completion-file-name-regexp' for unified remoting. @@ -35180,6 +35224,10 @@ backend of FILE. If FILE is not registered, then the first backend in `vc-handled-backends' that declares itself responsible for FILE is returned. +Note that if FILE is a symbolic link, it will not be resolved -- +the responsible backend system for the symbolic link itself will +be reported. + \(fn FILE)" nil nil) (autoload 'vc-next-action "vc" "\ @@ -37301,13 +37349,13 @@ The problems cleaned up are: If `whitespace-style' includes the value `empty', remove all empty lines at beginning and/or end of buffer. -3. 8 or more SPACEs at beginning of line. +3. `tab-width' or more SPACEs at beginning of line. If `whitespace-style' includes the value `indentation': - replace 8 or more SPACEs at beginning of line by TABs, if - `indent-tabs-mode' is non-nil; otherwise, replace TABs by + replace `tab-width' or more SPACEs at beginning of line by + TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. If `whitespace-style' includes the value `indentation::tab', - replace 8 or more SPACEs at beginning of line by TABs. + replace `tab-width' or more SPACEs at beginning of line by TABs. If `whitespace-style' includes the value `indentation::space', replace TABs by SPACEs. @@ -37324,7 +37372,7 @@ The problems cleaned up are: If `whitespace-style' includes the value `trailing', remove all SPACEs or TABs at end of line. -6. 8 or more SPACEs after TAB. +6. `tab-width' or more SPACEs after TAB. If `whitespace-style' includes the value `space-after-tab': replace SPACEs by TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. @@ -37343,13 +37391,13 @@ Cleanup some blank problems at region. The problems cleaned up are: -1. 8 or more SPACEs at beginning of line. +1. `tab-width' or more SPACEs at beginning of line. If `whitespace-style' includes the value `indentation': - replace 8 or more SPACEs at beginning of line by TABs, if - `indent-tabs-mode' is non-nil; otherwise, replace TABs by + replace `tab-width' or more SPACEs at beginning of line by TABs, + if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. If `whitespace-style' includes the value `indentation::tab', - replace 8 or more SPACEs at beginning of line by TABs. + replace `tab-width' or more SPACEs at beginning of line by TABs. If `whitespace-style' includes the value `indentation::space', replace TABs by SPACEs. @@ -37366,7 +37414,7 @@ The problems cleaned up are: If `whitespace-style' includes the value `trailing', remove all SPACEs or TABs at end of line. -4. 8 or more SPACEs after TAB. +4. `tab-width' or more SPACEs after TAB. If `whitespace-style' includes the value `space-after-tab': replace SPACEs by TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by SPACEs. @@ -37395,13 +37443,8 @@ non-nil. If FORCE is non-nil or \\[universal-argument] was pressed just before calling `whitespace-report-region' interactively, it -forces `whitespace-style' to have: - - empty - trailing - indentation - space-before-tab - space-after-tab +forces all classes of whitespace problem to be considered +significant. If REPORT-IF-BOGUS is t, it reports only when there are any whitespace problems in buffer; if it is `never', it does not @@ -37413,9 +37456,9 @@ Report if some of the following whitespace problems exist: empty 1. empty lines at beginning of buffer. empty 2. empty lines at end of buffer. trailing 3. SPACEs or TABs at end of line. - indentation 4. 8 or more SPACEs at beginning of line. + indentation 4. line starts with `tab-width' or more SPACEs. space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. + space-after-tab 6. `tab-width' or more SPACEs after TAB. * If `indent-tabs-mode' is nil: empty 1. empty lines at beginning of buffer. @@ -37423,7 +37466,7 @@ Report if some of the following whitespace problems exist: trailing 3. SPACEs or TABs at end of line. indentation 4. TABS at beginning of line. space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. + space-after-tab 6. `tab-width' or more SPACEs after TAB. See `whitespace-style' for documentation. See also `whitespace-cleanup' and `whitespace-cleanup-region' for