Now on revision 113211. ------------------------------------------------------------ revno: 113211 committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-06-27 22:48:53 -0700 message: * image.c (x_from_xcolors): Remove unused local. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-28 02:44:19 +0000 +++ src/ChangeLog 2013-06-28 05:48:53 +0000 @@ -1,3 +1,7 @@ +2013-06-28 Paul Eggert + + * image.c (x_from_xcolors): Remove unused local. + 2013-06-28 YAMAMOTO Mitsuharu Defer image data transfer between X client and server until actual === modified file 'src/image.c' --- src/image.c 2013-06-28 03:41:37 +0000 +++ src/image.c 2013-06-28 05:48:53 +0000 @@ -4657,7 +4657,6 @@ { int x, y; XImagePtr oimg = NULL; - Pixmap pixmap; XColor *p; init_color_table (); ------------------------------------------------------------ revno: 113210 committer: YAMAMOTO Mitsuharu branch nick: trunk timestamp: Fri 2013-06-28 12:41:37 +0900 message: Fix W32-specific part of last change. diff: === modified file 'src/image.c' --- src/image.c 2013-06-28 02:37:23 +0000 +++ src/image.c 2013-06-28 03:41:37 +0000 @@ -2181,10 +2181,13 @@ release_frame_dc (f, frame_dc); *prev = SelectObject (ximg, !mask_p ? img->pixmap : img->mask); + + return ximg; } -static void image_unget_x_image_or_dc (struct frame *img, bool mask_p, - XImagePtr_or_DC ximg, HGDIOBJ prev) +static void +image_unget_x_image_or_dc (struct image *img, bool mask_p, + XImagePtr_or_DC ximg, HGDIOBJ prev) { SelectObject (ximg, prev); DeleteDC (ximg); ------------------------------------------------------------ revno: 113209 committer: YAMAMOTO Mitsuharu branch nick: trunk timestamp: Fri 2013-06-28 11:44:19 +0900 message: Fix typo in ChangeLog for last commit. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-28 02:37:23 +0000 +++ src/ChangeLog 2013-06-28 02:44:19 +0000 @@ -14,7 +14,7 @@ macros for `flags' arg to x_clear_image_1. (postprocess_image, xpm_load_image, x_build_heuristic_mask) (png_load_body): Use x_clear_image_1 instead of Free_Pixmap. - (NO_PIXMAP, XGetImage) [HAVE_NS]: Remove. + (ZPixmap, XGetImage) [HAVE_NS]: Remove. (image_get_x_image_or_dc, image_unget_x_image_or_dc) (image_get_x_image, image_unget_x_image): New functions or macros. (image_background, image_background_transparent, x_to_xcolors) ------------------------------------------------------------ revno: 113208 committer: YAMAMOTO Mitsuharu branch nick: trunk timestamp: Fri 2013-06-28 11:37:23 +0900 message: Defer image data transfer between X client and server until actual display happens. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-27 14:47:52 +0000 +++ src/ChangeLog 2013-06-28 02:37:23 +0000 @@ -1,3 +1,39 @@ +2013-06-28 YAMAMOTO Mitsuharu + + Defer image data transfer between X client and server until actual + display happens. + + * dispextern.h (struct image) [HAVE_X_WINDOWS]: New members `ximg' + and `mask_img'. + + * image.c (Destroy_Image): Remove. + (x_clear_image_1): New arg `flags' instead of 3 bools `pixmap_p', + `mask_p', and `colors_p'. All uses changed. + (x_clear_image_1) [HAVE_X_WINDOWS]: Destroy `ximg' and `mask_img'. + (CLEAR_IMAGE_PIXMAP, CLEAR_IMAGE_MASK, CLEAR_IMAGE_COLORS): New + macros for `flags' arg to x_clear_image_1. + (postprocess_image, xpm_load_image, x_build_heuristic_mask) + (png_load_body): Use x_clear_image_1 instead of Free_Pixmap. + (NO_PIXMAP, XGetImage) [HAVE_NS]: Remove. + (image_get_x_image_or_dc, image_unget_x_image_or_dc) + (image_get_x_image, image_unget_x_image): New functions or macros. + (image_background, image_background_transparent, x_to_xcolors) + (x_build_heuristic_mask): Use image_get_x_image_or_dc instead of + XGetImage or CreateCompatibleDC. Use image_unget_x_image_or_dc + instead of Destroy_Image. + (image_create_x_image_and_pixmap, image_put_x_image): New functions. + (xpm_load_image, x_from_xcolors, x_build_heuristic_mask, pbm_load) + (png_load_body, jpeg_load_body, tiff_load, gif_load) + (imagemagick_load_image, svg_load_image): Use them instead of + x_create_x_image_and_pixmap, and x_put_x_image followed by + x_destroy_x_image, respectively. + (xpm_load) [HAVE_XPM && !HAVE_NTGUI]: Use XpmReadFileToImage and + XpmCreateImageFromBuffer instead of XpmReadFileToPixmap and + XpmCreatePixmapFromBuffer. Create pixmaps. Fill background and + background_transparent fields. + (image_sync_to_pixmaps) [HAVE_X_WINDOWS]: New function. + (prepare_image_for_display, x_disable_image) [HAVE_X_WINDOWS]: Use it. + 2013-06-27 Paul Eggert Do not tickle glib SIGCHLD handling if Cygwin (Bug#14569). === modified file 'src/dispextern.h' --- src/dispextern.h 2013-06-17 06:03:19 +0000 +++ src/dispextern.h 2013-06-28 02:37:23 +0000 @@ -2870,6 +2870,14 @@ /* Pixmaps of the image. */ Pixmap pixmap, mask; +#ifdef HAVE_X_WINDOWS + /* X images of the image, corresponding to the above Pixmaps. + Non-NULL means it and its Pixmap counterpart may be out of sync + and the latter is outdated. NULL means the X image has been + synchronized to Pixmap. */ + XImagePtr ximg, mask_img; +#endif + /* Colors allocated for this image, if any. Allocated via xmalloc. */ unsigned long *colors; int ncolors; === modified file 'src/image.c' --- src/image.c 2013-06-23 19:24:27 +0000 +++ src/image.c 2013-06-28 02:37:23 +0000 @@ -106,8 +106,6 @@ #define GET_PIXEL(ximg, x, y) XGetPixel (ximg, x, y) #define NO_PIXMAP 0 -#define ZPixmap 0 - #define PIX_MASK_RETAIN 0 #define PIX_MASK_DRAW 1 @@ -146,16 +144,6 @@ data more than once will not be caught. */ #ifdef HAVE_NS -XImagePtr -XGetImage (Display *display, Pixmap pixmap, int x, int y, - unsigned int width, unsigned int height, - unsigned long plane_mask, int format) -{ - /* TODO: not sure what this function is supposed to do.. */ - ns_retain_object (pixmap); - return pixmap; -} - /* Use with images created by ns_image_for_XPM. */ unsigned long XGetPixel (XImagePtr ximage, int x, int y) @@ -435,8 +423,24 @@ XImagePtr *, Pixmap *); static void x_destroy_x_image (XImagePtr ximg); +#ifdef HAVE_NTGUI +static XImagePtr_or_DC image_get_x_image_or_dc (struct frame *, struct image *, + bool, HGDIOBJ *); +static void image_unget_x_image_or_dc (struct image *, bool, XImagePtr_or_DC, + HGDIOBJ); +#else +static XImagePtr image_get_x_image (struct frame *, struct image *, bool); +static void image_unget_x_image (struct image *, bool, XImagePtr); +#define image_get_x_image_or_dc(f, img, mask_p, dummy) \ + image_get_x_image (f, img, mask_p) +#define image_unget_x_image_or_dc(img, mask_p, ximg, dummy) \ + image_unget_x_image (img, mask_p, ximg) +#endif + #ifdef HAVE_X_WINDOWS +static void image_sync_to_pixmaps (struct frame *, struct image *); + /* Useful functions defined in the section `Image type independent image structures' below. */ @@ -1050,6 +1054,14 @@ if (img->pixmap == NO_PIXMAP && !img->load_failed_p) img->load_failed_p = ! img->type->load (f, img); +#ifdef HAVE_X_WINDOWS + if (!img->load_failed_p) + { + block_input (); + image_sync_to_pixmaps (f, img); + unblock_input (); + } +#endif } @@ -1145,25 +1157,16 @@ #ifdef HAVE_NTGUI -#define Destroy_Image(img_dc, prev) \ - do { SelectObject (img_dc, prev); DeleteDC (img_dc); } while (0) - #define Free_Pixmap(display, pixmap) \ DeleteObject (pixmap) #elif defined (HAVE_NS) -#define Destroy_Image(ximg, dummy) \ - ns_release_object (ximg) - #define Free_Pixmap(display, pixmap) \ ns_release_object (pixmap) #else -#define Destroy_Image(ximg, dummy) \ - XDestroyImage (ximg) - #define Free_Pixmap(display, pixmap) \ XFreePixmap (display, pixmap) @@ -1187,22 +1190,12 @@ #endif /* HAVE_NTGUI */ if (free_ximg) - { -#ifndef HAVE_NTGUI - ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap, - 0, 0, img->width, img->height, ~0, ZPixmap); -#else - HDC frame_dc = get_frame_dc (f); - ximg = CreateCompatibleDC (frame_dc); - release_frame_dc (f, frame_dc); - prev = SelectObject (ximg, img->pixmap); -#endif /* !HAVE_NTGUI */ - } + ximg = image_get_x_image_or_dc (f, img, 0, &prev); img->background = four_corners_best (ximg, img->corners, img->width, img->height); if (free_ximg) - Destroy_Image (ximg, prev); + image_unget_x_image_or_dc (img, 0, ximg, prev); img->background_valid = 1; } @@ -1228,23 +1221,13 @@ #endif /* HAVE_NTGUI */ if (free_mask) - { -#ifndef HAVE_NTGUI - mask = XGetImage (FRAME_X_DISPLAY (f), img->mask, - 0, 0, img->width, img->height, ~0, ZPixmap); -#else - HDC frame_dc = get_frame_dc (f); - mask = CreateCompatibleDC (frame_dc); - release_frame_dc (f, frame_dc); - prev = SelectObject (mask, img->mask); -#endif /* HAVE_NTGUI */ - } + mask = image_get_x_image_or_dc (f, img, 1, &prev); img->background_transparent = (four_corners_best (mask, img->corners, img->width, img->height) == PIX_MASK_RETAIN); if (free_mask) - Destroy_Image (mask, prev); + image_unget_x_image_or_dc (img, 1, mask, prev); } else img->background_transparent = 0; @@ -1260,30 +1243,58 @@ Helper functions for X image types ***********************************************************************/ -/* Clear X resources of image IMG on frame F. PIXMAP_P means free the - pixmap if any. MASK_P means clear the mask pixmap if any. - COLORS_P means free colors allocated for the image, if any. */ +/* Clear X resources of image IMG on frame F according to FLAGS. + FLAGS is bitwise-or of the following masks: + CLEAR_IMAGE_PIXMAP free the pixmap if any. + CLEAR_IMAGE_MASK means clear the mask pixmap if any. + CLEAR_IMAGE_COLORS means free colors allocated for the image, if + any. */ + +#define CLEAR_IMAGE_PIXMAP (1 << 0) +#define CLEAR_IMAGE_MASK (1 << 1) +#define CLEAR_IMAGE_COLORS (1 << 2) static void -x_clear_image_1 (struct frame *f, struct image *img, bool pixmap_p, - bool mask_p, bool colors_p) +x_clear_image_1 (struct frame *f, struct image *img, int flags) { - if (pixmap_p && img->pixmap) - { - Free_Pixmap (FRAME_X_DISPLAY (f), img->pixmap); - img->pixmap = NO_PIXMAP; - /* NOTE (HAVE_NS): background color is NOT an indexed color! */ - img->background_valid = 0; - } - - if (mask_p && img->mask) - { - Free_Pixmap (FRAME_X_DISPLAY (f), img->mask); - img->mask = NO_PIXMAP; - img->background_transparent_valid = 0; - } - - if (colors_p && img->ncolors) + if (flags & CLEAR_IMAGE_PIXMAP) + { + if (img->pixmap) + { + Free_Pixmap (FRAME_X_DISPLAY (f), img->pixmap); + img->pixmap = NO_PIXMAP; + /* NOTE (HAVE_NS): background color is NOT an indexed color! */ + img->background_valid = 0; + } +#ifdef HAVE_X_WINDOWS + if (img->ximg) + { + x_destroy_x_image (img->ximg); + img->ximg = NULL; + img->background_valid = 0; + } +#endif + } + + if (flags & CLEAR_IMAGE_MASK) + { + if (img->mask) + { + Free_Pixmap (FRAME_X_DISPLAY (f), img->mask); + img->mask = NO_PIXMAP; + img->background_transparent_valid = 0; + } +#ifdef HAVE_X_WINDOWS + if (img->mask_img) + { + x_destroy_x_image (img->mask_img); + img->mask_img = NULL; + img->background_transparent_valid = 0; + } +#endif + } + + if ((flags & CLEAR_IMAGE_COLORS) && img->ncolors) { /* W32_TODO: color table support. */ #ifdef HAVE_X_WINDOWS @@ -1302,7 +1313,8 @@ x_clear_image (struct frame *f, struct image *img) { block_input (); - x_clear_image_1 (f, img, 1, 1, 1); + x_clear_image_1 (f, img, + CLEAR_IMAGE_PIXMAP | CLEAR_IMAGE_MASK | CLEAR_IMAGE_COLORS); unblock_input (); } @@ -1633,10 +1645,7 @@ x_build_heuristic_mask (f, img, XCDR (mask)); } else if (NILP (mask) && found_p && img->mask) - { - Free_Pixmap (FRAME_X_DISPLAY (f), img->mask); - img->mask = NO_PIXMAP; - } + x_clear_image_1 (f, img, CLEAR_IMAGE_MASK); } @@ -2094,6 +2103,130 @@ #endif } +/* Thin wrapper for x_create_x_image_and_pixmap, so that it matches + with image_put_x_image. */ + +static bool +image_create_x_image_and_pixmap (struct frame *f, struct image *img, + int width, int height, int depth, + XImagePtr *ximg, bool mask_p) +{ + eassert ((!mask_p ? img->pixmap : img->mask) == NO_PIXMAP); + + return x_create_x_image_and_pixmap (f, width, height, depth, ximg, + !mask_p ? &img->pixmap : &img->mask); +} + +/* Put X image XIMG into image IMG on frame F, as a mask if and only + if MASK_P. On X, this simply records XIMG on a member of IMG, so + it can be put into the pixmap afterwards via image_sync_to_pixmaps. + On the other platforms, it puts XIMG into the pixmap, then frees + the X image and its buffer. */ + +static void +image_put_x_image (struct frame *f, struct image *img, XImagePtr ximg, + bool mask_p) +{ +#ifdef HAVE_X_WINDOWS + if (!mask_p) + { + eassert (img->ximg == NULL); + img->ximg = ximg; + } + else + { + eassert (img->mask_img == NULL); + img->mask_img = ximg; + } +#else + x_put_x_image (f, ximg, !mask_p ? img->pixmap : img->mask, + img->width, img->height); + x_destroy_x_image (ximg); +#endif +} + +#ifdef HAVE_X_WINDOWS +/* Put the X images recorded in IMG on frame F into pixmaps, then free + the X images and their buffers. */ + +static void +image_sync_to_pixmaps (struct frame *f, struct image *img) +{ + if (img->ximg) + { + x_put_x_image (f, img->ximg, img->pixmap, img->width, img->height); + x_destroy_x_image (img->ximg); + img->ximg = NULL; + } + if (img->mask_img) + { + x_put_x_image (f, img->mask_img, img->mask, img->width, img->height); + x_destroy_x_image (img->mask_img); + img->mask_img = NULL; + } +} +#endif + +#ifdef HAVE_NTGUI +/* Create a memory device context for IMG on frame F. It stores the + currently selected GDI object into *PREV for future restoration by + image_unget_x_image_or_dc. */ + +static XImagePtr_or_DC +image_get_x_image_or_dc (struct frame *f, struct image *img, bool mask_p, + HGDIOBJ *prev) +{ + HDC frame_dc = get_frame_dc (f); + XImagePtr_or_DC ximg = CreateCompatibleDC (frame_dc); + + release_frame_dc (f, frame_dc); + *prev = SelectObject (ximg, !mask_p ? img->pixmap : img->mask); +} + +static void image_unget_x_image_or_dc (struct frame *img, bool mask_p, + XImagePtr_or_DC ximg, HGDIOBJ prev) +{ + SelectObject (ximg, prev); + DeleteDC (ximg); +} +#else /* !HAVE_NTGUI */ +/* Get the X image for IMG on frame F. The resulting X image data + should be treated as read-only at least on X. */ + +static XImagePtr +image_get_x_image (struct frame *f, struct image *img, bool mask_p) +{ +#ifdef HAVE_X_WINDOWS + XImagePtr ximg_in_img = !mask_p ? img->ximg : img->mask_img; + + if (ximg_in_img) + return ximg_in_img; + else + return XGetImage (FRAME_X_DISPLAY (f), !mask_p ? img->pixmap : img->mask, + 0, 0, img->width, img->height, ~0, ZPixmap); +#elif defined (HAVE_NS) + XImagePtr pixmap = !mask_p ? img->pixmap : img->mask; + + ns_retain_object (pixmap); + return pixmap; +#endif +} + +static void image_unget_x_image (struct image *img, bool mask_p, XImagePtr ximg) +{ +#ifdef HAVE_X_WINDOWS + XImagePtr ximg_in_img = !mask_p ? img->ximg : img->mask_img; + + if (ximg_in_img) + eassert (ximg == ximg_in_img); + else + XDestroyImage (ximg); +#elif defined (HAVE_NS) + ns_release_object (ximg); +#endif +} +#endif /* !HAVE_NTGUI */ + /*********************************************************************** File Handling @@ -3461,9 +3594,9 @@ &xpm_image, &xpm_mask, &attrs); #else - rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - SSDATA (file), &img->pixmap, &img->mask, - &attrs); + rc = XpmReadFileToImage (FRAME_X_DISPLAY (f), SSDATA (file), + &img->ximg, &img->mask_img, + &attrs); #endif /* HAVE_NTGUI */ } else @@ -3484,13 +3617,38 @@ &xpm_image, &xpm_mask, &attrs); #else - rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - SSDATA (buffer), - &img->pixmap, &img->mask, - &attrs); + rc = XpmCreateImageFromBuffer (FRAME_X_DISPLAY (f), SSDATA (buffer), + &img->ximg, &img->mask_img, + &attrs); #endif /* HAVE_NTGUI */ } +#ifdef HAVE_X_WINDOWS + if (rc == XpmSuccess) + { + img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + img->ximg->width, img->ximg->height, + img->ximg->depth); + if (img->pixmap == NO_PIXMAP) + { + x_clear_image (f, img); + rc = XpmNoMemory; + } + else if (img->mask_img) + { + img->mask = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + img->mask_img->width, + img->mask_img->height, + img->mask_img->depth); + if (img->mask == NO_PIXMAP) + { + x_clear_image (f, img); + rc = XpmNoMemory; + } + } + } +#endif + if (rc == XpmSuccess) { #if defined (COLOR_TABLE_SUPPORT) && defined (ALLOC_XPM_COLORS) @@ -3549,6 +3707,15 @@ #else XpmFreeAttributes (&attrs); #endif /* HAVE_NTGUI */ + +#ifdef HAVE_X_WINDOWS + /* Maybe fill in the background field while we have ximg handy. */ + IMAGE_BACKGROUND (img, f, img->ximg); + if (img->mask_img) + /* Fill in the background_transparent field while we have the + mask handy. */ + image_background_transparent (img, f, img->mask_img); +#endif } else { @@ -3847,11 +4014,10 @@ goto failure; } - if (!x_create_x_image_and_pixmap (f, width, height, 0, - &ximg, &img->pixmap) + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0) #ifndef HAVE_NS - || !x_create_x_image_and_pixmap (f, width, height, 1, - &mask_img, &img->mask) + || !image_create_x_image_and_pixmap (f, img, width, height, 1, + &mask_img, 1) #endif ) { @@ -3986,8 +4152,7 @@ if (NILP (image_spec_value (img->spec, QCbackground, NULL))) IMAGE_BACKGROUND (img, f, ximg); - x_put_x_image (f, ximg, img->pixmap, width, height); - x_destroy_x_image (ximg); + image_put_x_image (f, img, ximg, 0); #ifndef HAVE_NS if (have_mask) { @@ -3995,14 +4160,12 @@ mask handy. */ image_background_transparent (img, f, mask_img); - x_put_x_image (f, mask_img, img->mask, width, height); - x_destroy_x_image (mask_img); + image_put_x_image (f, img, mask_img, 1); } else { x_destroy_x_image (mask_img); - Free_Pixmap (FRAME_X_DISPLAY (f), img->mask); - img->mask = NO_PIXMAP; + x_clear_image_1 (f, img, CLEAR_IMAGE_MASK); } #endif return 1; @@ -4400,17 +4563,8 @@ memory_full (SIZE_MAX); colors = xmalloc (sizeof *colors * img->width * img->height); -#ifndef HAVE_NTGUI - /* Get the X image IMG->pixmap. */ - ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap, - 0, 0, img->width, img->height, ~0, ZPixmap); -#else - /* Load the image into a memory device context. */ - hdc = get_frame_dc (f); - ximg = CreateCompatibleDC (hdc); - release_frame_dc (f, hdc); - prev = SelectObject (ximg, img->pixmap); -#endif /* HAVE_NTGUI */ + /* Get the X image or create a memory device context for IMG. */ + ximg = image_get_x_image_or_dc (f, img, 0, &prev); /* Fill the `pixel' members of the XColor array. I wished there were an easy and portable way to circumvent XGetPixel. */ @@ -4440,7 +4594,7 @@ #endif /* HAVE_X_WINDOWS */ } - Destroy_Image (ximg, prev); + image_unget_x_image_or_dc (img, 0, ximg, prev); return colors; } @@ -4505,8 +4659,9 @@ init_color_table (); - x_create_x_image_and_pixmap (f, img->width, img->height, 0, - &oimg, &pixmap); + x_clear_image_1 (f, img, CLEAR_IMAGE_PIXMAP | CLEAR_IMAGE_COLORS); + image_create_x_image_and_pixmap (f, img, img->width, img->height, 0, + &oimg, 0); p = colors; for (y = 0; y < img->height; ++y) for (x = 0; x < img->width; ++x, ++p) @@ -4517,11 +4672,8 @@ } xfree (colors); - x_clear_image_1 (f, img, 1, 0, 1); - x_put_x_image (f, oimg, pixmap, img->width, img->height); - x_destroy_x_image (oimg); - img->pixmap = pixmap; + image_put_x_image (f, img, oimg, 0); #ifdef COLOR_TABLE_SUPPORT img->colors = colors_in_color_table (&img->ncolors); free_color_table (); @@ -4706,7 +4858,10 @@ #define MaskForeground(f) WHITE_PIX_DEFAULT (f) Display *dpy = FRAME_X_DISPLAY (f); - GC gc = XCreateGC (dpy, img->pixmap, 0, NULL); + GC gc; + + image_sync_to_pixmaps (f, img); + gc = XCreateGC (dpy, img->pixmap, 0, NULL); XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f)); XDrawLine (dpy, img->pixmap, gc, 0, 0, img->width - 1, img->height - 1); @@ -4781,37 +4936,25 @@ unsigned long bg = 0; if (img->mask) - { - Free_Pixmap (FRAME_X_DISPLAY (f), img->mask); - img->mask = NO_PIXMAP; - img->background_transparent_valid = 0; - } + x_clear_image_1 (f, img, CLEAR_IMAGE_MASK); #ifndef HAVE_NTGUI #ifndef HAVE_NS /* Create an image and pixmap serving as mask. */ - rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1, - &mask_img, &img->mask); + rc = image_create_x_image_and_pixmap (f, img, img->width, img->height, 1, + &mask_img, 1); if (!rc) return; #endif /* !HAVE_NS */ - - /* Get the X image of IMG->pixmap. */ - ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap, 0, 0, - img->width, img->height, - ~0, ZPixmap); #else /* Create the bit array serving as mask. */ row_width = (img->width + 7) / 8; mask_img = xzalloc (row_width * img->height); - - /* Create a memory device context for IMG->pixmap. */ - frame_dc = get_frame_dc (f); - ximg = CreateCompatibleDC (frame_dc); - release_frame_dc (f, frame_dc); - prev = SelectObject (ximg, img->pixmap); #endif /* HAVE_NTGUI */ + /* Get the X image or create a memory device context for IMG. */ + ximg = image_get_x_image_or_dc (f, img, 0, &prev); + /* Determine the background color of ximg. If HOW is `(R G B)' take that as color. Otherwise, use the image's background color. */ use_img_background = 1; @@ -4858,9 +5001,8 @@ /* Fill in the background_transparent field while we have the mask handy. */ image_background_transparent (img, f, mask_img); - /* Put mask_img into img->mask. */ - x_put_x_image (f, mask_img, img->mask, img->width, img->height); - x_destroy_x_image (mask_img); + /* Put mask_img into the image. */ + image_put_x_image (f, img, mask_img, 1); #endif /* !HAVE_NS */ #else for (y = 0; y < img->height; ++y) @@ -4882,7 +5024,7 @@ xfree (mask_img); #endif /* HAVE_NTGUI */ - Destroy_Image (ximg, prev); + image_unget_x_image_or_dc (img, 0, ximg, prev); } @@ -5110,8 +5252,7 @@ goto error; } - if (!x_create_x_image_and_pixmap (f, width, height, 0, - &ximg, &img->pixmap)) + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) goto error; /* Initialize the color hash table. */ @@ -5248,9 +5389,8 @@ /* Casting avoids a GCC warning. */ IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); - /* Put the image into a pixmap. */ - x_put_x_image (f, ximg, img->pixmap, width, height); - x_destroy_x_image (ximg); + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); /* X and W32 versions did it here, MAC version above. ++kfs img->width = width; @@ -5688,8 +5828,7 @@ /* Create the X image and pixmap now, so that the work below can be omitted if the image is too large for X. */ - if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, - &img->pixmap)) + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) goto error; /* If image contains simply transparency data, we prefer to @@ -5801,12 +5940,11 @@ contains an alpha channel. */ if (channels == 4 && !transparent_p - && !x_create_x_image_and_pixmap (f, width, height, 1, - &mask_img, &img->mask)) + && !image_create_x_image_and_pixmap (f, img, width, height, 1, + &mask_img, 1)) { x_destroy_x_image (ximg); - Free_Pixmap (FRAME_X_DISPLAY (f), img->pixmap); - img->pixmap = NO_PIXMAP; + x_clear_image_1 (f, img, CLEAR_IMAGE_PIXMAP); goto error; } @@ -5880,9 +6018,8 @@ Casting avoids a GCC warning. */ IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); - /* Put the image into the pixmap, then free the X image and its buffer. */ - x_put_x_image (f, ximg, img->pixmap, width, height); - x_destroy_x_image (ximg); + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); /* Same for the mask. */ if (mask_img) @@ -5891,8 +6028,7 @@ mask handy. Casting avoids a GCC warning. */ image_background_transparent (img, f, (XImagePtr_or_DC)mask_img); - x_put_x_image (f, mask_img, img->mask, img->width, img->height); - x_destroy_x_image (mask_img); + image_put_x_image (f, img, mask_img, 1); } return 1; @@ -6429,7 +6565,7 @@ } /* Create X image and pixmap. */ - if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap)) + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) { mgr->failure_code = MY_JPEG_CANNOT_CREATE_X; sys_longjmp (mgr->setjmp_buffer, 1); @@ -6496,9 +6632,8 @@ /* Casting avoids a GCC warning. */ IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); - /* Put the image into the pixmap. */ - x_put_x_image (f, ximg, img->pixmap, width, height); - x_destroy_x_image (ximg); + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); return 1; } @@ -6895,8 +7030,8 @@ /* Create the X image and pixmap. */ if (! (height <= min (PTRDIFF_MAX, SIZE_MAX) / sizeof *buf / width - && x_create_x_image_and_pixmap (f, width, height, 0, - &ximg, &img->pixmap))) + && image_create_x_image_and_pixmap (f, img, width, height, 0, + &ximg, 0))) { fn_TIFFClose (tiff); return 0; @@ -6955,9 +7090,8 @@ /* Casting avoids a GCC warning on W32. */ IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); - /* Put the image into the pixmap, then free the X image and its buffer. */ - x_put_x_image (f, ximg, img->pixmap, width, height); - x_destroy_x_image (ximg); + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); xfree (buf); return 1; @@ -7285,7 +7419,7 @@ } /* Create the X image and pixmap. */ - if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap)) + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) { fn_DGifCloseFile (gif); return 0; @@ -7469,9 +7603,8 @@ /* Casting avoids a GCC warning. */ IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); - /* Put the image into the pixmap, then free the X image and its buffer. */ - x_put_x_image (f, ximg, img->pixmap, width, height); - x_destroy_x_image (ximg); + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); return 1; } @@ -7909,8 +8042,8 @@ int imagedepth = 24; /*MagickGetImageDepth(image_wand);*/ const char *exportdepth = imagedepth <= 8 ? "I" : "BGRP"; /*"RGBP";*/ /* Try to create a x pixmap to hold the imagemagick pixmap. */ - if (!x_create_x_image_and_pixmap (f, width, height, imagedepth, - &ximg, &img->pixmap)) + if (!image_create_x_image_and_pixmap (f, img, width, height, imagedepth, + &ximg, 0)) { #ifdef COLOR_TABLE_SUPPORT free_color_table (); @@ -7948,8 +8081,8 @@ size_t image_height; /* Try to create a x pixmap to hold the imagemagick pixmap. */ - if (!x_create_x_image_and_pixmap (f, width, height, 0, - &ximg, &img->pixmap)) + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, + &ximg, 0)) { #ifdef COLOR_TABLE_SUPPORT free_color_table (); @@ -8003,10 +8136,8 @@ img->width = width; img->height = height; - /* Put the image into the pixmap, then free the X image and its - buffer. */ - x_put_x_image (f, ximg, img->pixmap, width, height); - x_destroy_x_image (ximg); + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); /* Final cleanup. image_wand should be the only resource left. */ DestroyMagickWand (image_wand); @@ -8400,7 +8531,7 @@ eassert (fn_gdk_pixbuf_get_bits_per_sample (pixbuf) == 8); /* Try to create a x pixmap to hold the svg pixmap. */ - if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap)) + if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) { fn_g_object_unref (pixbuf); return 0; @@ -8475,10 +8606,8 @@ Casting avoids a GCC warning. */ IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg); - /* Put the image into the pixmap, then free the X image and its - buffer. */ - x_put_x_image (f, ximg, img->pixmap, width, height); - x_destroy_x_image (ximg); + /* Put ximg into the image. */ + image_put_x_image (f, img, ximg, 0); return 1; ------------------------------------------------------------ revno: 113207 committer: Glenn Morris branch nick: trunk timestamp: Thu 2013-06-27 09:14:05 -0700 message: Add Copyright header, standardize license notice diff: === modified file 'test/automated/package-test.el' --- test/automated/package-test.el 2013-06-27 09:26:54 +0000 +++ test/automated/package-test.el 2013-06-27 16:14:05 +0000 @@ -1,14 +1,16 @@ ;;; package-test.el --- Tests for the Emacs package system +;; Copyright (C) 2013 Free Software Foundation, Inc. + ;; Author: Daniel Hackney ;; Version: 1.0 ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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, or (at your option) -;; any later version. +;; 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 @@ -16,9 +18,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: === modified file 'test/automated/package-x-test.el' --- test/automated/package-x-test.el 2013-06-27 09:51:55 +0000 +++ test/automated/package-x-test.el 2013-06-27 16:14:05 +0000 @@ -1,14 +1,16 @@ ;;; package-test.el --- Tests for the Emacs package system +;; Copyright (C) 2013 Free Software Foundation, Inc. + ;; Author: Daniel Hackney ;; Version: 1.0 ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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, or (at your option) -;; any later version. +;; 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 @@ -16,9 +18,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ------------------------------------------------------------ revno: 113206 committer: Paul Eggert branch nick: trunk timestamp: Thu 2013-06-27 07:47:52 -0700 message: Do not tickle glib SIGCHLD handling if Cygwin. This mostly consists of undoing recent changes. * callproc.c (Fcall_process): * process.c (create_process): Do not worry about catching SIGCHLD here, undoing previous change. * nsterm.m (ns_term_init): Re-catch SIGCHLD, undoing previous change. * process.c, process.h (catch_child_signal): No longer extern if !NS_IMPL_GNUSTEP, undoing 06-22 change. * process.c (catch_child_handler): Don't worry about being called lazily and do not assume caller has blocked SIGCHLD, undoing previous change. Move first-time stuff back to init_process_emacs, undoing 06-22 change. If CYGWIN, do not tickle glib, as that causes Cygwin bootstrap to fail. Do not set lib_child_handler if it's already initialized, which may help avoid problems on GNUStep. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-06-24 00:31:31 +0000 +++ src/ChangeLog 2013-06-27 14:47:52 +0000 @@ -1,3 +1,21 @@ +2013-06-27 Paul Eggert + + Do not tickle glib SIGCHLD handling if Cygwin (Bug#14569). + This mostly consists of undoing recent changes. + * callproc.c (Fcall_process): + * process.c (create_process): + Do not worry about catching SIGCHLD here, undoing previous change. + * nsterm.m (ns_term_init): Re-catch SIGCHLD, undoing previous change. + * process.c, process.h (catch_child_signal): + No longer extern if !NS_IMPL_GNUSTEP, undoing 06-22 change. + * process.c (catch_child_handler): Don't worry about being called + lazily and do not assume caller has blocked SIGCHLD, undoing + previous change. Move first-time stuff back to + init_process_emacs, undoing 06-22 change. If CYGWIN, do not + tickle glib, as that causes Cygwin bootstrap to fail. Do not + set lib_child_handler if it's already initialized, which may + help avoid problems on GNUStep. + 2013-06-23 Paul Eggert A more-conservative workaround for Cygwin SIGCHLD issues (Bug#14569). === modified file 'src/callproc.c' --- src/callproc.c 2013-06-24 00:31:31 +0000 +++ src/callproc.c 2013-06-27 14:47:52 +0000 @@ -613,7 +613,6 @@ block_input (); block_child_signal (); - catch_child_signal (); #ifdef WINDOWSNT pid = child_setup (filefd, fd1, fd_error, new_argv, 0, current_dir); === modified file 'src/nsterm.m' --- src/nsterm.m 2013-06-24 00:31:31 +0000 +++ src/nsterm.m 2013-06-27 14:47:52 +0000 @@ -4360,6 +4360,12 @@ [NSApp run]; ns_do_open_file = YES; + +#ifdef NS_IMPL_GNUSTEP + /* GNUstep steals SIGCHLD for use in NSTask, but we don't use NSTask. + We must re-catch it so subprocess works. */ + catch_child_signal (); +#endif return dpyinfo; } === modified file 'src/process.c' --- src/process.c 2013-06-24 00:31:31 +0000 +++ src/process.c 2013-06-27 14:47:52 +0000 @@ -1685,7 +1685,6 @@ block_input (); block_child_signal (); - catch_child_signal (); #ifndef WINDOWSNT /* vfork, and prevent local vars from being clobbered by the vfork. */ @@ -7061,48 +7060,24 @@ futz with the SIGCHLD handler, but before Emacs forks any children. This function's caller should block SIGCHLD. */ +#ifndef NS_IMPL_GNUSTEP +static +#endif void catch_child_signal (void) { struct sigaction action, old_action; - -#if !defined CANNOT_DUMP - if (noninteractive && !initialized) - return; -#endif - -#ifndef NS_IMPL_GNUSTEP - if (lib_child_handler) - return; -#endif - -#if defined HAVE_GLIB && !defined WINDOWSNT - /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself; - this should always fail, but is enough to initialize glib's - private SIGCHLD handler, allowing the code below to copy it into - LIB_CHILD_HANDLER. - - Do this here, rather than early in Emacs initialization where it - might make more sense, to try to avoid bugs in Cygwin glib (Bug#14569). */ - { - GSource *source = g_child_watch_source_new (getpid ()); - g_source_unref (source); - } -#endif - emacs_sigaction_init (&action, deliver_child_signal); + block_child_signal (); sigaction (SIGCHLD, &action, &old_action); eassert (! (old_action.sa_flags & SA_SIGINFO)); -#ifdef NS_IMPL_GNUSTEP - if (old_action.sa_handler == deliver_child_signal) - return; -#endif - - lib_child_handler - = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN - ? dummy_handler - : old_action.sa_handler); + if (old_action.sa_handler != deliver_child_signal) + lib_child_handler + = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN + ? dummy_handler + : old_action.sa_handler); + unblock_child_signal (); } @@ -7116,6 +7091,24 @@ inhibit_sentinels = 0; +#ifndef CANNOT_DUMP + if (! noninteractive || initialized) +#endif + { +#if defined HAVE_GLIB && !defined WINDOWSNT && !defined CYGWIN + /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself; + this should always fail, but is enough to initialize glib's + private SIGCHLD handler, allowing the code below to copy it into + LIB_CHILD_HANDLER. + + For some reason tickling causes Cygwin bootstrap to fail, so it's + skipped under Cygwin. FIXME: Skipping the tickling likely causes + bugs in subprocess handling under Cygwin (Bug#14569). */ + g_source_unref (g_child_watch_source_new (getpid ())); +#endif + catch_child_signal (); + } + FD_ZERO (&input_wait_mask); FD_ZERO (&non_keyboard_wait_mask); FD_ZERO (&non_process_wait_mask); === modified file 'src/process.h' --- src/process.h 2013-06-23 18:18:47 +0000 +++ src/process.h 2013-06-27 14:47:52 +0000 @@ -219,6 +219,8 @@ extern void delete_read_fd (int fd); extern void add_write_fd (int fd, fd_callback func, void *data); extern void delete_write_fd (int fd); +#ifdef NS_IMPL_GNUSTEP extern void catch_child_signal (void); +#endif INLINE_HEADER_END ------------------------------------------------------------ revno: 113205 committer: Dmitry Gutov branch nick: trunk timestamp: Thu 2013-06-27 13:51:55 +0400 message: * test/automated/package-x-test.el: Change the commentary. (package-x-test--single-archive-entry-1-3) (package-x-test--single-archive-entry-1-4): Fix the tests, by using the appropriate data structure. diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2013-06-27 09:30:37 +0000 +++ test/ChangeLog 2013-06-27 09:51:55 +0000 @@ -1,6 +1,9 @@ 2013-06-27 Dmitry Gutov * automated/package-x-test.el: Change the commentary. + (package-x-test--single-archive-entry-1-3) + (package-x-test--single-archive-entry-1-4): Fix the tests, by + using the appropriate data structure. 2013-06-27 Daniel Hackney === modified file 'test/automated/package-x-test.el' --- test/automated/package-x-test.el 2013-06-27 09:30:37 +0000 +++ test/automated/package-x-test.el 2013-06-27 09:51:55 +0000 @@ -44,17 +44,17 @@ (require 'package-test)) (defvar package-x-test--single-archive-entry-1-3 - (package-desc-create :name 'simple-single - :version '(1 3) - :summary "A single-file package with no dependencies" - :kind 'single) + (cons 'simple-single + (package-make-ac-desc '(1 3) nil + "A single-file package with no dependencies" + 'single)) "Expected contents of the archive entry from the \"simple-single\" package.") (defvar package-x-test--single-archive-entry-1-4 - (package-desc-create :name 'simple-single - :version '(1 4) - :summary "A single-file package with no dependencies" - :kind 'single) + (cons 'simple-single + (package-make-ac-desc '(1 4) nil + "A single-file package with no dependencies" + 'single)) "Expected contents of the archive entry from the updated \"simple-single\" package.") (ert-deftest package-x-test-upload-buffer () ------------------------------------------------------------ revno: 113204 committer: Dmitry Gutov branch nick: trunk timestamp: Thu 2013-06-27 13:30:37 +0400 message: * test/automated/package-x-test.el: Change the commentary. diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2013-06-27 09:26:54 +0000 +++ test/ChangeLog 2013-06-27 09:30:37 +0000 @@ -1,3 +1,7 @@ +2013-06-27 Dmitry Gutov + + * automated/package-x-test.el: Change the commentary. + 2013-06-27 Daniel Hackney * automated/Makefile.in (setwins): Include the 'data' subdirectory. === modified file 'test/automated/package-x-test.el' --- test/automated/package-x-test.el 2013-06-27 09:26:54 +0000 +++ test/automated/package-x-test.el 2013-06-27 09:30:37 +0000 @@ -22,9 +22,9 @@ ;;; Commentary: -;; Run this from a separate Emacs instance from your main one as it -;; messes with the package archive files. In fact, it wouldn't be a -;; bad idea to back up your whole package archive before testing! +;; You may want to run this from a separate Emacs instance from your +;; main one, because a bug in the code below could mess with your +;; installed packages. ;; Run this in a clean Emacs session using: ;; ------------------------------------------------------------ revno: 113203 committer: Dmitry Gutov branch nick: trunk timestamp: Thu 2013-06-27 13:26:54 +0400 message: * automated/Makefile.in (setwins): Include the 'data' subdirectory. * automated/package-x-test.el: New file. * automated/package-test.el: New file. * automated/data/package: New directory, with test examples. * lisp/emacs-lisp/package-x.el (package-upload-buffer-internal): Adapt to `package-desc-version' being a list. Use `package--ac-desc-version' to retrieve version from a package archive element. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-27 09:20:04 +0000 +++ lisp/ChangeLog 2013-06-27 09:26:54 +0000 @@ -1,3 +1,10 @@ +2013-06-27 Dmitry Gutov + + * emacs-lisp/package-x.el (package-upload-buffer-internal): Adapt + to `package-desc-version' being a list. Use + `package--ac-desc-version' to retrieve version from a package + archive element. + 2013-06-27 Juanma Barranquero New experimental feature to save&restore window and frame setup. === modified file 'lisp/emacs-lisp/package-x.el' --- lisp/emacs-lisp/package-x.el 2013-06-25 16:13:49 +0000 +++ lisp/emacs-lisp/package-x.el 2013-06-27 09:26:54 +0000 @@ -204,12 +204,12 @@ package--default-summary) (read-string "Description of package: ") (package-desc-summary pkg-desc))) - (pkg-version (package-desc-version pkg-desc)) + (split-version (package-desc-version pkg-desc)) (commentary (pcase file-type (`single (lm-commentary)) (`tar nil))) ;; FIXME: Get it from the README file. - (split-version (version-to-list pkg-version)) + (pkg-version (package-version-join split-version)) (pkg-buffer (current-buffer))) ;; Get archive-contents from ARCHIVE-URL if it's non-nil, or @@ -223,7 +223,7 @@ (let ((elt (assq pkg-name (cdr contents)))) (if elt (if (version-list-<= split-version - (package-desc-version (cdr elt))) + (package--ac-desc-version (cdr elt))) (error "New package has smaller version: %s" pkg-version) (setcdr elt new-desc)) (setq contents (cons (car contents) === modified file 'test/ChangeLog' --- test/ChangeLog 2013-06-27 05:46:51 +0000 +++ test/ChangeLog 2013-06-27 09:26:54 +0000 @@ -1,3 +1,13 @@ +2013-06-27 Daniel Hackney + + * automated/Makefile.in (setwins): Include the 'data' subdirectory. + + * automated/package-x-test.el: New file. + + * automated/package-test.el: New file. + + * automated/data/package: New directory, with test examples. + 2013-06-27 Glenn Morris * automated/python-tests.el (python-tests-with-temp-file): === modified file 'test/automated/Makefile.in' --- test/automated/Makefile.in 2013-01-01 09:11:05 +0000 +++ test/automated/Makefile.in 2013-06-27 09:26:54 +0000 @@ -50,7 +50,7 @@ # Common command to find subdirectories setwins=subdirs=`find . -type d -print`; \ for file in $$subdirs; do \ - case $$file in */.* | */.*/* | */=* ) ;; \ + case $$file in */.* | */.*/* | */=* | ./data* ) ;; \ *) wins="$$wins $$file" ;; \ esac; \ done === added directory 'test/automated/data' === added directory 'test/automated/data/package' === added file 'test/automated/data/package/archive-contents' --- test/automated/data/package/archive-contents 1970-01-01 00:00:00 +0000 +++ test/automated/data/package/archive-contents 2013-06-27 09:26:54 +0000 @@ -0,0 +1,10 @@ +(1 + (simple-single . + [(1 3) + nil "A single-file package with no dependencies" single]) + (simple-depend . + [(1 0) + ((simple-single (1 3))) "A single-file package with a dependency." single]) + (multi-file . + [(0 2 3) + nil "Example of a multi-file tar package" tar])) === added file 'test/automated/data/package/multi-file-0.2.3.tar' Binary files test/automated/data/package/multi-file-0.2.3.tar 1970-01-01 00:00:00 +0000 and test/automated/data/package/multi-file-0.2.3.tar 2013-06-27 09:26:54 +0000 differ === added file 'test/automated/data/package/multi-file-readme.txt' --- test/automated/data/package/multi-file-readme.txt 1970-01-01 00:00:00 +0000 +++ test/automated/data/package/multi-file-readme.txt 2013-06-27 09:26:54 +0000 @@ -0,0 +1,1 @@ +This is a bare-bones readme file for the multi-file package. === added directory 'test/automated/data/package/newer-versions' === added file 'test/automated/data/package/newer-versions/archive-contents' --- test/automated/data/package/newer-versions/archive-contents 1970-01-01 00:00:00 +0000 +++ test/automated/data/package/newer-versions/archive-contents 2013-06-27 09:26:54 +0000 @@ -0,0 +1,13 @@ +(1 + (simple-single . + [(1 4) + nil "A single-file package with no dependencies" single]) + (simple-depend . + [(1 0) + ((simple-single (1 3))) "A single-file package with a dependency." single]) + (new-pkg . + [(1 0) + nil "A package only seen after "updating" archive-contents" single]) + (multi-file . + [(0 2 3) + nil "Example of a multi-file tar package" tar])) === added file 'test/automated/data/package/newer-versions/new-pkg-1.0.el' --- test/automated/data/package/newer-versions/new-pkg-1.0.el 1970-01-01 00:00:00 +0000 +++ test/automated/data/package/newer-versions/new-pkg-1.0.el 2013-06-27 09:26:54 +0000 @@ -0,0 +1,18 @@ +;;; new-pkg.el --- A package only seen after "updating" archive-contents + +;; Author: J. R. Hacker +;; Version: 1.0 + +;;; Commentary: + +;; This will only show up after updating "archive-contents". + +;;; Code: + +(defun new-pkg-frob () + "Ignore me." + (ignore)) + +(provide 'new-pkg) + +;;; new-pkg.el ends here === added file 'test/automated/data/package/newer-versions/simple-single-1.4.el' --- test/automated/data/package/newer-versions/simple-single-1.4.el 1970-01-01 00:00:00 +0000 +++ test/automated/data/package/newer-versions/simple-single-1.4.el 2013-06-27 09:26:54 +0000 @@ -0,0 +1,36 @@ +;;; simple-single.el --- A single-file package with no dependencies + +;; Author: J. R. Hacker +;; Version: 1.4 +;; Keywords: frobnicate + +;;; Commentary: + +;; This package provides a minor mode to frobnicate and/or bifurcate +;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly" +;; and all your dreams will come true. +;; +;; This is a new, updated version. + +;;; Code: + +(defgroup simple-single nil "Simply a file" + :group 'lisp) + +(defcustom simple-single-super-sunday nil + "How great is this? +Default changed to `nil'." + :type 'boolean + :group 'simple-single + :package-version "1.4") + +(defvar simple-single-sudo-sandwich nil + "Make a sandwich?") + +;;;###autoload +(define-minor-mode simple-single-mode + "It does good things to stuff") + +(provide 'simple-single) + +;;; simple-single.el ends here === added file 'test/automated/data/package/simple-depend-1.0.el' --- test/automated/data/package/simple-depend-1.0.el 1970-01-01 00:00:00 +0000 +++ test/automated/data/package/simple-depend-1.0.el 2013-06-27 09:26:54 +0000 @@ -0,0 +1,17 @@ +;;; simple-depend.el --- A single-file package with a dependency. + +;; Author: J. R. Hacker +;; Version: 1.0 +;; Keywords: frobnicate +;; Package-Requires: ((simple-single "1.3")) + +;;; Commentary: + +;; Depends on another package. + +;;; Code: + +(defvar simple-depend "Value" + "Some trivial code") + +;;; simple-depend.el ends here === added file 'test/automated/data/package/simple-single-1.3.el' --- test/automated/data/package/simple-single-1.3.el 1970-01-01 00:00:00 +0000 +++ test/automated/data/package/simple-single-1.3.el 2013-06-27 09:26:54 +0000 @@ -0,0 +1,32 @@ +;;; simple-single.el --- A single-file package with no dependencies + +;; Author: J. R. Hacker +;; Version: 1.3 +;; Keywords: frobnicate + +;;; Commentary: + +;; This package provides a minor mode to frobnicate and/or bifurcate +;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly" +;; and all your dreams will come true. + +;;; Code: + +(defgroup simple-single nil "Simply a file" + :group 'lisp) + +(defcustom simple-single-super-sunday t + "How great is this?" + :type 'boolean + :group 'simple-single) + +(defvar simple-single-sudo-sandwich nil + "Make a sandwich?") + +;;;###autoload +(define-minor-mode simple-single-mode + "It does good things to stuff") + +(provide 'simple-single) + +;;; simple-single.el ends here === added file 'test/automated/data/package/simple-single-readme.txt' --- test/automated/data/package/simple-single-readme.txt 1970-01-01 00:00:00 +0000 +++ test/automated/data/package/simple-single-readme.txt 2013-06-27 09:26:54 +0000 @@ -0,0 +1,3 @@ +This package provides a minor mode to frobnicate and/or bifurcate +any flanges you desire. To activate it, type "C-M-r M-3 butterfly" +and all your dreams will come true. === added file 'test/automated/package-test.el' --- test/automated/package-test.el 1970-01-01 00:00:00 +0000 +++ test/automated/package-test.el 2013-06-27 09:26:54 +0000 @@ -0,0 +1,398 @@ +;;; package-test.el --- Tests for the Emacs package system + +;; Author: Daniel Hackney +;; Version: 1.0 + +;; 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, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; You may want to run this from a separate Emacs instance from your +;; main one, because a bug in the code below could mess with your +;; installed packages. + +;; Run this in a clean Emacs session using: +;; +;; $ emacs -Q --batch -L . -l package-test.el -l ert -f ert-run-tests-batch-and-exit + +;;; Code: + +(require 'package) +(require 'ert) +(require 'cl-lib) + +(defvar package-test-user-dir nil + "Directory to use for installing packages during testing.") + +(defvar package-test-file-dir (file-name-directory (or load-file-name + buffer-file-name)) + "Directory of the actual \"package-test.el\" file.") + +(defvar simple-single-desc + (package-desc-create :name 'simple-single + :version '(1 3) + :summary "A single-file package with no dependencies" + :kind 'single) + "Expected `package-desc' parsed from simple-single-1.3.el.") + +(defvar simple-single-desc-1-4 + (package-desc-create :name 'simple-single + :version '(1 4) + :summary "A single-file package with no dependencies" + :kind 'single) + "Expected `package-desc' parsed from simple-single-1.4.el.") + +(defvar simple-depend-desc + (package-desc-create :name 'simple-depend + :version '(1 0) + :summary "A single-file package with a dependency." + :kind 'single + :reqs '((simple-single (1 3)))) + "Expected `package-desc' parsed from simple-depend-1.0.el.") + +(defvar multi-file-desc + (package-desc-create :name 'multi-file + :version '(0 2 3) + :summary "Example of a multi-file tar package" + :kind 'tar) + "Expected `package-desc' from \"multi-file-0.2.3.tar\".") + +(defvar new-pkg-desc + (package-desc-create :name 'new-pkg + :version '(1 0) + :kind 'single) + "Expected `package-desc' parsed from new-pkg-1.0.el.") + +(defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir) + "Base directory of package test files.") + +(defvar package-test-fake-contents-file + (expand-file-name "archive-contents" package-test-data-dir) + "Path to a static copy of \"archive-contents\".") + +(defvar package-test-built-file-suffixes '(".tar" "/dir" "/*.info") + "Remove these files when cleaning up a built package.") + +(cl-defmacro with-package-test ((&optional &key file + basedir + install + update-news + upload-base) + &rest body) + "Set up temporary locations and variables for testing." + (declare (indent 1)) + `(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t)) + (package-user-dir package-test-user-dir) + (package-archives `(("gnu" . ,package-test-data-dir))) + (old-yes-no-defn (symbol-function 'yes-or-no-p)) + (old-pwd default-directory) + package--initialized + package-alist + ,@(if update-news + '(package-update-news-on-upload t) + (list (cl-gensym))) + ,@(if upload-base + '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t)) + (package-archive-upload-base package-test-archive-upload-base)) + (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind `nil' + (unwind-protect + (progn + ,(if basedir `(cd ,basedir)) + (setf (symbol-function 'yes-or-no-p) #'(lambda (&rest r) t)) + (unless (file-directory-p package-user-dir) + (mkdir package-user-dir)) + ,@(when install + `((package-initialize) + (package-refresh-contents) + (mapc 'package-install ,install))) + (with-temp-buffer + ,(if file + `(insert-file-contents ,file)) + ,@body)) + + (when (file-directory-p package-test-user-dir) + (delete-directory package-test-user-dir t)) + + (when (and (boundp 'package-test-archive-upload-base) + (file-directory-p package-test-archive-upload-base)) + (delete-directory package-test-archive-upload-base t)) + (setf (symbol-function 'yes-or-no-p) old-yes-no-defn) + (cd old-pwd)))) + +(defmacro with-fake-help-buffer (&rest body) + "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer." + `(with-temp-buffer + (help-mode) + ;; Trick `help-buffer' into using the temp buffer. + (let ((help-xref-following t)) + ,@body))) + +(defun package-test-install-texinfo (file) + "Install from texinfo FILE. + +FILE should be a .texinfo file relative to the current +`default-directory'" + (require 'info) + (let* ((full-file (expand-file-name file)) + (info-file (replace-regexp-in-string "\\.texi\\'" ".info" full-file)) + (old-info-defn (symbol-function 'Info-revert-find-node))) + (require 'info) + (setf (symbol-function 'Info-revert-find-node) #'ignore) + (with-current-buffer (find-file-literally full-file) + (unwind-protect + (progn + (require 'makeinfo) + (makeinfo-buffer) + ;; Give `makeinfo-buffer' a chance to finish + (while compilation-in-progress + (sit-for 0.1)) + (call-process "ginstall-info" nil nil nil + (format "--info-dir=%s" default-directory) + (format "%s" info-file))) + (kill-buffer) + (setf (symbol-function 'Info-revert-find-node) old-info-defn))))) + +(defun package-test-strip-version (dir) + (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir))) + +(defun package-test-suffix-matches (base suffix-list) + "Return file names matching BASE concatenated with each item in SUFFIX-LIST" + (cl-mapcan + '(lambda (item) (file-expand-wildcards (concat base item))) + suffix-list)) + +(defun package-test-cleanup-built-files (dir) + "Remove files which were the result of creating a tar archive. + +DIR is the base name of the package directory, without the trailing slash" + (let* ((pkg-dirname (file-name-nondirectory dir))) + (dolist (file (package-test-suffix-matches dir package-test-built-file-suffixes)) + (delete-file file)))) + +(defun package-test-search-tar-file (filename) + "Search the current buffer's `tar-parse-info' variable for FILENAME. + +Must called from within a `tar-mode' buffer." + (cl-dolist (header tar-parse-info) + (let ((tar-name (tar-header-name header))) + (when (string= tar-name filename) + (cl-return t))))) + +(defun package-test-desc-version-string (desc) + "Return the package version as a string." + (package-version-join (package-desc-version desc))) + +(ert-deftest package-test-desc-from-buffer () + "Parse an elisp buffer to get a `package-desc' object." + (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") + (should (equal (package-buffer-info) simple-single-desc))) + (with-package-test (:basedir "data/package" :file "simple-depend-1.0.el") + (should (equal (package-buffer-info) simple-depend-desc))) + (with-package-test (:basedir "data/package" + :file "multi-file-0.2.3.tar") + (tar-mode) + (should (equal (package-tar-file-info) multi-file-desc)))) + +(ert-deftest package-test-install-single () + "Install a single file without using an archive." + (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") + (should (package-install-from-buffer)) + (package-initialize) + (should (package-installed-p 'simple-single)) + (let* ((simple-pkg-dir (file-name-as-directory + (expand-file-name + "simple-single-1.3" + package-test-user-dir))) + (autoloads-file (expand-file-name "simple-single-autoloads.el" + simple-pkg-dir))) + (should (file-directory-p simple-pkg-dir)) + (with-temp-buffer + (insert-file-contents (expand-file-name "simple-single-pkg.el" + simple-pkg-dir)) + (should (string= (buffer-string) + (concat "(define-package \"simple-single\" \"1.3\" " + "\"A single-file package " + "with no dependencies\" 'nil)\n")))) + (should (file-exists-p autoloads-file)) + (should-not (get-file-buffer autoloads-file))))) + +(ert-deftest package-test-install-dependency () + "Install a package which includes a dependency." + (with-package-test () + (package-initialize) + (package-refresh-contents) + (package-install 'simple-depend) + (should (package-installed-p 'simple-single)) + (should (package-installed-p 'simple-depend)))) + +(ert-deftest package-test-refresh-contents () + "Parse an \"archive-contents\" file." + (with-package-test () + (package-initialize) + (package-refresh-contents) + (should (eq 3 (length package-archive-contents))))) + +(ert-deftest package-test-install-single-from-archive () + "Install a single package from a package archive." + (with-package-test () + (package-initialize) + (package-refresh-contents) + (package-install 'simple-single))) + +(ert-deftest package-test-install-multifile () + "Check properties of the installed multi-file package." + (with-package-test (:basedir "data/package" :install '(multi-file)) + (let ((autoload-file + (expand-file-name "multi-file-autoloads.el" + (expand-file-name + "multi-file-0.2.3" + package-test-user-dir))) + (installed-files '("dir" "multi-file.info" "multi-file-sub.elc" + "multi-file-autoloads.el" "multi-file.elc")) + (autoload-forms '("^(defvar multi-file-custom-var" + "^(custom-autoload 'multi-file-custom-var" + "^(autoload 'multi-file-mode")) + (pkg-dir (file-name-as-directory + (expand-file-name + "multi-file-0.2.3" + package-test-user-dir)))) + (package-refresh-contents) + (should (package-installed-p 'multi-file)) + (with-temp-buffer + (insert-file-contents-literally autoload-file) + (dolist (fn installed-files) + (should (file-exists-p (expand-file-name fn pkg-dir)))) + (dolist (re autoload-forms) + (goto-char (point-min)) + (should (re-search-forward re nil t))))))) + +(ert-deftest package-test-update-listing () + "Ensure installed package status is updated." + (with-package-test () + (let ((buf (package-list-packages))) + (search-forward-regexp "^ +simple-single") + (package-menu-mark-install) + (package-menu-execute) + (should (package-installed-p 'simple-single)) + (switch-to-buffer "*Packages*") + (goto-char (point-min)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t)) + (kill-buffer buf)))) + +(ert-deftest package-test-update-archives () + "Test updating package archives." + (with-package-test () + (let ((buf (package-list-packages))) + (package-menu-refresh) + (search-forward-regexp "^ +simple-single") + (package-menu-mark-install) + (package-menu-execute) + (should (package-installed-p 'simple-single)) + (let ((package-test-data-dir + (expand-file-name "data/package/newer-versions" package-test-file-dir))) + (setq package-archives `(("gnu" . ,package-test-data-dir))) + (package-menu-refresh) + + ;; New version should be available and old version should be installed + (goto-char (point-min)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) + + (goto-char (point-min)) + (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t)) + + (package-menu-mark-upgrades) + (package-menu-execute) + (package-menu-refresh) + (should (package-installed-p 'simple-single '(1 4))))))) + +(ert-deftest package-test-describe-package () + "Test displaying help for a package." + + (require 'finder-inf) + ;; Built-in + (with-fake-help-buffer + (describe-package '5x5) + (goto-char (point-min)) + (should (search-forward "5x5 is a built-in package." nil t)) + (should (search-forward "Status: Built-in." nil t)) + (should (search-forward "Summary: simple little puzzle game" nil t)) + (should (search-forward "The aim of 5x5" nil t))) + + ;; Installed + (with-package-test () + (package-initialize) + (package-refresh-contents) + (package-install 'simple-single) + (with-fake-help-buffer + (describe-package 'simple-single) + (goto-char (point-min)) + (should (search-forward "simple-single is an installed package." nil t)) + (should (search-forward + (format "Status: Installed in `%s/'." + (expand-file-name "simple-single-1.3" package-user-dir)) + nil t)) + (should (search-forward "Version: 1.3" nil t)) + (should (search-forward "Summary: A single-file package with no dependencies" + nil t)) + ;; No description, though. Because at this point we don't know + ;; what archive the package originated from, and we don't have + ;; its readme file saved. + ))) + +(ert-deftest package-test-describe-not-installed-package () + "Test displaying of the readme for not-installed package." + + (with-package-test () + (package-initialize) + (package-refresh-contents) + (with-fake-help-buffer + (describe-package 'simple-single) + (goto-char (point-min)) + (should (search-forward "This package provides a minor mode to frobnicate" + nil t))))) + +(ert-deftest package-test-describe-non-installed-package () + "Test displaying of the readme for non-installed package." + + (with-package-test () + (package-initialize) + (package-refresh-contents) + (with-fake-help-buffer + (describe-package 'simple-single) + (goto-char (point-min)) + (should (search-forward "This package provides a minor mode to frobnicate" + nil t))))) + +(ert-deftest package-test-describe-non-installed-multi-file-package () + "Test displaying of the readme for non-installed multi-file package." + + (with-package-test () + (package-initialize) + (package-refresh-contents) + (with-fake-help-buffer + (describe-package 'multi-file) + (goto-char (point-min)) + (should (search-forward "This is a bare-bones readme file for the multi-file" + nil t))))) + +(provide 'package-test) + +;;; package-test.el ends here === added file 'test/automated/package-x-test.el' --- test/automated/package-x-test.el 1970-01-01 00:00:00 +0000 +++ test/automated/package-x-test.el 2013-06-27 09:26:54 +0000 @@ -0,0 +1,107 @@ +;;; package-test.el --- Tests for the Emacs package system + +;; Author: Daniel Hackney +;; Version: 1.0 + +;; 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, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Run this from a separate Emacs instance from your main one as it +;; messes with the package archive files. In fact, it wouldn't be a +;; bad idea to back up your whole package archive before testing! + +;; Run this in a clean Emacs session using: +;; +;; $ emacs -Q --batch -L . -l package-x-test.el -f ert-run-tests-batch-and-exit + +;;; Code: + +(require 'package-x) +(require 'ert) +(require 'cl-lib) + +;; package-test is not normally in `load-path', so temporarily set +;; `load-path' to contain the current directory. +(let ((load-path (append (list (file-name-directory (or load-file-name + buffer-file-name))) + load-path))) + (require 'package-test)) + +(defvar package-x-test--single-archive-entry-1-3 + (package-desc-create :name 'simple-single + :version '(1 3) + :summary "A single-file package with no dependencies" + :kind 'single) + "Expected contents of the archive entry from the \"simple-single\" package.") + +(defvar package-x-test--single-archive-entry-1-4 + (package-desc-create :name 'simple-single + :version '(1 4) + :summary "A single-file package with no dependencies" + :kind 'single) + "Expected contents of the archive entry from the updated \"simple-single\" package.") + +(ert-deftest package-x-test-upload-buffer () + "Test creating an \"archive-contents\" file" + (with-package-test (:basedir "data/package" + :file "simple-single-1.3.el" + :upload-base t) + (package-upload-buffer) + (should (file-exists-p (expand-file-name "archive-contents" + package-archive-upload-base))) + (should (file-exists-p (expand-file-name "simple-single-1.3.el" + package-archive-upload-base))) + (should (file-exists-p (expand-file-name "simple-single-readme.txt" + package-archive-upload-base))) + + (let (archive-contents) + (with-temp-buffer + (insert-file-contents + (expand-file-name "archive-contents" + package-archive-upload-base)) + (setq archive-contents + (package-read-from-string + (buffer-substring (point-min) (point-max))))) + (should (equal archive-contents + (list 1 package-x-test--single-archive-entry-1-3)))))) + +(ert-deftest package-x-test-upload-new-version () + "Test uploading a new version of a package" + (with-package-test (:basedir "data/package" + :file "simple-single-1.3.el" + :upload-base t) + (package-upload-buffer) + (with-temp-buffer + (insert-file-contents "newer-versions/simple-single-1.4.el") + (package-upload-buffer)) + + (let (archive-contents) + (with-temp-buffer + (insert-file-contents + (expand-file-name "archive-contents" + package-archive-upload-base)) + (setq archive-contents + (package-read-from-string + (buffer-substring (point-min) (point-max))))) + (should (equal archive-contents + (list 1 package-x-test--single-archive-entry-1-4)))))) + +(provide 'package-x-test) + +;;; package-x-test.el ends here ------------------------------------------------------------ revno: 113202 fixes bug: http://debbugs.gnu.org/14717 committer: Stephen Berman branch nick: trunk timestamp: Thu 2013-06-27 11:20:04 +0200 message: * info.el (Info-try-follow-nearest-node): Move search for footnote above search for node name to prevent missing a footnote. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-27 09:08:14 +0000 +++ lisp/ChangeLog 2013-06-27 09:20:04 +0000 @@ -15,6 +15,11 @@ 2013-06-27 Stephen Berman + * info.el (Info-try-follow-nearest-node): Move search for footnote + above search for node name to prevent missing a footnote (bug#14717). + +2013-06-27 Stephen Berman + * obsolete/otodo-mode.el: Add obsolescence info to file header. 2013-06-27 Leo Liu === modified file 'lisp/info.el' --- lisp/info.el 2013-05-27 22:42:11 +0000 +++ lisp/info.el 2013-06-27 09:20:04 +0000 @@ -3870,23 +3870,6 @@ ((setq node (Info-get-token (point) "\\*note[ \n\t]+" "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?")) (Info-follow-reference node fork)) - ;; menu item: node name - ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::")) - (Info-goto-node node fork)) - ;; menu item: node name or index entry - ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ") - (beginning-of-line) - (forward-char 2) - (setq node (Info-extract-menu-node-name nil (Info-index-node))) - (Info-goto-node node fork)) - ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)")) - (Info-goto-node node fork)) - ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)")) - (Info-goto-node node fork)) - ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)")) - (Info-goto-node "Top" fork)) - ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)")) - (Info-goto-node node fork)) ;; footnote ((setq node (Info-get-token (point) "(" "\\(([0-9]+)\\)")) (let ((old-point (point)) new-point) @@ -3904,7 +3887,24 @@ (progn (goto-char new-point) (setq node t)) - (setq node nil))))) + (setq node nil)))) + ;; menu item: node name + ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::")) + (Info-goto-node node fork)) + ;; menu item: node name or index entry + ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ") + (beginning-of-line) + (forward-char 2) + (setq node (Info-extract-menu-node-name nil (Info-index-node))) + (Info-goto-node node fork)) + ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)")) + (Info-goto-node node fork)) + ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)")) + (Info-goto-node node fork)) + ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)")) + (Info-goto-node "Top" fork)) + ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)")) + (Info-goto-node node fork))) node)) (defun Info-mouse-follow-link (click) ------------------------------------------------------------ revno: 113201 committer: Juanma Barranquero branch nick: trunk timestamp: Thu 2013-06-27 11:08:14 +0200 message: New experimental feature to save&restore window and frame setup. * etc/NEWS: Document new Desktop option `desktop-save-windows'. * lisp/desktop.el (desktop-save-windows): New defcustom. (desktop--saved-states): New var. (desktop--excluded-frame-parameters): New defconst. (desktop--filter-frame-parms, desktop--find-frame-in-display) (desktop--restore-windows, desktop--save-windows): New functions. (desktop-save): Call `desktop--save-windows'. (desktop-read): Call `desktop--restore-windows'. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2013-06-27 08:44:19 +0000 +++ etc/ChangeLog 2013-06-27 09:08:14 +0000 @@ -1,3 +1,7 @@ +2013-06-27 Juanma Barranquero + + * NEWS: Document new Desktop option `desktop-save-windows'. + 2013-06-27 Stephen Berman * NEWS: Mention new version of todo-mode.el and obsoleting and === modified file 'etc/NEWS' --- etc/NEWS 2013-06-27 08:44:19 +0000 +++ etc/NEWS 2013-06-27 09:08:14 +0000 @@ -237,6 +237,9 @@ *** `desktop-auto-save-timeout' defines the number of seconds between auto-saves of the desktop. +*** `desktop-save-windows' enables saving and restoring the window/frame +configuration. + ** Dired *** New minor mode `dired-hide-details-mode' hides details. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-27 09:01:08 +0000 +++ lisp/ChangeLog 2013-06-27 09:08:14 +0000 @@ -1,3 +1,14 @@ +2013-06-27 Juanma Barranquero + + New experimental feature to save&restore window and frame setup. + * desktop.el (desktop-save-windows): New defcustom. + (desktop--saved-states): New var. + (desktop--excluded-frame-parameters): New defconst. + (desktop--filter-frame-parms, desktop--find-frame-in-display) + (desktop--restore-windows, desktop--save-windows): New functions. + (desktop-save): Call `desktop--save-windows'. + (desktop-read): Call `desktop--restore-windows'. + 2013-06-27 Lars Magne Ingebrigtsen * net/shr.el (add-face-text-property): Removed compat definition. === modified file 'lisp/desktop.el' --- lisp/desktop.el 2013-05-02 17:47:39 +0000 +++ lisp/desktop.el 2013-06-27 09:08:14 +0000 @@ -371,6 +371,12 @@ :type '(repeat symbol) :group 'desktop) +(defcustom desktop-save-windows nil + "When non-nil, save window/frame configuration to desktop file." + :type 'boolean + :group 'desktop + :version "24.4") + (defcustom desktop-file-name-format 'absolute "Format in which desktop file names should be saved. Possible values are: @@ -556,6 +562,9 @@ "Checksum of the last auto-saved contents of the desktop file. Used to avoid writing contents unchanged between auto-saves.") +(defvar desktop--saved-states nil + "Internal use only.") + ;; ---------------------------------------------------------------------------- ;; Desktop file conflict detection (defvar desktop-file-modtime nil @@ -858,6 +867,42 @@ ;; ---------------------------------------------------------------------------- +(defconst desktop--excluded-frame-parameters + '(buffer-list + buffer-predicate + buried-buffer-list + explicit-name + font-backend + minibuffer + name + outer-window-id + parent-id + window-id + window-system) + "Frame parameters not saved or restored.") + +(defun desktop--filter-frame-parms (frame) + "Return frame parameters of FRAME. +Parameters in `desktop--excluded-frame-parameters' are excluded. +Internal use only." + (let (params) + (dolist (param (frame-parameters frame)) + (unless (memq (car param) desktop--excluded-frame-parameters) + (push param params))) + params)) + +(defun desktop--save-windows () + "Save window/frame state, as a global variable. +Intended to be called from `desktop-save'. +Internal use only." + (setq desktop--saved-states + (and desktop-save-windows + (mapcar (lambda (frame) + (cons (desktop--filter-frame-parms frame) + (window-state-get (frame-root-window frame) t))) + (frame-list)))) + (desktop-outvar 'desktop--saved-states)) + ;;;###autoload (defun desktop-save (dirname &optional release auto-save) "Save the desktop in a desktop file. @@ -896,6 +941,9 @@ (save-excursion (run-hooks 'desktop-save-hook)) (goto-char (point-max)) (insert "\n;; Global section:\n") + ;; Called here because we save the window/frame state as a global + ;; variable for compatibility with previous Emacsen. + (desktop--save-windows) (mapc (function desktop-outvar) desktop-globals-to-save) (when (memq 'kill-ring desktop-globals-to-save) (insert @@ -954,6 +1002,37 @@ (defvar desktop-lazy-timer nil) ;; ---------------------------------------------------------------------------- +(defun desktop--find-frame-in-display (frames display) + (let (result) + (while (and frames (not result)) + (if (equal display (frame-parameter (car frames) 'display)) + (setq result (car frames)) + (setq frames (cdr frames)))) + result)) + +(defun desktop--restore-windows () + "Restore window/frame configuration. +Internal use only." + (when (and desktop-save-windows desktop--saved-states) + (condition-case nil + (let ((frames (frame-list))) + (dolist (state desktop--saved-states) + (let* ((fconfig (car state)) + (display (cdr (assq 'display fconfig))) + (frame (desktop--find-frame-in-display frames display))) + (if (not frame) + ;; no frames in the display -- make a new one + (setq frame (make-frame-on-display display fconfig)) + ;; found one -- reuse and remove from list + (setq frames (delq frame frames)) + (modify-frame-parameters frame fconfig)) + ;; restore windows + (window-state-put (cdr state) (frame-root-window frame) 'safe))) + ;; delete any remaining frames + (mapc #'delete-frame frames)) + (error + (message "Error loading window configuration from desktop file"))))) + ;;;###autoload (defun desktop-read (&optional dirname) "Read and process the desktop file in directory DIRNAME. @@ -1022,6 +1101,7 @@ (switch-to-buffer (car (buffer-list))) (run-hooks 'desktop-delay-hook) (setq desktop-delay-hook nil) + (desktop--restore-windows) (run-hooks 'desktop-after-read-hook) (message "Desktop: %d buffer%s restored%s%s." desktop-buffer-ok-count ------------------------------------------------------------ revno: 113200 committer: Lars Magne Ingebrigtsen branch nick: trunk timestamp: Thu 2013-06-27 11:01:08 +0200 message: * net/shr.el (add-face-text-property): Removed compat definition. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-27 08:33:43 +0000 +++ lisp/ChangeLog 2013-06-27 09:01:08 +0000 @@ -1,3 +1,7 @@ +2013-06-27 Lars Magne Ingebrigtsen + + * net/shr.el (add-face-text-property): Removed compat definition. + 2013-06-27 Stephen Berman * obsolete/otodo-mode.el: Add obsolescence info to file header. === modified file 'lisp/net/shr.el' --- lisp/net/shr.el 2013-06-25 19:25:14 +0000 +++ lisp/net/shr.el 2013-06-27 09:01:08 +0000 @@ -1606,27 +1606,6 @@ (shr-count (cdr row) 'th)))))) max)) -;; Emacs less than 24.3 -(unless (fboundp 'add-face-text-property) - (defun add-face-text-property (beg end face &optional appendp object) - "Combine FACE BEG and END." - (let ((b beg)) - (while (< b end) - (let ((oldval (get-text-property b 'face))) - (put-text-property - b (setq b (next-single-property-change b 'face nil end)) - 'face (cond ((null oldval) - face) - ((and (consp oldval) - (not (keywordp (car oldval)))) - (if appendp - (nconc oldval (list face)) - (cons face oldval))) - (t - (if appendp - (list oldval face) - (list face oldval)))))))))) - (provide 'shr) ;; Local Variables: ------------------------------------------------------------ revno: 113199 committer: Stephen Berman branch nick: trunk timestamp: Thu 2013-06-27 10:44:19 +0200 message: * NEWS: Mention new version of todo-mode.el and obsoleting and renaming of old version. diff: === modified file 'etc/ChangeLog' --- etc/ChangeLog 2013-06-27 01:40:46 +0000 +++ etc/ChangeLog 2013-06-27 08:44:19 +0000 @@ -1,3 +1,8 @@ +2013-06-27 Stephen Berman + + * NEWS: Mention new version of todo-mode.el and obsoleting and + renaming of old version. + 2013-06-27 Juanma Barranquero * NEWS: Mention policy change with respect to locallisppath dirs. === modified file 'etc/NEWS' --- etc/NEWS 2013-06-27 01:40:46 +0000 +++ etc/NEWS 2013-06-27 08:44:19 +0000 @@ -167,9 +167,6 @@ ** More packages look for ~/.emacs.d/ additionally to ~/.. Affected files: ~/.emacs.d/timelog replaces ~/.timelog -~/.emacs.d/todo-do replaces ~/.todo-do -~/.emacs.d/todo-done replaces ~/.todo-done -~/.emacs.d/todo-top replaces ~/.todo-top ~/.emacs.d/vip replaces ~/.vip ~/.emacs.d/viper replaces ~/.viper ~/.emacs.d/ido.last replaces ~/.ido.last @@ -183,6 +180,11 @@ ~/.emacs.d/strokes replaces ~/.strokes ~/.emacs.d/notes replaces ~/.notes ~/.emacs.d/type-break replaces ~/.type-break +Also the following files used by the now obsolete otodo-mode.el: +~/.emacs.d/todo-do replaces ~/.todo-do +~/.emacs.d/todo-done replaces ~/.todo-done +~/.emacs.d/todo-top replaces ~/.todo-top + ** Delphi mode is now called OPascal mode. *** All delphi-* variables and functions have been renamed to opascal-*. @@ -352,6 +354,25 @@ `just-one-space' command it can handle or ignore newlines and leave different number of spaces. +** Todo mode has been rewritten and enhanced. +New features include: +- support for multiple todo files and archive files of done items; +- renaming, reordering, moving, merging, and deleting categories; +- sortable tabular summaries of categories and the types of items they contain; +- cross-categorial lists of items filtered by specific criteria; +- more fine-grained interaction with the Emacs diary, by being able to decide + for each todo item whether it appears in the Fancy Diary display; +- highly flexible new item insertion and item editing; +- moving items between categories, storing done items in their category or in + archive files, undoing or unarchiving done items; +- reprioritizing items by inputting a numerical priority; +- extensive customizability of operation and display, including numerous faces. +To support some of these features, a new file format is used, which is +incompatible with the old format; however, you can convert old todo and done +item files to the new format on initializing the first new todo file, or at any +later time with the provided conversion command. The old version of +todo-mode.el has been made obsolete and renamed otodo-mode.el. + ** Tramp +++ @@ -397,6 +418,8 @@ *** terminal.el is obsolete; use term.el instead. +*** The previous version of todo-mode.el is obsolete and renamed otodo-mode.el. + *** xesam.el. +++ ------------------------------------------------------------ revno: 113198 committer: Stephen Berman branch nick: trunk timestamp: Thu 2013-06-27 10:33:43 +0200 message: * obsolete/otodo-mode.el: Add obsolescence info to file header. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-06-27 04:27:53 +0000 +++ lisp/ChangeLog 2013-06-27 08:33:43 +0000 @@ -1,3 +1,7 @@ +2013-06-27 Stephen Berman + + * obsolete/otodo-mode.el: Add obsolescence info to file header. + 2013-06-27 Leo Liu * net/eww.el (eww-read-bookmarks): Check file size. === modified file 'lisp/obsolete/otodo-mode.el' --- lisp/obsolete/otodo-mode.el 2013-06-19 19:50:32 +0000 +++ lisp/obsolete/otodo-mode.el 2013-06-27 08:33:43 +0000 @@ -6,6 +6,7 @@ ;; Maintainer: Stephen Berman ;; Created: 2 Aug 1997 ;; Keywords: calendar, todo +;; Obsolete-since: 24.4 ;; This file is part of GNU Emacs. ------------------------------------------------------------ revno: 113197 committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-06-26 22:46:51 -0700 message: * python-tests.el (python-tests-with-temp-file): Clean up after ourself diff: === modified file 'test/ChangeLog' --- test/ChangeLog 2013-06-27 02:16:53 +0000 +++ test/ChangeLog 2013-06-27 05:46:51 +0000 @@ -1,5 +1,8 @@ 2013-06-27 Glenn Morris + * automated/python-tests.el (python-tests-with-temp-file): + Clean up after ourself. + * automated/undo-tests.el (undo-test3): Remove test that seems to do nothing that the previous one doesn't, except leave a tempfile. === modified file 'test/automated/python-tests.el' --- test/automated/python-tests.el 2013-04-19 02:31:09 +0000 +++ test/automated/python-tests.el 2013-06-27 05:46:51 +0000 @@ -39,7 +39,8 @@ BODY is code to be executed within the temp buffer. Point is always located at the beginning of buffer." (declare (indent 1) (debug t)) - `(let* ((temp-file (concat (make-temp-file "python-tests") ".py")) + ;; temp-file never actually used for anything? + `(let* ((temp-file (make-temp-file "python-tests" nil ".py")) (buffer (find-file-noselect temp-file))) (unwind-protect (with-current-buffer buffer @@ -47,7 +48,8 @@ (insert ,contents) (goto-char (point-min)) ,@body) - (and buffer (kill-buffer buffer))))) + (and buffer (kill-buffer buffer)) + (delete-file temp-file)))) (defun python-tests-look-at (string &optional num restore-point) "Move point at beginning of STRING in the current buffer.