commit 988d3d79bac0343dd2b1b89d1b15470edbb5e6ac (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sun Jan 30 16:02:58 2022 +0800 Use XRender to composite fringe bitmaps This will allow us to apply transforms such as scaling in the future. * src/xterm.c (x_draw_fringe_bitmap): Composite fringe bitmaps with XRender if available. diff --git a/src/xterm.c b/src/xterm.c index 0ecebfb420..e41319e95e 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1976,9 +1976,15 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring { Drawable drawable = FRAME_X_DRAWABLE (f); char *bits; - Pixmap pixmap, clipmask = (Pixmap) 0; + Pixmap pixmap, clipmask = None; int depth = FRAME_DISPLAY_INFO (f)->n_planes; XGCValues gcv; +#ifdef HAVE_XRENDER + Picture picture = None; + XRenderPictureAttributes attrs; + + memset (&attrs, 0, sizeof attrs); +#endif if (p->wd > 8) bits = (char *) (p->bits + p->dh); @@ -1994,20 +2000,57 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring : face->foreground), face->background, depth); +#ifdef HAVE_XRENDER + if (FRAME_X_PICTURE_FORMAT (f) + && (x_xr_ensure_picture (f), FRAME_X_PICTURE (f))) + picture = XRenderCreatePicture (display, pixmap, + FRAME_X_PICTURE_FORMAT (f), + 0, &attrs); +#endif + if (p->overlay_p) { clipmask = XCreatePixmapFromBitmapData (display, FRAME_DISPLAY_INFO (f)->root_window, bits, p->wd, p->h, 1, 0, 1); - gcv.clip_mask = clipmask; - gcv.clip_x_origin = p->x; - gcv.clip_y_origin = p->y; - XChangeGC (display, gc, GCClipMask | GCClipXOrigin | GCClipYOrigin, &gcv); + +#ifdef HAVE_XRENDER + if (picture != None) + { + attrs.clip_mask = clipmask; + attrs.clip_x_origin = p->x; + attrs.clip_y_origin = p->y; + + XRenderChangePicture (display, FRAME_X_PICTURE (f), + CPClipMask | CPClipXOrigin | CPClipYOrigin, + &attrs); + } + else +#endif + { + gcv.clip_mask = clipmask; + gcv.clip_x_origin = p->x; + gcv.clip_y_origin = p->y; + XChangeGC (display, gc, GCClipMask | GCClipXOrigin | GCClipYOrigin, &gcv); + } } - XCopyArea (display, pixmap, drawable, gc, 0, 0, - p->wd, p->h, p->x, p->y); +#ifdef HAVE_XRENDER + if (picture != None) + { + x_xr_apply_ext_clip (f, gc); + XRenderComposite (display, PictOpSrc, picture, + None, FRAME_X_PICTURE (f), + 0, 0, 0, 0, p->x, p->y, p->wd, p->h); + x_xr_reset_ext_clip (f); + + XRenderFreePicture (display, picture); + } + else +#endif + XCopyArea (display, pixmap, drawable, gc, 0, 0, + p->wd, p->h, p->x, p->y); XFreePixmap (display, pixmap); if (p->overlay_p) commit 26a9acc86ae4e646b17570f009dcdf566f75c3de Author: Po Lu Date: Sun Jan 30 14:02:40 2022 +0800 Fix some problems with inconsistent visuals on GDK * src/xterm.c (x_xr_ensure_picture): Use the visual GDK used instead of our own. diff --git a/src/xterm.c b/src/xterm.c index 209e99fc09..0ecebfb420 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -382,11 +382,22 @@ x_xr_ensure_picture (struct frame *f) { XRenderPictureAttributes attrs; attrs.clip_mask = None; + XRenderPictFormat *fmt; + +#ifdef USE_GTK + GdkWindow *wnd = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); + GdkVisual *visual = gdk_window_get_visual (wnd); + Visual *xvisual = gdk_x11_visual_get_xvisual (visual); + + fmt = XRenderFindVisualFormat (FRAME_X_DISPLAY (f), xvisual); + + if (!fmt) +#endif + fmt = FRAME_X_PICTURE_FORMAT (f); FRAME_X_PICTURE (f) = XRenderCreatePicture (FRAME_X_DISPLAY (f), FRAME_X_RAW_DRAWABLE (f), - FRAME_X_PICTURE_FORMAT (f), - CPClipMask, &attrs); + fmt, CPClipMask, &attrs); } } #endif commit f4ddd6153d0108e6101590699ab4a839a90739d9 Merge: 2886520160 e81e375539 Author: Stefan Kangas Date: Sun Jan 30 06:31:11 2022 +0100 Merge from origin/emacs-28 e81e375539 ; Yet another minor fix of Malayalam composition rules. 94f38cbec4 Fix last change of Malayalam composition rules ed3bbeb80d Fix rendering of Malayalam script 5ef3a52342 Improve documentation of Occur mode commit 28865201604c57c4d7a43625010c1aed8ca1bd46 Author: Po Lu Date: Sun Jan 30 05:20:15 2022 +0000 Use consistent font when displaying menu equivalent keys on Haiku * src/haiku_support.cc (DrawContent): Set plain font when drawing key text. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 2284953517..794023c98e 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1679,11 +1679,17 @@ class EmacsMenuItem : public BMenuItem if (key) { - BRect r = menu->Frame (); - int w = menu->StringWidth (key); + BRect r = Frame (); + int w; + + menu->PushState (); + menu->ClipToRect (r); + menu->SetFont (be_plain_font); + w = menu->StringWidth (key); menu->MovePenTo (BPoint (BE_RECT_WIDTH (r) - w - 4, menu->PenLocation ().y)); menu->DrawString (key); + menu->PopState (); } } commit 310bcda934a88f2c93e8b34b093853ce695c8d3b Author: Po Lu Date: Sun Jan 30 09:23:40 2022 +0800 Add support for ARGB visuals on non-Xt builds * src/gtkutil.c (xg_create_frame_widgets): Enable RGBA visual on non-PGTK builds. * src/xfns.c (select_visual): Select 32-bit visuals on non-Xt builds. * src/xterm.c (x_draw_fringe_bitmap): (x_draw_image_glyph_string): Stop using DefaultDepthOfScreen. (x_query_colors): * src/xterm.h (x_make_truecolor_pixel): Make colors opaque on 32-bit visuals. diff --git a/src/gtkutil.c b/src/gtkutil.c index 067df216a4..ef6270dbcf 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1593,7 +1593,7 @@ xg_create_frame_widgets (struct frame *f) GdkScreen *screen = gtk_widget_get_screen (wtop); -#if !defined HAVE_PGTK && defined USE_CAIRO +#if !defined HAVE_PGTK if (FRAME_DISPLAY_INFO (f)->n_planes == 32) { GdkVisual *visual = gdk_screen_get_rgba_visual (screen); diff --git a/src/xfns.c b/src/xfns.c index b37ba139a2..7fe181fa3f 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6375,7 +6375,7 @@ select_visual (struct x_display_info *dpyinfo) vinfo_template.screen = XScreenNumberOfScreen (screen); -#if defined (USE_GTK) && defined (USE_CAIRO) +#if !defined USE_X_TOOLKIT /* First attempt to use 32-bit visual if available */ vinfo_template.depth = 32; @@ -6391,7 +6391,7 @@ select_visual (struct x_display_info *dpyinfo) return; } -#endif /* USE_GTK && USE_CAIRO */ +#endif /* !USE_X_TOOLKIT */ /* 32-bit visual not available, fallback to default visual */ dpyinfo->visual = DefaultVisualOfScreen (screen); diff --git a/src/xterm.c b/src/xterm.c index ab5fd46c4c..209e99fc09 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1966,7 +1966,7 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring Drawable drawable = FRAME_X_DRAWABLE (f); char *bits; Pixmap pixmap, clipmask = (Pixmap) 0; - int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f)); + int depth = FRAME_DISPLAY_INFO (f)->n_planes; XGCValues gcv; if (p->wd > 8) @@ -2812,12 +2812,12 @@ void x_query_colors (struct frame *f, XColor *colors, int ncolors) { struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + int i; if (dpyinfo->red_bits > 0) { /* For TrueColor displays, we can decompose the RGB value directly. */ - int i; unsigned int rmult, gmult, bmult; unsigned int rmask, gmask, bmask; @@ -2854,6 +2854,12 @@ x_query_colors (struct frame *f, XColor *colors, int ncolors) colors[i].green = (g * gmult) >> 16; colors[i].blue = (b * bmult) >> 16; } + + if (FRAME_DISPLAY_INFO (f)->n_planes == 32) + { + for (i = 0; i < ncolors; ++i) + colors[i].pixel |= ((unsigned long) 0xFF << 24); + } return; } @@ -2871,6 +2877,12 @@ x_query_colors (struct frame *f, XColor *colors, int ncolors) } XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, ncolors); + + if (FRAME_DISPLAY_INFO (f)->n_planes == 32) + { + for (i = 0; i < ncolors; ++i) + colors[i].pixel |= ((unsigned long) 0xFF << 24); + } } /* Store F's background color into *BGCOLOR. */ @@ -3924,8 +3936,7 @@ x_draw_image_glyph_string (struct glyph_string *s) /* Create a pixmap as large as the glyph string. Fill it with the background color. Copy the image to it, using its mask. Copy the temporary pixmap to the display. */ - Screen *screen = FRAME_X_SCREEN (s->f); - int depth = DefaultDepthOfScreen (screen); + int depth = FRAME_DISPLAY_INFO (s->f)->n_planes; /* Create a pixmap as large as the glyph string. */ pixmap = XCreatePixmap (display, FRAME_X_DRAWABLE (s->f), diff --git a/src/xterm.h b/src/xterm.h index 33887be52b..aa5bd2caa1 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -1270,7 +1270,7 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time t) INLINE unsigned long x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) { - unsigned long pr, pg, pb; + unsigned long pr, pg, pb, pa = 0; /* Scale down RGB values to the visual's bits per RGB, and shift them to the right position in the pixel color. Note that the @@ -1279,8 +1279,11 @@ x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) pg = (g >> (16 - dpyinfo->green_bits)) << dpyinfo->green_offset; pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset; + if (dpyinfo->n_planes == 32) + pa = ((unsigned long) 0xFF << 24); + /* Assemble the pixel color. */ - return pr | pg | pb; + return pr | pg | pb | pa; } /* If display has an immutable color map, freeing colors is not commit 391c1289e28ce11d5639a4d754ec36e7b26aa6ac Author: Po Lu Date: Sun Jan 30 08:51:13 2022 +0800 Some adjustments to last change * src/gtkutil.c (xg_set_undecorated): Only set ARGB visual on Cairo builds wtihout PGTK. * src/xfns.c (select_visual): Likewise. diff --git a/src/gtkutil.c b/src/gtkutil.c index 8b8123c807..067df216a4 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1593,12 +1593,14 @@ xg_create_frame_widgets (struct frame *f) GdkScreen *screen = gtk_widget_get_screen (wtop); +#if !defined HAVE_PGTK && defined USE_CAIRO if (FRAME_DISPLAY_INFO (f)->n_planes == 32) { GdkVisual *visual = gdk_screen_get_rgba_visual (screen); gtk_widget_set_visual (wtop, visual); gtk_widget_set_visual (wfixed, visual); } +#endif #ifndef HAVE_PGTK /* Must realize the windows so the X window gets created. It is used diff --git a/src/xfns.c b/src/xfns.c index 2f2e33fa69..b37ba139a2 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6375,7 +6375,7 @@ select_visual (struct x_display_info *dpyinfo) vinfo_template.screen = XScreenNumberOfScreen (screen); -#if defined (USE_GTK) +#if defined (USE_GTK) && defined (USE_CAIRO) /* First attempt to use 32-bit visual if available */ vinfo_template.depth = 32; @@ -6391,7 +6391,7 @@ select_visual (struct x_display_info *dpyinfo) return; } -#endif /* defined (USE_GTK) */ +#endif /* USE_GTK && USE_CAIRO */ /* 32-bit visual not available, fallback to default visual */ dpyinfo->visual = DefaultVisualOfScreen (screen); commit b944841173f12134e4c68d269d5b82b1820b2a40 Author: Håkon Flatval Date: Sat Jan 29 16:13:06 2022 +0100 Add background transparency support for GTK+Cairo diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index ccf7e35eee..bb362ca3ea 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -149,6 +149,15 @@ various X toolkits (GTK+, Lucid, etc.)---we indicate below when this is the case. @table @asis +@item @code{alpha} (class @code{Alpha}) +Sets the @samp{alpha} frame parameter, determining frame transparency +(@pxref{Frame Parameters,,, elisp, The Emacs Lisp Reference Manual}). + +@item @code{alphaBackground} (class @code{AlphaBackground}) +Sets the @samp{alpha-background} frame parameter, determining background +transparency +(@pxref{Frame Parameters,,, elisp, The Emacs Lisp Reference Manual}). + @item @code{background} (class @code{Background}) Background color (@pxref{Colors}). diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 7d3ce9d74e..f8188708e5 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2433,6 +2433,16 @@ opacity when it is not selected. Some window systems do not support the @code{alpha} parameter for child frames (@pxref{Child Frames}). + +@vindex alpha-background@r{, a frame parameter} +@item alpha-background +@cindex opacity, frame +@cindex transparency, frame +Sets the background transparency of the frame. Unlike the @code{alpha} +frame parameter, this only controls the transparency of the background +while keeping foreground elements such as text fully opaque. It +should be an integer between 0 and 100, where 0 means +completely transparent and 100 means completely opaque (default). @end table The following frame parameters are semi-obsolete in that they are diff --git a/src/frame.c b/src/frame.c index 8aaff949ba..c331cff32b 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3907,6 +3907,7 @@ static const struct frame_parm_table frame_parms[] = {"z-group", SYMBOL_INDEX (Qz_group)}, {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)}, {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)}, + {"alpha-background", SYMBOL_INDEX (Qalpha_background)}, #ifdef NS_IMPL_COCOA {"ns-appearance", SYMBOL_INDEX (Qns_appearance)}, {"ns-transparent-titlebar", SYMBOL_INDEX (Qns_transparent_titlebar)}, @@ -5024,6 +5025,33 @@ gui_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } } +void +gui_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + double alpha = 1.0; + + if (NILP (arg)) + alpha = 1.0; + else if (FLOATP (arg)) + { + alpha = XFLOAT_DATA (arg); + if (! (0 <= alpha && alpha <= 1.0)) + args_out_of_range (make_float (0.0), make_float (1.0)); + } + else if (FIXNUMP (arg)) + { + EMACS_INT ialpha = XFIXNUM (arg); + if (! (0 <= ialpha && ialpha <= 100)) + args_out_of_range (make_fixnum (0), make_fixnum (100)); + alpha = ialpha / 100.0; + } + else + wrong_type_argument (Qnumberp, arg); + + f->alpha_background = alpha; + + SET_FRAME_GARBAGED (f); +} /** * gui_set_no_special_glyphs: @@ -6100,6 +6128,7 @@ syms_of_frame (void) #endif DEFSYM (Qalpha, "alpha"); + DEFSYM (Qalpha_background, "alpha-background"); DEFSYM (Qauto_lower, "auto-lower"); DEFSYM (Qauto_raise, "auto-raise"); DEFSYM (Qborder_color, "border-color"); diff --git a/src/frame.h b/src/frame.h index cb2f58e261..5d5f2122fb 100644 --- a/src/frame.h +++ b/src/frame.h @@ -637,6 +637,9 @@ struct frame Negative values mean not to change alpha. */ double alpha[2]; + /* Background opacity */ + double alpha_background; + /* Exponent for gamma correction of colors. 1/(VIEWING_GAMMA * SCREEN_GAMMA) where viewing_gamma is 0.4545 and SCREEN_GAMMA is a frame parameter. 0 means don't do gamma correction. */ @@ -1669,6 +1672,7 @@ extern void gui_set_scroll_bar_height (struct frame *, Lisp_Object, Lisp_Object) extern long gui_figure_window_size (struct frame *, Lisp_Object, bool, bool); extern void gui_set_alpha (struct frame *, Lisp_Object, Lisp_Object); +extern void gui_set_alpha_background (struct frame *, Lisp_Object, Lisp_Object); extern void gui_set_no_special_glyphs (struct frame *, Lisp_Object, Lisp_Object); extern void validate_x_resource_name (void); diff --git a/src/gtkutil.c b/src/gtkutil.c index 98907bf022..8b8123c807 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1467,6 +1467,10 @@ xg_create_frame_widgets (struct frame *f) } wtop = gtk_window_new (type); gtk_widget_add_events (wtop, GDK_ALL_EVENTS_MASK); + + /* This prevents GTK from painting the window's background, which + would interfere with transparent background in some environments */ + gtk_widget_set_app_paintable (wtop, TRUE); #endif /* gtk_window_set_has_resize_grip is a Gtk+ 3.0 function but Ubuntu @@ -1587,6 +1591,15 @@ xg_create_frame_widgets (struct frame *f) #endif | GDK_VISIBILITY_NOTIFY_MASK); + GdkScreen *screen = gtk_widget_get_screen (wtop); + + if (FRAME_DISPLAY_INFO (f)->n_planes == 32) + { + GdkVisual *visual = gdk_screen_get_rgba_visual (screen); + gtk_widget_set_visual (wtop, visual); + gtk_widget_set_visual (wfixed, visual); + } + #ifndef HAVE_PGTK /* Must realize the windows so the X window gets created. It is used by callers of this function. */ @@ -1651,7 +1664,6 @@ xg_create_frame_widgets (struct frame *f) #endif { - GdkScreen *screen = gtk_widget_get_screen (wtop); GtkSettings *gs = gtk_settings_get_for_screen (screen); /* Only connect this signal once per screen. */ if (! g_signal_handler_find (G_OBJECT (gs), diff --git a/src/haikufns.c b/src/haikufns.c index 58a2e1d464..0e0cffea72 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -830,6 +830,8 @@ haiku_create_frame (Lisp_Object parms) RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qfullscreen, Qnil, "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); @@ -1043,6 +1045,8 @@ haiku_create_tip_frame (Lisp_Object parms) "cursorType", "CursorType", RES_TYPE_SYMBOL); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); initial_setup_back_buffer (f); @@ -2609,7 +2613,8 @@ frame_parm_handler haiku_frame_parm_handlers[] = haiku_set_no_accept_focus, NULL, /* set z group */ haiku_set_override_redirect, - gui_set_no_special_glyphs + gui_set_no_special_glyphs, + gui_set_alpha_background, }; void diff --git a/src/nsfns.m b/src/nsfns.m index 11132a294a..467e56ece4 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1004,6 +1004,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. ns_set_z_group, 0, /* x_set_override_redirect */ gui_set_no_special_glyphs, + gui_set_alpha_background, #ifdef NS_IMPL_COCOA ns_set_appearance, ns_set_transparent_titlebar, @@ -1436,6 +1437,8 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qfullscreen, Qnil, "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 9c37c04810..5980b31d6e 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -1043,6 +1043,7 @@ frame_parm_handler pgtk_frame_parm_handlers[] = { x_set_z_group, x_set_override_redirect, gui_set_no_special_glyphs, + gui_set_alpha_background, }; @@ -1667,6 +1668,8 @@ This function is an internal primitive--use `make-frame' instead. */ ) RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); if (!NILP (parent_frame)) { @@ -2936,6 +2939,8 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct "cursorType", "CursorType", RES_TYPE_SYMBOL); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) diff --git a/src/w32fns.c b/src/w32fns.c index 1ea685d194..009855602e 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6018,6 +6018,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, NULL, NULL, RES_TYPE_BOOLEAN); gui_default_parameter (f, parameters, Qno_special_glyphs, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parameters, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Process alpha here (Bug#16619). On XP this fails with child frames. For `no-focus-on-map' frames delay processing of alpha @@ -6155,6 +6157,9 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, gui_default_parameter (f, parameters, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL); + gui_default_parameter (f, parameters, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + /* Make the window appear on the frame and enable display, unless the caller says not to. However, with explicit parent, Emacs cannot control visibility, so don't try. */ @@ -7089,6 +7094,8 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) /* Process alpha here (Bug#17344). */ gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -10436,6 +10443,7 @@ frame_parm_handler w32_frame_parm_handlers[] = w32_set_z_group, 0, /* x_set_override_redirect */ gui_set_no_special_glyphs, + gui_set_alpha_background, }; void diff --git a/src/xfns.c b/src/xfns.c index faab1b1158..2f2e33fa69 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4598,6 +4598,8 @@ This function is an internal primitive--use `make-frame' instead. */) RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); if (!NILP (parent_frame)) { @@ -6371,10 +6373,29 @@ select_visual (struct x_display_info *dpyinfo) int n_visuals; XVisualInfo *vinfo, vinfo_template; - dpyinfo->visual = DefaultVisualOfScreen (screen); + vinfo_template.screen = XScreenNumberOfScreen (screen); + +#if defined (USE_GTK) + /* First attempt to use 32-bit visual if available */ + + vinfo_template.depth = 32; + + vinfo = XGetVisualInfo (dpy, VisualScreenMask | VisualDepthMask, + &vinfo_template, &n_visuals); + if (n_visuals > 0) + { + dpyinfo->n_planes = vinfo->depth; + dpyinfo->visual = vinfo->visual; + XFree (vinfo); + return; + } + +#endif /* defined (USE_GTK) */ + + /* 32-bit visual not available, fallback to default visual */ + dpyinfo->visual = DefaultVisualOfScreen (screen); vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual); - vinfo_template.screen = XScreenNumberOfScreen (screen); vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask, &vinfo_template, &n_visuals); if (n_visuals <= 0) @@ -7232,6 +7253,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) "cursorType", "CursorType", RES_TYPE_SYMBOL); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -8560,6 +8583,7 @@ frame_parm_handler x_frame_parm_handlers[] = x_set_z_group, x_set_override_redirect, gui_set_no_special_glyphs, + gui_set_alpha_background, }; void diff --git a/src/xterm.c b/src/xterm.c index 3f277c5b87..ab5fd46c4c 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -874,12 +874,27 @@ x_set_cr_source_with_gc_background (struct frame *f, GC gc) { XGCValues xgcv; XColor color; + unsigned int depth; XGetGCValues (FRAME_X_DISPLAY (f), gc, GCBackground, &xgcv); color.pixel = xgcv.background; + x_query_colors (f, &color, 1); - cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, - color.green / 65535.0, color.blue / 65535.0); + + depth = FRAME_DISPLAY_INFO (f)->n_planes; + + if (f->alpha_background < 1.0 && depth == 32) + { + cairo_set_source_rgba (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0, + f->alpha_background); + + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_SOURCE); + } + else + cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0); + } static const cairo_user_data_key_t xlib_surface_key, saved_drawable_key; @@ -1318,6 +1333,29 @@ x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) #endif } + +static void +x_clear_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) +{ +#ifdef USE_CAIRO + cairo_t *cr; + + cr = x_begin_cr_clip (f, gc); + x_set_cr_source_with_gc_background (f, gc); + cairo_rectangle (cr, x, y, width, height); + cairo_fill (cr); + x_end_cr_clip (f); +#else + XGCValues xgcv; + Display *dpy = FRAME_X_DISPLAY (f); + XGetGCValues (dpy, gc, GCBackground | GCForeground, &xgcv); + XSetForeground (dpy, gc, xgcv.background); + XFillRectangle (dpy, FRAME_X_DRAWABLE (f), + gc, x, y, width, height); + XSetForeground (dpy, gc, xgcv.foreground); +#endif +} + static void x_draw_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) { @@ -1898,9 +1936,9 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring if (face->stipple) XSetFillStyle (display, face->gc, FillOpaqueStippled); else - XSetForeground (display, face->gc, face->background); + XSetBackground (display, face->gc, face->background); - x_fill_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny); + x_clear_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny); if (!face->stipple) XSetForeground (display, face->gc, face->foreground); @@ -2201,12 +2239,7 @@ x_compute_glyph_string_overhangs (struct glyph_string *s) static void x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) { - Display *display = FRAME_X_DISPLAY (s->f); - XGCValues xgcv; - XGetGCValues (display, s->gc, GCForeground | GCBackground, &xgcv); - XSetForeground (display, s->gc, xgcv.background); - x_fill_rectangle (s->f, s->gc, x, y, w, h); - XSetForeground (display, s->gc, xgcv.foreground); + x_clear_rectangle (s->f, s->gc, x, y, w, h); } commit 35cd9197fc3bda7576b3c343d1183360067dccd2 Author: Stefan Monnier Date: Sat Jan 29 17:50:02 2022 -0500 package.el: Fix bug#53529 * lisp/emacs-lisp/package.el (package-autoload-ensure-default-file): Enforce Unix EOLs. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index aa3e48155c..2e01449613 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1005,7 +1005,8 @@ untar into a directory named DIR; otherwise, signal an error." "Make sure that the autoload file FILE exists and if not create it." (unless (file-exists-p file) (require 'autoload) - (write-region (autoload-rubric file "package" nil) nil file nil 'silent)) + (let ((coding-system-for-write 'utf-8-emacs-unix)) + (write-region (autoload-rubric file "package" nil) nil file nil 'silent))) file) (defvar autoload-timestamps) commit e81e375539b95753e34cde3d9d5188d48aa1922f Author: Eli Zaretskii Date: Sat Jan 29 22:14:30 2022 +0200 ; Yet another minor fix of Malayalam composition rules. diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 8e2ac8a713..e0adb0de6c 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -354,8 +354,8 @@ South Indian language Malayalam is supported in this language environment.")) ("X" . "[\u0D00-\u0D7F]")))) ; all coverage (indian-compose-regexp (concat - ;; any sequence of Malayalam characters, or - "X+\\|" + ;; any sequence of 2 or more Malayalam characters, or + "XX+\\|" ;; consonant-based syllables, or "C\\(?:J?HJ?C\\)*\\(?:H[NJ]?\\|v?A?\\)\\|" ;; syllables with an independent vowel, or commit 94f38cbec4387ba0a332985b9de52ac394e93833 Author: Eli Zaretskii Date: Sat Jan 29 21:56:53 2022 +0200 Fix last change of Malayalam composition rules * lisp/language/indian.el (malayalam-composable-pattern): Reinstate. Instead of removing it, add any sequence of Malayalam characters to the existing patterns, so as not to lose the patterns that use ZWJ and ZWNJ. (Bug#53625) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 971ecd7ca9..8e2ac8a713 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -341,6 +341,30 @@ South Indian language Malayalam is supported in this language environment.")) table)) "Regexp matching a composable sequence of Kannada characters.") +(defconst malayalam-composable-pattern + (let ((table + '(("A" . "[\u0D02\u0D03]") ; SIGN ANUSVARA .. VISARGA + ("V" . "[\u0D05-\u0D14\u0D60\u0D61]") ; independent vowel + ("C" . "[\u0D15-\u0D39]") ; consonant + ("Y" . "[\u0D2F\u0D30\u0D32\u0D35]") ; YA, RA, LA, VA + ("v" . "[\u0D3E-\u0D4C\u0D57\u0D62\u0D63]") ; postbase matra + ("H" . "\u0D4D") ; SIGN VIRAMA + ("N" . "\u200C") ; ZWNJ + ("J" . "\u200D") ; ZWJ + ("X" . "[\u0D00-\u0D7F]")))) ; all coverage + (indian-compose-regexp + (concat + ;; any sequence of Malayalam characters, or + "X+\\|" + ;; consonant-based syllables, or + "C\\(?:J?HJ?C\\)*\\(?:H[NJ]?\\|v?A?\\)\\|" + ;; syllables with an independent vowel, or + "V\\(?:J?HY\\)?v*?A?\\|" + ;; special consonant form + "JHY") + table)) + "Regexp matching a composable sequence of Malayalam characters.") + (let ((script-regexp-alist `((devanagari . ,devanagari-composable-pattern) (bengali . ,bengali-composable-pattern) @@ -349,7 +373,8 @@ South Indian language Malayalam is supported in this language environment.")) (oriya . ,oriya-composable-pattern) (tamil . ,tamil-composable-pattern) (telugu . ,telugu-composable-pattern) - (kannada . ,kannada-composable-pattern)))) + (kannada . ,kannada-composable-pattern) + (malayalam . ,malayalam-composable-pattern)))) (map-char-table #'(lambda (key val) (let ((slot (assq val script-regexp-alist))) @@ -359,11 +384,6 @@ South Indian language Malayalam is supported in this language environment.")) (list (vector (cdr slot) 0 #'font-shape-gstring)))))) char-script-table)) -;; Malayalam: pass any sequence of characters to the shaping engine. -(set-char-table-range composition-function-table '(#x0D00 . #x0D7F) - `([,(purecopy "[\u0D00-\u0D7F]+") - 0 font-shape-gstring])) - (provide 'indian) ;;; indian.el ends here commit ed3bbeb80db07d41747f0a046446ea3d3128c4bb Author: Eli Zaretskii Date: Sat Jan 29 21:22:02 2022 +0200 Fix rendering of Malayalam script * lisp/language/indian.el (malayalam-composable-pattern): Remove. (script-regexp-alist): Remove 'malayalam-composable-pattern'. Instead, pass any sequence of Malayalam codepoints to the shaping engine. (Bug#53625) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 614d0767e7..971ecd7ca9 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -341,30 +341,6 @@ South Indian language Malayalam is supported in this language environment.")) table)) "Regexp matching a composable sequence of Kannada characters.") -(defconst malayalam-composable-pattern - (let ((table - '(("A" . "[\u0D02\u0D03]") ; SIGN ANUSVARA .. VISARGA - ("V" . "[\u0D05-\u0D14\u0D60\u0D61]") ; independent vowel - ("C" . "[\u0D15-\u0D39]") ; consonant - ("Y" . "[\u0D2F\u0D30\u0D32\u0D35]") ; YA, RA, LA, VA - ("v" . "[\u0D3E-\u0D4C\u0D57\u0D62\u0D63]") ; postbase matra - ("H" . "\u0D4D") ; SIGN VIRAMA - ("N" . "\u200C") ; ZWNJ - ("J" . "\u200D") ; ZWJ - ("X" . "[\u0D00-\u0D7F]")))) ; all coverage - (indian-compose-regexp - (concat - ;; consonant-based syllables, or - "C\\(?:J?HJ?C\\)*\\(?:H[NJ]?\\|v?A?\\)\\|" - ;; syllables with an independent vowel, or - "V\\(?:J?HY\\)?v*?A?\\|" - ;; special consonant form, or - "JHY\\|" - ;; any other singleton characters - "X") - table)) - "Regexp matching a composable sequence of Malayalam characters.") - (let ((script-regexp-alist `((devanagari . ,devanagari-composable-pattern) (bengali . ,bengali-composable-pattern) @@ -373,8 +349,7 @@ South Indian language Malayalam is supported in this language environment.")) (oriya . ,oriya-composable-pattern) (tamil . ,tamil-composable-pattern) (telugu . ,telugu-composable-pattern) - (kannada . ,kannada-composable-pattern) - (malayalam . ,malayalam-composable-pattern)))) + (kannada . ,kannada-composable-pattern)))) (map-char-table #'(lambda (key val) (let ((slot (assq val script-regexp-alist))) @@ -384,6 +359,11 @@ South Indian language Malayalam is supported in this language environment.")) (list (vector (cdr slot) 0 #'font-shape-gstring)))))) char-script-table)) +;; Malayalam: pass any sequence of characters to the shaping engine. +(set-char-table-range composition-function-table '(#x0D00 . #x0D7F) + `([,(purecopy "[\u0D00-\u0D7F]+") + 0 font-shape-gstring])) + (provide 'indian) ;;; indian.el ends here commit 96533c18b7f9d75dce9e6bb534a16ed4ccf44ad1 Author: Juri Linkov Date: Sat Jan 29 21:05:55 2022 +0200 * lisp/tab-bar.el (tab-bar-menu-bar-button): New variable (bug#51648). (tab-bar-format-menu-bar): Use it. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index d49fc2efea..06ad8f60af 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -751,9 +751,13 @@ Used by `tab-bar-format-menu-bar'." (menu-bar-keymap)) (popup-menu menu event))) +(defvar tab-bar-menu-bar-button + (propertize "Menu" 'face 'tab-bar-tab-inactive) + "Button for the menu bar.") + (defun tab-bar-format-menu-bar () "Produce the Menu button for the tab bar that shows the menu bar." - `((menu-bar menu-item (propertize "Menu" 'face 'tab-bar-tab-inactive) + `((menu-bar menu-item ,tab-bar-menu-bar-button tab-bar-menu-bar :help "Menu Bar"))) (defun tab-bar-format-history () commit e241e7719453a6b55f528c2efc51844a9d42020a Author: Juri Linkov Date: Sat Jan 29 20:55:17 2022 +0200 * lisp/isearch.el: Put 'isearch-scroll' property on two new symbols. Put 'isearch-scroll' property on new commands 'recenter-other-window' and 'context-menu-open'. diff --git a/lisp/isearch.el b/lisp/isearch.el index 833d031c56..4086a1bf11 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2934,6 +2934,7 @@ to the barrier." (put 'scroll-other-window-down 'isearch-scroll t) (put 'beginning-of-buffer-other-window 'isearch-scroll t) (put 'end-of-buffer-other-window 'isearch-scroll t) +(put 'recenter-other-window 'isearch-scroll t) ;; Commands which change the window layout (put 'delete-other-windows 'isearch-scroll t) @@ -2948,6 +2949,9 @@ to the barrier." (put 'mouse-drag-mode-line 'isearch-scroll t) (put 'mouse-drag-vertical-line 'isearch-scroll t) +;; For context menu with isearch submenu +(put 'context-menu-open 'isearch-scroll t) + ;; Aliases for split-window-* (put 'split-window-vertically 'isearch-scroll t) (put 'split-window-horizontally 'isearch-scroll t) commit 4320eebb4a90e563978b260ebd55da2234dbbc1c Author: Eli Zaretskii Date: Sat Jan 29 19:18:26 2022 +0200 ; * lisp/subr.el (use-dialog-box-p): Fix typo. diff --git a/lisp/subr.el b/lisp/subr.el index f307b2d4e2..fccd75361b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3252,7 +3252,7 @@ character. This is not possible when using `read-key', but using (defvar from--tty-menu-p nil "Non-nil means the current command was invoked from a TTY menu.") (defun use-dialog-box-p () - "Say whether the current command should promp the user via GUI dialog box." + "Say whether the current command should prompt the user via a dialog box." (and last-input-event ; not during startup (or (listp last-nonmenu-event) ; invoked by a mouse event from--tty-menu-p) ; invoked via TTY menu commit 99f4c17615c9c8461d30916cbd3ce1a3e93a3aa9 Author: Lars Ingebrigtsen Date: Sat Jan 29 17:49:52 2022 +0100 Modernise the security section in the efaq a bit * doc/misc/efaq.texi (Security risks with Emacs): Remove the X bit, and add a bit about browsing the web (bug#24489). diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index ed8a919ac7..5d4d378d82 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3376,56 +3376,13 @@ bottom of files by setting the variable @code{enable-local-eval}. @xref{File Variables,,, emacs, The GNU Emacs Manual}. @item -Synthetic X events. (Yes, a risk; use @samp{MIT-MAGIC-COOKIE-1} or -better.) - -Emacs accepts synthetic X events generated by the @code{SendEvent} -request as though they were regular events. As a result, if you are -using the trivial host-based authentication, other users who can open X -connections to your X workstation can make your Emacs process do -anything, including run other processes with your privileges. - -The only fix for this is to prevent other users from being able to open -X connections. The standard way to prevent this is to use a real -authentication mechanism, such as @samp{MIT-MAGIC-COOKIE-1}. If using -the @code{xauth} program has any effect, then you are probably using -@samp{MIT-MAGIC-COOKIE-1}. Your site may be using a superior -authentication method; ask your system administrator. - -If real authentication is not a possibility, you may be satisfied by -just allowing hosts access for brief intervals while you start your X -programs, then removing the access. This reduces the risk somewhat by -narrowing the time window when hostile users would have access, but -@emph{does not eliminate the risk}. - -On most computers running Unix and X, you enable and disable -access using the @code{xhost} command. To allow all hosts access to -your X server, use +Browsing the web. -@example -xhost + -@end example - -@noindent -at the shell prompt, which (on an HP machine, at least) produces the -following message: - -@example -access control disabled, clients can connect from any host -@end example - -To deny all hosts access to your X server (except those explicitly -allowed by name), use - -@example -xhost - -@end example - -On the test HP computer, this command generated the following message: - -@example -access control enabled, only authorized clients can connect -@end example +Emacs relies on C libraries to parse images, and historically, many of +these have had exploitable weaknesses. If you're browsing the web +with the eww browser, it will usually download and display images +using these libraries. If an image library has a weakness, it may be +used by an attacker to gain access. @end itemize commit 43a5f22857e3d41ef50068d0b61c32d92fb30ef0 Author: Lars Ingebrigtsen Date: Sat Jan 29 17:23:48 2022 +0100 Allow redirecting `message' output to a different buffer * doc/lispref/display.texi (Logging Messages): Document it. * src/xdisp.c (message_dolog): Add sanity checking. (syms_of_xdisp): Make Vmessages_buffer_name into a defvar (bug#27170). diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 3ce93200a5..ee86df446a 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -612,6 +612,16 @@ how to display a message and prevent it from being logged: @end example @end defopt +@defvar messages-buffer-name +This variable has the name of the buffer where messages should be +logged to, and defaults to @file{*Messages*}. Some packages may find +it useful to temporarily redirect the output to a different buffer +(perhaps to write the buffer out to a log file later), and they can +bind this variable to a different buffer name. (Note that this buffer +(if it doesn't exist already), will be created and put into +@code{messages-buffer-mode}.) +@end defvar + To make @file{*Messages*} more convenient for the user, the logging facility combines successive identical messages. It also combines successive related messages for the sake of two cases: question diff --git a/etc/NEWS b/etc/NEWS index 19eee6cf1d..184046c9ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1023,6 +1023,10 @@ functions. * Lisp Changes in Emacs 29.1 +** New variable 'messages-buffer-name'. +This variable (defaulting to "*Messages*") allows packages to override +where messages are logged. + +++ ** New function 'readablep'. This function says whether an object can be written out and then diff --git a/src/xdisp.c b/src/xdisp.c index 26bd45a861..381df49070 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -741,10 +741,6 @@ int update_mode_lines; static bool line_number_displayed; -/* The name of the *Messages* buffer, a string. */ - -static Lisp_Object Vmessages_buffer_name; - /* Current, index 0, and last displayed echo area message. Either buffers from echo_buffers, or nil to indicate no message. */ @@ -11378,6 +11374,10 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) old_deactivate_mark = Vdeactivate_mark; oldbuf = current_buffer; + /* Sanity check, in case the variable has been set to something + invalid. */ + if (! STRINGP (Vmessages_buffer_name)) + Vmessages_buffer_name = build_string ("*Messages*"); /* Ensure the Messages buffer exists, and switch to it. If we created it, set the major-mode. */ bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name)); @@ -35626,8 +35626,13 @@ be let-bound around code that needs to disable messages temporarily. */); staticpro (&echo_area_buffer[0]); staticpro (&echo_area_buffer[1]); - Vmessages_buffer_name = build_pure_c_string ("*Messages*"); - staticpro (&Vmessages_buffer_name); + DEFVAR_LISP ("messages-buffer-name", Vmessages_buffer_name, + doc: /* The name of the buffer where messages are logged. +This is normally \"\*Messages*\", but can be rebound by packages that +wish to redirect messages to a different buffer. (If the buffer +doesn't exist, it will be created and put into +`messages-buffer-mode'.) */); + Vmessages_buffer_name = build_string ("*Messages*"); mode_line_proptrans_alist = Qnil; staticpro (&mode_line_proptrans_alist); diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index 0870dc9de4..6ff64d0431 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -170,4 +170,13 @@ int main () { (should (equal (get-display-property 2 'height) 2.0)) (should (equal (get-display-property 2 'space-width) 20)))) +(ert-deftest test-messages-buffer-name () + (should + (equal + (let ((messages-buffer-name "test-message")) + (message "foo") + (with-current-buffer messages-buffer-name + (buffer-string))) + "foo\n"))) + ;;; xdisp-tests.el ends here commit bddd9c5f686cd5707fe395bba68c32baf4698cb9 Author: Eli Zaretskii Date: Sat Jan 29 17:56:30 2022 +0200 ; Fix formatting of last change. diff --git a/lisp/subr.el b/lisp/subr.el index 6d70d9e8d6..f307b2d4e2 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3249,14 +3249,13 @@ switch back again to the minibuffer before entering the character. This is not possible when using `read-key', but using `read-key' may be less confusing to some users.") - (defvar from--tty-menu-p nil "Non-nil means the current command was invoked from a TTY menu.") (defun use-dialog-box-p () "Say whether the current command should promp the user via GUI dialog box." (and last-input-event ; not during startup (or (listp last-nonmenu-event) ; invoked by a mouse event - from--tty-menu-p) ; invoked via TTY menu + from--tty-menu-p) ; invoked via TTY menu use-dialog-box)) (defun y-or-n-p (prompt) commit f7b408ec5001e777bf5facc81fcb815be0e1f5f6 Author: Eli Zaretskii Date: Sat Jan 29 17:54:43 2022 +0200 Don't require mouse for prompting via dialog boxes * lisp/subr.el (use-dialog-box-p): Don't require mouse support, and allow dialog boxes when invoked via the TTY menus without a mouse. (from--tty-menu-p): New internal variable. * lisp/menu-bar.el (popup-menu): Bind 'from--tty-menu-p' when invoking a command from the menu. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 817c2d485e..b6dbf209ec 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2629,8 +2629,11 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." ;; `setup-specified-language-environment', for instance, ;; expects this to be set from a menu keymap. (setq last-command-event (car (last event))) - ;; mouse-major-mode-menu was using `command-execute' instead. - (call-interactively cmd)))) + (setq from--tty-menu-p nil) + ;; Signal use-dialog-box-p this command was invoked from a menu. + (let ((from--tty-menu-p t)) + ;; mouse-major-mode-menu was using `command-execute' instead. + (call-interactively cmd))))) (defun popup-menu-normalize-position (position) "Convert the POSITION to the form which `popup-menu' expects internally. diff --git a/lisp/subr.el b/lisp/subr.el index 4b4412a883..6d70d9e8d6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3249,11 +3249,14 @@ switch back again to the minibuffer before entering the character. This is not possible when using `read-key', but using `read-key' may be less confusing to some users.") + +(defvar from--tty-menu-p nil + "Non-nil means the current command was invoked from a TTY menu.") (defun use-dialog-box-p () - "Say whether the user should be prompted with a dialog popup box." - (and (display-popup-menus-p) - last-input-event ; not during startup - (listp last-nonmenu-event) + "Say whether the current command should promp the user via GUI dialog box." + (and last-input-event ; not during startup + (or (listp last-nonmenu-event) ; invoked by a mouse event + from--tty-menu-p) ; invoked via TTY menu use-dialog-box)) (defun y-or-n-p (prompt) commit a836e8bf0c818e081cdf81d1b5bdadfe6b0df85f Author: Charles A. Roelli Date: Sat Jan 29 16:47:52 2022 +0100 Make revert-buffer ('g') keep point in VC diff buffers * lisp/vc/vc.el (vc-diff-restore-buffer): New function. (vc-diff-finish): Update its calling convention to include an optional 'oldbuf' parameter, and handle it. (vc-diff-internal): Pass a clone of the incumbent vc-diff buffer to 'vc-diff-finish' (bug#28852). diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 54457a2143..0096a5fcb3 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1742,7 +1742,20 @@ BUFFER defaults to the current buffer." "Functions run at the end of the diff command. Each function runs in the diff output buffer without args.") -(defun vc-diff-finish (buffer messages) +(defun vc-diff-restore-buffer (original new) + "Restore point in buffer NEW to where it was in ORIGINAL. + +This function works by updating buffer ORIGINAL with the contents +of NEW (without destroying existing markers), swapping their text +objects, and finally killing buffer ORIGINAL." + (with-current-buffer original + (let ((inhibit-read-only t)) + (replace-buffer-contents new))) + (with-current-buffer new + (buffer-swap-text original)) + (kill-buffer original)) + +(defun vc-diff-finish (buffer messages &optional oldbuf) ;; The empty sync output case has already been handled, so the only ;; possibility of an empty output is for an async process. (when (buffer-live-p buffer) @@ -1754,7 +1767,11 @@ Each function runs in the diff output buffer without args.") (message "%s" (cdr messages)))) (diff-setup-whitespace) (diff-setup-buffer-type) - (goto-char (point-min)) + ;; `oldbuf' is the buffer that used to show this diff. Make + ;; sure that we restore point in it if it's given. + (if oldbuf + (vc-diff-restore-buffer oldbuf buffer) + (goto-char (point-min))) (run-hooks 'vc-diff-finish-functions)) (when (and messages (not emptyp)) (message "%sdone" (car messages)))))) @@ -1779,7 +1796,12 @@ Return t if the buffer had changes, nil otherwise." ;; but the only way to set it for each file included would ;; be to call the back end separately for each file. (coding-system-for-read - (if files (vc-coding-system-for-diff (car files)) 'undecided))) + (if files (vc-coding-system-for-diff (car files)) 'undecided)) + (orig-diff-buffer-clone + (if (and (get-buffer buffer) revert-buffer-in-progress-p) + (with-current-buffer buffer + (clone-buffer + (generate-new-buffer-name " *vc-diff-clone*") nil))))) ;; On MS-Windows and MS-DOS, Diff is likely to produce DOS-style ;; EOLs, which will look ugly if (car files) happens to have Unix ;; EOLs. @@ -1840,7 +1862,8 @@ Return t if the buffer had changes, nil otherwise." ;; after `pop-to-buffer'; the former assumes the diff buffer is ;; shown in some window. (let ((buf (current-buffer))) - (vc-run-delayed (vc-diff-finish buf (when verbose messages)))) + (vc-run-delayed (vc-diff-finish buf (when verbose messages) + orig-diff-buffer-clone))) ;; In the async case, we return t even if there are no differences ;; because we don't know that yet. t))) commit 7608b77d9ee54e26ac61abb5132ac8c3c13f906a Author: Lars Ingebrigtsen Date: Sat Jan 29 16:39:48 2022 +0100 Clarify Fmatch_data doc string * src/search.c (Fmatch_data): Note quirk about non-matching optional groups in the doc string (bug#29343). diff --git a/src/search.c b/src/search.c index a1adfa2d8c..80541921de 100644 --- a/src/search.c +++ b/src/search.c @@ -2827,6 +2827,14 @@ All the elements are markers or nil (nil if the Nth pair didn't match) if the last match was on a buffer; integers or nil if a string was matched. Use `set-match-data' to reinstate the data in this list. +Note that non-matching optional groups at the end of the regexp are +elided instead of being represented with two `nil's each. For instance: + + (progn + (string-match "^\\(a\\)?\\(b\\)\\(c\\)?$" "b") + (match-data)) + => (0 1 nil nil 0 1) + If INTEGERS (the optional first argument) is non-nil, always use integers (rather than markers) to represent buffer positions. In this case, and if the last match was in a buffer, the buffer will get commit 5ef3a523425a77276ac524f3ef2a9563805f30c0 Author: Eli Zaretskii Date: Sat Jan 29 16:51:30 2022 +0200 Improve documentation of Occur mode * doc/emacs/search.texi (Other Repeating Search): Improve wording and document Occur Edit mode better. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 4bf6832e2a..8b799f093b 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1860,12 +1860,12 @@ replacing regexp matches in file names. @node Other Repeating Search @section Other Search-and-Loop Commands - Here are some other commands that find matches for a regular -expression. They all ignore case in matching, if the pattern contains + Here are some other commands that find matches for regular +expressions. They all ignore case in matching, if the pattern contains no upper-case letters and @code{case-fold-search} is non-@code{nil}. Aside from @code{multi-occur} and @code{multi-occur-in-matching-buffers}, -which always search the whole buffer, all operate on the text from point -to the end of the buffer, or on the region if it is active. +which always search the whole buffer, all of the commands operate on the +text from point to the end of the buffer, or on the region if it is active. @table @kbd @findex multi-isearch-buffers @@ -1939,19 +1939,27 @@ is not considered a match. @kindex RET @r{(Occur mode)} @kindex o @r{(Occur mode)} @kindex C-o @r{(Occur mode)} -In the @file{*Occur*} buffer, you can click on each entry, or move -point there and type @key{RET}, to visit the corresponding position in -the buffer that was searched. @kbd{o} and @kbd{C-o} display the match -in another window; @kbd{C-o} does not select it. Alternatively, you -can use the @kbd{M-g M-n} (@code{next-error}) command to visit the -occurrences one by one (@pxref{Compilation Mode}). +The @file{*Occur*} buffer uses the Occur mode as its major mode. You +can use the @kbd{n} and @kbd{p} keys to move to the next or previous +match; with prefix numeric argument, these commands move that many +matches. Digit keys are bound to @code{digit-argument}, so @kbd{5 n} +moves to the fifth next match (you don't have to type @kbd{C-u}). +@key{SPC} and @key{DEL} scroll the @file{*Occur*} buffer up and down. +Clicking on a match or moving point there and typing @key{RET} visits +the corresponding position in the original buffer that was searched. +@kbd{o} and @kbd{C-o} display the match in another window; @kbd{C-o} +does not select that window. Alternatively, you can use the @kbd{M-g +M-n} (@code{next-error}) command to visit the occurrences one by one +(@pxref{Compilation Mode}). Finally, @kbd{q} quits the window showing +the @file{*Occur*} buffer and buries the buffer. @cindex Occur Edit mode @cindex mode, Occur Edit -Typing @kbd{e} in the @file{*Occur*} buffer switches to Occur Edit -mode, in which edits made to the entries are also applied to the text -in the originating buffer. Type @kbd{C-c C-c} to return to Occur -mode. +Typing @kbd{e} in the @file{*Occur*} buffer makes the buffer writable +and enters the Occur Edit mode, in which you can edit the matching +lines and have those edits reflected in the text in the originating +buffer. Type @kbd{C-c C-c} to leave the Occur Edit mode and return to +the Occur mode. @findex list-matching-lines The command @kbd{M-x list-matching-lines} is a synonym for @kbd{M-x commit 852a5f24bb28a5d814a9515faa525c5bd5ab1c71 Author: Jae-hyeon Park Date: Sat Jan 29 15:44:44 2022 +0100 Make gnus-icalendar-with-decoded-handle more DWIM * lisp/gnus/gnus-icalendar.el (gnus-icalendar-with-decoded-handle): Assume that calendars with no charset is utf-8. Copyright-paperwork-exempt: yes diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 754a1d91cb..1bffdf3513 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -830,11 +830,12 @@ These will be used to retrieve the RSVP information from ical events." (defmacro gnus-icalendar-with-decoded-handle (handle &rest body) "Execute BODY in buffer containing the decoded contents of HANDLE." (let ((charset (make-symbol "charset"))) - `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) + `(let ((,charset (downcase + (or (cdr (assoc 'charset (mm-handle-type ,handle))) + "utf-8")))) (with-temp-buffer (mm-insert-part ,handle) - (when (and ,charset (string= (downcase ,charset) "utf-8")) - (decode-coding-region (point-min) (point-max) 'utf-8)) + (decode-coding-region (point-min) (point-max) (intern ,charset)) ,@body)))) commit 4bac7d8c73440be88eaf07a6da54feb7eaaf2503 Author: Po Lu Date: Sat Jan 29 20:38:13 2022 +0800 Fix error after merge * src/filelock.c (lock_file): Fix test against I_OWN_IT. diff --git a/src/filelock.c b/src/filelock.c index 7dfdd5ddec..cb548ac79b 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -682,7 +682,7 @@ lock_file (Lisp_Object fn) if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn)) - && !(lfname && (current_lock_owner (NULL, lfname) != I_OWN_IT))) + && !(lfname && (current_lock_owner (NULL, lfname) == I_OWN_IT))) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); /* Don't do locking if the user has opted out. */ commit 04bba4a28f959cb202e7fb993b619c7358084ec3 Merge: a85e9d7641 611736f3bc Author: Po Lu Date: Sat Jan 29 20:37:24 2022 +0800 Merge from origin/emacs-28 611736f3bc Remove debug logging ddba3c3dba Fix error in filelock.c # Conflicts: # src/filelock.c commit 611736f3bc5d9f410adef4cc175c7f9b1c015f2c Author: Alan Third Date: Thu Oct 28 11:21:00 2021 +0100 Remove debug logging * src/nsterm.m ([EmacsView copyRect:to:]): Remove logging as it's no longer required. diff --git a/src/nsterm.m b/src/nsterm.m index 08bec519db..40540c47be 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -7892,25 +7892,6 @@ - (void)copyRect:(NSRect)srcRect to:(NSPoint)dest NSRect dstRect = NSMakeRect (dest.x, dest.y, NSWidth (srcRect), NSHeight (srcRect)); - NSRect frame = [self frame]; - - /* TODO: This check is an attempt to debug a rare graphical glitch - on macOS and should be removed before the Emacs 28 release. */ - if (!NSContainsRect (frame, srcRect) - || !NSContainsRect (frame, dstRect)) - { - NSLog (@"[EmacsView copyRect:to:] Attempting to copy to or " - "from an area outside the graphics buffer."); - NSLog (@" Frame: (%f, %f) %f×%f", - NSMinX (frame), NSMinY (frame), - NSWidth (frame), NSHeight (frame)); - NSLog (@" Source: (%f, %f) %f×%f", - NSMinX (srcRect), NSMinY (srcRect), - NSWidth (srcRect), NSHeight (srcRect)); - NSLog (@" Destination: (%f, %f) %f×%f", - NSMinX (dstRect), NSMinY (dstRect), - NSWidth (dstRect), NSHeight (dstRect)); - } #ifdef NS_IMPL_COCOA if ([self wantsLayer]) commit a85e9d76414123a0cdd547edaf87de97436b1f46 Author: Po Lu Date: Sat Jan 29 19:08:52 2022 +0800 Fix error at startup with recent change * lisp/startup.el (normal-top-level): Don't access `native-comp-eln-load-path' if not (featurep 'native-compile). diff --git a/lisp/startup.el b/lisp/startup.el index b45cfbbdc3..4653b1ded6 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -834,31 +834,32 @@ It is the default value of the variable `top-level'." ;; Amend `native-comp-eln-load-path' after `command-line', since ;; the latter may have altered `user-emacs-directory'. - (let ((tmp-dir (and (equal (getenv "HOME") "/nonexistent") - (file-writable-p (expand-file-name - (or temporary-file-directory ""))) - (car native-comp-eln-load-path))) - (coding (if (eq system-type 'windows-nt) - 'utf-8 - locale-coding-system))) - (if tmp-dir - (setq native-comp-eln-load-path - (cdr native-comp-eln-load-path))) - ;; Remove the original eln-cache. - (setq native-comp-eln-load-path - (cdr native-comp-eln-load-path)) - ;; Add the new eln-cache. - (push (expand-file-name "eln-cache/" - (if coding - (decode-coding-string user-emacs-directory - coding t) - user-emacs-directory)) - native-comp-eln-load-path) - (when tmp-dir - ;; Recompute tmp-dir, in case user-emacs-directory affects it. - (setq tmp-dir (make-temp-file "emacs-testsuite-" t)) - (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) - (push tmp-dir native-comp-eln-load-path))) + (when (featurep 'native-compile) + (let ((tmp-dir (and (equal (getenv "HOME") "/nonexistent") + (file-writable-p (expand-file-name + (or temporary-file-directory ""))) + (car native-comp-eln-load-path))) + (coding (if (eq system-type 'windows-nt) + 'utf-8 + locale-coding-system))) + (if tmp-dir + (setq native-comp-eln-load-path + (cdr native-comp-eln-load-path))) + ;; Remove the original eln-cache. + (setq native-comp-eln-load-path + (cdr native-comp-eln-load-path)) + ;; Add the new eln-cache. + (push (expand-file-name "eln-cache/" + (if coding + (decode-coding-string user-emacs-directory + coding t) + user-emacs-directory)) + native-comp-eln-load-path) + (when tmp-dir + ;; Recompute tmp-dir, in case user-emacs-directory affects it. + (setq tmp-dir (make-temp-file "emacs-testsuite-" t)) + (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) + (push tmp-dir native-comp-eln-load-path)))) ;; Subprocesses of Emacs do not have direct access to the terminal, so ;; unless told otherwise they should only assume a dumb terminal. commit e380fb509b1c506e5745eafc61e053ca6455fe62 Author: Po Lu Date: Sat Jan 29 18:53:28 2022 +0800 Fix unrelated help text tooltips if a popup is shown during the delay * doc/lispref/frames.texi (Pop-Up Menus): Document new hook. * etc/NEWS: Announce `x-pre-popup-menu-hook'. * lisp/tooltip.el (tooltip-mode): Make sure `tooltip-hide' is run before any popup menu is displayed to prevent unrelated help text from obscuring the popup menu if it pops up during the tooltip delay. * src/menu.c (x_popup_menu_1): Run said hook right before the popup menu is displayed. (syms_of_menu): New hook `x-pre-popup-menu-hook'. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 2eeb8b7ed7..7d3ce9d74e 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3744,6 +3744,13 @@ still use a menu keymap to implement it. To make the contents vary, add a hook function to @code{menu-bar-update-hook} to update the contents of the menu keymap as necessary. +@defvar x-pre-popup-menu-hook + A normal hook run immediately before a pop-up menu is displayed, +either directly by calling @code{x-popup-menu}, or through a menu +keymap. It won't be called if @code{x-popup-menu} returns for some +other reason without displaying a pop-up menu. +@end defvar + @node Dialog Boxes @section Dialog Boxes @cindex dialog boxes diff --git a/etc/NEWS b/etc/NEWS index 99e2533194..19eee6cf1d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1085,6 +1085,11 @@ This event is sent when a user performs a pinch gesture on a touchpad, which is comprised of placing two fingers on the touchpad and moving them towards or away from each other. ++++ +** New hook 'x-pre-popup-menu-hook'. +This hook is run before 'x-popup-menu' is about to display a +deck-of-cards menu on screen. + ** Text security and suspiciousness +++ diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 9d523e7967..0ee3c38e26 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -58,9 +58,11 @@ echo area, instead of making a pop-up window." (if (and tooltip-mode (fboundp 'x-show-tip)) (progn (add-hook 'pre-command-hook 'tooltip-hide) - (add-hook 'tooltip-functions 'tooltip-help-tips)) + (add-hook 'tooltip-functions 'tooltip-help-tips) + (add-hook 'x-pre-popup-menu-hook 'tooltip-hide)) (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode) - (remove-hook 'pre-command-hook 'tooltip-hide)) + (remove-hook 'pre-command-hook 'tooltip-hide) + (remove-hook 'x-pre-popup-menu-hook 'tooltip-hide)) (remove-hook 'tooltip-functions 'tooltip-help-tips)) (setq show-help-function (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode))) diff --git a/src/menu.c b/src/menu.c index 18ecaf0b0b..449f0b44ae 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1395,6 +1395,8 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) record_unwind_protect_void (discard_menu_items); #endif + run_hook (Qx_pre_popup_menu_hook); + /* Display them in a menu, but not if F is the initial frame that doesn't have its hooks set (e.g., in a batch session), because such a frame cannot display menus. */ @@ -1408,7 +1410,11 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) discard_menu_items (); #endif -#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */ +#ifdef HAVE_NTGUI /* W32 specific because other terminals clear + the grab inside their `menu_show_hook's if + it's actually required (i.e. there isn't a + way to query the buttons currently held down + after XMenuActivate). */ if (FRAME_W32_P (f)) FRAME_DISPLAY_INFO (f)->grabbed = 0; #endif @@ -1602,6 +1608,14 @@ syms_of_menu (void) staticpro (&menu_items); DEFSYM (Qhide, "hide"); + DEFSYM (Qx_pre_popup_menu_hook, "x-pre-popup-menu-hook"); + + DEFVAR_LISP ("x-pre-popup-menu-hook", Vx_pre_popup_menu_hook, + doc: /* Hook run before `x-popup-menu' displays a popup menu. +It is only run before the menu is really going to be displayed. It +won't be run if `x-popup-menu' fails or returns for some other reason +(such as the keymap is invalid). */); + Vx_pre_popup_menu_hook = Qnil; defsubr (&Sx_popup_menu); defsubr (&Sx_popup_dialog); commit ddba3c3dba539155e1b3835217a9e38bdf431185 Author: Michael Albinus Date: Sat Jan 29 11:45:38 2022 +0100 Fix error in filelock.c * src/filelock.c (lock_file): Move call of file name handler to `Flock_file'. Determine lock_filename only in case create_lockfiles is non-nil. Adapt the rest of the function accordingly. (Flock_file): Do not check for create_lockfiles. Call file name handler if appropriate. (Bug#53207) diff --git a/src/filelock.c b/src/filelock.c index 892a451e8c..e1e2cc1b23 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -646,6 +646,7 @@ make_lock_file_name (Lisp_Object fn) static Lisp_Object lock_file (Lisp_Object fn) { + char *lfname = NULL; lock_info_type lock_info; /* Don't do locking while dumping Emacs. @@ -654,47 +655,46 @@ lock_file (Lisp_Object fn) if (will_dump_p ()) return Qnil; - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - Lisp_Object handler; - handler = Ffind_file_name_handler (fn, Qlock_file); - if (!NILP (handler)) + if (create_lockfiles) { - return call2 (handler, Qlock_file, fn); + /* Create the name of the lock-file for file fn */ + Lisp_Object lock_filename = make_lock_file_name (fn); + if (NILP (lock_filename)) + return Qnil; + lfname = SSDATA (ENCODE_FILE (lock_filename)); } - Lisp_Object lock_filename = make_lock_file_name (fn); - if (NILP (lock_filename)) - return Qnil; - char *lfname = SSDATA (ENCODE_FILE (lock_filename)); - /* See if this file is visited and has changed on disk since it was visited. */ Lisp_Object subject_buf = get_truename_buffer (fn); if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn)) - && current_lock_owner (NULL, lfname) != -2) + && !(lfname && current_lock_owner (NULL, lfname) == -2)) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); - /* Try to lock the lock. FIXME: This ignores errors when - lock_if_free returns a positive errno value. */ - if (lock_if_free (&lock_info, lfname) < 0) + /* Don't do locking if the user has opted out. */ + if (lfname) { - /* Someone else has the lock. Consider breaking it. */ - Lisp_Object attack; - char *dot = lock_info.dot; - ptrdiff_t pidlen = lock_info.colon - (dot + 1); - static char const replacement[] = " (pid "; - int replacementlen = sizeof replacement - 1; - memmove (dot + replacementlen, dot + 1, pidlen); - strcpy (dot + replacementlen + pidlen, ")"); - memcpy (dot, replacement, replacementlen); - attack = call2 (intern ("ask-user-about-lock"), fn, - build_string (lock_info.user)); - /* Take the lock if the user said so. */ - if (!NILP (attack)) - lock_file_1 (lfname, 1); + /* Try to lock the lock. FIXME: This ignores errors when + lock_if_free returns a positive errno value. */ + if (lock_if_free (&lock_info, lfname) < 0) + { + /* Someone else has the lock. Consider breaking it. */ + Lisp_Object attack; + char *dot = lock_info.dot; + ptrdiff_t pidlen = lock_info.colon - (dot + 1); + static char const replacement[] = " (pid "; + int replacementlen = sizeof replacement - 1; + memmove (dot + replacementlen, dot + 1, pidlen); + strcpy (dot + replacementlen + pidlen, ")"); + memcpy (dot, replacement, replacementlen); + attack = call2 (intern ("ask-user-about-lock"), fn, + build_string (lock_info.user)); + /* Take the lock if the user said so. */ + if (!NILP (attack)) + lock_file_1 (lfname, 1); + } } return Qnil; } @@ -748,12 +748,16 @@ If the option `create-lockfiles' is nil, this does nothing. */) (Lisp_Object file) { #ifndef MSDOS - /* Don't do locking if the user has opted out. */ - if (create_lockfiles) - { - CHECK_STRING (file); - lock_file (file); - } + CHECK_STRING (file); + + /* If the file name has special constructs in it, + call the corresponding file name handler. */ + Lisp_Object handler; + handler = Ffind_file_name_handler (file, Qlock_file); + if (!NILP (handler)) + return call2 (handler, Qlock_file, file); + + lock_file (file); #endif /* MSDOS */ return Qnil; } commit 0a5ece3da157c5a33023dfdf6211fc34015f197d Author: Eli Zaretskii Date: Sat Jan 29 12:19:23 2022 +0200 Allow key to delete entire grapheme clusters * lisp/simple.el (delete-forward-char): If deleting forward, delete complete grapheme clusters as single units. * etc/NEWS: Announce the change. diff --git a/etc/NEWS b/etc/NEWS index d1eaf08036..99e2533194 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -119,6 +119,16 @@ This is to open up the 'C-x 8 .' map to bind further characters there. This is for compatibility with the shell versions of these commands, which don't handle options like '--help' in any special way. +--- +** The 'delete-forward-char' command now deletes by grapheme clusters. +This command is by default bound to the function key +(a.k.a. ). When invoked without a prefix argument or with +a positive prefix numeric argument, the command will now delete +complete grapheme clusters produced by character composition. For +example, if point is before an Emoji sequence, pressing will +delete the entire sequence, not just a single character at its +beginning. + * Changes in Emacs 29.1 diff --git a/lisp/simple.el b/lisp/simple.el index 00669ac634..3cf3024184 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1292,6 +1292,11 @@ If Transient Mark mode is enabled, the mark is active, and N is 1, delete the text in the region and deactivate the mark instead. To disable this, set variable `delete-active-region' to nil. +If N is positive, characters composed into a single grapheme cluster +count as a single character and are deleted together. Thus, +\"\\[universal-argument] 2 \\[delete-forward-char]\" when two grapheme clusters follow point will +delete the characters composed into both of the grapheme clusters. + Optional second arg KILLFLAG non-nil means to kill (save in kill ring) instead of delete. If called interactively, a numeric prefix argument specifies N, and KILLFLAG is also set if a prefix @@ -1312,6 +1317,21 @@ the actual saved text might be different from what was killed." (kill-region (region-beginning) (region-end) 'region) (funcall region-extract-function 'delete-only))) + ;; For forward deletion, treat composed characters as a single + ;; character to delete. + ((>= n 1) + (let ((pos (point)) + start cmp) + (setq start pos) + (while (> n 0) + ;; 'find-composition' will return (FROM TO ....) or nil. + (setq cmp (find-composition pos)) + (if cmp + (setq pos (cadr cmp)) + (setq pos (1+ pos))) + (setq n (1- n))) + (delete-char (- pos start) killflag))) + ;; Otherwise, do simple deletion. (t (delete-char n killflag)))) commit a773d7f05b365e26bb070ed5f5a36d1f43003777 Author: Eli Zaretskii Date: Sat Jan 29 11:55:02 2022 +0200 Fix native-compilation at startup * lisp/startup.el (normal-top-level): Set up the initial value of 'native-comp-eln-load-path' early into startup, then amend it after calling 'command-line'. (Bug#53497) diff --git a/lisp/startup.el b/lisp/startup.el index 66dd726ae9..b45cfbbdc3 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -558,6 +558,27 @@ It is the default value of the variable `top-level'." (setq user-emacs-directory (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) + (when (featurep 'native-compile) + ;; Form `native-comp-eln-load-path'. + (let ((path-env (getenv "EMACSNATIVELOADPATH"))) + (when path-env + (dolist (path (split-string path-env path-separator)) + (unless (string= "" path) + (push path native-comp-eln-load-path))))) + (push (expand-file-name "eln-cache/" user-emacs-directory) + native-comp-eln-load-path) + ;; When $HOME is set to '/nonexistent' means we are running the + ;; testsuite, add a temporary folder in front to produce there + ;; new compilations. + (when (and (equal (getenv "HOME") "/nonexistent") + ;; We may be running in a chroot environment where we + ;; can't write anything. + (file-writable-p (expand-file-name + (or temporary-file-directory "")))) + (let ((tmp-dir (make-temp-file "emacs-testsuite-" t))) + (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) + (push tmp-dir native-comp-eln-load-path)))) + ;; Look in each dir in load-path for a subdirs.el file. If we ;; find one, load it, which will add the appropriate subdirs of ;; that dir into load-path. This needs to be done before setting @@ -644,6 +665,16 @@ It is the default value of the variable `top-level'." (set pathsym (mapcar (lambda (dir) (decode-coding-string dir coding t)) path))))) + (when (featurep 'native-compile) + (let ((npath (symbol-value 'native-comp-eln-load-path))) + (set 'native-comp-eln-load-path + (mapcar (lambda (dir) + ;; Call expand-file-name to remove all the + ;; pesky ".." from the directyory names in + ;; native-comp-eln-load-path. + (expand-file-name + (decode-coding-string dir coding t))) + npath)))) (dolist (filesym '(data-directory doc-directory exec-directory installation-directory invocation-directory invocation-name @@ -801,6 +832,34 @@ It is the default value of the variable `top-level'." (unless inhibit-startup-hooks (run-hooks 'window-setup-hook)))) + ;; Amend `native-comp-eln-load-path' after `command-line', since + ;; the latter may have altered `user-emacs-directory'. + (let ((tmp-dir (and (equal (getenv "HOME") "/nonexistent") + (file-writable-p (expand-file-name + (or temporary-file-directory ""))) + (car native-comp-eln-load-path))) + (coding (if (eq system-type 'windows-nt) + 'utf-8 + locale-coding-system))) + (if tmp-dir + (setq native-comp-eln-load-path + (cdr native-comp-eln-load-path))) + ;; Remove the original eln-cache. + (setq native-comp-eln-load-path + (cdr native-comp-eln-load-path)) + ;; Add the new eln-cache. + (push (expand-file-name "eln-cache/" + (if coding + (decode-coding-string user-emacs-directory + coding t) + user-emacs-directory)) + native-comp-eln-load-path) + (when tmp-dir + ;; Recompute tmp-dir, in case user-emacs-directory affects it. + (setq tmp-dir (make-temp-file "emacs-testsuite-" t)) + (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) + (push tmp-dir native-comp-eln-load-path))) + ;; Subprocesses of Emacs do not have direct access to the terminal, so ;; unless told otherwise they should only assume a dumb terminal. ;; We are careful to do it late (after term-setup-hook), although the