Now on revision 111536. ------------------------------------------------------------ revno: 111536 fixes bug: http://debbugs.gnu.org/13448 committer: Paul Eggert branch nick: trunk timestamp: Tue 2013-01-15 22:04:58 -0800 message: * configure.ac: Document that --enable-gcc-warnings emits errors. diff: === modified file 'ChangeLog' --- ChangeLog 2013-01-13 20:03:01 +0000 +++ ChangeLog 2013-01-16 06:04:58 +0000 @@ -1,3 +1,8 @@ +2013-01-16 Paul Eggert + + * configure.ac: Document that --enable-gcc-warnings emits errors. + (Bug#13448) + 2013-01-13 Glenn Morris * make-dist: Add options for xz compression and no compression. === modified file 'configure.ac' --- configure.ac 2013-01-12 05:21:06 +0000 +++ configure.ac 2013-01-16 06:04:58 +0000 @@ -627,7 +627,7 @@ AC_ARG_ENABLE([gcc-warnings], [AS_HELP_STRING([--enable-gcc-warnings], - [turn on lots of GCC warnings. This is intended for + [turn on lots of GCC warnings/errors. This is intended for developers, and may generate false alarms when used with older or non-GNU development tools.])], [case $enableval in ------------------------------------------------------------ revno: 111535 committer: Glenn Morris branch nick: trunk timestamp: Tue 2013-01-15 21:46:25 -0500 message: * lisp/gnus/smiley.el (smiley-style): Make the file loadable in batch mode. Not likely to be very useful, of course, but helps with automated testing. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-01-15 04:26:28 +0000 +++ lisp/gnus/ChangeLog 2013-01-16 02:46:25 +0000 @@ -1,3 +1,7 @@ +2013-01-16 Glenn Morris + + * smiley.el (smiley-style): Make the file loadable in batch mode. + 2013-01-15 Stefan Monnier * nnimap.el (nnimap-keepalive): Don't throw an error if there's no more === modified file 'lisp/gnus/smiley.el' --- lisp/gnus/smiley.el 2013-01-01 09:11:05 +0000 +++ lisp/gnus/smiley.el 2013-01-16 02:46:25 +0000 @@ -59,7 +59,10 @@ (defcustom smiley-style (if (or (and (fboundp 'face-attribute) - (>= (face-attribute 'default :height) 160)) + ;; In batch mode, attributes can be unspecified. + (condition-case nil + (>= (face-attribute 'default :height) 160) + (error nil))) (and (fboundp 'face-height) (>= (face-height 'default) 14))) 'medium ------------------------------------------------------------ revno: 111534 committer: Paul Eggert branch nick: trunk timestamp: Tue 2013-01-15 13:38:58 -0800 message: * src/alloc.c (free_save_value): Now static. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-15 10:14:31 +0000 +++ src/ChangeLog 2013-01-15 21:38:58 +0000 @@ -1,3 +1,7 @@ +2013-01-15 Paul Eggert + + * alloc.c (free_save_value): Now static. + 2013-01-15 Dmitry Antipov * keymap.c (map_keymap_internal): Use format_save_value. === modified file 'src/alloc.c' --- src/alloc.c 2013-01-15 09:22:25 +0000 +++ src/alloc.c 2013-01-15 21:38:58 +0000 @@ -209,6 +209,7 @@ static Lisp_Object Qpost_gc_hook; +static void free_save_value (Lisp_Object); static void mark_terminals (void); static void gc_sweep (void); static Lisp_Object make_pure_vector (ptrdiff_t); @@ -3417,7 +3418,7 @@ /* Free a Lisp_Save_Value object. Do not use this function if SAVE contains pointer other than returned by xmalloc. */ -void +static void free_save_value (Lisp_Object save) { xfree (XSAVE_POINTER (save, 0)); === modified file 'src/lisp.h' --- src/lisp.h 2013-01-15 09:22:25 +0000 +++ src/lisp.h 2013-01-15 21:38:58 +0000 @@ -3020,7 +3020,6 @@ extern ptrdiff_t inhibit_garbage_collection (void); extern Lisp_Object format_save_value (const char *, ...); extern Lisp_Object make_save_value (void *, ptrdiff_t); -extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_marker (Lisp_Object); extern void free_cons (struct Lisp_Cons *); ------------------------------------------------------------ revno: 111533 fixes bug: http://debbugs.gnu.org/13448 committer: Paul Eggert branch nick: trunk timestamp: Tue 2013-01-15 13:26:01 -0800 message: * make-docfile.c (write_globals): Make it a bit clearer. This pacifies GCC 4.7.2 when Emacs is configured with --enable-link-time-optimization and --enable-gcc-warnings. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2013-01-02 16:13:04 +0000 +++ lib-src/ChangeLog 2013-01-15 21:26:01 +0000 @@ -1,3 +1,9 @@ +2013-01-15 Paul Eggert + + * make-docfile.c (write_globals): Make it a bit clearer (Bug#13448). + This pacifies GCC 4.7.2 when Emacs is configured with + --enable-link-time-optimization and --enable-gcc-warnings. + 2013-01-01 Juanma Barranquero * makefile.w32-in (lisp1): Add macroexp.elc (bug#13320). === modified file 'lib-src/make-docfile.c' --- lib-src/make-docfile.c 2013-01-01 09:11:05 +0000 +++ lib-src/make-docfile.c 2013-01-15 21:26:01 +0000 @@ -624,7 +624,7 @@ qsort (globals, num_globals, sizeof (struct global), compare_globals); for (i = 0; i < num_globals; ++i) { - char const *type; + char const *type = 0; switch (globals[i].type) { @@ -649,7 +649,7 @@ fatal ("not a recognized DEFVAR_", 0); } - if (globals[i].type != FUNCTION) + if (type) { fprintf (outfile, " %s f_%s;\n", type, globals[i].name); fprintf (outfile, "#define %s globals.f_%s\n", ------------------------------------------------------------ revno: 111532 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2013-01-15 14:14:31 +0400 message: * keymap.c (map_keymap_internal): Use format_save_value. (map_keymap_char_table_item): Adjust accordingly. * fileio.c (non_regular_fd, non_regular_inserted) (non_regular_nbytes): Remove. (Finsert_file_contents): Convert trytry to ptrdiff_t. Use format_save_value to pass parameters to read_non_regular. (read_non_regular): Use XSAVE_ macros to extract parameters. Adjust comment. * xmenu.c (xmenu_show) [!USE_X_TOOLKIT && !USE_GTK]: Use format_save_value. (pop_down_menu) [!USE_X_TOOLKIT && !USE_GTK]: Adjust user. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-15 09:22:25 +0000 +++ src/ChangeLog 2013-01-15 10:14:31 +0000 @@ -1,5 +1,19 @@ 2013-01-15 Dmitry Antipov + * keymap.c (map_keymap_internal): Use format_save_value. + (map_keymap_char_table_item): Adjust accordingly. + * fileio.c (non_regular_fd, non_regular_inserted) + (non_regular_nbytes): Remove. + (Finsert_file_contents): Convert trytry to ptrdiff_t. Use + format_save_value to pass parameters to read_non_regular. + (read_non_regular): Use XSAVE_ macros to extract parameters. + Adjust comment. + * xmenu.c (xmenu_show) [!USE_X_TOOLKIT && !USE_GTK]: Use + format_save_value. + (pop_down_menu) [!USE_X_TOOLKIT && !USE_GTK]: Adjust user. + +2013-01-15 Dmitry Antipov + * lisp.h (XSAVE_POINTER, XSAVE_INTEGER): Change to allow extraction from any Lisp_Save_Value slot. Add type checking. * alloc.c, dired.c, editfns.c, fileio.c, ftfont.c, gtkutil.c: === modified file 'src/fileio.c' --- src/fileio.c 2013-01-15 09:22:25 +0000 +++ src/fileio.c 2013-01-15 10:14:31 +0000 @@ -3408,30 +3408,22 @@ return Qnil; } - -/* Used to pass values from insert-file-contents to read_non_regular. */ - -static int non_regular_fd; -static ptrdiff_t non_regular_inserted; -static int non_regular_nbytes; - - -/* Read from a non-regular file. - Read non_regular_nbytes bytes max from non_regular_fd. - Non_regular_inserted specifies where to put the read bytes. - Value is the number of bytes read. */ +/* Read from a non-regular file. STATE is a Lisp_Save_Value + object where slot 0 is the file descriptor, slot 1 specifies + an offset to put the read bytes, and slot 2 is the maximum + amount of bytes to read. Value is the number of bytes read. */ static Lisp_Object -read_non_regular (Lisp_Object ignore) +read_non_regular (Lisp_Object state) { int nbytes; immediate_quit = 1; QUIT; - nbytes = emacs_read (non_regular_fd, + nbytes = emacs_read (XSAVE_INTEGER (state, 0), ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE - + non_regular_inserted), - non_regular_nbytes); + + XSAVE_INTEGER (state, 1)), + XSAVE_INTEGER (state, 2)); immediate_quit = 0; return make_number (nbytes); } @@ -4238,7 +4230,7 @@ while (how_much < total) { /* try is reserved in some compilers (Microsoft C) */ - int trytry = min (total - how_much, READ_BUF_SIZE); + ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE); ptrdiff_t this; if (not_regular) @@ -4255,12 +4247,11 @@ /* Read from the file, capturing `quit'. When an error occurs, end the loop, and arrange for a quit to be signaled after decoding the text we read. */ - non_regular_fd = fd; - non_regular_inserted = inserted; - non_regular_nbytes = trytry; - nbytes = internal_condition_case_1 (read_non_regular, - Qnil, Qerror, - read_non_regular_quit); + nbytes = internal_condition_case_1 + (read_non_regular, + format_save_value ("iii", (ptrdiff_t) fd, inserted, trytry), + Qerror, read_non_regular_quit); + if (NILP (nbytes)) { read_quit = 1; === modified file 'src/keymap.c' --- src/keymap.c 2013-01-15 09:22:25 +0000 +++ src/keymap.c 2013-01-15 10:14:31 +0000 @@ -565,14 +565,13 @@ { if (!NILP (val)) { - map_keymap_function_t fun = XSAVE_POINTER (XCAR (args), 0); - args = XCDR (args); + map_keymap_function_t fun = XSAVE_POINTER (args, 0); /* If the key is a range, make a copy since map_char_table modifies it in place. */ if (CONSP (key)) key = Fcons (XCAR (key), XCDR (key)); - map_keymap_item (fun, XCDR (args), key, val, - XSAVE_POINTER (XCAR (args), 0)); + map_keymap_item (fun, XSAVE_OBJECT (args, 2), key, + val, XSAVE_POINTER (args, 1)); } } @@ -610,12 +609,8 @@ } } else if (CHAR_TABLE_P (binding)) - { - map_char_table (map_keymap_char_table_item, Qnil, binding, - Fcons (make_save_value ((void *) fun, 0), - Fcons (make_save_value (data, 0), - args))); - } + map_char_table (map_keymap_char_table_item, Qnil, binding, + format_save_value ("ppo", fun, data, args)); } UNGCPRO; return tail; === modified file 'src/xmenu.c' --- src/xmenu.c 2013-01-15 09:22:25 +0000 +++ src/xmenu.c 2013-01-15 10:14:31 +0000 @@ -2236,8 +2236,8 @@ static Lisp_Object pop_down_menu (Lisp_Object arg) { - FRAME_PTR f = XSAVE_POINTER (Fcar (arg), 0); - XMenu *menu = XSAVE_POINTER (Fcdr (arg), 0); + FRAME_PTR f = XSAVE_POINTER (arg, 0); + XMenu *menu = XSAVE_POINTER (arg, 1); block_input (); #ifndef MSDOS @@ -2479,8 +2479,7 @@ #endif record_unwind_protect (pop_down_menu, - Fcons (make_save_value (f, 0), - make_save_value (menu, 0))); + format_save_value ("pp", f, menu)); /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ ------------------------------------------------------------ revno: 111531 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2013-01-15 13:22:25 +0400 message: * src/lisp.h (XSAVE_POINTER, XSAVE_INTEGER): Change to allow extraction from any Lisp_Save_Value slot. Add type checking. * src/alloc.c, src/dired.c, src/editfns.c, src/fileio.c, src/ftfont.c: * src/gtkutil.c, src/keymap.c, src/lread.c, src/nsterm.h, src/nsmenu.c: * src/xfns.c, src/xmenu.c, src/xselect.c: All users changed. * admin/coccinelle/xsave.cocci: Semantic patch to adjust users of XSAVE_POINTER and XSAVE_INTEGER macros. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2013-01-10 03:43:02 +0000 +++ admin/ChangeLog 2013-01-15 09:22:25 +0000 @@ -1,3 +1,8 @@ +2013-01-15 Dmitry Antipov + + * coccinelle/xsave.cocci: Semantic patch to adjust users of + XSAVE_POINTER and XSAVE_INTEGER macros. + 2013-01-03 Glenn Morris * check-doc-strings: Update for CVS->bzr, moved lispref/ directory. === added file 'admin/coccinelle/xsave.cocci' --- admin/coccinelle/xsave.cocci 1970-01-01 00:00:00 +0000 +++ admin/coccinelle/xsave.cocci 2013-01-15 09:22:25 +0000 @@ -0,0 +1,11 @@ +// Adjust users of XSAVE_POINTER and XSAVE_INTEGER. +@@ +expression E; +@@ +( +- XSAVE_POINTER (E) ++ XSAVE_POINTER (E, 0) +| +- XSAVE_INTEGER (E) ++ XSAVE_INTEGER (E, 1) +) === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-15 08:38:07 +0000 +++ src/ChangeLog 2013-01-15 09:22:25 +0000 @@ -1,5 +1,13 @@ 2013-01-15 Dmitry Antipov + * lisp.h (XSAVE_POINTER, XSAVE_INTEGER): Change to allow + extraction from any Lisp_Save_Value slot. Add type checking. + * alloc.c, dired.c, editfns.c, fileio.c, ftfont.c, gtkutil.c: + * keymap.c, lread.c, nsterm.h, nsmenu.c, xfns.c, xmenu.c: + * xselect.c: All users changed. + +2013-01-15 Dmitry Antipov + Some convenient bits to deal with Lisp_Save_Values. * lisp.h (XSAVE_OBJECT): New macro to extract saved objects. (allocate_misc): Remove prototype. === modified file 'src/alloc.c' --- src/alloc.c 2013-01-15 08:38:07 +0000 +++ src/alloc.c 2013-01-15 09:22:25 +0000 @@ -3420,7 +3420,7 @@ void free_save_value (Lisp_Object save) { - xfree (XSAVE_POINTER (save)); + xfree (XSAVE_POINTER (save, 0)); free_misc (save); } === modified file 'src/dired.c' --- src/dired.c 2013-01-14 17:46:14 +0000 +++ src/dired.c 2013-01-15 09:22:25 +0000 @@ -78,7 +78,7 @@ static Lisp_Object directory_files_internal_unwind (Lisp_Object dh) { - DIR *d = XSAVE_POINTER (dh); + DIR *d = XSAVE_POINTER (dh, 0); block_input (); closedir (d); unblock_input (); === modified file 'src/editfns.c' --- src/editfns.c 2013-01-15 08:38:07 +0000 +++ src/editfns.c 2013-01-15 09:22:25 +0000 @@ -4254,7 +4254,7 @@ memcpy (buf, initial_buffer, used); } else - XSAVE_POINTER (buf_save_value) = buf = xrealloc (buf, bufsize); + XSAVE_POINTER (buf_save_value, 0) = buf = xrealloc (buf, bufsize); p = buf + used; } === modified file 'src/fileio.c' --- src/fileio.c 2013-01-14 17:46:14 +0000 +++ src/fileio.c 2013-01-15 09:22:25 +0000 @@ -5507,7 +5507,7 @@ do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */ { - FILE *stream = XSAVE_POINTER (arg); + FILE *stream = XSAVE_POINTER (arg, 0); auto_saving = 0; if (stream != NULL) { === modified file 'src/font.c' --- src/font.c 2013-01-14 09:55:21 +0000 +++ src/font.c 2013-01-15 09:22:25 +0000 @@ -1857,7 +1857,7 @@ OTF *otf; if (! NILP (val)) - otf = XSAVE_POINTER (XCDR (val)); + otf = XSAVE_POINTER (XCDR (val), 0); else { otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; === modified file 'src/ftfont.c' --- src/ftfont.c 2013-01-14 09:55:21 +0000 +++ src/ftfont.c 2013-01-15 09:22:25 +0000 @@ -400,7 +400,7 @@ else { val = XCDR (cache); - cache_data = XSAVE_POINTER (val); + cache_data = XSAVE_POINTER (val, 0); } if (cache_for == FTFONT_CACHE_FOR_ENTITY) @@ -466,7 +466,7 @@ cache = ftfont_lookup_cache (entity, FTFONT_CACHE_FOR_CHARSET); val = XCDR (cache); - cache_data = XSAVE_POINTER (val); + cache_data = XSAVE_POINTER (val, 0); return cache_data->fc_charset; } @@ -1198,9 +1198,9 @@ filename = XCAR (val); idx = XCDR (val); val = XCDR (cache); - cache_data = XSAVE_POINTER (XCDR (cache)); + cache_data = XSAVE_POINTER (XCDR (cache), 0); ft_face = cache_data->ft_face; - if (XSAVE_INTEGER (val) > 0) + if (XSAVE_INTEGER (val, 1) > 0) { /* FT_Face in this cache is already used by the different size. */ if (FT_New_Size (ft_face, &ft_size) != 0) @@ -1211,13 +1211,13 @@ return Qnil; } } - XSAVE_INTEGER (val)++; + XSAVE_INTEGER (val, 1)++; size = XINT (AREF (entity, FONT_SIZE_INDEX)); if (size == 0) size = pixel_size; if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) { - if (XSAVE_INTEGER (val) == 0) + if (XSAVE_INTEGER (val, 1) == 0) FT_Done_Face (ft_face); return Qnil; } @@ -1326,10 +1326,10 @@ cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE); eassert (CONSP (cache)); val = XCDR (cache); - (XSAVE_INTEGER (val))--; - if (XSAVE_INTEGER (val) == 0) + XSAVE_INTEGER (val, 1)--; + if (XSAVE_INTEGER (val, 1) == 0) { - struct ftfont_cache_data *cache_data = XSAVE_POINTER (val); + struct ftfont_cache_data *cache_data = XSAVE_POINTER (val, 0); FT_Done_Face (cache_data->ft_face); #ifdef HAVE_LIBOTF === modified file 'src/gtkutil.c' --- src/gtkutil.c 2013-01-14 17:46:14 +0000 +++ src/gtkutil.c 2013-01-15 09:22:25 +0000 @@ -1650,7 +1650,7 @@ static Lisp_Object pop_down_dialog (Lisp_Object arg) { - struct xg_dialog_data *dd = XSAVE_POINTER (arg); + struct xg_dialog_data *dd = XSAVE_POINTER (arg, 0); block_input (); if (dd->w) gtk_widget_destroy (dd->w); === modified file 'src/keymap.c' --- src/keymap.c 2013-01-14 17:46:14 +0000 +++ src/keymap.c 2013-01-15 09:22:25 +0000 @@ -565,14 +565,14 @@ { if (!NILP (val)) { - map_keymap_function_t fun = XSAVE_POINTER (XCAR (args)); + map_keymap_function_t fun = XSAVE_POINTER (XCAR (args), 0); args = XCDR (args); /* If the key is a range, make a copy since map_char_table modifies it in place. */ if (CONSP (key)) key = Fcons (XCAR (key), XCDR (key)); map_keymap_item (fun, XCDR (args), key, val, - XSAVE_POINTER (XCAR (args))); + XSAVE_POINTER (XCAR (args), 0)); } } === modified file 'src/lisp.h' --- src/lisp.h 2013-01-15 08:38:07 +0000 +++ src/lisp.h 2013-01-15 09:22:25 +0000 @@ -1413,15 +1413,21 @@ } data[4]; }; -/* Compatibility macro to set and extract saved pointer. */ +/* Macro to set and extract Nth saved pointer. Type + checking is ugly because it's used as an lvalue. */ -#define XSAVE_POINTER(obj) XSAVE_VALUE (obj)->data[0].pointer +#define XSAVE_POINTER(obj, n) \ + XSAVE_VALUE (obj)->data[(eassert (XSAVE_VALUE (obj)->type \ + ## n == SAVE_POINTER), n)].pointer /* Likewise for the saved integer. */ -#define XSAVE_INTEGER(obj) XSAVE_VALUE (obj)->data[1].integer +#define XSAVE_INTEGER(obj, n) \ + XSAVE_VALUE (obj)->data[(eassert (XSAVE_VALUE (obj)->type \ + ## n == SAVE_INTEGER), n)].integer -/* Macro to extract Nth saved object. */ +/* Macro to extract Nth saved object. This is never used as + an lvalue, so we can do more convenient type checking. */ #define XSAVE_OBJECT(obj, n) \ (eassert (XSAVE_VALUE (obj)->type ## n == SAVE_OBJECT), \ === modified file 'src/lread.c' --- src/lread.c 2013-01-14 17:46:14 +0000 +++ src/lread.c 2013-01-15 09:22:25 +0000 @@ -1357,7 +1357,7 @@ static Lisp_Object load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */ { - FILE *stream = XSAVE_POINTER (arg); + FILE *stream = XSAVE_POINTER (arg, 0); if (stream != NULL) { block_input (); === modified file 'src/nsmenu.m' --- src/nsmenu.m 2013-01-14 17:46:14 +0000 +++ src/nsmenu.m 2013-01-15 09:22:25 +0000 @@ -1347,7 +1347,7 @@ static Lisp_Object pop_down_menu (Lisp_Object arg) { - struct Popdown_data *unwind_data = XSAVE_POINTER (arg); + struct Popdown_data *unwind_data = XSAVE_POINTER (arg, 0); block_input (); if (popup_activated_flag) === modified file 'src/nsterm.h' --- src/nsterm.h 2013-01-14 09:55:21 +0000 +++ src/nsterm.h 2013-01-15 09:22:25 +0000 @@ -675,9 +675,9 @@ #define FRAME_FONT(f) ((f)->output_data.ns->font) #ifdef __OBJC__ -#define XNS_SCROLL_BAR(vec) ((id) XSAVE_POINTER (vec)) +#define XNS_SCROLL_BAR(vec) ((id) XSAVE_POINTER (vec, 0)) #else -#define XNS_SCROLL_BAR(vec) XSAVE_POINTER (vec) +#define XNS_SCROLL_BAR(vec) XSAVE_POINTER (vec, 0) #endif /* Compute pixel size for vertical scroll bars */ === modified file 'src/xfns.c' --- src/xfns.c 2013-01-14 17:46:14 +0000 +++ src/xfns.c 2013-01-15 09:22:25 +0000 @@ -5292,7 +5292,7 @@ static Lisp_Object clean_up_file_dialog (Lisp_Object arg) { - Widget dialog = XSAVE_POINTER (arg); + Widget dialog = XSAVE_POINTER (arg, 0); /* Clean up. */ block_input (); === modified file 'src/xmenu.c' --- src/xmenu.c 2013-01-14 17:46:14 +0000 +++ src/xmenu.c 2013-01-15 09:22:25 +0000 @@ -1413,7 +1413,7 @@ { popup_activated_flag = 0; block_input (); - gtk_widget_destroy (GTK_WIDGET (XSAVE_POINTER (arg))); + gtk_widget_destroy (GTK_WIDGET (XSAVE_POINTER (arg, 0))); unblock_input (); return Qnil; } @@ -1610,7 +1610,7 @@ static Lisp_Object cleanup_widget_value_tree (Lisp_Object arg) { - free_menubar_widget_value_tree (XSAVE_POINTER (arg)); + free_menubar_widget_value_tree (XSAVE_POINTER (arg, 0)); return Qnil; } @@ -2236,8 +2236,8 @@ static Lisp_Object pop_down_menu (Lisp_Object arg) { - FRAME_PTR f = XSAVE_POINTER (Fcar (arg)); - XMenu *menu = XSAVE_POINTER (Fcdr (arg)); + FRAME_PTR f = XSAVE_POINTER (Fcar (arg), 0); + XMenu *menu = XSAVE_POINTER (Fcdr (arg), 0); block_input (); #ifndef MSDOS === modified file 'src/xselect.c' --- src/xselect.c 2013-01-14 09:55:21 +0000 +++ src/xselect.c 2013-01-15 09:22:25 +0000 @@ -1120,7 +1120,7 @@ static Lisp_Object wait_for_property_change_unwind (Lisp_Object loc) { - struct prop_location *location = XSAVE_POINTER (loc); + struct prop_location *location = XSAVE_POINTER (loc, 0); unexpect_property_change (location); if (location == property_change_reply_object) ------------------------------------------------------------ revno: 111530 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2013-01-15 12:38:07 +0400 message: Some convenient bits to deal with Lisp_Save_Values. * lisp.h (XSAVE_OBJECT): New macro to extract saved objects. (allocate_misc): Remove prototype. (format_save_value): New prototype. * alloc.c (allocate_misc): Revert back to static. (format_save_value): New function to build Lisp_Save_Value object with the specified internal structure. (make_save_value): Reimplement using format_save_value. * editfns.c (save_excursion_save): Use format_save_value. (save_excursion_restore): Use XSAVE_OBJECT. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-01-14 17:46:14 +0000 +++ src/ChangeLog 2013-01-15 08:38:07 +0000 @@ -1,3 +1,16 @@ +2013-01-15 Dmitry Antipov + + Some convenient bits to deal with Lisp_Save_Values. + * lisp.h (XSAVE_OBJECT): New macro to extract saved objects. + (allocate_misc): Remove prototype. + (format_save_value): New prototype. + * alloc.c (allocate_misc): Revert back to static. + (format_save_value): New function to build Lisp_Save_Value + object with the specified internal structure. + (make_save_value): Reimplement using format_save_value. + * editfns.c (save_excursion_save): Use format_save_value. + (save_excursion_restore): Use XSAVE_OBJECT. + 2013-01-14 Paul Eggert Avoid needless casts with XSAVE_POINTER. === modified file 'src/alloc.c' --- src/alloc.c 2013-01-14 17:46:14 +0000 +++ src/alloc.c 2013-01-15 08:38:07 +0000 @@ -3302,7 +3302,7 @@ /* Return a newly allocated Lisp_Misc object of specified TYPE. */ -Lisp_Object +static Lisp_Object allocate_misc (enum Lisp_Misc_Type type) { Lisp_Object val; @@ -3350,6 +3350,59 @@ total_free_markers++; } +/* Return a Lisp_Save_Value object with the data saved according to + FMT. Format specifiers are `i' for an integer, `p' for a pointer + and `o' for Lisp_Object. Up to 4 objects can be specified. */ + +Lisp_Object +format_save_value (const char *fmt, ...) +{ + va_list ap; + int len = strlen (fmt); + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + + eassert (0 < len && len < 5); + va_start (ap, fmt); + +#define INITX(index) \ + do { \ + if (len <= index) \ + p->type ## index = SAVE_UNUSED; \ + else \ + { \ + if (fmt[index] == 'i') \ + { \ + p->type ## index = SAVE_INTEGER; \ + p->data[index].integer = va_arg (ap, ptrdiff_t); \ + } \ + else if (fmt[index] == 'p') \ + { \ + p->type ## index = SAVE_POINTER; \ + p->data[index].pointer = va_arg (ap, void *); \ + } \ + else if (fmt[index] == 'o') \ + { \ + p->type ## index = SAVE_OBJECT; \ + p->data[index].object = va_arg (ap, Lisp_Object); \ + } \ + else \ + emacs_abort (); \ + } \ + } while (0) + + INITX (0); + INITX (1); + INITX (2); + INITX (3); + +#undef INITX + + va_end (ap); + p->area = 0; + return val; +} + /* Return a Lisp_Save_Value object containing POINTER and INTEGER. Most code should use this to package C integers and pointers to call record_unwind_protect. The unwind function can get the @@ -3358,18 +3411,7 @@ Lisp_Object make_save_value (void *pointer, ptrdiff_t integer) { - register Lisp_Object val; - register struct Lisp_Save_Value *p; - - val = allocate_misc (Lisp_Misc_Save_Value); - p = XSAVE_VALUE (val); - p->type0 = SAVE_POINTER; - p->data[0].pointer = pointer; - p->type1 = SAVE_INTEGER; - p->data[1].integer = integer; - p->type2 = p->type3 = SAVE_UNUSED; - p->area = 0; - return val; + return format_save_value ("pi", pointer, integer); } /* Free a Lisp_Save_Value object. Do not use this function === modified file 'src/editfns.c' --- src/editfns.c 2013-01-14 09:55:21 +0000 +++ src/editfns.c 2013-01-15 08:38:07 +0000 @@ -833,31 +833,17 @@ Lisp_Object save_excursion_save (void) { - Lisp_Object save = allocate_misc (Lisp_Misc_Save_Value); - register struct Lisp_Save_Value *v = XSAVE_VALUE (save); - - /* Do not allocate extra space and pack everything in SAVE. */ - v->area = 0; - - v->type0 = SAVE_OBJECT; - v->data[0].object = Fpoint_marker (); - - /* Do not copy the mark if it points to nowhere. */ - v->type1 = SAVE_OBJECT; - v->data[1].object = (XMARKER (BVAR (current_buffer, mark))->buffer - ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) - : Qnil); - - /* Selected window if current buffer is shown in it, nil otherwise. */ - v->type2 = SAVE_OBJECT; - v->data[2].object - = ((XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) - ? selected_window : Qnil); - - v->type3 = SAVE_OBJECT; - v->data[3].object = BVAR (current_buffer, mark_active); - - return save; + return format_save_value + ("oooo", + Fpoint_marker (), + /* Do not copy the mark if it points to nowhere. */ + (XMARKER (BVAR (current_buffer, mark))->buffer + ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) + : Qnil), + /* Selected window if current buffer is shown in it, nil otherwise. */ + ((XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) + ? selected_window : Qnil), + BVAR (current_buffer, mark_active)); } /* Restore saved buffer before leaving `save-excursion' special form. */ @@ -867,13 +853,8 @@ { Lisp_Object tem, tem1, omark, nmark; struct gcpro gcpro1, gcpro2, gcpro3; - register struct Lisp_Save_Value *v = XSAVE_VALUE (info); - - /* Paranoid. */ - eassert (v->type0 == SAVE_OBJECT && v->type1 == SAVE_OBJECT - && v->type2 == SAVE_OBJECT && v->type3 == SAVE_OBJECT); - - tem = Fmarker_buffer (v->data[0].object); + + tem = Fmarker_buffer (XSAVE_OBJECT (info, 0)); /* If we're unwinding to top level, saved buffer may be deleted. This means that all of its markers are unchained and so tem is nil. */ if (NILP (tem)) @@ -885,12 +866,12 @@ Fset_buffer (tem); /* Point marker. */ - tem = v->data[0].object; + tem = XSAVE_OBJECT (info, 0); Fgoto_char (tem); unchain_marker (XMARKER (tem)); /* Mark marker. */ - tem = v->data[1].object; + tem = XSAVE_OBJECT (info, 1); omark = Fmarker_position (BVAR (current_buffer, mark)); if (NILP (tem)) unchain_marker (XMARKER (BVAR (current_buffer, mark))); @@ -902,7 +883,7 @@ } /* Mark active. */ - tem = v->data[3].object; + tem = XSAVE_OBJECT (info, 3); tem1 = BVAR (current_buffer, mark_active); bset_mark_active (current_buffer, tem); @@ -926,7 +907,7 @@ /* If buffer was visible in a window, and a different window was selected, and the old selected window is still showing this buffer, restore point in that window. */ - tem = v->data[2].object; + tem = XSAVE_OBJECT (info, 2); if (WINDOWP (tem) && !EQ (tem, selected_window) && (tem1 = XWINDOW (tem)->buffer, === modified file 'src/lisp.h' --- src/lisp.h 2013-01-14 11:16:14 +0000 +++ src/lisp.h 2013-01-15 08:38:07 +0000 @@ -1421,6 +1421,12 @@ #define XSAVE_INTEGER(obj) XSAVE_VALUE (obj)->data[1].integer +/* Macro to extract Nth saved object. */ + +#define XSAVE_OBJECT(obj, n) \ + (eassert (XSAVE_VALUE (obj)->type ## n == SAVE_OBJECT), \ + XSAVE_VALUE (obj)->data[n].object) + /* A miscellaneous object, when it's on the free list. */ struct Lisp_Free { @@ -2921,7 +2927,6 @@ /* Defined in alloc.c. */ extern void check_pure_size (void); -extern Lisp_Object allocate_misc (enum Lisp_Misc_Type); extern void free_misc (Lisp_Object); extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void malloc_warning (const char *); @@ -3007,6 +3012,7 @@ extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); +extern Lisp_Object format_save_value (const char *, ...); extern Lisp_Object make_save_value (void *, ptrdiff_t); extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); ------------------------------------------------------------ revno: 111529 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-01-15 01:05:22 -0500 message: * lisp/emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to the use of nadvice.el. * lisp/emacs-lisp/nadvice.el (advice--tweak): Make it possible for `tweak' to return an explicit nil. (advice--remove-function): Change accordingly. * test/automated/advice-tests.el: Split up. Add advice-test-preactivate. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-01-15 04:20:13 +0000 +++ lisp/ChangeLog 2013-01-15 06:05:22 +0000 @@ -1,5 +1,12 @@ 2013-01-15 Stefan Monnier + * emacs-lisp/nadvice.el (advice--tweak): Make it possible for `tweak' + to return an explicit nil. + (advice--remove-function): Change accordingly. + + * emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to + the use of nadvice.el. + * progmodes/which-func.el (which-function): Silence imenu errors (bug#13433). === modified file 'lisp/emacs-lisp/advice.el' --- lisp/emacs-lisp/advice.el 2013-01-08 15:24:56 +0000 +++ lisp/emacs-lisp/advice.el 2013-01-15 06:05:22 +0000 @@ -2866,10 +2866,8 @@ (defun ad-preactivate-advice (function advice class position) "Preactivate FUNCTION and returns the constructed cache." - (let* ((function-defined-p (fboundp function)) - (old-definition - (if function-defined-p - (symbol-function function))) + (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname)) + (old-advice (symbol-function advicefunname)) (old-advice-info (ad-copy-advice-info function)) (ad-advised-functions ad-advised-functions)) (unwind-protect @@ -2883,10 +2881,9 @@ (list (ad-get-cache-definition function) (ad-get-cache-id function)))) (ad-set-advice-info function old-advice-info) - ;; Don't `fset' function to nil if it was previously unbound: - (if function-defined-p - (fset function old-definition) - (fmakunbound function))))) + (advice-remove function advicefunname) + (fset advicefunname old-advice) + (if old-advice (advice-add function :around advicefunname))))) ;; @@ Activation and definition handling: === modified file 'lisp/emacs-lisp/nadvice.el' --- lisp/emacs-lisp/nadvice.el 2013-01-08 15:24:56 +0000 +++ lisp/emacs-lisp/nadvice.el 2013-01-15 06:05:22 +0000 @@ -173,20 +173,21 @@ (let ((first (advice--car flist)) (rest (advice--cdr flist)) (props (advice--props flist))) - (or (funcall tweaker first rest props) + (let ((val (funcall tweaker first rest props))) + (if val (car val) (let ((nrest (advice--tweak rest tweaker))) (if (eq rest nrest) flist (advice--make-1 (aref flist 1) (aref flist 3) - first nrest props))))))) + first nrest props)))))))) ;;;###autoload (defun advice--remove-function (flist function) (advice--tweak flist (lambda (first rest props) - (if (or (not first) - (equal function first) + (cond ((not first) rest) + ((or (equal function first) (equal function (cdr (assq 'name props)))) - rest)))) + (list rest)))))) (defvar advice--buffer-local-function-sample nil) === modified file 'test/ChangeLog' --- test/ChangeLog 2013-01-14 01:08:13 +0000 +++ test/ChangeLog 2013-01-15 06:05:22 +0000 @@ -1,3 +1,7 @@ +2013-01-15 Stefan Monnier + + * automated/advice-tests.el: Split up. Add advice-test-preactivate. + 2013-01-14 Glenn Morris * automated/compile-tests.el (compile-tests--test-regexps-data): === modified file 'test/automated/advice-tests.el' --- test/automated/advice-tests.el 2013-01-07 18:03:01 +0000 +++ test/automated/advice-tests.el 2013-01-15 06:05:22 +0000 @@ -21,99 +21,112 @@ ;;; Code: -(ert-deftest advice-tests () +(ert-deftest advice-tests-nadvice () + "Test nadvice code." + (defun sm-test1 (x) (+ x 4)) + (should (equal (sm-test1 6) 10)) + (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test1 6) 50)) + (defun sm-test1 (x) (+ x 14)) + (should (equal (sm-test1 6) 100)) + (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) + (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test1 6) 20)) + (should (equal (get 'sm-test1 'defalias-fset-function) nil)) + + (advice-add 'sm-test3 :around + (lambda (f &rest args) `(toto ,(apply f args))) + '((name . wrap-with-toto))) + (defmacro sm-test3 (x) `(call-test3 ,x)) + (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56))))) + +(ert-deftest advice-tests-advice () "Test advice code." - (with-temp-buffer - (defun sm-test1 (x) (+ x 4)) - (should (equal (sm-test1 6) 10)) - (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) - (should (equal (sm-test1 6) 50)) - (defun sm-test1 (x) (+ x 14)) - (should (equal (sm-test1 6) 100)) - (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) - (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) - (should (equal (sm-test1 6) 20)) - (should (equal (null (get 'sm-test1 'defalias-fset-function)) t)) - - (defun sm-test2 (x) (+ x 4)) - (should (equal (sm-test2 6) 10)) - (defadvice sm-test2 (around sm-test activate) - ad-do-it (setq ad-return-value (* ad-return-value 5))) - (should (equal (sm-test2 6) 50)) - (ad-deactivate 'sm-test2) - (should (equal (sm-test2 6) 10)) - (ad-activate 'sm-test2) - (should (equal (sm-test2 6) 50)) - (defun sm-test2 (x) (+ x 14)) - (should (equal (sm-test2 6) 100)) - (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) - (ad-remove-advice 'sm-test2 'around 'sm-test) - (should (equal (sm-test2 6) 100)) - (ad-activate 'sm-test2) - (should (equal (sm-test2 6) 20)) - (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) - - (advice-add 'sm-test3 :around - (lambda (f &rest args) `(toto ,(apply f args))) - '((name . wrap-with-toto))) - (defmacro sm-test3 (x) `(call-test3 ,x)) - (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))) - - (defadvice sm-test4 (around wrap-with-toto activate) - ad-do-it (setq ad-return-value `(toto ,ad-return-value))) - (defmacro sm-test4 (x) `(call-test4 ,x)) - (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) - (defmacro sm-test4 (x) `(call-testq ,x)) - (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) - - ;; Combining old style and new style advices. - (defun sm-test5 (x) (+ x 4)) - (should (equal (sm-test5 6) 10)) - (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) - (should (equal (sm-test5 6) 50)) - (defadvice sm-test5 (around test activate) - ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) - (should (equal (sm-test5 5) 45.1)) - (ad-deactivate 'sm-test5) - (should (equal (sm-test5 6) 50)) - (ad-activate 'sm-test5) - (should (equal (sm-test5 6) 50.1)) - (defun sm-test5 (x) (+ x 14)) - (should (equal (sm-test5 6) 100.1)) - (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) - (should (equal (sm-test5 6) 20.1)) - - ;; This used to signal an error (bug#12858). - (autoload 'sm-test6 "foo") - (defadvice sm-test6 (around test activate) - ad-do-it) - - ;; Check interaction between advice and called-interactively-p. - (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) - (advice-add 'sm-test7 :around - (lambda (f &rest args) - (list (cons 1 (called-interactively-p)) (apply f args)))) - (should (equal (sm-test7) '((1 . nil) 11))) - (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) - (let ((smi 7)) - (advice-add 'sm-test7 :before - (lambda (&rest args) - (setq smi (called-interactively-p)))) - (should (equal (list (sm-test7) smi) - '(((1 . nil) 11) nil))) - (should (equal (list (call-interactively 'sm-test7) smi) - '(((1 . t) 11) t)))) - (advice-add 'sm-test7 :around - (lambda (f &rest args) - (cons (cons 2 (called-interactively-p)) (apply f args)))) - (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))) - - ;; Check handling of interactive spec. - (defun sm-test8 (a) (interactive "p") a) - (defadvice sm-test8 (before adv1 activate) nil) - (defadvice sm-test8 (before adv2 activate) (interactive "P") nil) - (should (equal (interactive-form 'sm-test8) '(interactive "P"))) - )) + (defun sm-test2 (x) (+ x 4)) + (should (equal (sm-test2 6) 10)) + (defadvice sm-test2 (around sm-test activate) + ad-do-it (setq ad-return-value (* ad-return-value 5))) + (should (equal (sm-test2 6) 50)) + (ad-deactivate 'sm-test2) + (should (equal (sm-test2 6) 10)) + (ad-activate 'sm-test2) + (should (equal (sm-test2 6) 50)) + (defun sm-test2 (x) (+ x 14)) + (should (equal (sm-test2 6) 100)) + (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) + (ad-remove-advice 'sm-test2 'around 'sm-test) + (should (equal (sm-test2 6) 100)) + (ad-activate 'sm-test2) + (should (equal (sm-test2 6) 20)) + (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) + + (defadvice sm-test4 (around wrap-with-toto activate) + ad-do-it (setq ad-return-value `(toto ,ad-return-value))) + (defmacro sm-test4 (x) `(call-test4 ,x)) + (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) + (defmacro sm-test4 (x) `(call-testq ,x)) + (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) + + ;; This used to signal an error (bug#12858). + (autoload 'sm-test6 "foo") + (defadvice sm-test6 (around test activate) + ad-do-it)) + +(ert-deftest advice-tests-combination () + "Combining old style and new style advices." + (defun sm-test5 (x) (+ x 4)) + (should (equal (sm-test5 6) 10)) + (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test5 6) 50)) + (defadvice sm-test5 (around test activate) + ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) + (should (equal (sm-test5 5) 45.1)) + (ad-deactivate 'sm-test5) + (should (equal (sm-test5 6) 50)) + (ad-activate 'sm-test5) + (should (equal (sm-test5 6) 50.1)) + (defun sm-test5 (x) (+ x 14)) + (should (equal (sm-test5 6) 100.1)) + (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) + (should (equal (sm-test5 6) 20.1))) + +(ert-deftest advice-test-called-interactively-p () + "Check interaction between advice and called-interactively-p." + (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) + (advice-add 'sm-test7 :around + (lambda (f &rest args) + (list (cons 1 (called-interactively-p)) (apply f args)))) + (should (equal (sm-test7) '((1 . nil) 11))) + (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) + (let ((smi 7)) + (advice-add 'sm-test7 :before + (lambda (&rest args) + (setq smi (called-interactively-p)))) + (should (equal (list (sm-test7) smi) + '(((1 . nil) 11) nil))) + (should (equal (list (call-interactively 'sm-test7) smi) + '(((1 . t) 11) t)))) + (advice-add 'sm-test7 :around + (lambda (f &rest args) + (cons (cons 2 (called-interactively-p)) (apply f args)))) + (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11)))) + +(ert-deftest advice-test-interactive () + "Check handling of interactive spec." + (defun sm-test8 (a) (interactive "p") a) + (defadvice sm-test8 (before adv1 activate) nil) + (defadvice sm-test8 (before adv2 activate) (interactive "P") nil) + (should (equal (interactive-form 'sm-test8) '(interactive "P")))) + +(ert-deftest advice-test-preactivate () + (should (equal (null (get 'sm-test9 'defalias-fset-function)) t)) + (defun sm-test9 (a) (interactive "p") a) + (should (equal (null (get 'sm-test9 'defalias-fset-function)) t)) + (defadvice sm-test9 (before adv1 pre act protect compile) nil) + (should (equal (null (get 'sm-test9 'defalias-fset-function)) nil)) + (defadvice sm-test9 (before adv2 pre act protect compile) + (interactive "P") nil) + (should (equal (interactive-form 'sm-test9) '(interactive "P")))) ;; Local Variables: ;; no-byte-compile: t