commit aa17de9056ccce4f080b910bf5eede3df4a12d5c (HEAD, refs/remotes/origin/master) Author: Ken Raeburn Date: Sat Nov 7 03:06:32 2015 -0500 Speed up x_real_pos_and_offsets using XCB * src/xfns.c (x_real_pos_and_offsets) [USE_XCB]: Add XCB flavors of all X calls, and pipeline requests when possible, collecting results later. Eliminate use of x_catch_errors (and thus XSync) in XCB case. diff --git a/src/xfns.c b/src/xfns.c index c55e6fe..9071b89 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -181,24 +181,38 @@ x_real_pos_and_offsets (struct frame *f, int *yptr, int *outer_border) { - int win_x, win_y, outer_x IF_LINT (= 0), outer_y IF_LINT (= 0); + int win_x = 0, win_y = 0, outer_x = 0, outer_y = 0; int real_x = 0, real_y = 0; bool had_errors = false; Window win = f->output_data.x->parent_desc; + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + long max_len = 400; + Atom target_type = XA_CARDINAL; + unsigned int ow = 0, oh = 0; + unsigned int fw = 0, fh = 0; + unsigned int bw = 0; + /* We resort to XCB if possible because there are several X calls + here which require responses from the server but do not have data + dependencies between them. Using XCB lets us pipeline requests, + whereas with Xlib we must wait for each answer before sending the + next request. + + For a non-local display, the round-trip time could be a few tens + of milliseconds, depending on the network distance. It doesn't + take a lot of those to add up to a noticeable hesitation in + responding to user actions. */ +#ifdef USE_XCB + xcb_connection_t *xcb_conn = dpyinfo->xcb_connection; + xcb_get_property_cookie_t prop_cookie; + xcb_get_geometry_cookie_t outer_geom_cookie; + bool sent_requests = false; +#else Atom actual_type; unsigned long actual_size, bytes_remaining; int rc, actual_format; - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); - long max_len = 400; Display *dpy = FRAME_X_DISPLAY (f); unsigned char *tmp_data = NULL; - Atom target_type = XA_CARDINAL; - unsigned int ow IF_LINT (= 0), oh IF_LINT (= 0); - unsigned int fw, fh; - - block_input (); - - x_catch_errors (dpy); +#endif if (x_pixels_diff) *x_pixels_diff = 0; if (y_pixels_diff) *y_pixels_diff = 0; @@ -213,6 +227,13 @@ x_real_pos_and_offsets (struct frame *f, if (win == dpyinfo->root_window) win = FRAME_OUTER_WINDOW (f); + block_input (); + +#ifndef USE_XCB + /* If we're using XCB, all errors are checked for on each call. */ + x_catch_errors (dpy); +#endif + /* This loop traverses up the containment tree until we hit the root window. Window managers may intersect many windows between our window and the root window. The window we find just before the root window @@ -220,6 +241,22 @@ x_real_pos_and_offsets (struct frame *f, for (;;) { Window wm_window, rootw; + +#ifdef USE_XCB + xcb_query_tree_cookie_t query_tree_cookie; + xcb_query_tree_reply_t *query_tree; + + query_tree_cookie = xcb_query_tree (xcb_conn, win); + query_tree = xcb_query_tree_reply (xcb_conn, query_tree_cookie, NULL); + if (query_tree == NULL) + had_errors = true; + else + { + wm_window = query_tree->parent; + rootw = query_tree->root; + free (query_tree); + } +#else Window *tmp_children; unsigned int tmp_nchildren; int success; @@ -234,6 +271,7 @@ x_real_pos_and_offsets (struct frame *f, break; XFree (tmp_children); +#endif if (wm_window == rootw || had_errors) break; @@ -243,15 +281,74 @@ x_real_pos_and_offsets (struct frame *f, if (! had_errors) { - unsigned int bw, ign; +#ifdef USE_XCB + xcb_get_geometry_cookie_t geom_cookie; + xcb_translate_coordinates_cookie_t trans_cookie; + xcb_translate_coordinates_cookie_t outer_trans_cookie; + + xcb_translate_coordinates_reply_t *trans; + xcb_get_geometry_reply_t *geom; +#else Window child, rootw; + unsigned int ign; +#endif + +#ifdef USE_XCB + /* Fire off the requests that don't have data dependencies. + + Once we've done this, we must collect the results for each + one before returning, even if other errors are detected, + making the other responses moot. */ + geom_cookie = xcb_get_geometry (xcb_conn, win); + + trans_cookie = + xcb_translate_coordinates (xcb_conn, + /* From-window, to-window. */ + FRAME_DISPLAY_INFO (f)->root_window, + FRAME_X_WINDOW (f), + + /* From-position. */ + 0, 0); + if (FRAME_X_WINDOW (f) != FRAME_OUTER_WINDOW (f)) + outer_trans_cookie = + xcb_translate_coordinates (xcb_conn, + /* From-window, to-window. */ + FRAME_DISPLAY_INFO (f)->root_window, + FRAME_OUTER_WINDOW (f), + + /* From-position. */ + 0, 0); + if (right_offset_x || bottom_offset_y) + outer_geom_cookie = xcb_get_geometry (xcb_conn, + FRAME_OUTER_WINDOW (f)); + + if (dpyinfo->root_window == f->output_data.x->parent_desc) + /* Try _NET_FRAME_EXTENTS if our parent is the root window. */ + prop_cookie = xcb_get_property (xcb_conn, 0, win, + dpyinfo->Xatom_net_frame_extents, + target_type, 0, max_len); + + sent_requests = true; +#endif /* Get the real coordinates for the WM window upper left corner */ +#ifdef USE_XCB + geom = xcb_get_geometry_reply (xcb_conn, geom_cookie, NULL); + if (geom) + { + real_x = geom->x; + real_y = geom->y; + ow = geom->width; + oh = geom->height; + bw = geom->border_width; + free (geom); + } + else + had_errors = true; +#else XGetGeometry (dpy, win, - &rootw, &real_x, &real_y, &ow, &oh, &bw, &ign); - - if (outer_border) - *outer_border = bw; + &rootw, &real_x, &real_y, &ow, &oh, &bw, &ign); +#endif /* Translate real coordinates to coordinates relative to our window. For our window, the upper left corner is 0, 0. @@ -262,7 +359,23 @@ x_real_pos_and_offsets (struct frame *f, | title | | ----------------- v y | | our window - */ + + Since we don't care about the child window corresponding to + the actual coordinates, we can send zero to get the offsets + and compute the resulting coordinates below. This reduces + the data dependencies between calls and lets us pipeline the + requests better in the XCB case. */ +#ifdef USE_XCB + trans = xcb_translate_coordinates_reply (xcb_conn, trans_cookie, NULL); + if (trans) + { + win_x = trans->dst_x; + win_y = trans->dst_y; + free (trans); + } + else + had_errors = true; +#else XTranslateCoordinates (dpy, /* From-window, to-window. */ @@ -274,6 +387,7 @@ x_real_pos_and_offsets (struct frame *f, /* Child of win. */ &child); +#endif win_x += real_x; win_y += real_y; @@ -285,6 +399,21 @@ x_real_pos_and_offsets (struct frame *f, } else { +#ifdef USE_XCB + xcb_translate_coordinates_reply_t *outer_trans; + + outer_trans = xcb_translate_coordinates_reply (xcb_conn, + outer_trans_cookie, + NULL); + if (outer_trans) + { + outer_x = outer_trans->dst_x; + outer_y = outer_trans->dst_y; + free (outer_trans); + } + else + had_errors = true; +#else XTranslateCoordinates (dpy, /* From-window, to-window. */ @@ -296,17 +425,46 @@ x_real_pos_and_offsets (struct frame *f, /* Child of win. */ &child); +#endif outer_x += real_x; outer_y += real_y; } +#ifndef USE_XCB had_errors = x_had_errors_p (dpy); +#endif } - if (!had_errors && dpyinfo->root_window == f->output_data.x->parent_desc) + if (dpyinfo->root_window == f->output_data.x->parent_desc) { /* Try _NET_FRAME_EXTENTS if our parent is the root window. */ +#ifdef USE_XCB + /* Make sure we didn't get an X error early and skip sending the + request. */ + if (sent_requests) + { + xcb_get_property_reply_t *prop; + + prop = xcb_get_property_reply (xcb_conn, prop_cookie, NULL); + if (prop) + { + if (prop->type == target_type + && xcb_get_property_value_length (prop) == 4 + && prop->format == 32) + { + long *fe = xcb_get_property_value (prop); + + outer_x = -fe[0]; + outer_y = -fe[2]; + real_x -= fe[0]; + real_y -= fe[2]; + } + free (prop); + } + /* Xlib version doesn't set had_errors here. Intentional or bug? */ + } +#else rc = XGetWindowProperty (dpy, win, dpyinfo->Xatom_net_frame_extents, 0, max_len, False, target_type, &actual_type, &actual_format, &actual_size, @@ -324,19 +482,42 @@ x_real_pos_and_offsets (struct frame *f, } if (tmp_data) XFree (tmp_data); +#endif } if (right_offset_x || bottom_offset_y) { +#ifdef USE_XCB + /* Make sure we didn't get an X error early and skip sending the + request. */ + if (sent_requests) + { + xcb_get_geometry_reply_t *outer_geom; + + outer_geom = xcb_get_geometry_reply (xcb_conn, outer_geom_cookie, + NULL); + if (outer_geom) + { + fw = outer_geom->width; + fh = outer_geom->height; + free (outer_geom); + } + else + had_errors = true; + } +#else int xy_ign; unsigned int ign; Window rootw; XGetGeometry (dpy, FRAME_OUTER_WINDOW (f), &rootw, &xy_ign, &xy_ign, &fw, &fh, &ign, &ign); +#endif } +#ifndef USE_XCB x_uncatch_errors (); +#endif unblock_input (); @@ -351,6 +532,8 @@ x_real_pos_and_offsets (struct frame *f, if (xptr) *xptr = real_x; if (yptr) *yptr = real_y; + if (outer_border) *outer_border = bw; + if (right_offset_x) *right_offset_x = ow - fw + outer_x; if (bottom_offset_y) *bottom_offset_y = oh - fh + outer_y; } commit a838c8331cf3f360d919a75cc8d92c72e6d900f0 Author: Ken Raeburn Date: Sat Nov 7 03:06:32 2015 -0500 Enable use of XCB for checking window manager state * src/xterm.c (get_current_wm_state) [USE_XCB]: Use XCB calls instead of XGetWindowProperty plus error-catching, since we can explicitly check for errors in the XCB version. This eliminates 3 XSync calls on top of the round-trip actually fetching the information. diff --git a/src/xterm.c b/src/xterm.c index d1cf8e4..36a914c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10096,20 +10096,45 @@ get_current_wm_state (struct frame *f, int *size_state, bool *sticky) { - Atom actual_type; - unsigned long actual_size, bytes_remaining; - int i, rc, actual_format; + unsigned long actual_size; + int i; bool is_hidden = false; struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); long max_len = 65536; - Display *dpy = FRAME_X_DISPLAY (f); unsigned char *tmp_data = NULL; Atom target_type = XA_ATOM; + /* If XCB is available, we can avoid three XSync calls. */ +#ifdef USE_XCB + xcb_get_property_cookie_t prop_cookie; + xcb_get_property_reply_t *prop; +#else + Display *dpy = FRAME_X_DISPLAY (f); + unsigned long bytes_remaining; + int rc, actual_format; + Atom actual_type; +#endif *sticky = false; *size_state = FULLSCREEN_NONE; block_input (); + +#ifdef USE_XCB + prop_cookie = xcb_get_property (dpyinfo->xcb_connection, 0, window, + dpyinfo->Xatom_net_wm_state, + target_type, 0, max_len); + prop = xcb_get_property_reply (dpyinfo->xcb_connection, prop_cookie, NULL); + if (prop && prop->type == target_type) + { + tmp_data = xcb_get_property_value (prop); + actual_size = xcb_get_property_value_length (prop); + } + else + { + actual_size = 0; + is_hidden = FRAME_ICONIFIED_P (f); + } +#else x_catch_errors (dpy); rc = XGetWindowProperty (dpy, window, dpyinfo->Xatom_net_wm_state, 0, max_len, False, target_type, @@ -10118,13 +10143,12 @@ get_current_wm_state (struct frame *f, if (rc != Success || actual_type != target_type || x_had_errors_p (dpy)) { - if (tmp_data) XFree (tmp_data); - x_uncatch_errors (); - unblock_input (); - return !FRAME_ICONIFIED_P (f); + actual_size = 0; + is_hidden = FRAME_ICONIFIED_P (f); } x_uncatch_errors (); +#endif for (i = 0; i < actual_size; ++i) { @@ -10151,7 +10175,12 @@ get_current_wm_state (struct frame *f, *sticky = true; } +#ifdef USE_XCB + free (prop); +#else if (tmp_data) XFree (tmp_data); +#endif + unblock_input (); return ! is_hidden; } commit c7f2b6ad892c93b8b848d21835a4b093c424cae6 Author: Ken Raeburn Date: Sat Nov 7 03:06:32 2015 -0500 Detect XCB and save a connection handle * configure.ac: If using X11, check for XCB libraries and header. * src/Makefile.in (XCB_LIBS): Define. (LIBX_EXTRA): Include it. * src/xterm.h [USE_XCB]: Include X11/Xlib-xcb.h. (struct x_display_info) [USE_XCB]: Add an XCB connection handle field. * src/xterm.c (x_term_init) [USE_XCB]: Initialize the new field. diff --git a/configure.ac b/configure.ac index 5b2d9c7..94ee9b7 100644 --- a/configure.ac +++ b/configure.ac @@ -3115,6 +3115,21 @@ if test "${HAVE_X11}" = "yes"; then fi fi +if test "${HAVE_X11}" = "yes"; then + AC_CHECK_HEADER(X11/Xlib-xcb.h, + AC_CHECK_LIB(xcb, xcb_translate_coordinates, HAVE_XCB=yes)) + if test "${HAVE_XCB}" = "yes"; then + AC_CHECK_LIB(X11-xcb, XGetXCBConnection, HAVE_X11_XCB=yes) + if test "${HAVE_X11_XCB}" = "yes"; then + AC_DEFINE(USE_XCB, 1, +[Define to 1 if you have the XCB library and X11-XCB library for mixed + X11/XCB programming.]) + XCB_LIBS="-lX11-xcb -lxcb" + AC_SUBST(XCB_LIBS) + fi + fi +fi + ### Use -lXpm if available, unless '--with-xpm=no'. ### mingw32 doesn't use -lXpm, since it loads the library dynamically. ### In the Cygwin-w32 build, we need to use /usr/include/noX/X11/xpm.h diff --git a/src/Makefile.in b/src/Makefile.in index f735759..d667c55 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -128,8 +128,9 @@ LIB_PTHREAD=@LIB_PTHREAD@ LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ +XCB_LIBS=@XCB_LIBS@ XFT_LIBS=@XFT_LIBS@ -LIBX_EXTRA=-lX11 $(XFT_LIBS) +LIBX_EXTRA=-lX11 $(XCB_LIBS) $(XFT_LIBS) FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@ FONTCONFIG_LIBS = @FONTCONFIG_LIBS@ diff --git a/src/xterm.c b/src/xterm.c index 5756378..d1cf8e4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11773,6 +11773,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) struct terminal *terminal; struct x_display_info *dpyinfo; XrmDatabase xrdb; +#ifdef USE_XCB + xcb_connection_t *xcb_conn; +#endif block_input (); @@ -11911,6 +11914,25 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) return 0; } +#ifdef USE_XCB + xcb_conn = XGetXCBConnection (dpy); + if (xcb_conn == 0) + { +#ifdef USE_GTK + xg_display_close (dpy); +#else +#ifdef USE_X_TOOLKIT + XtCloseDisplay (dpy); +#else + XCloseDisplay (dpy); +#endif +#endif /* ! USE_GTK */ + + unblock_input (); + return 0; + } +#endif + /* We have definitely succeeded. Record the new connection. */ dpyinfo = xzalloc (sizeof *dpyinfo); @@ -11961,6 +11983,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->name_list_element = Fcons (display_name, Qnil); dpyinfo->display = dpy; dpyinfo->connection = ConnectionNumber (dpyinfo->display); +#ifdef USE_XCB + dpyinfo->xcb_connection = xcb_conn; +#endif /* http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00194.html */ dpyinfo->smallest_font_height = 1; diff --git a/src/xterm.h b/src/xterm.h index f7d2803..192839b 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -87,6 +87,10 @@ typedef GtkWidget *xt_or_gtk_widget; #include #endif +#ifdef USE_XCB +#include +#endif + #include "dispextern.h" #include "termhooks.h" @@ -458,6 +462,10 @@ struct x_display_info #ifdef USE_CAIRO XExtCodes *ext_codes; #endif + +#ifdef USE_XCB + xcb_connection_t *xcb_connection; +#endif }; #ifdef HAVE_X_I18N commit e1c27dbd25ab22f6000d1e46259e2a60d56416c1 Author: Ken Raeburn Date: Sat Nov 7 03:06:32 2015 -0500 Reduce some data dependencies between X calls Gains nothing in the traditional-Xlib code, but more closely aligns with how the XCB version will work. * src/xfns.c (x_real_pos_and_offsets): When translating coordinates, send coordinates (0,0) to the X server and add in the real coordinates after getting the response. Move XGetGeometry for outer window inside error-trapping block. Use DPY variable more, since it's available. diff --git a/src/xfns.c b/src/xfns.c index db87fcc..c55e6fe 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -194,6 +194,7 @@ x_real_pos_and_offsets (struct frame *f, unsigned char *tmp_data = NULL; Atom target_type = XA_CARDINAL; unsigned int ow IF_LINT (= 0), oh IF_LINT (= 0); + unsigned int fw, fh; block_input (); @@ -223,10 +224,10 @@ x_real_pos_and_offsets (struct frame *f, unsigned int tmp_nchildren; int success; - success = XQueryTree (FRAME_X_DISPLAY (f), win, &rootw, + success = XQueryTree (dpy, win, &rootw, &wm_window, &tmp_children, &tmp_nchildren); - had_errors = x_had_errors_p (FRAME_X_DISPLAY (f)); + had_errors = x_had_errors_p (dpy); /* Don't free tmp_children if XQueryTree failed. */ if (! success) @@ -246,7 +247,7 @@ x_real_pos_and_offsets (struct frame *f, Window child, rootw; /* Get the real coordinates for the WM window upper left corner */ - XGetGeometry (FRAME_X_DISPLAY (f), win, + XGetGeometry (dpy, win, &rootw, &real_x, &real_y, &ow, &oh, &bw, &ign); if (outer_border) @@ -262,18 +263,21 @@ x_real_pos_and_offsets (struct frame *f, | ----------------- v y | | our window */ - XTranslateCoordinates (FRAME_X_DISPLAY (f), + XTranslateCoordinates (dpy, /* From-window, to-window. */ FRAME_DISPLAY_INFO (f)->root_window, FRAME_X_WINDOW (f), /* From-position, to-position. */ - real_x, real_y, &win_x, &win_y, + 0, 0, &win_x, &win_y, /* Child of win. */ &child); + win_x += real_x; + win_y += real_y; + if (FRAME_X_WINDOW (f) == FRAME_OUTER_WINDOW (f)) { outer_x = win_x; @@ -281,20 +285,23 @@ x_real_pos_and_offsets (struct frame *f, } else { - XTranslateCoordinates (FRAME_X_DISPLAY (f), + XTranslateCoordinates (dpy, /* From-window, to-window. */ FRAME_DISPLAY_INFO (f)->root_window, FRAME_OUTER_WINDOW (f), /* From-position, to-position. */ - real_x, real_y, &outer_x, &outer_y, + 0, 0, &outer_x, &outer_y, /* Child of win. */ &child); + + outer_x += real_x; + outer_y += real_y; } - had_errors = x_had_errors_p (FRAME_X_DISPLAY (f)); + had_errors = x_had_errors_p (dpy); } if (!had_errors && dpyinfo->root_window == f->output_data.x->parent_desc) @@ -319,6 +326,16 @@ x_real_pos_and_offsets (struct frame *f, if (tmp_data) XFree (tmp_data); } + if (right_offset_x || bottom_offset_y) + { + int xy_ign; + unsigned int ign; + Window rootw; + + XGetGeometry (dpy, FRAME_OUTER_WINDOW (f), + &rootw, &xy_ign, &xy_ign, &fw, &fh, &ign, &ign); + } + x_uncatch_errors (); unblock_input (); @@ -334,17 +351,8 @@ x_real_pos_and_offsets (struct frame *f, if (xptr) *xptr = real_x; if (yptr) *yptr = real_y; - if (right_offset_x || bottom_offset_y) - { - int xy_ign; - unsigned int ign, fw, fh; - Window rootw; - - XGetGeometry (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - &rootw, &xy_ign, &xy_ign, &fw, &fh, &ign, &ign); - if (right_offset_x) *right_offset_x = ow - fw + outer_x; - if (bottom_offset_y) *bottom_offset_y = oh - fh + outer_y; - } + if (right_offset_x) *right_offset_x = ow - fw + outer_x; + if (bottom_offset_y) *bottom_offset_y = oh - fh + outer_y; } /* Store the screen positions of frame F into XPTR and YPTR. commit 25e32bd861cdf405e74f8025116625b2f6d6607b Author: Ken Raeburn Date: Sat Nov 7 03:06:32 2015 -0500 Use color cache for creating bitmap * src/image.c (x_create_bitmap_from_xpm_data) [ALLOC_XPM_COLORS]: Set attributes to use the caching color allocator. Initialize and free the cache. diff --git a/src/image.c b/src/image.c index 41687eb..544435e 100644 --- a/src/image.c +++ b/src/image.c @@ -3508,6 +3508,14 @@ x_create_bitmap_from_xpm_data (struct frame *f, const char **bits) attrs.valuemask |= XpmVisual; attrs.valuemask |= XpmColormap; +#ifdef ALLOC_XPM_COLORS + attrs.color_closure = f; + attrs.alloc_color = xpm_alloc_color; + attrs.free_colors = xpm_free_colors; + attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure; + xpm_init_color_cache (f, &attrs); +#endif + rc = XpmCreatePixmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), (char **) bits, &bitmap, &mask, &attrs); if (rc != XpmSuccess) @@ -3526,6 +3534,9 @@ x_create_bitmap_from_xpm_data (struct frame *f, const char **bits) dpyinfo->bitmaps[id - 1].depth = attrs.depth; dpyinfo->bitmaps[id - 1].refcount = 1; +#ifdef ALLOC_XPM_COLORS + xpm_free_color_cache (); +#endif XpmFreeAttributes (&attrs); return id; } commit 851be0f60718795c985f504db4823344508b107d Author: Eli Barzilay Date: Thu Nov 12 03:07:38 2015 -0500 Add "^" to the interactive specs of `dired-next/previous-line' * lisp/dired.el (dired-next-line, dired-previous-line): It makes sense to bind these commands to the arrow keys, and that means that they work better with a "^" in the `interactive' declaration so selection works as expected. diff --git a/lisp/dired.el b/lisp/dired.el index 5f0a83a..049d45d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2031,7 +2031,7 @@ Otherwise, toggle `read-only-mode'." (defun dired-next-line (arg) "Move down lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." - (interactive "p") + (interactive "^p") (let ((line-move-visual) (goal-column)) (line-move arg t)) @@ -2044,7 +2044,7 @@ Optional prefix ARG says how many lines to move; default is one line." (defun dired-previous-line (arg) "Move up lines then position at filename. Optional prefix ARG says how many lines to move; default is one line." - (interactive "p") + (interactive "^p") (dired-next-line (- (or arg 1)))) (defun dired-next-dirline (arg &optional opoint) commit 055ca3a57e7326cd24bbb958531f6938466f5fd9 Author: Thomas Fitzsimmons Date: Wed Nov 11 23:43:50 2015 -0500 Sync with soap-client repository, version 3.0.2 * soap-client.el: Bump version to 3.0.2. * soap-client.el (soap-warning): Use format, not format-message. * soap-client.el: Add cl-lib to Package-Requires. Require cl-lib. (soap-validate-xs-simple-type): Use cl-labels instead of cl-flet. * soap-client.el: Support Emacs versions that do not have define-error. * soap-inspect.el: Remove version header. * soap-client.el, soap-inspect.el, jira2.el: Fix first line header format. diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 8317325..71d4245 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -1,14 +1,15 @@ -;;;; soap-client.el -- Access SOAP web services -*- lexical-binding: t -*- +;;; soap-client.el --- Access SOAP web services -*- lexical-binding: t -*- ;; Copyright (C) 2009-2015 Free Software Foundation, Inc. ;; Author: Alexandru Harsanyi ;; Author: Thomas Fitzsimmons ;; Created: December, 2009 -;; Version: 3.0.1 +;; Version: 3.0.2 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client +;; Package-Requires: ((cl-lib "0.5")) ;; This file is part of GNU Emacs. @@ -43,6 +44,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'xml) (require 'xsd-regexp) @@ -57,8 +59,8 @@ (defsubst soap-warning (message &rest args) "Display a warning MESSAGE with ARGS, using the 'soap-client warning type." - (display-warning 'soap-client (apply #'format-message message args) - :warning)) + ;; Do not use #'format-message, to support older Emacs versions. + (display-warning 'soap-client (apply #'format message args) :warning)) (defgroup soap-client nil "Access SOAP web services from Emacs." @@ -1246,9 +1248,9 @@ See also `soap-wsdl-resolve-references'." (error (push (cadr error-object) messages)))) (when messages (error (mapconcat 'identity (nreverse messages) "; and: ")))) - (cl-flet ((fail-with-message (format value) - (push (format format value) messages) - (throw 'invalid nil))) + (cl-labels ((fail-with-message (format value) + (push (format format value) messages) + (throw 'invalid nil))) (catch 'invalid (let ((enumeration (soap-xs-simple-type-enumeration type))) (when (and (> (length enumeration) 1) @@ -2753,7 +2755,14 @@ decode function to perform the actual decoding." ;;;; Soap Envelope parsing -(define-error 'soap-error "SOAP error") +(if (fboundp 'define-error) + (define-error 'soap-error "SOAP error") + ;; Support older Emacs versions that do not have define-error, so + ;; that soap-client can remain unchanged in GNU ELPA. + (put 'soap-error + 'error-conditions + '(error soap-error)) + (put 'soap-error 'error-message "SOAP error")) (defun soap-parse-envelope (node operation wsdl) "Parse the SOAP envelope in NODE and return the response. diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index b01e2bf..a443041 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -1,10 +1,9 @@ -;;;; soap-inspect.el -- Interactive WSDL inspector -*- lexical-binding: t -*- +;;; soap-inspect.el --- Interactive WSDL inspector -*- lexical-binding: t -*- ;; Copyright (C) 2010-2015 Free Software Foundation, Inc. ;; Author: Alexandru Harsanyi ;; Created: October 2010 -;; Version: 3.0.1 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; Homepage: https://github.com/alex-hhh/emacs-soap-client commit e0f64e7b4f9c3bbc12c4909ca8c8aa751f1fca4a Author: Alan Mackenzie Date: Wed Nov 11 22:06:12 2015 +0000 CC Mode: Respect users' settings of open-paren-in-column-0-is-defun-start. lisp/progmodes/cc-engine.el (c-backward-single-comment, c-backward-comments) (c-invalidate-state-cache-1, c-parse-state-1, c-guess-basic-syntax): remove bindings of open-paren-in-column-0-is-defun-start to nil. (c-get-fallback-scan-pos): "New" function (existed several years ago). (c-parse-state-get-strategy): Reintroduce the 'BOD strategy, using c-get-fallback-scan-pos. (c-parse-state-1): Handle 'BOD strategy. lisp/progmodes/cc-mode.el (c-before-change, c-after-change) c-font-lock-fontify-region): remove bindings of open-paren-in-column-0-is-defun-start to nil. cc-mode.texi (Performance Issues, Limitations and Known Bugs): Fix mix up between @chapter and @appendix. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index b93bc8f..9b488cb 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -6860,7 +6860,7 @@ to change some of the actual values. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Performance Issues, Limitations and Known Bugs, Sample Init File, Top @comment node-name, next, previous, up -@chapter Performance Issues +@appendix Performance Issues @cindex performance @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -6969,7 +6969,7 @@ more info. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Limitations and Known Bugs, FAQ, Performance Issues, Top @comment node-name, next, previous, up -@chapter Limitations and Known Bugs +@appendix Limitations and Known Bugs @cindex limitations @cindex bugs @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 6382b14..6572cee 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1449,13 +1449,12 @@ This function does not do any hidden buffer changes." ;; same line. (re-search-forward "\\=\\s *[\n\r]" start t) - (if (if (let (open-paren-in-column-0-is-defun-start) (forward-comment -1)) + (if (if (forward-comment -1) (if (eolp) ;; If forward-comment above succeeded and we're at eol ;; then the newline we moved over above didn't end a ;; line comment, so we give it another go. - (let (open-paren-in-column-0-is-defun-start) - (forward-comment -1)) + (forward-comment -1) t)) ;; Emacs <= 20 and XEmacs move back over the closer of a @@ -1482,7 +1481,7 @@ comment at the start of cc-engine.el for more info." ;; return t when moving backwards at bob. (not (bobp)) - (if (let (open-paren-in-column-0-is-defun-start moved-comment) + (if (let (moved-comment) (while (and (not (setq moved-comment (forward-comment -1))) ;; Cope specifically with ^M^J here - @@ -2524,6 +2523,20 @@ comment at the start of cc-engine.el for more info." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Defuns which analyze the buffer, yet don't change `c-state-cache'. +(defun c-get-fallback-scan-pos (here) + ;; Return a start position for building `c-state-cache' from + ;; scratch. This will be at the top level, 2 defuns back. + (save-excursion + ;; Go back 2 bods, but ignore any bogus positions returned by + ;; beginning-of-defun (i.e. open paren in column zero). + (goto-char here) + (let ((cnt 2)) + (while (not (or (bobp) (zerop cnt))) + (c-beginning-of-defun-1) ; Pure elisp BOD. + (if (eq (char-after) ?\{) + (setq cnt (1- cnt))))) + (point))) + (defun c-state-balance-parens-backwards (here- here+ top) ;; Return the position of the opening paren/brace/bracket before HERE- which ;; matches the outermost close p/b/b between HERE+ and TOP. Except when @@ -2584,22 +2597,46 @@ comment at the start of cc-engine.el for more info." ;; o - ('backward nil) - scan backwards (from HERE). ;; o - ('back-and-forward START-POINT) - like 'forward, but when HERE is earlier ;; than GOOD-POS. + ;; o - ('BOD START-POINT) - scan forwards from START-POINT, which is at the + ;; top level. ;; o - ('IN-LIT nil) - point is inside the literal containing point-min. (let ((cache-pos (c-get-cache-scan-pos here)) ; highest position below HERE in cache (or 1) - strategy ; 'forward, 'backward, or 'IN-LIT. - start-point) + BOD-pos ; position of 2nd BOD before HERE. + strategy ; 'forward, 'backward, 'BOD, or 'IN-LIT. + start-point + how-far) ; putative scanning distance. (setq good-pos (or good-pos (c-state-get-min-scan-pos))) (cond ((< here (c-state-get-min-scan-pos)) - (setq strategy 'IN-LIT)) + (setq strategy 'IN-LIT + start-point nil + cache-pos nil + how-far 0)) ((<= good-pos here) (setq strategy 'forward - start-point (max good-pos cache-pos))) + start-point (max good-pos cache-pos) + how-far (- here start-point))) ((< (- good-pos here) (- here cache-pos)) ; FIXME!!! ; apply some sort of weighting. - (setq strategy 'backward)) + (setq strategy 'backward + how-far (- good-pos here))) (t (setq strategy 'back-and-forward - start-point cache-pos))) + start-point cache-pos + how-far (- here start-point)))) + + ;; Might we be better off starting from the top level, two defuns back, + ;; instead? This heuristic no longer works well in C++, where + ;; declarations inside namespace brace blocks are frequently placed at + ;; column zero. (2015-11-10): Remove the condition on C++ Mode. + (when (and (or (not (memq 'col-0-paren c-emacs-features)) + open-paren-in-column-0-is-defun-start) + ;; (not (c-major-mode-is 'c++-mode)) + (> how-far c-state-cache-too-far)) + (setq BOD-pos (c-get-fallback-scan-pos here)) ; somewhat EXPENSIVE!!! + (if (< (- here BOD-pos) how-far) + (setq strategy 'BOD + start-point BOD-pos))) + (list strategy start-point))) @@ -3227,8 +3264,7 @@ comment at the start of cc-engine.el for more info." ;; Truncate `c-state-cache' and set `c-state-cache-good-pos' to a value ;; below `here'. To maintain its consistency, we may need to insert a new ;; brace pair. - (let (open-paren-in-column-0-is-defun-start - (here-bol (c-point 'bol here)) + (let ((here-bol (c-point 'bol here)) too-high-pa ; recorded {/(/[ next above here, or nil. dropped-cons ; was the last removed element a brace pair? pa) @@ -3299,7 +3335,6 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (let* ((here (point)) (here-bopl (c-point 'bopl)) - open-paren-in-column-0-is-defun-start strategy ; 'forward, 'backward etc.. ;; Candidate positions to start scanning from: cache-pos ; highest position below HERE already existing in @@ -3320,9 +3355,13 @@ comment at the start of cc-engine.el for more info." strategy (car res) start-point (cadr res)) + (when (eq strategy 'BOD) + (setq c-state-cache nil + c-state-cache-good-pos start-point)) + ;; SCAN! (cond - ((memq strategy '(forward back-and-forward)) + ((memq strategy '(forward back-and-forward BOD)) (setq res (c-remove-stale-state-cache start-point here here-bopl)) (setq cache-pos (car res) scan-backward-pos (cadr res) @@ -9571,7 +9610,6 @@ comment at the start of cc-engine.el for more info." (c-save-buffer-state ((indent-point (point)) (case-fold-search nil) - open-paren-in-column-0-is-defun-start ;; A whole ugly bunch of various temporary variables. Have ;; to declare them here since it's not possible to declare ;; a variable with only the scope of a cond test and the diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 1b6a233..a46ee15 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1098,10 +1098,9 @@ Note that the style variables are always made local to the buffer." (buffer-substring-no-properties beg end))))))) (if c-get-state-before-change-functions - (let (open-paren-in-column-0-is-defun-start) - (mapc (lambda (fn) - (funcall fn beg end)) - c-get-state-before-change-functions))) + (mapc (lambda (fn) + (funcall fn beg end)) + c-get-state-before-change-functions)) ))) ;; The following must be done here rather than in `c-after-change' because ;; newly inserted parens would foul up the invalidation algorithm. @@ -1132,7 +1131,7 @@ Note that the style variables are always made local to the buffer." (unless (c-called-from-text-property-change-p) (setq c-just-done-before-change nil) - (c-save-buffer-state (case-fold-search open-paren-in-column-0-is-defun-start) + (c-save-buffer-state (case-fold-search) ;; When `combine-after-change-calls' is used we might get calls ;; with regions outside the current narrowing. This has been ;; observed in Emacs 20.7. @@ -1268,8 +1267,7 @@ Note that the style variables are always made local to the buffer." ;; ;; Type a space in the first blank line, and the fontification of the next ;; line was fouled up by context fontification. - (let (new-beg new-end new-region case-fold-search - open-paren-in-column-0-is-defun-start) + (let (new-beg new-end new-region case-fold-search) (if (and c-in-after-change-fontification (< beg c-new-END) (> end c-new-BEG)) ;; Region and the latest after-change fontification region overlap. commit 952395d3eb813e1c21b8bace10e54aa67bee9122 Author: Artur Malabarba Date: Wed Nov 11 22:30:22 2015 +0000 * lisp/obarray.el: Fix shadowed variables (obarray-map, obarray-remove, obarray-put, obarray-get): Change OBARRAY arg to OB to avoid shadowing ‘obarray’. diff --git a/lisp/obarray.el b/lisp/obarray.el index bf8bb3e..a93c9a9 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -42,24 +42,25 @@ (and (vectorp object) (< 0 (length object)))) -(defun obarray-get (obarray name) - "Return symbol named NAME if it is contained in OBARRAY. +;; Don’t use obarray as a variable name to avoid shadowing. +(defun obarray-get (ob name) + "Return symbol named NAME if it is contained in obarray OB. Return nil otherwise." - (intern-soft name obarray)) + (intern-soft name ob)) -(defun obarray-put (obarray name) - "Return symbol named NAME from OBARRAY. +(defun obarray-put (ob name) + "Return symbol named NAME from obarray OB. Creates and adds the symbol if doesn't exist." - (intern name obarray)) + (intern name ob)) -(defun obarray-remove (obarray name) - "Remove symbol named NAME if it is contained in OBARRAY. +(defun obarray-remove (ob name) + "Remove symbol named NAME if it is contained in obarray OB. Return t on success, nil otherwise." - (unintern name obarray)) + (unintern name ob)) -(defun obarray-map (fn obarray) - "Call function FN on every symbol in OBARRAY and return nil." - (mapatoms fn obarray)) +(defun obarray-map (fn ob) + "Call function FN on every symbol in obarray OB and return nil." + (mapatoms fn ob)) (provide 'obarray) ;;; obarray.el ends here commit 436d3307211db86d5606e6cec51d6fbe9f7572a8 Author: Eli Zaretskii Date: Wed Nov 11 22:01:39 2015 +0200 Avoid error in submitting a form with EWW * lisp/gnus/mm-url.el (mm-url-form-encode-xwfu): Allow argument CHUNK to be nil. (Bug#21881) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 6d5f2a3..ecc5ac4 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -392,17 +392,18 @@ spaces. Die Die Die." (if (consp chunk) (setq chunk (cdr chunk))) - (mapconcat - (lambda (char) - (cond - ((= char ? ) "+") - ((memq char mm-url-unreserved-chars) (char-to-string char)) - (t (upcase (format "%%%02x" char))))) - (mm-encode-coding-string chunk - (if (fboundp 'find-coding-systems-string) - (car (find-coding-systems-string chunk)) - buffer-file-coding-system)) - "")) + (if chunk + (mapconcat + (lambda (char) + (cond + ((= char ? ) "+") + ((memq char mm-url-unreserved-chars) (char-to-string char)) + (t (upcase (format "%%%02x" char))))) + (mm-encode-coding-string chunk + (if (fboundp 'find-coding-systems-string) + (car (find-coding-systems-string chunk)) + buffer-file-coding-system)) + ""))) (defun mm-url-encode-www-form-urlencoded (pairs) "Return PAIRS encoded for forms." commit e887f6e33bd22eee5102f85c04397483169a1722 Author: Juanma Barranquero Date: Wed Nov 11 18:42:25 2015 +0100 ; * doc/lispref/os.texi: Fix indentation of sample code. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 1345ed2..53aa0e1 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2893,7 +2893,7 @@ of setting this variable for supporting images on MS-Windows: (svg "librsvg-2-2.dll") (gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") (glib "libglib-2.0-0.dll") - (gobject "libgobject-2.0-0.dll"))) + (gobject "libgobject-2.0-0.dll"))) @end example Note that image types @code{pbm} and @code{xbm} do not need entries in commit 51d840a8a13105172211bb25d36f594aff377d8e Author: Nicolas Petton Date: Wed Nov 11 18:18:32 2015 +0100 Rename seq-p and map-p to seqp and mapp * lisp/emacs-lisp/seq.el (seqp): New name. * lisp/emacs-lisp/map.el (mapp): New name. * doc/lispref/sequences.texi: Update the documentation for seqp. * test/automated/map-tests.el: Update the tests for mapp. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 84a7c32..66d88e4 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -467,18 +467,18 @@ built-in sequence types, @code{seq-length} behaves like @code{length}. @xref{Definition of length}. @end defun -@defun seq-p sequence +@defun seqp sequence This function returns non-@code{nil} if @var{sequence} is a sequence (a list or array), or any additional type of sequence defined via @file{seq.el} generic functions. @example @group -(seq-p [1 2]) +(seqp [1 2]) @result{} t @end group @group -(seq-p 2) +(seqp 2) @result{} nil @end group @end example diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 7ff9031..98a3565 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -58,7 +58,7 @@ unquoted form. ARGS can also be a list of symbols, which stands for ('SYMBOL SYMBOL)." - `(and (pred map-p) + `(and (pred mapp) ,@(map--make-pcase-bindings args))) (defmacro map-let (keys map &rest body) @@ -155,7 +155,7 @@ MAP can be a list, hash-table or array." Map can be a nested map composed of alists, hash-tables and arrays." (or (seq-reduce (lambda (acc key) - (when (map-p acc) + (when (mapp acc) (map-elt acc key))) keys map) @@ -239,7 +239,7 @@ MAP can be a list, hash-table or array." (map-filter (lambda (key val) (not (funcall pred key val))) map)) -(defun map-p (map) +(defun mapp (map) "Return non-nil if MAP is a map (list, hash-table or array)." (or (listp map) (hash-table-p map) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 6826509..456efd0 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 2.2 +;; Version: 2.3 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -46,7 +46,7 @@ ;; - `seq-elt' ;; - `seq-length' ;; - `seq-do' -;; - `seq-p' +;; - `seqp' ;; - `seq-subseq' ;; - `seq-into-sequence' ;; - `seq-copy' @@ -79,7 +79,7 @@ corresponding element of SEQUENCE. Extra elements of the sequence are ignored if fewer PATTERNS are given, and the match does not fail." - `(and (pred seq-p) + `(and (pred seqp) ,@(seq--make-pcase-bindings patterns))) (defmacro seq-let (args sequence &rest body) @@ -117,7 +117,7 @@ Return SEQUENCE." (defalias 'seq-each #'seq-do) -(cl-defgeneric seq-p (sequence) +(cl-defgeneric seqp (sequence) "Return non-nil if SEQUENCE is a sequence, nil otherwise." (sequencep sequence)) @@ -433,7 +433,7 @@ SEQUENCE must be a sequence of numbers or markers." "Return a list of `(seq ...)' pcase patterns from the argument list ARGS." (cons 'seq (seq-map (lambda (elt) - (if (seq-p elt) + (if (seqp elt) (seq--make-pcase-patterns elt) elt)) args))) diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index 1a759b5..2a7fcc3 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -126,16 +126,16 @@ Evaluate BODY for each created map. (should (null (map-nested-elt vec '(2 1 1)))) (should (= 4 (map-nested-elt vec '(2 1 1) 4))))) -(ert-deftest test-map-p () - (should (map-p nil)) - (should (map-p '((a . b) (c . d)))) - (should (map-p '(a b c d))) - (should (map-p [])) - (should (map-p [1 2 3])) - (should (map-p (make-hash-table))) - (should (map-p "hello")) - (should (not (map-p 1))) - (should (not (map-p 'hello)))) +(ert-deftest test-mapp () + (should (mapp nil)) + (should (mapp '((a . b) (c . d)))) + (should (mapp '(a b c d))) + (should (mapp [])) + (should (mapp [1 2 3])) + (should (mapp (make-hash-table))) + (should (mapp "hello")) + (should (not (mapp 1))) + (should (not (mapp 'hello)))) (ert-deftest test-map-keys () (with-maps-do map commit 23036bac7d470397f364d02eb992d701f1ebab4b Author: Nicolas Petton Date: Wed Nov 11 18:09:42 2015 +0100 Rename obarray-p to obarrayp * lisp/obarray.el (obarrayp): New name. * test/automated/obarray-tests.el: Update the tests. diff --git a/lisp/obarray.el b/lisp/obarray.el index 0e57381..bf8bb3e 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -37,7 +37,7 @@ (make-vector size 0) (signal 'wrong-type-argument '(size 0))))) -(defun obarray-p (object) +(defun obarrayp (object) "Return t if OBJECT is an obarray." (and (vectorp object) (< 0 (length object)))) diff --git a/test/automated/obarray-tests.el b/test/automated/obarray-tests.el index 97df3b3..4cc61b6 100644 --- a/test/automated/obarray-tests.el +++ b/test/automated/obarray-tests.el @@ -26,30 +26,30 @@ (require 'obarray) (require 'ert) -(ert-deftest obarray-p-test () +(ert-deftest obarrayp-test () "Should assert that given object is an obarray." - (should-not (obarray-p 42)) - (should-not (obarray-p "aoeu")) - (should-not (obarray-p '())) - (should-not (obarray-p [])) - (should (obarray-p (make-vector 7 0)))) + (should-not (obarrayp 42)) + (should-not (obarrayp "aoeu")) + (should-not (obarrayp '())) + (should-not (obarrayp [])) + (should (obarrayp (make-vector 7 0)))) -(ert-deftest obarray-p-unchecked-content-test () +(ert-deftest obarrayp-unchecked-content-test () "Should fail to check content of passed obarray." :expected-result :failed - (should-not (obarray-p ["a" "b" "c"])) - (should-not (obarray-p [1 2 3]))) + (should-not (obarrayp ["a" "b" "c"])) + (should-not (obarrayp [1 2 3]))) (ert-deftest obarray-make-default-test () (let ((table (obarray-make))) - (should (obarray-p table)) + (should (obarrayp table)) (should (equal (make-vector 59 0) table)))) (ert-deftest obarray-make-with-size-test () (should-error (obarray-make -1) :type 'wrong-type-argument) (should-error (obarray-make 0) :type 'wrong-type-argument) (let ((table (obarray-make 1))) - (should (obarray-p table)) + (should (obarrayp table)) (should (equal (make-vector 1 0) table)))) (ert-deftest obarray-get-test () commit 20aea4293439281570c5c05d3f54bc5b261a4d0f Author: Nicolas Petton Date: Wed Nov 11 17:53:41 2015 +0100 Rename obarray-foreach to obarray-map * lisp/obarray.el (obarray-map): New name. * test/automated/obarray-tests.el: Update the corresponding tests. diff --git a/lisp/obarray.el b/lisp/obarray.el index fb7a333..0e57381 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -57,7 +57,7 @@ Creates and adds the symbol if doesn't exist." Return t on success, nil otherwise." (unintern name obarray)) -(defun obarray-foreach (fn obarray) +(defun obarray-map (fn obarray) "Call function FN on every symbol in OBARRAY and return nil." (mapatoms fn obarray)) diff --git a/test/automated/obarray-tests.el b/test/automated/obarray-tests.el index 16ed694..97df3b3 100644 --- a/test/automated/obarray-tests.el +++ b/test/automated/obarray-tests.el @@ -73,17 +73,17 @@ (should (obarray-remove table "aoeu")) (should-not (obarray-get table "aoeu")))) -(ert-deftest obarray-foreach-test () +(ert-deftest obarray-map-test () "Should execute function on all elements of obarray." (let* ((table (obarray-make 3)) (syms '()) (collect-names (lambda (sym) (push (symbol-name sym) syms)))) - (obarray-foreach collect-names table) + (obarray-map collect-names table) (should (null syms)) (obarray-put table "a") (obarray-put table "b") (obarray-put table "c") - (obarray-foreach collect-names table) + (obarray-map collect-names table) (should (equal (sort syms #'string<) '("a" "b" "c"))))) (provide 'obarray-tests) commit a3b210129ccf416301f36ec9ab6e624b455db907 Author: Przemysław Wojnowski Date: Sun Nov 8 16:59:07 2015 +0100 New file with obarray functions. * lisp/obarray.el: basic obarray functions extracted from abbrev.el * test/automated/obarray-tests.el: new file diff --git a/lisp/obarray.el b/lisp/obarray.el new file mode 100644 index 0000000..fb7a333 --- /dev/null +++ b/lisp/obarray.el @@ -0,0 +1,65 @@ +;;; obarray.el --- obarray functions -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Keywords: obarray functions +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file provides function for working with obarrays. + +;;; Code: + +(defconst obarray-default-size 59 + "The value 59 is an arbitrary prime number that gives a good hash.") + +(defun obarray-make (&optional size) + "Return a new obarray of size SIZE or `obarray-default-size'." + (let ((size (or size obarray-default-size))) + (if (< 0 size) + (make-vector size 0) + (signal 'wrong-type-argument '(size 0))))) + +(defun obarray-p (object) + "Return t if OBJECT is an obarray." + (and (vectorp object) + (< 0 (length object)))) + +(defun obarray-get (obarray name) + "Return symbol named NAME if it is contained in OBARRAY. +Return nil otherwise." + (intern-soft name obarray)) + +(defun obarray-put (obarray name) + "Return symbol named NAME from OBARRAY. +Creates and adds the symbol if doesn't exist." + (intern name obarray)) + +(defun obarray-remove (obarray name) + "Remove symbol named NAME if it is contained in OBARRAY. +Return t on success, nil otherwise." + (unintern name obarray)) + +(defun obarray-foreach (fn obarray) + "Call function FN on every symbol in OBARRAY and return nil." + (mapatoms fn obarray)) + +(provide 'obarray) +;;; obarray.el ends here diff --git a/test/automated/obarray-tests.el b/test/automated/obarray-tests.el new file mode 100644 index 0000000..16ed694 --- /dev/null +++ b/test/automated/obarray-tests.el @@ -0,0 +1,90 @@ +;;; obarray-tests.el --- Tests for obarray -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Przemysław Wojnowski + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'obarray) +(require 'ert) + +(ert-deftest obarray-p-test () + "Should assert that given object is an obarray." + (should-not (obarray-p 42)) + (should-not (obarray-p "aoeu")) + (should-not (obarray-p '())) + (should-not (obarray-p [])) + (should (obarray-p (make-vector 7 0)))) + +(ert-deftest obarray-p-unchecked-content-test () + "Should fail to check content of passed obarray." + :expected-result :failed + (should-not (obarray-p ["a" "b" "c"])) + (should-not (obarray-p [1 2 3]))) + +(ert-deftest obarray-make-default-test () + (let ((table (obarray-make))) + (should (obarray-p table)) + (should (equal (make-vector 59 0) table)))) + +(ert-deftest obarray-make-with-size-test () + (should-error (obarray-make -1) :type 'wrong-type-argument) + (should-error (obarray-make 0) :type 'wrong-type-argument) + (let ((table (obarray-make 1))) + (should (obarray-p table)) + (should (equal (make-vector 1 0) table)))) + +(ert-deftest obarray-get-test () + (let ((table (obarray-make 3))) + (should-not (obarray-get table "aoeu")) + (intern "aoeu" table) + (should (string= "aoeu" (obarray-get table "aoeu"))))) + +(ert-deftest obarray-put-test () + (let ((table (obarray-make 3))) + (should-not (obarray-get table "aoeu")) + (should (string= "aoeu" (obarray-put table "aoeu"))) + (should (string= "aoeu" (obarray-get table "aoeu"))))) + +(ert-deftest obarray-remove-test () + (let ((table (obarray-make 3))) + (should-not (obarray-get table "aoeu")) + (should-not (obarray-remove table "aoeu")) + (should (string= "aoeu" (obarray-put table "aoeu"))) + (should (string= "aoeu" (obarray-get table "aoeu"))) + (should (obarray-remove table "aoeu")) + (should-not (obarray-get table "aoeu")))) + +(ert-deftest obarray-foreach-test () + "Should execute function on all elements of obarray." + (let* ((table (obarray-make 3)) + (syms '()) + (collect-names (lambda (sym) (push (symbol-name sym) syms)))) + (obarray-foreach collect-names table) + (should (null syms)) + (obarray-put table "a") + (obarray-put table "b") + (obarray-put table "c") + (obarray-foreach collect-names table) + (should (equal (sort syms #'string<) '("a" "b" "c"))))) + +(provide 'obarray-tests) +;;; obarray-tests.el ends here commit 9d43941569fc3840fa9306d149461a8439a54d68 Author: Eli Zaretskii Date: Wed Nov 11 18:29:36 2015 +0200 Implement tray notifications for MS-Windows * src/w32fns.c (MY_NOTIFYICONDATAW): New typedef. (NOTIFYICONDATAW_V1_SIZE, NOTIFYICONDATAW_V2_SIZE) (NOTIFYICONDATAW_V3_SIZE, NIF_INFO, NIIF_NONE, NIIF_INFO) (NIIF_WARNING, NIIF_ERROR, EMACS_TRAY_NOTIFICATION_ID) (EMACS_NOTIFICATION_MSG): New macros. (NI_Severity): New enumeration. (get_dll_version, utf8_mbslen_lim, add_tray_notification) (delete_tray_notification, Fw32_notification_notify) (Fw32_notification_close): New functions. (syms_of_w32fns): Defsubr functions exposed to Lisp. DEFSYM keywords used by w32-notification-notify. * doc/lispref/os.texi (Desktop Notifications): Describe the native w32 tray notifications. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 7050df8..1345ed2 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2323,10 +2323,11 @@ Emacs is restarted by the session manager. @cindex notifications, on desktop Emacs is able to send @dfn{notifications} on systems that support the -freedesktop.org Desktop Notifications Specification. In order to use -this functionality, Emacs must have been compiled with D-Bus support, -and the @code{notifications} library must be loaded. @xref{Top, , -D-Bus,dbus,D-Bus integration in Emacs}. +freedesktop.org Desktop Notifications Specification and on MS-Windows. +In order to use this functionality on Posix hosts, Emacs must have +been compiled with D-Bus support, and the @code{notifications} library +must be loaded. @xref{Top, , D-Bus,dbus,D-Bus integration in Emacs}. +The following function is supported when D-Bus support is available: @defun notifications-notify &rest params This function sends a notification to the desktop via D-Bus, @@ -2559,6 +2560,85 @@ If @var{spec_version} is @code{nil}, the server supports a specification prior to @samp{"1.0"}. @end defun +@cindex tray notifications, MS-Windows +When Emacs runs on MS-Windows as a GUI session, it supports a small +subset of the D-Bus notifications functionality via a native +primitive: + +@defun w32-notification-notify &rest params +This function displays an MS-Windows tray notification as specified by +@var{params}. MS-Windows tray notifications are displayed in a +balloon from an icon in the notification area of the taskbar. + +Value is the integer unique ID of the notification that can be used to +remove the notification using @code{w32-notification-close}, described +below. If the function fails, the return value is @code{nil}. + +The arguments @var{params} are specified as keyword/value pairs. All the +parameters are optional, but if no parameters are specified, the +function will do nothing and return @code{nil}. + +The following parameters are supported: + +@table @code +@item :icon @var{icon} +Display @var{icon} in the system tray. If @var{icon} is a string, it +should specify a file name from which to load the icon; the specified +file should be a @file{.ico} Windows icon file. If @var{icon} is not +a string, or if this parameter is not specified, the standard Emacs +icon will be used. + +@item :tip @var{tip} +Use @var{tip} as the tooltip for the notification. If @var{tip} is a +string, this is the text of a tooltip that will be shown when the +mouse pointer hovers over the tray icon added by the notification. If +@var{tip} is not a string, or if this parameter is not specified, the +default tooltip text is @samp{Emacs notification}. The tooltip text can +be up to 127 characters long (63 on Windows versions before W2K). +Longer strings will be truncated. + +@item :level @var{level} +Notification severity level, one of @code{info}, @code{warning}, or +@code{error}. If given, the value determines the icon displayed to the +left of the notification title, but only if the @code{:title} parameter +(see below) is also specified and is a string. + +@item :timeout @var{timeout} +@var{timeout} is the time in seconds after which the notification +disappears. The value can be integer or floating-point. This is +ignored on Vista and later systems, where the duration is fixed at 9 +sec and can only be customized via system-wide Accessibility settings. + +@item :title @var{title} +The title of the notification. If @var{title} is a string, it is +displayed in a larger font immediately above the body text. The title +text can be up to 63 characters long; longer text will be truncated. + +@item :body @var{body} +The body of the notification. If @var{body} is a string, it specifies +the text of the notification message. Use embedded newlines to +control how the text is broken into lines. The body text can be up to +255 characters long, and will be truncated if it's longer. Unlike +with D-Bus, the body text should be plain text, with no markup. +@end table + +Note that versions of Windows before W2K support only @code{:icon} and +@code{:tip}. The other parameters can be passed, but they will be +ignored on those old systems. + +There can be at most one active notification at any given time. An +active notification must be removed by calling +@code{w32-notification-close} before a new one can be shown. +@end defun + +To remove the notification and its icon from the taskbar, use the +following function: + +@defun w32-notification-close id +This function removes the tray notification given by its unique +@var{id}. +@end defun + @node File Notifications @section Notifications on File Changes @cindex file notifications diff --git a/src/w32fns.c b/src/w32fns.c index d92352a..eed849f 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -55,6 +55,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include #include #include @@ -8755,6 +8756,473 @@ Internal use only. */) return menubar_in_use ? Qt : Qnil; } +/*********************************************************************** + Tray notifications + ***********************************************************************/ +/* A private struct declaration to avoid compile-time limits. */ +typedef struct MY_NOTIFYICONDATAW { + DWORD cbSize; + HWND hWnd; + UINT uID; + UINT uFlags; + UINT uCallbackMessage; + HICON hIcon; + WCHAR szTip[128]; + DWORD dwState; + DWORD dwStateMask; + WCHAR szInfo[256]; + _ANONYMOUS_UNION union { + UINT uTimeout; + UINT uVersion; + } DUMMYUNIONNAME; + WCHAR szInfoTitle[64]; + DWORD dwInfoFlags; + GUID guidItem; + HICON hBalloonIcon; +} MY_NOTIFYICONDATAW; + +#ifndef NOTIFYICONDATAW_V1_SIZE +# define NOTIFYICONDATAW_V1_SIZE offsetof (MY_NOTIFYICONDATAW, szTip[64]) +#endif +#ifndef NOTIFYICONDATAW_V2_SIZE +# define NOTIFYICONDATAW_V2_SIZE offsetof (MY_NOTIFYICONDATAW, guidItem) +#endif +#ifndef NOTIFYICONDATAW_V3_SIZE +# define NOTIFYICONDATAW_V3_SIZE offsetof (MY_NOTIFYICONDATAW, hBalloonIcon) +#endif +#ifndef NIF_INFO +# define NIF_INFO 0x00000010 +#endif +#ifndef NIIF_NONE +# define NIIF_NONE 0x00000000 +#endif +#ifndef NIIF_INFO +# define NIIF_INFO 0x00000001 +#endif +#ifndef NIIF_WARNING +# define NIIF_WARNING 0x00000002 +#endif +#ifndef NIIF_ERROR +# define NIIF_ERROR 0x00000003 +#endif + + +#define EMACS_TRAY_NOTIFICATION_ID 42 /* arbitrary */ +#define EMACS_NOTIFICATION_MSG (WM_APP + 1) + +enum NI_Severity { + Ni_None, + Ni_Info, + Ni_Warn, + Ni_Err +}; + +/* Report the version of a DLL given by its name. The return value is + constructed using MAKEDLLVERULL. */ +static ULONGLONG +get_dll_version (const char *dll_name) +{ + ULONGLONG version = 0; + HINSTANCE hdll = LoadLibrary (dll_name); + + if (hdll) + { + DLLGETVERSIONPROC pDllGetVersion + = (DLLGETVERSIONPROC) GetProcAddress (hdll, "DllGetVersion"); + + if (pDllGetVersion) + { + DLLVERSIONINFO dvi; + HRESULT result; + + memset (&dvi, 0, sizeof(dvi)); + dvi.cbSize = sizeof(dvi); + result = pDllGetVersion (&dvi); + if (SUCCEEDED (result)) + version = MAKEDLLVERULL (dvi.dwMajorVersion, dvi.dwMinorVersion, + 0, 0); + } + FreeLibrary (hdll); + } + + return version; +} + +/* Return the number of bytes in UTF-8 encoded string STR that + corresponds to at most LIM characters. If STR ends before LIM + characters, return the number of bytes in STR including the + terminating null byte. */ +static int +utf8_mbslen_lim (const char *str, int lim) +{ + const char *p = str; + int mblen = 0, nchars = 0; + + while (*p && nchars < lim) + { + int nbytes = CHAR_BYTES (*p); + + mblen += nbytes; + nchars++; + p += nbytes; + } + + if (!*p && nchars < lim) + mblen++; + + return mblen; +} + +/* Low-level subroutine to show tray notifications. All strings are + supposed to be unibyte UTF-8 encoded by the caller. */ +static EMACS_INT +add_tray_notification (struct frame *f, const char *icon, const char *tip, + enum NI_Severity severity, unsigned timeout, + const char *title, const char *msg) +{ + EMACS_INT retval = EMACS_TRAY_NOTIFICATION_ID; + + if (FRAME_W32_P (f)) + { + MY_NOTIFYICONDATAW nidw; + ULONGLONG shell_dll_version = get_dll_version ("Shell32.dll"); + wchar_t tipw[128], msgw[256], titlew[64]; + int tiplen; + + memset (&nidw, 0, sizeof(nidw)); + + /* MSDN says the full struct is supported since Vista, whose + Shell32.dll version is said to be 6.0.6. But DllGetVersion + cannot report the 3rd field value, it reports "build number" + instead, which is something else. So we use the Windows 7's + version 6.1 as cutoff, and Vista loses. (Actually, the loss + is not a real one, since we don't expose the hBalloonIcon + member of the struct to Lisp.) */ + if (shell_dll_version >= MAKEDLLVERULL (6, 1, 0, 0)) /* >= Windows 7 */ + nidw.cbSize = sizeof (nidw); + else if (shell_dll_version >= MAKEDLLVERULL (6, 0, 0, 0)) /* XP */ + nidw.cbSize = NOTIFYICONDATAW_V3_SIZE; + else if (shell_dll_version >= MAKEDLLVERULL (5, 0, 0, 0)) /* W2K */ + nidw.cbSize = NOTIFYICONDATAW_V2_SIZE; + else + nidw.cbSize = NOTIFYICONDATAW_V1_SIZE; /* < W2K */ + nidw.hWnd = FRAME_W32_WINDOW (f); + nidw.uID = EMACS_TRAY_NOTIFICATION_ID; + nidw.uFlags = NIF_MESSAGE | NIF_ICON | NIF_TIP | NIF_INFO; + nidw.uCallbackMessage = EMACS_NOTIFICATION_MSG; + if (!*icon) + nidw.hIcon = LoadIcon (hinst, EMACS_CLASS); + else + { + if (w32_unicode_filenames) + { + wchar_t icon_w[MAX_PATH]; + + if (filename_to_utf16 (icon, icon_w) != 0) + { + errno = ENOENT; + return -1; + } + nidw.hIcon = LoadImageW (NULL, icon_w, IMAGE_ICON, 0, 0, + LR_DEFAULTSIZE | LR_LOADFROMFILE); + } + else + { + char icon_a[MAX_PATH]; + + if (filename_to_ansi (icon, icon_a) != 0) + { + errno = ENOENT; + return -1; + } + nidw.hIcon = LoadImageA (NULL, icon_a, IMAGE_ICON, 0, 0, + LR_DEFAULTSIZE | LR_LOADFROMFILE); + } + } + if (!nidw.hIcon) + { + switch (GetLastError ()) + { + case ERROR_FILE_NOT_FOUND: + errno = ENOENT; + break; + default: + errno = ENOMEM; + break; + } + return -1; + } + + /* Windows 9X and NT4 support only 64 characters in the Tip, + later versions support up to 128. */ + if (nidw.cbSize == NOTIFYICONDATAW_V1_SIZE) + { + tiplen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, + tip, utf8_mbslen_lim (tip, 63), + tipw, 64); + if (tiplen >= 63) + tipw[63] = 0; + } + else + { + tiplen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, + tip, utf8_mbslen_lim (tip, 127), + tipw, 128); + if (tiplen >= 127) + tipw[127] = 0; + } + if (tiplen == 0) + { + errno = EINVAL; + retval = -1; + goto done; + } + wcscpy (nidw.szTip, tipw); + + /* The rest of the structure is only supported since Windows 2000. */ + if (nidw.cbSize > NOTIFYICONDATAW_V1_SIZE) + { + int slen; + + slen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, + msg, utf8_mbslen_lim (msg, 255), + msgw, 256); + if (slen >= 255) + msgw[255] = 0; + else if (slen == 0) + { + errno = EINVAL; + retval = -1; + goto done; + } + wcscpy (nidw.szInfo, msgw); + nidw.uTimeout = timeout; + slen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, + title, utf8_mbslen_lim (title, 63), + titlew, 64); + if (slen >= 63) + titlew[63] = 0; + else if (slen == 0) + { + errno = EINVAL; + retval = -1; + goto done; + } + wcscpy (nidw.szInfoTitle, titlew); + + switch (severity) + { + case Ni_None: + nidw.dwInfoFlags = NIIF_NONE; + break; + case Ni_Info: + default: + nidw.dwInfoFlags = NIIF_INFO; + break; + case Ni_Warn: + nidw.dwInfoFlags = NIIF_WARNING; + break; + case Ni_Err: + nidw.dwInfoFlags = NIIF_ERROR; + break; + } + } + + if (!Shell_NotifyIconW (NIM_ADD, (PNOTIFYICONDATAW)&nidw)) + { + /* GetLastError returns meaningless results when + Shell_NotifyIcon fails. */ + DebPrint (("Shell_NotifyIcon ADD failed (err=%d)\n", + GetLastError ())); + errno = EINVAL; + retval = -1; + } + done: + if (*icon && !DestroyIcon (nidw.hIcon)) + DebPrint (("DestroyIcon failed (err=%d)\n", GetLastError ())); + } + return retval; +} + +/* Low-level subroutine to remove a tray notification. Note: we only + pass the minimum data about the notification: its ID and the handle + of the window to which it sends messages. MSDN doesn't say this is + enough, but it works in practice. This allows us to avoid keeping + the notification data around after we show the notification. */ +static void +delete_tray_notification (struct frame *f, int id) +{ + if (FRAME_W32_P (f)) + { + MY_NOTIFYICONDATAW nidw; + + memset (&nidw, 0, sizeof(nidw)); + nidw.hWnd = FRAME_W32_WINDOW (f); + nidw.uID = id; + + if (!Shell_NotifyIconW (NIM_DELETE, (PNOTIFYICONDATAW)&nidw)) + { + /* GetLastError returns meaningless results when + Shell_NotifyIcon fails. */ + DebPrint (("Shell_NotifyIcon DELETE failed\n")); + errno = EINVAL; + return; + } + } + return; +} + +DEFUN ("w32-notification-notify", + Fw32_notification_notify, Sw32_notification_notify, + 0, MANY, 0, + doc: /* Display an MS-Windows tray notification as specified by PARAMS. + +Value is the integer unique ID of the notification that can be used +to remove the notification using `w32-notification-close', which see. +If the function fails, the return value is nil. + +Tray notifications, a.k.a. \"taskbar messages\", are messages that +inform the user about events unrelated to the current user activity, +such as a significant system event, by briefly displaying informative +text in a balloon from an icon in the notification area of the taskbar. + +Parameters in PARAMS are specified as keyword/value pairs. All the +parameters are optional, but if no parameters are specified, the +function will do nothing and return nil. + +The following parameters are supported: + +:icon ICON -- Display ICON in the system tray. If ICON is a string, + it should specify a file name from which to load the + icon; the specified file should be a .ico Windows icon + file. If ICON is not a string, or if this parameter + is not specified, the standard Emacs icon will be used. + +:tip TIP -- Use TIP as the tooltip for the notification. If TIP + is a string, this is the text of a tooltip that will + be shown when the mouse pointer hovers over the tray + icon added by the notification. If TIP is not a + string, or if this parameter is not specified, the + default tooltip text is \"Emacs notification\". The + tooltip text can be up to 127 characters long (63 + on Windows versions before W2K). Longer strings + will be truncated. + +:level LEVEL -- Notification severity level, one of `info', + `warning', or `error'. If given, the value + determines the icon displayed to the left of the + notification title, but only if the `:title' + parameter (see below) is also specified and is a + string. + +:timeout TIMEOUT -- TIMEOUT is the time in seconds after which the + notification disappears. The value can be integer + or floating-point. This is ignored on Vista and + later systems, where the duration is fixed at 9 sec + and can only be customized via system-wide + Accessibility settings. + +:title TITLE -- The title of the notification. If TITLE is a string, + it is displayed in a larger font immediately above + the body text. The title text can be up to 63 + characters long; longer text will be truncated. + +:body BODY -- The body of the notification. If BODY is a string, + it specifies the text of the notification message. + Use embedded newlines to control how the text is + broken into lines. The body text can be up to 255 + characters long, and will be truncated if it's longer. + +Note that versions of Windows before W2K support only `:icon' and `:tip'. +You can pass the other parameters, but they will be ignored on those +old systems. + +There can be at most one active notification at any given time. An +active notification must be removed by calling `w32-notification-close' +before a new one can be shown. + +usage: (w32-notification-notify &rest PARAMS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + struct frame *f = SELECTED_FRAME (); + Lisp_Object arg_plist, lres; + EMACS_INT retval; + char *icon, *tip, *title, *msg; + enum NI_Severity severity; + unsigned timeout; + + if (nargs == 0) + return Qnil; + + arg_plist = Flist (nargs, args); + + /* Icon. */ + lres = Fplist_get (arg_plist, QCicon); + if (STRINGP (lres)) + icon = SSDATA (ENCODE_FILE (Fexpand_file_name (lres, Qnil))); + else + icon = ""; + + /* Tip. */ + lres = Fplist_get (arg_plist, QCtip); + if (STRINGP (lres)) + tip = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); + else + tip = "Emacs notification"; + + /* Severity. */ + lres = Fplist_get (arg_plist, QClevel); + if (NILP (lres)) + severity = Ni_None; + else if (EQ (lres, Qinfo)) + severity = Ni_Info; + else if (EQ (lres, Qwarning)) + severity = Ni_Warn; + else if (EQ (lres, Qerror)) + severity = Ni_Err; + else + severity = Ni_Info; + + /* Timeout. */ + lres = Fplist_get (arg_plist, QCtimeout); + if (NUMBERP (lres)) + timeout = 1000 * (INTEGERP (lres) ? XINT (lres) : XFLOAT_DATA (lres)); + else + timeout = 0; + + /* Title. */ + lres = Fplist_get (arg_plist, QCtitle); + if (STRINGP (lres)) + title = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); + else + title = ""; + + /* Notification body text. */ + lres = Fplist_get (arg_plist, QCbody); + if (STRINGP (lres)) + msg = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1)); + else + msg = ""; + + /* Do it! */ + retval = add_tray_notification (f, icon, tip, severity, timeout, title, msg); + return (retval < 0 ? Qnil : make_number (retval)); +} + +DEFUN ("w32-notification-close", + Fw32_notification_close, Sw32_notification_close, + 1, 1, 0, + doc: /* Remove the MS-Windows tray notification specified by its ID. */) + (Lisp_Object id) +{ + struct frame *f = SELECTED_FRAME (); + + if (INTEGERP (id)) + delete_tray_notification (f, XINT (id)); + + return Qnil; +} + /*********************************************************************** Initialization @@ -8828,6 +9296,14 @@ syms_of_w32fns (void) DEFSYM (Qframes, "frames"); DEFSYM (Qtip_frame, "tip-frame"); DEFSYM (Qunicode_sip, "unicode-sip"); + DEFSYM (QCicon, ":icon"); + DEFSYM (QCtip, ":tip"); + DEFSYM (QClevel, ":level"); + DEFSYM (Qinfo, "info"); + DEFSYM (Qwarning, "warning"); + DEFSYM (QCtimeout, ":timeout"); + DEFSYM (QCtitle, ":title"); + DEFSYM (QCbody, ":body"); /* Symbols used elsewhere, but only in MS-Windows-specific code. */ DEFSYM (Qgnutls_dll, "gnutls"); @@ -9161,6 +9637,8 @@ This variable has effect only on Windows Vista and later. */); defsubr (&Sw32_window_exists_p); defsubr (&Sw32_battery_status); defsubr (&Sw32__menu_bar_in_use); + defsubr (&Sw32_notification_notify); + defsubr (&Sw32_notification_close); #ifdef WINDOWSNT defsubr (&Sfile_system_info); commit ef75c3b56b8ff034eb47e0c69328227127cc93fa Author: Michael Albinus Date: Wed Nov 11 11:47:26 2015 +0100 Optimize `file-equal-p' and `file-in-directory-p' in Tramp * lisp/net/tramp.el (tramp-handle-file-equal-p) (tramp-handle-file-in-directory-p): New defuns. Suggested by Harvey Chapman * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): Use them. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 88dea6a..178b3a0 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -117,11 +117,11 @@ It is used for TCP/IP devices." (file-acl . ignore) (file-attributes . tramp-adb-handle-file-attributes) (file-directory-p . tramp-adb-handle-file-directory-p) - ;; `file-equal-p' performed by default handler. + (file-equal-p . tramp-handle-file-equal-p) ;; FIXME: This is too sloppy. (file-executable-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p) - ;; `file-in-directory-p' performed by default handler. + (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-adb-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-adb-handle-file-name-all-completions) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 8683241..c5a6075 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -430,10 +430,10 @@ Every entry is a list (NAME ADDRESS).") (file-acl . ignore) (file-attributes . tramp-gvfs-handle-file-attributes) (file-directory-p . tramp-gvfs-handle-file-directory-p) - ;; `file-equal-p' performed by default handler. + (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-gvfs-handle-file-executable-p) (file-exists-p . tramp-handle-file-exists-p) - ;; `file-in-directory-p' performed by default handler. + (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-gvfs-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1753c73..f5ff6a7 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -993,10 +993,10 @@ of command line.") (file-acl . tramp-sh-handle-file-acl) (file-attributes . tramp-sh-handle-file-attributes) (file-directory-p . tramp-sh-handle-file-directory-p) - ;; `file-equal-p' performed by default handler. + (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-sh-handle-file-executable-p) (file-exists-p . tramp-sh-handle-file-exists-p) - ;; `file-in-directory-p' performed by default handler. + (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-sh-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-sh-handle-file-name-all-completions) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index c956795..65c77eb 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -232,10 +232,10 @@ See `tramp-actions-before-shell' for more info.") (file-acl . tramp-smb-handle-file-acl) (file-attributes . tramp-smb-handle-file-attributes) (file-directory-p . tramp-smb-handle-file-directory-p) - ;; `file-equal-p' performed by default handler. + (file-file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-handle-file-exists-p) (file-exists-p . tramp-handle-file-exists-p) - ;; `file-in-directory-p' performed by default handler. + (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-smb-handle-file-local-copy) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-smb-handle-file-name-all-completions) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 89aad07..42a9e3d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2910,10 +2910,30 @@ User is always nil." (and (file-directory-p filename) (file-readable-p filename))) +(defun tramp-handle-file-equal-p (filename1 filename2) + "Like `file-equalp-p' for Tramp files." + ;; Native `file-equalp-p' calls `file-truename', which requires a + ;; remote connection. This can be avoided, if FILENAME1 and + ;; FILENAME2 are not located on the same remote host. + (when (string-equal + (file-remote-p (expand-file-name filename1)) + (file-remote-p (expand-file-name filename2))) + (tramp-run-real-handler 'file-equal-p (list filename1 filename2)))) + (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." (not (null (file-attributes filename)))) +(defun tramp-handle-file-in-directory-p (filename directory) + "Like `file-in-directory-p' for Tramp files." + ;; Native `file-in-directory-p' calls `file-truename', which + ;; requires a remote connection. This can be avoided, if FILENAME + ;; and DIRECTORY are not located on the same remote host. + (when (string-equal + (file-remote-p (expand-file-name filename)) + (file-remote-p (expand-file-name directory))) + (tramp-run-real-handler 'file-in-directory-p (list filename directory)))) + (defun tramp-handle-file-modes (filename) "Like `file-modes' for Tramp files." (let ((truename (or (file-truename filename) filename)))