commit df8efda552d85c571966219ec72d9e50b4f998cd (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sat May 14 14:12:39 2022 +0800 Try to restore valuator values when a device is enabled * src/xterm.c (struct xi_known_valuator): New struct. (xi_populate_device_from_info): Figure out all the values of the valuators and set the scroll valuators's current_value to it. diff --git a/src/xterm.c b/src/xterm.c index 0bec87438e..64c4f91a18 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4067,27 +4067,48 @@ x_free_xi_devices (struct x_display_info *dpyinfo) unblock_input (); } +#ifdef HAVE_XINPUT2_1 +struct xi_known_valuator +{ + /* The current value of this valuator. */ + double current_value; + + /* The number of the valuator. */ + int number; + + /* The next valuator whose value we already know. */ + struct xi_known_valuator *next; +}; +#endif + static void xi_populate_device_from_info (struct xi_device_t *xi_device, XIDeviceInfo *device) { #ifdef HAVE_XINPUT2_1 struct xi_scroll_valuator_t *valuator; + struct xi_known_valuator *values, *tem; int actual_valuator_count; XIScrollClassInfo *info; + XIValuatorClassInfo *val_info; #endif + int c; #ifdef HAVE_XINPUT2_2 XITouchClassInfo *touch_info; #endif - int c; + +#ifdef HAVE_XINPUT2_1 + USE_SAFE_ALLOCA; +#endif xi_device->device_id = device->deviceid; xi_device->grab = 0; #ifdef HAVE_XINPUT2_1 actual_valuator_count = 0; - xi_device->valuators = - xmalloc (sizeof *xi_device->valuators * device->num_classes); + xi_device->valuators = xmalloc (sizeof *xi_device->valuators + * device->num_classes); + values = NULL; #endif #ifdef HAVE_XINPUT2_2 xi_device->touchpoints = NULL; @@ -4119,7 +4140,21 @@ xi_populate_device_from_info (struct xi_device_t *xi_device, break; } + + case XIValuatorClass: + { + val_info = (XIValuatorClassInfo *) device->classes[c]; + tem = SAFE_ALLOCA (sizeof *tem); + + tem->next = values; + tem->number = val_info->number; + tem->current_value = val_info->value; + + values = tem; + break; + } #endif + #ifdef HAVE_XINPUT2_2 case XITouchClass: { @@ -4134,6 +4169,25 @@ xi_populate_device_from_info (struct xi_device_t *xi_device, #ifdef HAVE_XINPUT2_1 xi_device->scroll_valuator_count = actual_valuator_count; + + /* Now look through all the valuators whose values are already known + and populate our client-side records with their current + values. */ + + for (tem = values; values; values = values->next) + { + for (c = 0; c < xi_device->scroll_valuator_count; ++c) + { + if (xi_device->valuators[c].number == tem->number) + { + xi_device->valuators[c].invalid_p = false; + xi_device->valuators[c].current_value = tem->current_value; + xi_device->valuators[c].pending_enter_reset = true; + } + } + } + + SAFE_FREE (); #endif } commit 004c2ced6e1eb71a54ea58e78c714ae69e215f63 Author: Po Lu Date: Sat May 14 13:50:52 2022 +0800 Better fix for disappearing menu items on NS * src/frame.c (delete_frame): Revert last change. * src/nsmenu.m (free_frame_menubar): Only free if that frame's menu bar is actually being displayed. (ns_update_menubar): Note the last frame to have updated the menu bar. diff --git a/src/frame.c b/src/frame.c index 2fb91ca5e7..1391cef628 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2334,12 +2334,8 @@ delete_frame (Lisp_Object frame, Lisp_Object force) } /* Cause frame titles to update--necessary if we now have just one - frame. On NS the menu bar becomes empty after a tooltip frame is - deleted for an unknown reason, so this serves to restore the - contents of the menu bar as well. */ -#ifndef HAVE_NS + frame. */ if (!is_tooltip_frame) -#endif update_mode_lines = 15; /* Now run the post-deletion hooks. */ diff --git a/src/nsmenu.m b/src/nsmenu.m index 5599d51906..531f0d3bb6 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -52,6 +52,10 @@ /* Nonzero means a menu is currently active. */ static int popup_activated_flag; +/* The last frame whose menubar was updated. (This is the frame whose + menu bar is currently being displayed.) */ +static struct frame *last_menubar_frame; + /* NOTE: toolbar implementation is at end, following complete menu implementation. */ @@ -71,6 +75,12 @@ free_frame_menubar (struct frame *f) { id menu = [NSApp mainMenu]; + + if (f != last_menubar_frame) + return; + + last_menubar_frame = NULL; + for (int i = [menu numberOfItems] - 1 ; i >= 0; i--) { NSMenuItem *item = (NSMenuItem *)[menu itemAtIndex:i]; @@ -135,9 +145,9 @@ #endif return; } - XSETFRAME (Vmenu_updating_frame, f); -/*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */ + XSETFRAME (Vmenu_updating_frame, f); + last_menubar_frame = f; block_input (); /* Menu may have been created automatically; if so, discard it. */ @@ -155,7 +165,7 @@ #if NSMENUPROFILE ftime (&tb); - t = -(1000*tb.time+tb.millitm); + t = -(1000 * tb.time + tb.millitm); #endif if (deep_p) @@ -413,7 +423,7 @@ #if NSMENUPROFILE ftime (&tb); - t += 1000*tb.time+tb.millitm; + t += 1000 * tb.time + tb.millitm; fprintf (stderr, "Menu update took %ld msec.\n", t); #endif commit 320eaa0017c01d1b30cd97c491fdffe8e7580329 Author: Po Lu Date: Sat May 14 05:29:49 2022 +0000 Add more cursor bitmaps on Haiku * src/haikufns.c (cursor_bitmaps): Register new cursor bitmaps. * src/haikugui.h (hand_ptr_bits, hand_ptrmask_bits) (horizd_ptr_bits, horizd_ptrmask_bits, vertd_ptr_bits) (vertd_ptrmask_bits, hourglass_bits, hourglass_mask_bits): New cursor bitmaps. diff --git a/src/haikufns.c b/src/haikufns.c index b4cdb93b96..e15a3dc09b 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1856,10 +1856,10 @@ struct user_cursor_bitmap_info cursor_bitmaps[] = { ibeam_ptr_bits, ibeam_ptrmask_bits, 15, 15, 7, 7 }, /* text_cursor */ { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, /* nontext_cursor */ { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, /* modeline_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* hand_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* hourglass_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* horizontal_drag_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* vertical_drag_cursor */ + { hand_ptr_bits, hand_ptrmask_bits, 15, 15, 4, 3 }, /* hand_cursor */ + { hourglass_bits, hourglass_mask_bits, 15, 15, 7, 7 }, /* hourglass_cursor */ + { horizd_ptr_bits, horizd_ptrmask_bits, 15, 15, 7, 7 }, /* horizontal_drag_cursor */ + { vertd_ptr_bits, vertd_ptrmask_bits, 15, 15, 7, 7 }, /* vertical_drag_cursor */ { NULL, NULL, 0, 0, 0, 0 }, /* left_edge_cursor */ { NULL, NULL, 0, 0, 0, 0 }, /* top_left_corner_cursor */ { NULL, NULL, 0, 0, 0, 0 }, /* top_edge_cursor */ diff --git a/src/haikugui.h b/src/haikugui.h index f197e718c0..0dc127e6b6 100644 --- a/src/haikugui.h +++ b/src/haikugui.h @@ -144,4 +144,60 @@ MAYBE_UNUSED static unsigned char ibeam_ptrmask_bits[] = 0xfc, 0x1f, 0xfe, 0x3f, 0xfc, 0x1f, 0x00, 0x00 }; +MAYBE_UNUSED static unsigned char hand_ptr_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xa0, 0x02, 0xa0, 0x02, 0xa0, + 0x02, 0xf0, 0x07, 0xf0, 0x07, 0xf0, 0x07, 0xf0, 0x07, 0xf0, 0x07, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char hand_ptrmask_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0xa0, 0x02, 0xf0, 0x07, 0xf0, 0x07, 0xf8, + 0x0f, 0xf8, 0x0f, 0xf8, 0x0f, 0xf8, 0x0f, 0xf8, 0x0f, 0xf8, 0x0f, + 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char horizd_ptr_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x04, 0x28, + 0x0a, 0xf4, 0x17, 0x02, 0x20, 0xf4, 0x17, 0x28, 0x0a, 0x10, 0x04, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char horizd_ptrmask_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x04, 0x38, + 0x0e, 0xfc, 0x1f, 0xfe, 0x3f, 0xfc, 0x1f, 0x38, 0x0e, 0x10, 0x04, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char vertd_ptr_bits[] = + { + 0x00, 0x00, 0x80, 0x00, 0x40, 0x01, 0x20, 0x02, 0x50, 0x05, 0x60, + 0x03, 0x40, 0x01, 0x40, 0x01, 0x40, 0x01, 0x60, 0x03, 0x50, 0x05, + 0x20, 0x02, 0x40, 0x01, 0x80, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char vertd_ptrmask_bits[] = + { + 0x00, 0x00, 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xe0, + 0x03, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, + 0xe0, 0x03, 0xc0, 0x01, 0x80, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char hourglass_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0x10, 0x04, 0x08, 0x08, 0x24, + 0x10, 0x44, 0x10, 0x84, 0x10, 0x84, 0x10, 0x84, 0x10, 0x88, 0x08, + 0x10, 0x04, 0xe0, 0x03, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char hourglass_mask_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, + 0x1f, 0xfc, 0x1f, 0xfc, 0x1f, 0xfc, 0x1f, 0xfc, 0x1f, 0xf8, 0x0f, + 0xf0, 0x07, 0xe0, 0x03, 0x00, 0x00, 0x00, 0x00 + }; + #endif /* _HAIKU_GUI_H_ */ commit 3e23957bd68ff03470cb23fd403a499d4ccb642f Merge: bfdd93aefe f044da7704 Author: Stefan Kangas Date: Sat May 14 06:31:37 2022 +0200 ; Merge from origin/emacs-28 The following commit was skipped: f044da7704 Fix tooltip face overwriting dragged text strings during m... commit bfdd93aefe835b1b658af576f960a0f82d95b22d Merge: c33b048a86 a769cbfcfb Author: Stefan Kangas Date: Sat May 14 06:31:34 2022 +0200 Merge from origin/emacs-28 a769cbfcfb Fix lexical-binding fallout in vhdl-mode.el commit c33b048a863f9df12a0f68f51d143d0515e34043 Author: Po Lu Date: Sat May 14 12:16:34 2022 +0800 Work around deleting tooltip frames clearing menubars on NS * src/frame.c (delete_frame): Update menu bars if a tooltip frame was deleted on NS. diff --git a/src/frame.c b/src/frame.c index 93028aa895..2fb91ca5e7 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2333,8 +2333,13 @@ delete_frame (Lisp_Object frame, Lisp_Object force) kset_default_minibuffer_frame (kb, Qnil); } - /* Cause frame titles to update--necessary if we now have just one frame. */ + /* Cause frame titles to update--necessary if we now have just one + frame. On NS the menu bar becomes empty after a tooltip frame is + deleted for an unknown reason, so this serves to restore the + contents of the menu bar as well. */ +#ifndef HAVE_NS if (!is_tooltip_frame) +#endif update_mode_lines = 15; /* Now run the post-deletion hooks. */ commit 09e86785ce2dae9176f4122c399c61b51240cfec Author: Po Lu Date: Sat May 14 11:29:43 2022 +0800 Implement non-system tooltips on NS * src/nsfns.m (unwind_create_frame): Return Lisp_Object like on X. (do_unwind_create_frame): New function. (Fx_create_frame): Adjust accordingly. (compute_tip_xy): Fix coding style. (unwind_create_tip_frame, ns_create_tip_frame): New functions. (x_hide_tip, Fx_show_tip, Fx_hide_tip): Create and hide actual tooltip frames. (syms_of_nsfns): New defvar `x-max-tooltip-size' and staticpros. * src/nsterm.m (ns_set_window_size): Clean up coding style. ([EmacsWindow initWithEmacsFrame:]): ([EmacsWindow initWithEmacsFrame:fullscreen:screen:]): Handle tooltip frames. diff --git a/src/nsfns.m b/src/nsfns.m index a67dafe095..f82665a300 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -53,6 +53,26 @@ Updated by Christian Limpach (chris@nice.ch) static EmacsTooltip *ns_tooltip = nil; +/* The frame of the currently visible tooltip, or nil if none. */ +static Lisp_Object tip_frame; + +/* The window-system window corresponding to the frame of the + currently visible tooltip. */ +static NSWindow *tip_window; + +/* A timer that hides or deletes the currently visible tooltip when it + fires. */ +static Lisp_Object tip_timer; + +/* STRING argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_string; + +/* Normalized FRAME argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_frame; + +/* PARMS argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_parms; + /* Static variables to handle AppleScript execution. */ static Lisp_Object as_script, *as_result; static int as_status; @@ -1021,7 +1041,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. /* Handler for signals raised during x_create_frame. FRAME is the frame which is partially constructed. */ -static void +static Lisp_Object unwind_create_frame (Lisp_Object frame) { struct frame *f = XFRAME (frame); @@ -1030,7 +1050,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. display is disconnected after the frame has become official, but before x_create_frame removes the unwind protect. */ if (!FRAME_LIVE_P (f)) - return; + return Qnil; /* If frame is ``official'', nothing to do. */ if (NILP (Fmemq (frame, Vframe_list))) @@ -1057,7 +1077,18 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. /* Check that reference counts are indeed correct. */ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount); #endif + + return Qt; } + + return Qnil; +} + + +static void +do_unwind_create_frame (Lisp_Object frame) +{ + unwind_create_frame (frame); } /* @@ -1191,7 +1222,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. FRAME_DISPLAY_INFO (f) = dpyinfo; /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */ - record_unwind_protect (unwind_create_frame, frame); + record_unwind_protect (do_unwind_create_frame, frame); f->output_data.ns->window_desc = desc_ctr++; if (TYPE_RANGED_FIXNUMP (Window, parent)) @@ -2769,16 +2800,10 @@ Frames are listed from topmost (first) to bottommost (last). */) return make_fixnum (1 << min (dpyinfo->n_planes, 24)); } -/* TODO: move to xdisp or similar */ static void -compute_tip_xy (struct frame *f, - Lisp_Object parms, - Lisp_Object dx, - Lisp_Object dy, - int width, - int height, - int *root_x, - int *root_y) +compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, + Lisp_Object dy, int width, int height, int *root_x, + int *root_y) { Lisp_Object left, top, right, bottom; NSPoint pt; @@ -2847,6 +2872,299 @@ Frames are listed from topmost (first) to bottommost (last). */) *root_y = screen.frame.origin.y + screen.frame.size.height - height; } +static void +unwind_create_tip_frame (Lisp_Object frame) +{ + Lisp_Object deleted; + + deleted = unwind_create_frame (frame); + if (EQ (deleted, Qt)) + { + tip_window = NULL; + tip_frame = Qnil; + } +} + +/* Create a frame for a tooltip on the display described by DPYINFO. + PARMS is a list of frame parameters. TEXT is the string to + display in the tip frame. Value is the frame. + + Note that functions called here, esp. gui_default_parameter can + signal errors, for instance when a specified color name is + undefined. We have to make sure that we're in a consistent state + when this happens. */ + +static Lisp_Object +ns_create_tip_frame (struct ns_display_info *dpyinfo, Lisp_Object parms) +{ + struct frame *f; + Lisp_Object frame; + Lisp_Object name; + specpdl_ref count = SPECPDL_INDEX (); + bool face_change_before = face_change; + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + parms = Fcopy_alist (parms); + + /* Get the name of the frame to use for resource lookup. */ + name = gui_display_get_arg (dpyinfo, parms, Qname, "name", "Name", + RES_TYPE_STRING); + if (!STRINGP (name) + && !EQ (name, Qunbound) + && !NILP (name)) + error ("Invalid frame name--not a string or nil"); + + frame = Qnil; + f = make_frame (false); + f->wants_modeline = false; + XSETFRAME (frame, f); + record_unwind_protect (unwind_create_tip_frame, frame); + + f->terminal = dpyinfo->terminal; + + f->output_method = output_ns; + f->output_data.ns = xzalloc (sizeof *f->output_data.ns); + f->tooltip = true; + + FRAME_FONTSET (f) = -1; + FRAME_DISPLAY_INFO (f) = dpyinfo; + + block_input (); +#ifdef NS_IMPL_COCOA + mac_register_font_driver (f); +#else + register_font_driver (&nsfont_driver, f); +#endif + unblock_input (); + + image_cache_refcount = + FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; + + gui_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + { +#ifdef NS_IMPL_COCOA + /* use for default font name */ + id font = [NSFont userFixedPitchFontOfSize: -1.0]; /* default */ + gui_default_parameter (f, parms, Qfontsize, + make_fixnum (0 /* (int)[font pointSize] */), + "fontSize", "FontSize", RES_TYPE_NUMBER); + // Remove ' Regular', not handled by backends. + char *fontname = xstrdup ([[font displayName] UTF8String]); + int len = strlen (fontname); + if (len > 8 && strcmp (fontname + len - 8, " Regular") == 0) + fontname[len-8] = '\0'; + gui_default_parameter (f, parms, Qfont, + build_string (fontname), + "font", "Font", RES_TYPE_STRING); + xfree (fontname); +#else + gui_default_parameter (f, parms, Qfont, + build_string ("fixed"), + "font", "Font", RES_TYPE_STRING); +#endif + } + + gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), + "borderWidth", "BorderWidth", RES_TYPE_NUMBER); + + /* This defaults to 1 in order to match xterm. We recognize either + internalBorderWidth or internalBorder (which is what xterm calls + it). */ + if (NILP (Fassq (Qinternal_border_width, parms))) + { + Lisp_Object value; + + value = gui_display_get_arg (dpyinfo, parms, Qinternal_border_width, + "internalBorder", "internalBorder", + RES_TYPE_NUMBER); + if (! EQ (value, Qunbound)) + parms = Fcons (Fcons (Qinternal_border_width, value), + parms); + } + + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (1), + "internalBorderWidth", "internalBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + + /* Also do the stuff which must be set before the window exists. */ + gui_default_parameter (f, parms, Qforeground_color, build_string ("black"), + "foreground", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qbackground_color, build_string ("white"), + "background", "Background", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qmouse_color, build_string ("black"), + "pointerColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qcursor_color, build_string ("black"), + "cursorColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qborder_color, build_string ("black"), + "borderColor", "BorderColor", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + /* Init faces before gui_default_parameter is called for the + scroll-bar-width parameter because otherwise we end up in + init_iterator with a null face cache, which should not happen. */ + init_frame_faces (f); + + f->output_data.ns->parent_desc = FRAME_DISPLAY_INFO (f)->root_window; + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + gui_figure_window_size (f, parms, false, false); + + block_input (); + [[EmacsView alloc] initFrameFromEmacs: f]; + ns_icon (f, parms); + unblock_input (); + + gui_default_parameter (f, parms, Qauto_raise, Qnil, + "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qauto_lower, Qnil, + "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); + + /* Add `tooltip' frame parameter's default value. */ + if (NILP (Fframe_parameter (frame, Qtooltip))) + { + AUTO_FRAME_ARG (arg, Qtooltip, Qt); + Fmodify_frame_parameters (frame, arg); + } + + /* FIXME - can this be done in a similar way to normal frames? + https://lists.gnu.org/r/emacs-devel/2007-10/msg00641.html */ + + /* Set the `display-type' frame parameter before setting up faces. */ + { + Lisp_Object disptype = intern ("color"); + + if (NILP (Fframe_parameter (frame, Qdisplay_type))) + { + AUTO_FRAME_ARG (arg, Qdisplay_type, disptype); + Fmodify_frame_parameters (frame, arg); + } + } + + /* Set up faces after all frame parameters are known. This call + also merges in face attributes specified for new frames. + + Frame parameters may be changed if .Xdefaults contains + specifications for the default font. For example, if there is an + `Emacs.default.attributeBackground: pink', the `background-color' + attribute of the frame gets set, which let's the internal border + of the tooltip frame appear in pink. Prevent this. */ + { + Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); + + call2 (Qface_set_after_frame_default, frame, Qnil); + + if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) + { + AUTO_FRAME_ARG (arg, Qbackground_color, bg); + Fmodify_frame_parameters (frame, arg); + } + } + + f->no_split = true; + + /* Now that the frame will be official, it counts as a reference to + its display and terminal. */ + f->terminal->reference_count++; + + /* It is now ok to make the frame official even if we get an error + below. And the frame needs to be on Vframe_list or making it + visible won't work. */ + Vframe_list = Fcons (frame, Vframe_list); + f->can_set_window_size = true; + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, Qtip_frame); + + /* Setting attributes of faces of the tooltip frame from resources + and similar will set face_change, which leads to the clearing of + all current matrices. Since this isn't necessary here, avoid it + by resetting face_change to the value it had before we created + the tip frame. */ + face_change = face_change_before; + + /* Discard the unwind_protect. */ + return unbind_to (count, frame); +} + +static Lisp_Object +x_hide_tip (bool delete) +{ + if (!NILP (tip_timer)) + { + call1 (intern ("cancel-timer"), tip_timer); + tip_timer = Qnil; + } + + if (!(ns_tooltip == nil || ![ns_tooltip isActive])) + { + [ns_tooltip hide]; + tip_last_frame = Qnil; + return Qt; + } + + if ((NILP (tip_last_frame) && NILP (tip_frame)) + || (!use_system_tooltips + && !delete + && !NILP (tip_frame) + && FRAME_LIVE_P (XFRAME (tip_frame)) + && !FRAME_VISIBLE_P (XFRAME (tip_frame)))) + /* Either there's no tooltip to hide or it's an already invisible + Emacs tooltip and we don't want to change its type. Return + quickly. */ + return Qnil; + else + { + specpdl_ref count; + Lisp_Object was_open = Qnil; + + count = SPECPDL_INDEX (); + specbind (Qinhibit_redisplay, Qt); + specbind (Qinhibit_quit, Qt); + + /* Now look whether there's an Emacs tip around. */ + if (!NILP (tip_frame)) + { + struct frame *f = XFRAME (tip_frame); + + if (FRAME_LIVE_P (f)) + { + if (delete || use_system_tooltips) + { + /* Delete the Emacs tooltip frame when DELETE is true + or we change the tooltip type from an Emacs one to + a GTK+ system one. */ + delete_frame (tip_frame, Qnil); + tip_frame = Qnil; + } + else + ns_make_frame_invisible (f); + + was_open = Qt; + } + else + tip_frame = Qnil; + } + else + tip_frame = Qnil; + + return unbind_to (count, was_open); + } +} DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, doc: /* SKIP: real doc in xfns.c. */) @@ -2854,11 +3172,18 @@ Frames are listed from topmost (first) to bottommost (last). */) { int root_x, root_y; specpdl_ref count = SPECPDL_INDEX (); - struct frame *f; + struct frame *f, *tip_f; + struct window *w; + struct buffer *old_buffer; + struct text_pos pos; + int width, height; + int old_windows_or_buffers_changed = windows_or_buffers_changed; + specpdl_ref count_1; + Lisp_Object window, size, tip_buf; char *str; - NSSize size; - NSColor *color; - Lisp_Object t; + NSWindow *nswindow; + + AUTO_STRING (tip, " *tip*"); specbind (Qinhibit_redisplay, Qt); @@ -2879,32 +3204,250 @@ Frames are listed from topmost (first) to bottommost (last). */) else CHECK_FIXNUM (dy); - block_input (); - if (ns_tooltip == nil) - ns_tooltip = [[EmacsTooltip alloc] init]; + if (use_system_tooltips) + { + NSSize size; + NSColor *color; + Lisp_Object t; + + block_input (); + if (ns_tooltip == nil) + ns_tooltip = [[EmacsTooltip alloc] init]; + else + Fx_hide_tip (); + + t = gui_display_get_arg (NULL, parms, Qbackground_color, NULL, NULL, + RES_TYPE_STRING); + if (ns_lisp_to_color (t, &color) == 0) + [ns_tooltip setBackgroundColor: color]; + + t = gui_display_get_arg (NULL, parms, Qforeground_color, NULL, NULL, + RES_TYPE_STRING); + if (ns_lisp_to_color (t, &color) == 0) + [ns_tooltip setForegroundColor: color]; + + [ns_tooltip setText: str]; + size = [ns_tooltip frame].size; + + /* Move the tooltip window where the mouse pointer is. Resize and + show it. */ + compute_tip_xy (f, parms, dx, dy, (int) size.width, (int) size.height, + &root_x, &root_y); + + [ns_tooltip showAtX: root_x Y: root_y for: XFIXNUM (timeout)]; + unblock_input (); + } else - Fx_hide_tip (); + { + if (!NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) + { + if (FRAME_VISIBLE_P (XFRAME (tip_frame)) + && EQ (frame, tip_last_frame) + && !NILP (Fequal_including_properties (tip_last_string, string)) + && !NILP (Fequal (tip_last_parms, parms))) + { + /* Only DX and DY have changed. */ + tip_f = XFRAME (tip_frame); + if (!NILP (tip_timer)) + { + call1 (intern ("cancel-timer"), tip_timer); + tip_timer = Qnil; + } + + nswindow = [FRAME_NS_VIEW (tip_f) window]; + + block_input (); + compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f), + FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y); + [nswindow setFrame: NSMakeRect (root_x, root_y, + FRAME_PIXEL_WIDTH (tip_f), + FRAME_PIXEL_HEIGHT (tip_f)) + display: YES]; + [nswindow setLevel: NSPopUpMenuWindowLevel]; + [nswindow orderFront: NSApp]; + [nswindow display]; + + SET_FRAME_VISIBLE (tip_f, 1); + unblock_input (); + + goto start_timer; + } + else if (tooltip_reuse_hidden_frame && EQ (frame, tip_last_frame)) + { + bool delete = false; + Lisp_Object tail, elt, parm, last; + + /* Check if every parameter in PARMS has the same value in + tip_last_parms. This may destruct tip_last_parms which, + however, will be recreated below. */ + for (tail = parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + /* The left, top, right and bottom parameters are handled + by compute_tip_xy so they can be ignored here. */ + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) + && !EQ (parm, Qright) && !EQ (parm, Qbottom)) + { + last = Fassq (parm, tip_last_parms); + if (NILP (Fequal (Fcdr (elt), Fcdr (last)))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + else + tip_last_parms = + call2 (intern ("assq-delete-all"), parm, tip_last_parms); + } + else + tip_last_parms = + call2 (intern ("assq-delete-all"), parm, tip_last_parms); + } + + /* Now check if every parameter in what is left of + tip_last_parms with a non-nil value has an association in + PARMS. */ + for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) + && !EQ (parm, Qbottom) && !NILP (Fcdr (elt))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + } + + x_hide_tip (delete); + } + else + x_hide_tip (true); + } + else + x_hide_tip (true); + + tip_last_frame = frame; + tip_last_string = string; + tip_last_parms = parms; - t = gui_display_get_arg (NULL, parms, Qbackground_color, NULL, NULL, - RES_TYPE_STRING); - if (ns_lisp_to_color (t, &color) == 0) - [ns_tooltip setBackgroundColor: color]; + if (NILP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame))) + { + /* Add default values to frame parameters. */ + if (NILP (Fassq (Qname, parms))) + parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms); + if (NILP (Fassq (Qinternal_border_width, parms))) + parms = Fcons (Fcons (Qinternal_border_width, make_fixnum (3)), parms); + if (NILP (Fassq (Qborder_width, parms))) + parms = Fcons (Fcons (Qborder_width, make_fixnum (1)), parms); + if (NILP (Fassq (Qborder_color, parms))) + parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms); + if (NILP (Fassq (Qbackground_color, parms))) + parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")), + parms); + + /* Create a frame for the tooltip, and record it in the global + variable tip_frame. */ + if (NILP (tip_frame = ns_create_tip_frame (FRAME_DISPLAY_INFO (f), parms))) + /* Creating the tip frame failed. */ + return unbind_to (count, Qnil); + } - t = gui_display_get_arg (NULL, parms, Qforeground_color, NULL, NULL, - RES_TYPE_STRING); - if (ns_lisp_to_color (t, &color) == 0) - [ns_tooltip setForegroundColor: color]; + tip_f = XFRAME (tip_frame); + window = FRAME_ROOT_WINDOW (tip_f); + tip_buf = Fget_buffer_create (tip, Qnil); + /* We will mark the tip window a "pseudo-window" below, and such + windows cannot have display margins. */ + bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + bset_right_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + set_window_buffer (window, tip_buf, false, false); + w = XWINDOW (window); + w->pseudo_window_p = true; + /* Try to avoid that `other-window' select us (Bug#47207). */ + Fset_window_parameter (window, Qno_other_window, Qt); + + /* Set up the frame's root window. Note: The following code does not + try to size the window or its frame correctly. Its only purpose is + to make the subsequent text size calculations work. The right + sizes should get installed when the toolkit gets back to us. */ + w->left_col = 0; + w->top_line = 0; + w->pixel_left = 0; + w->pixel_top = 0; + + if (CONSP (Vx_max_tooltip_size) + && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) + && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) + { + w->total_cols = XFIXNAT (XCAR (Vx_max_tooltip_size)); + w->total_lines = XFIXNAT (XCDR (Vx_max_tooltip_size)); + } + else + { + w->total_cols = 80; + w->total_lines = 40; + } - [ns_tooltip setText: str]; - size = [ns_tooltip frame].size; + w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (tip_f); + w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (tip_f); + FRAME_TOTAL_COLS (tip_f) = w->total_cols; + adjust_frame_glyphs (tip_f); + + /* Insert STRING into root window's buffer and fit the frame to the + buffer. */ + count_1 = SPECPDL_INDEX (); + old_buffer = current_buffer; + set_buffer_internal_1 (XBUFFER (w->contents)); + bset_truncate_lines (current_buffer, Qnil); + specbind (Qinhibit_read_only, Qt); + specbind (Qinhibit_modification_hooks, Qt); + specbind (Qinhibit_point_motion_hooks, Qt); + Ferase_buffer (); + Finsert (1, &string); + clear_glyph_matrix (w->desired_matrix); + clear_glyph_matrix (w->current_matrix); + SET_TEXT_POS (pos, BEGV, BEGV_BYTE); + try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); + /* Calculate size of tooltip window. */ + size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, + make_fixnum (w->pixel_height), Qnil, + Qnil); + /* Add the frame's internal border to calculated size. */ + width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + + /* Calculate position of tooltip frame. */ + compute_tip_xy (tip_f, parms, dx, dy, width, + height, &root_x, &root_y); + + block_input (); + nswindow = [FRAME_NS_VIEW (tip_f) window]; + [nswindow setFrame: NSMakeRect (root_x, root_y, + width, height) + display: YES]; + [nswindow setLevel: NSPopUpMenuWindowLevel]; + [nswindow orderFront: NSApp]; + [nswindow display]; + + SET_FRAME_VISIBLE (tip_f, YES); + FRAME_PIXEL_WIDTH (tip_f) = width; + FRAME_PIXEL_HEIGHT (tip_f) = height; + unblock_input (); - /* Move the tooltip window where the mouse pointer is. Resize and - show it. */ - compute_tip_xy (f, parms, dx, dy, (int)size.width, (int)size.height, - &root_x, &root_y); + w->must_be_updated_p = true; + update_single_window (w); + flush_frame (tip_f); + set_buffer_internal_1 (old_buffer); + unbind_to (count_1, Qnil); + windows_or_buffers_changed = old_windows_or_buffers_changed; - [ns_tooltip showAtX: root_x Y: root_y for: XFIXNUM (timeout)]; - unblock_input (); + start_timer: + /* Let the tip disappear after timeout seconds. */ + tip_timer = call3 (intern ("run-at-time"), timeout, Qnil, + intern ("x-hide-tip")); + } return unbind_to (count, Qnil); } @@ -2914,10 +3457,7 @@ Frames are listed from topmost (first) to bottommost (last). */) doc: /* SKIP: real doc in xfns.c. */) (void) { - if (ns_tooltip == nil || ![ns_tooltip isActive]) - return Qnil; - [ns_tooltip hide]; - return Qt; + return x_hide_tip (!tooltip_reuse_hidden_frame); } /* Return geometric attributes of FRAME. According to the value of @@ -3260,6 +3800,10 @@ - (Lisp_Object)lispString Default is t. */); ns_use_proxy_icon = true; + DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, + doc: /* SKIP: real doc in xfns.c. */); + Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); + defsubr (&Sns_read_file_name); defsubr (&Sns_get_resource); defsubr (&Sns_set_resource); @@ -3309,6 +3853,17 @@ - (Lisp_Object)lispString defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); + tip_timer = Qnil; + staticpro (&tip_timer); + tip_frame = Qnil; + staticpro (&tip_frame); + tip_last_frame = Qnil; + staticpro (&tip_last_frame); + tip_last_string = Qnil; + staticpro (&tip_last_string); + tip_last_parms = Qnil; + staticpro (&tip_last_parms); + #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1080 defsubr (&Ssystem_move_file_to_trash); #endif diff --git a/src/nsterm.h b/src/nsterm.h index ce2355e6b1..1135225e7b 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1176,6 +1176,7 @@ extern size_t ns_image_size_in_bytes (void *img); /* This in nsterm.m */ extern float ns_antialias_threshold; extern void ns_make_frame_visible (struct frame *f); +extern void ns_make_frame_invisible (struct frame *f); extern void ns_iconify_frame (struct frame *f); extern void ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value); diff --git a/src/nsterm.m b/src/nsterm.m index 9dff33da50..a1cbbff1cc 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1517,7 +1517,7 @@ -(void)remove } -static void +void ns_make_frame_invisible (struct frame *f) /* -------------------------------------------------------------------------- Hide the window (X11 semantics) @@ -1708,10 +1708,8 @@ Hide the window (X11 semantics) static void -ns_set_window_size (struct frame *f, - bool change_gravity, - int width, - int height) +ns_set_window_size (struct frame *f, bool change_gravity, + int width, int height) /* -------------------------------------------------------------------------- Adjust window pixel size based on native sizes WIDTH and HEIGHT. Impl is a bit more complex than other terms, need to do some @@ -8729,17 +8727,18 @@ - (int) fullscreenState @implementation EmacsWindow -- (instancetype) initWithEmacsFrame:(struct frame *)f +- (instancetype) initWithEmacsFrame: (struct frame *) f { return [self initWithEmacsFrame:f fullscreen:NO screen:nil]; } -- (instancetype) initWithEmacsFrame:(struct frame *)f - fullscreen:(BOOL)fullscreen - screen:(NSScreen *)screen +- (instancetype) initWithEmacsFrame: (struct frame *) f + fullscreen: (BOOL) fullscreen + screen: (NSScreen *) screen { NSWindowStyleMask styleMask; + int width, height; NSTRACE ("[EmacsWindow initWithEmacsFrame:fullscreen:screen:]"); @@ -8752,20 +8751,22 @@ - (instancetype) initWithEmacsFrame:(struct frame *)f styleMask |= NSWindowStyleMaskResizable; #endif } + else if (f->tooltip) + styleMask = 0; else - styleMask = NSWindowStyleMaskTitled - | NSWindowStyleMaskResizable - | NSWindowStyleMaskMiniaturizable - | NSWindowStyleMaskClosable; - - self = [super initWithContentRect: - NSMakeRect (0, 0, - FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols), - FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines)) - styleMask:styleMask - backing:NSBackingStoreBuffered - defer:YES - screen:screen]; + styleMask = (NSWindowStyleMaskTitled + | NSWindowStyleMaskResizable + | NSWindowStyleMaskMiniaturizable + | NSWindowStyleMaskClosable); + + width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols); + height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines); + + self = [super initWithContentRect: NSMakeRect (0, 0, width, height) + styleMask: styleMask + backing: NSBackingStoreBuffered + defer: YES + screen: screen]; if (self) { NSString *name; commit 949180b8ab4a76ae46389fed9e210d151b328a2a Author: Lars Ingebrigtsen Date: Sat May 14 04:59:24 2022 +0200 Put help-fns--compiler-macro last in the *Help* buffer * lisp/help-fns.el (help-fns-describe-function-functions): Make help-fns--compiler-macro the last entry (because it's not the most interesting information). diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d5f6a7b0be..f2b469c149 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1079,7 +1079,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) (add-hook 'help-fns-describe-function-functions #'help-fns--interactive-only) (add-hook 'help-fns-describe-function-functions #'help-fns--parent-mode) -(add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro) +(add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro 100) ;; Variables commit 96f60d1033dfba41fd995657a9afc73742daace6 Author: Po Lu Date: Sat May 14 02:38:53 2022 +0000 Fix display class of tooltip frames on Haiku * haikufns.c (haiku_create_tip_frame): Set up frame display class. (syms_of_haikufns): New symbols `mono', `grayscale' and `color'. diff --git a/src/haikufns.c b/src/haikufns.c index b628518c26..b4cdb93b96 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1119,6 +1119,23 @@ haiku_create_tip_frame (Lisp_Object parms) /* FIXME - can this be done in a similar way to normal frames? https://lists.gnu.org/r/emacs-devel/2007-10/msg00641.html */ + { + Lisp_Object disptype; + + if (be_get_display_planes () == 1) + disptype = Qmono; + else if (be_is_display_grayscale ()) + disptype = Qgrayscale; + else + disptype = Qcolor; + + if (NILP (Fframe_parameter (frame, Qdisplay_type))) + { + AUTO_FRAME_ARG (arg, Qdisplay_type, disptype); + Fmodify_frame_parameters (frame, arg); + } + } + /* Set up faces after all frame parameters are known. This call also merges in face attributes specified for new frames. @@ -3006,6 +3023,9 @@ syms_of_haikufns (void) DEFSYM (Qstatic_color, "static-color"); DEFSYM (Qstatic_gray, "static-gray"); DEFSYM (Qtrue_color, "true-color"); + DEFSYM (Qmono, "mono"); + DEFSYM (Qgrayscale, "grayscale"); + DEFSYM (Qcolor, "color"); defsubr (&Sx_hide_tip); defsubr (&Sxw_display_color_p); commit 334fa0c91d55c4397643a529ce33a12df39d2f7f Author: Lars Ingebrigtsen Date: Sat May 14 04:13:44 2022 +0200 Restore `with-help-window' return code * lisp/help.el (help--window-setup): Return the correct thing. diff --git a/lisp/help.el b/lisp/help.el index 8727b60bfd..ae65cc07df 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1966,8 +1966,9 @@ The `temp-buffer-window-setup-hook' hook is called." (delete-all-overlays) (prog1 (let ((standard-output (current-buffer))) - (funcall callback) - (run-hooks 'temp-buffer-window-setup-hook)) + (prog1 + (funcall callback) + (run-hooks 'temp-buffer-window-setup-hook))) (help-window-setup (temp-buffer-window-show (current-buffer))) (help-make-xrefs (current-buffer)))))) commit 5f7dd959c2ebe03caa316a83d52a6d6bba10f9c3 Author: Lars Ingebrigtsen Date: Sat May 14 04:06:32 2022 +0200 Improve the *Help* output for compiler macros and the like * doc/lispref/functions.texi (Advice and Byte Code): New node. * lisp/help-fns.el (help-fns--compiler-macro): Also output data on other byte compilation things, and link to the manual (bug#23264). diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 426bb6d017..968a2790e2 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -592,6 +592,7 @@ Advising Emacs Lisp Functions * Advising Named Functions:: Advising named functions. * Advice Combinators:: Ways to compose advice. * Porting Old Advice:: Adapting code using the old defadvice. +* Advice and Byte Code:: Not all functions can be advised. Macros diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 55bbf8fd5a..df50a627aa 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1717,6 +1717,7 @@ ways to do it. The added function is also called a piece of @emph{advice}. * Advising Named Functions:: Advising named functions. * Advice Combinators:: Ways to compose advice. * Porting Old Advice:: Adapting code using the old defadvice. +* Advice and Byte Code:: Not all functions can be advised. @end menu @node Core Advising Primitives @@ -2138,6 +2139,38 @@ changing @code{ad-return-value}, whereas new @code{:after} advice cannot, so when porting such old @code{after} advice, you'll need to turn it into new @code{:around} or @code{:filter-return} advice instead. +@c This is its own node because we link to it from *Help* buffers. +@node Advice and Byte Code +@subsection Advice and Byte Code +@cindex compiler macros, advising +@cindex @code{byte-compile}, advising +@cindex @code{byte-optimizer}, advising + + Not all functions can be reliably advised. The byte compiler may +choose to replace a call to a function with a sequence of instructions +that doesn't include the function call to the function you were +interested in altering. + +This usually happens due to one of the three following mechanisms: + +@table @dfn +@item @code{byte-compile} properties +If function @var{symbol} has a @code{byte-compile} property, that +property will be used instead of @var{symbol}'s definition. +@xref{Compilation Functions}. + +@item @code{byte-optimize} properties +If function @var{symbol} has a @code{byte-compile} property, the byte +compiler may rewrite the function arguments, or decide to use a +different function altogether. + +@item compiler macros +Compiler macros are defined using a special @code{declare} form. This +tells the compiler to use the defined @dfn{expander} as an +optimization function, and it can return a new expression to use +instead of the function call. @xref{Declare Form}. +@end table + @node Obsolete Functions @section Declaring Functions Obsolete @cindex obsolete functions diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 927a4f0d2c..d5f6a7b0be 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -614,9 +614,18 @@ the C sources, too." menus)) (defun help-fns--compiler-macro (function) - (let ((handler (function-get function 'compiler-macro))) + (pcase-dolist (`(,type . ,handler) + (list (cons "compiler macro" + (function-get function 'compiler-macro)) + (cons "`byte-compile' property" + (function-get function 'byte-compile)) + (cons "byte-code optimizer" + (function-get function 'byte-optimizer)))) (when handler - (insert " This function has a compiler macro") + (if (bolp) + (insert " This function has a ") + (insert " and a ")) + (insert type) (if (symbolp handler) (progn (insert (format-message " `%s'" handler)) @@ -631,8 +640,17 @@ the C sources, too." (save-excursion (re-search-backward (substitute-command-keys "`\\([^`']+\\)'") nil t) - (help-xref-button 1 'help-function-cmacro function lib))))) - (insert ".\n")))) + (help-xref-button 1 'help-function-cmacro function lib))))))) + (unless (bolp) + (insert ". See " + (buttonize "the manual" + (lambda (_) (info "(elisp)Advice and Byte Code"))) + " for details.\n") + (save-restriction + (let ((fill-prefix " ")) + (narrow-to-region (line-beginning-position -1) (point)) + (fill-region (point-min) (point-max))) + (goto-char (point-max))))) (defun help-fns--signature (function doc real-def real-function buffer) "Insert usage at point and return docstring. With highlighting." commit 0bedf074a64db05bde6d67f58faef054362be258 Author: Po Lu Date: Sat May 14 10:11:22 2022 +0800 Reenable frame sync for child frames after they're unparented * src/xfns.c (x_set_parent_frame, Fx_create_frame): Use correct boolean constants. * src/xterm.c (handle_one_xevent): Enable frame synchronization upon receiving a sync request event. diff --git a/src/xfns.c b/src/xfns.c index 7b5273e280..4ba7edcb98 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -973,7 +973,7 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu if (p) { window = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); - gdk_x11_window_set_frame_sync_enabled (window, false); + gdk_x11_window_set_frame_sync_enabled (window, FALSE); } #endif unblock_input (); @@ -4983,7 +4983,7 @@ This function is an internal primitive--use `make-frame' instead. */) #endif #ifdef HAVE_GTK3 gwin = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); - gdk_x11_window_set_frame_sync_enabled (gwin, false); + gdk_x11_window_set_frame_sync_enabled (gwin, FALSE); #endif unblock_input (); } diff --git a/src/xterm.c b/src/xterm.c index 170f65d06f..0bec87438e 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14765,17 +14765,21 @@ handle_one_xevent (struct x_display_info *dpyinfo, *finish = X_EVENT_DROP; #else widget = FRAME_GTK_OUTER_WIDGET (f); + window = gtk_widget_get_window (widget); + eassert (window); + + /* This could be a (former) child frame for which + frame synchronization was disabled. Enable it + now. */ + gdk_x11_window_set_frame_sync_enabled (window, TRUE); if (widget && !FRAME_X_OUTPUT (f)->xg_sync_end_pending_p) { - window = gtk_widget_get_window (widget); - eassert (window); frame_clock = gdk_window_get_frame_clock (window); eassert (frame_clock); gdk_frame_clock_request_phase (frame_clock, GDK_FRAME_CLOCK_PHASE_BEFORE_PAINT); - FRAME_X_OUTPUT (f)->xg_sync_end_pending_p = true; } #endif commit 221031b4ffdd10ee8a07b4aaf42350a057d1c570 Author: Lars Ingebrigtsen Date: Sat May 14 03:10:46 2022 +0200 Tweak querying in package-update-all * lisp/emacs-lisp/package.el (package-update-all): Reverse the QUERY logic to make calling more regular. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7f72caba65..b2a01248e8 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2164,14 +2164,15 @@ to install it but still mark it as selected." (package-desc-priority-version (cadr available)))))) package-alist))) -(defun package-update-all (&optional inhibit-queries) - "Upgrade all packages." - (interactive "P") +(defun package-update-all (&optional query) + "Upgrade all packages. +If QUERY, ask the user before updating packages. Interactively, +QUERY is always true." + (interactive (list t)) (let ((updateable (package--updateable-packages))) (if (not updateable) (message "No packages to update") - (when (and (not inhibit-queries) - (not noninteractive) + (when (and query (not (yes-or-no-p (if (length= updateable 1) "One package to update. Do it? " commit 1dec6548b824c7d4d90ad614040fa6119ebf984a Author: Stefan Kangas Date: Fri May 13 22:53:16 2022 +0200 Use ert-with-temp-file in undigest-tests.el * test/lisp/mail/undigest-tests.el (ert-x): Require. (rmail-undigest-test-rfc934-digest) (rmail-undigest-test-rfc1153-digest-strict) (rmail-undigest-test-rfc1153-less-strict-digest) (rmail-undigest-test-rfc1153-sloppy-digest) (rmail-undigest-test-rfc1521-mime-digest) (rmail-undigest-test-multipart-mixed-digest): Use ert-with-temp-file. diff --git a/test/lisp/mail/undigest-tests.el b/test/lisp/mail/undigest-tests.el index b88868be7f..1c473c4996 100644 --- a/test/lisp/mail/undigest-tests.el +++ b/test/lisp/mail/undigest-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'rmail) (require 'undigest) @@ -270,66 +271,50 @@ The footer. ;;; Tests: (ert-deftest rmail-undigest-test-rfc934-digest () "Test that we can undigest a RFC 934 digest." - (let ((file (make-temp-file "undigest-test-"))) - (unwind-protect - (with-temp-buffer - (insert rmail-rfc934-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 4)) - (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n"))) - (delete-file file)))) + (ert-with-temp-file file + :text rmail-rfc934-digest + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 4)) + (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n")))) (ert-deftest rmail-undigest-test-rfc1153-digest-strict () "Test that we can undigest a strict RFC 1153 digest." :expected-result :failed - (let ((file (make-temp-file "undigest-test-"))) - (unwind-protect - (with-temp-buffer - (insert rmail-rfc1153-digest-strict) - (write-region nil nil file) - (rmail file) - (should - (ignore-errors - ;; This throws an error, because the Trailer is not recognized - ;; as a valid RFC 822 (or later) message. - (undigestify-rmail-message) - (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n")) - t))) - (delete-file file)))) + (ert-with-temp-file file + :text rmail-rfc1153-digest-strict + (rmail file) + (should + (ignore-errors + ;; This throws an error, because the Trailer is not recognized + ;; as a valid RFC 822 (or later) message. + (undigestify-rmail-message) + (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n")) + t)))) (ert-deftest rmail-undigest-test-rfc1153-less-strict-digest () "Test that we can undigest a RFC 1153 with a Subject header in its footer." - (let ((file (make-temp-file "undigest-test-"))) - (unwind-protect - (with-temp-buffer - (insert rmail-rfc1153-digest-less-strict) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 5)) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n\n"))) - (delete-file file)))) + (ert-with-temp-file file + :text rmail-rfc1153-digest-less-strict + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 5)) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n\n")))) (ert-deftest rmail-undigest-test-rfc1153-sloppy-digest () "Test that we can undigest a sloppy RFC 1153 digest." - (let ((file (make-temp-file "undigest-test-"))) - (unwind-protect - (with-temp-buffer - (insert rmail-rfc1153-digest-sloppy) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 5)) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n\n"))) - (delete-file file)))) + (ert-with-temp-file file + :text rmail-rfc1153-digest-sloppy + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 5)) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n\n")))) ;; This fails because `rmail-digest-parse-mime' combines the preamble with the ;; first message of the digest. And then, it doesn't get rid of the last @@ -337,28 +322,20 @@ The footer. (ert-deftest rmail-undigest-test-rfc1521-mime-digest () "Test that we can undigest a RFC 1521 MIME digest." :expected-result :failed - (let ((file (make-temp-file "undigest-test-"))) - (unwind-protect - (with-temp-buffer - (insert rmail-rfc1521-mime-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 3)) - (should (string= (rmail-message-content 2) "Message one.\n\n")) - (should (string= (rmail-message-content 3) "Message two.\n\n"))) - (delete-file file)))) + (ert-with-temp-file file + :text rmail-rfc1521-mime-digest + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 3)) + (should (string= (rmail-message-content 2) "Message one.\n\n")) + (should (string= (rmail-message-content 3) "Message two.\n\n")))) (ert-deftest rmail-undigest-test-multipart-mixed-digest () "Test that we can undigest a digest inside a multipart/mixed digest." - (let ((file (make-temp-file "undigest-test-"))) - (unwind-protect - (with-temp-buffer - (insert rmail-multipart-mixed-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 4)) - (should (string= (rmail-message-content 2) "Message one.\n\n")) - (should (string= (rmail-message-content 3) "Message two.\n\n"))) - (delete-file file)))) + (ert-with-temp-file file + :text rmail-multipart-mixed-digest + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 4)) + (should (string= (rmail-message-content 2) "Message one.\n\n")) + (should (string= (rmail-message-content 3) "Message two.\n\n")))) commit 942bc9c8f56c072c4c76e010370b84ae9adc3366 Author: Stefan Kangas Date: Fri May 13 22:29:53 2022 +0200 Don't use obsolete yow library * lisp/erc/erc.el (erc-quit-reason-zippy, erc-part-reason-zippy): Don't use obsolete yow library. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 06381c5ebe..ff482d4933 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3625,12 +3625,7 @@ If S is non-nil, it will be used as the quit reason." "Zippy quit message. If S is non-nil, it will be used as the quit reason." - (or s - (if (fboundp 'yow) - (if (>= emacs-major-version 28) - (string-replace "\n" "" (yow)) - (replace-regexp-in-string "\n" "" (yow))) - (erc-quit/part-reason-default)))) + (or s (erc-quit/part-reason-default))) (make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4") @@ -3654,12 +3649,7 @@ If S is non-nil, it will be used as the part reason." "Zippy part message. If S is non-nil, it will be used as the quit reason." - (or s - (if (fboundp 'yow) - (if (>= emacs-major-version 28) - (string-replace "\n" "" (yow)) - (replace-regexp-in-string "\n" "" (yow))) - (erc-quit/part-reason-default)))) + (or s (erc-quit/part-reason-default))) (make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4") commit bc50a957b1e3a20abe118e2c3365828d4e9e6ef9 Author: Stefan Kangas Date: Fri May 13 22:21:35 2022 +0200 Remove some XEmacs compat code from flyspell.el * lisp/textmodes/flyspell.el (flyspell-display-next-corrections): Remove XEmacs compat code. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 5de04b12d4..2c5e30fecd 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -1942,9 +1942,7 @@ before point that's highlighted as misspelled." 'face 'flyspell-incorrect string)) (setq pos (cdr pos))) - (if (fboundp 'display-message) - (display-message 'no-log string) - (message "%s" string)))) + (message "%s" string))) ;;*---------------------------------------------------------------------*/ ;;* flyspell-abbrev-table ... */ commit cc8b6101f4479a80a6af7f9d80c6f9d774a85f40 Author: Stefan Kangas Date: Fri May 13 21:41:16 2022 +0200 Remove some XEmacs compat code from org-mode * lisp/org/ol-eww.el (org-eww-copy-for-org-mode): * lisp/org/ol-w3m.el (org-w3m-copy-for-org-mode): * lisp/org/org-refile.el (org-refile): * lisp/org/org.el (org-change-tag-in-region): Remove XEmacs compat code. diff --git a/lisp/org/ol-eww.el b/lisp/org/ol-eww.el index 69bf1ba62d..d1bb519510 100644 --- a/lisp/org/ol-eww.el +++ b/lisp/org/ol-eww.el @@ -115,7 +115,7 @@ keep the structure of the Org file." (setq transform-start (region-beginning)) (setq transform-end (region-end)) ;; Deactivate mark if current mark is activate. - (when (fboundp 'deactivate-mark) (deactivate-mark))) + (deactivate-mark)) (message "Transforming links...") (save-excursion (goto-char transform-start) diff --git a/lisp/org/ol-w3m.el b/lisp/org/ol-w3m.el index 517329889c..80d6811a5c 100644 --- a/lisp/org/ol-w3m.el +++ b/lisp/org/ol-w3m.el @@ -72,7 +72,7 @@ so that it can be yanked into an Org buffer with links working correctly." (setq transform-start (region-beginning)) (setq transform-end (region-end)) ;; Deactivate mark if current mark is activate. - (when (fboundp 'deactivate-mark) (deactivate-mark))) + (deactivate-mark)) (message "Transforming links...") (save-excursion (goto-char transform-start) diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index f76ebefe7b..71d00a7a22 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -577,7 +577,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (with-demoted-errors "Bookmark set error: %S" (bookmark-set bookmark-name)))) (move-marker org-capture-last-stored-marker (point))) - (when (fboundp 'deactivate-mark) (deactivate-mark)) + (deactivate-mark) (run-hooks 'org-after-refile-insert-hook))) (unless org-refile-keep (if regionp diff --git a/lisp/org/org.el b/lisp/org/org.el index 1fc4251a34..778f06aa64 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -12160,7 +12160,7 @@ This works in the agenda, and also in an Org buffer." (progn (message "[s]et or [r]emove? ") (equal (read-char-exclusive) ?r)))) - (when (fboundp 'deactivate-mark) (deactivate-mark)) + (deactivate-mark) (let ((agendap (equal major-mode 'org-agenda-mode)) l1 l2 m buf pos newhead (cnt 0)) (goto-char end) commit db492b1e41de332c92565a159a0b50c2520afc81 Author: Stefan Kangas Date: Fri May 13 21:30:05 2022 +0200 Remove some XEmacs compat code from eudc-bob.el * lisp/net/eudc-bob.el (eudc-bob-can-display-inline-images): Make into obsolete alias for display-graphic-p. Update all callers. (eudc-bob-display-jpeg): Remove XEmacs compat code. diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index f543678fa2..68a0ccb3a1 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -86,7 +86,7 @@ `("EUDC Image Menu" ["---" nil nil] ["Toggle inline display" eudc-bob-toggle-inline-display - (eudc-bob-can-display-inline-images)] + (display-graphic-p)] ,@(cdr (cdr eudc-bob-generic-menu)))) (defvar eudc-bob-sound-menu @@ -109,14 +109,6 @@ (setq overlays (cdr overlays))) value)) -(defun eudc-bob-can-display-inline-images () - "Return non-nil if we can display images inline." - (if (fboundp 'console-type) - (and (memq (console-type) '(x mswindows)) - (fboundp 'make-glyph)) - (and (fboundp 'display-graphic-p) - (display-graphic-p)))) - (defun eudc-bob-make-button (label keymap &optional menu plist) "Create a button with LABEL. Attach KEYMAP, MENU and properties from PLIST to a new overlay covering @@ -142,19 +134,7 @@ LABEL." "Display the JPEG DATA at point. If INLINE is non-nil, try to inline the image otherwise simply display a button." - (cond ((fboundp 'make-glyph) - (let ((glyph (if (eudc-bob-can-display-inline-images) - (make-glyph (list (vector 'jpeg :data data) - [string :data "[JPEG Picture]"]))))) - (eudc-bob-make-button "[JPEG Picture]" - eudc-bob-image-keymap - eudc-bob-image-menu - (list 'glyph glyph - 'end-glyph (if inline glyph) - 'duplicable t - 'invisible inline - 'object-data data)))) - ((fboundp 'create-image) + (cond ((fboundp 'create-image) (let* ((image (create-image data nil t)) (props (list 'object-data data 'eudc-image image))) (when (and inline (image-type-available-p 'jpeg)) @@ -167,7 +147,7 @@ display a button." (defun eudc-bob-toggle-inline-display () "Toggle inline display of an image." (interactive) - (when (eudc-bob-can-display-inline-images) + (when (display-graphic-p) (let* ((overlays (append (overlays-at (1- (point))) (overlays-at (point)))) image) @@ -287,11 +267,13 @@ display a button." ;;;###autoload (defun eudc-display-jpeg-inline (data) "Display the JPEG DATA inline at point if possible." - (eudc-bob-display-jpeg data (eudc-bob-can-display-inline-images))) + (eudc-bob-display-jpeg data (display-graphic-p))) ;;;###autoload (defun eudc-display-jpeg-as-button (data) "Display a button for the JPEG DATA." (eudc-bob-display-jpeg data nil)) +(define-obsolete-function-alias 'eudc-bob-can-display-inline-images #'display-graphic-p "29.1") + ;;; eudc-bob.el ends here commit 909f3e2dfd0f5f5339264922b8de9539b7e5fcc7 Author: Lars Ingebrigtsen Date: Fri May 13 21:24:26 2022 +0200 Regenerate ldefs-boot.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 977b743f39..95ad2f78cf 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -8478,7 +8478,46 @@ Display-Line-Numbers mode. \(fn &optional ARG)" t nil) -(register-definition-prefixes "display-line-numbers" '("display-line-numbers-")) +(defvar header-line-indent "" "\ +String to indent at the start if the header line. +This is used in `header-line-indent-mode', and buffers that have +this switched on should have a `header-line-format' that look like: + + (\"\" header-line-indent THE-REST...)") + +(defvar header-line-indent-width 0 "\ +The width of the current line numbers displayed.") + +(autoload 'header-line-indent-mode "display-line-numbers" "\ +Mode to indent the header line in `display-line-numbers-mode' buffers. + +This means that the header line will be kept indented so that it +has blank space that's as wide as the displayed line numbers in +the buffer. + +Buffers that have this switched on should have a +`header-line-format' that look like: + + (\"\" header-line-indent THE-REST...) + +This is a minor mode. If called interactively, toggle the +`Header-Line-Indent mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `header-line-indent-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +\(fn &optional ARG)" t nil) + +(register-definition-prefixes "display-line-numbers" '("display-line-numbers-" "header-line-indent--")) ;;;*** @@ -16471,9 +16510,13 @@ Commands: (autoload 'help-mode-setup "help-mode" "\ Enter Help mode in the current buffer." nil nil) +(make-obsolete 'help-mode-setup 'nil '"29.1") + (autoload 'help-mode-finish "help-mode" "\ Finalize Help mode setup in current buffer." nil nil) +(make-obsolete 'help-mode-finish 'nil '"29.1") + (autoload 'help-setup-xref "help-mode" "\ Invoked from commands using the \"*Help*\" buffer to install some xref info. @@ -18742,12 +18785,14 @@ With prefix argument ARG, display image in its original size. Add comment to current or marked files in Dired." t nil) (autoload 'image-dired-mark-tagged-files "image-dired" "\ -Use regexp to mark files with matching tag. +Use REGEXP to mark files with matching tag. A `tag' is a keyword, a piece of meta data, associated with an image file and stored in image-dired's database file. This command lets you input a regexp and this will be matched against all tags on all image files in the database file. The files that have a -matching tag will be marked in the Dired buffer." t nil) +matching tag will be marked in the Dired buffer. + +\(fn REGEXP)" t nil) (autoload 'image-dired-dired-edit-comment-and-tags "image-dired" "\ Edit comment and tags of current or marked image files. commit dea41d4c24d0d33e359cbfe34054d9048761adfd Author: Lars Ingebrigtsen Date: Fri May 13 21:24:12 2022 +0200 Add new minor mode `header-line-indent-mode' This is mostly factored out from tabulated-list.el (with bugs fixed). * doc/lispref/modes.texi (Header Lines): Document it. * lisp/display-line-numbers.el (header-line-indent): New variable. (header-line-indent--line-number-width) (header-line-indent--watch-line-number-width) (header-line-indent--window-scroll-function): New helper functions. (header-line-indent-mode): New minor mode. * lisp/display-line-numbers.el (header-line-indent-width): New variable. * lisp/emacs-lisp/tabulated-list.el (tabulated-list-line-number-width) (tabulated-list-watch-line-number-width) (tabulated-list-window-scroll-function): Make into obsolete aliases. (tabulated-list-mode): Use 'header-line-indent-mode'. * lisp/emacs-lisp/tabulated-list.el (tabulated-list-init-header): Adjust the header line format and computation. * src/buffer.c (syms_of_buffer): Mention header-line-indent-mode. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index a0c1c488fe..ddcda661a0 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -2575,7 +2575,23 @@ mode line feature, except that it's controlled by This variable, local in every buffer, specifies how to display the header line, for windows displaying the buffer. The format of the value is the same as for @code{mode-line-format} (@pxref{Mode Line Data}). -It is normally @code{nil}, so that ordinary buffers have no header line. +It is normally @code{nil}, so that ordinary buffers have no header +line. + +@findex header-line-indent-mode +If @code{display-line-numbers-mode} is used, and you want the header +line to be indented by the same amount as the buffer contents, you can +use the @code{header-line-indent-mode} minor mode. This minor mode +keeps the @code{header-line-indent} variable updated, so that you can +say something like: + +@lisp +(setq header-line-format + `("" header-line-format ,my-header-line)) +@end lisp + +This can be useful if you're displaying columnar data, and the header +line should align with that data in the buffer. @end defvar @defun window-header-line-height &optional window diff --git a/etc/NEWS b/etc/NEWS index d93a79ed36..f8f6d93cc2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1807,6 +1807,12 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** New minor mode 'header-line-indent-mode'. +This is meant to be used in modes that have a header line that should +be kept aligned with the buffer contents when the user switches +'display-line-numbers-mode' on or off. + +++ ** New predicate 'char-uppercase-p'. This returns non-nil if its argument its an uppercase character. diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el index 860aa758bc..897a88398f 100644 --- a/lisp/display-line-numbers.el +++ b/lisp/display-line-numbers.el @@ -108,6 +108,84 @@ the mode is on, set `display-line-numbers' directly." (define-globalized-minor-mode global-display-line-numbers-mode display-line-numbers-mode display-line-numbers--turn-on) + + +;;;###autoload +(defvar header-line-indent "" + "String to indent at the start if the header line. +This is used in `header-line-indent-mode', and buffers that have +this switched on should have a `header-line-format' that look like: + + (\"\" header-line-indent THE-REST...) + +Also see `header-line-indent-width'.") + +;;;###autoload +(defvar header-line-indent-width 0 + "The width of the current line numbers displayed. +This is updated when `header-line-indent-mode' is switched on. + +Also see `header-line-indent'.") + +(defun header-line-indent--line-number-width () + "Return the width taken by `display-line-numbers' in the current buffer." + ;; line-number-display-width returns the value for the selected + ;; window, which might not be the window in which the current buffer + ;; is displayed. + (if (not display-line-numbers) + 0 + (let ((cbuf-window (get-buffer-window (current-buffer) t))) + (if (window-live-p cbuf-window) + (with-selected-window cbuf-window + (truncate (line-number-display-width 'columns))) + 4)))) + +(defun header-line-indent--watch-line-number-width (_window) + (let ((width (header-line-indent--line-number-width))) + (setq header-line-indent-width width) + (unless (= (length header-line-indent) width) + (setq header-line-indent (make-string width ?\s))))) + +(defun header-line-indent--window-scroll-function (window _start) + (let ((width (with-selected-window window + (truncate (line-number-display-width 'columns))))) + (setq header-line-indent-width width) + (unless (= (length header-line-indent) width) + (setq header-line-indent (make-string width ?\s))))) + +;;;###autoload +(define-minor-mode header-line-indent-mode + "Mode to indent the header line in `display-line-numbers-mode' buffers. +This means that the header line will be kept indented so that it +has blank space that's as wide as the displayed line numbers in +the buffer. + +Buffers that have this switched on should have a +`header-line-format' that look like: + + (\"\" header-line-indent THE-REST...) + +The `header-line-indent-width' variable is also kept updated, and +has the width of `header-line-format'. This can be used, for +instance, in `:align-to' specs, like: + + (space :align-to (+ header-line-indent-width 10))" + :lighter nil + (if header-line-indent-mode + (progn + (setq-local header-line-indent "" + header-line-indent-width 0) + (add-hook 'pre-redisplay-functions + #'header-line-indent--watch-line-number-width nil t) + (add-hook 'window-scroll-functions + #'header-line-indent--window-scroll-function nil t)) + (setq-local header-line-indent "" + header-line-indent-width 0) + (remove-hook 'pre-redisplay-functions + #'header-line-indent--watch-line-number-width t) + (remove-hook 'window-scroll-functions + #'header-line-indent--window-scroll-function t))) + (provide 'display-line-numbers) ;;; display-line-numbers.el ends here diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index b740a7457a..7d815a3ced 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -264,18 +264,14 @@ variables `tabulated-list-tty-sort-indicator-asc' and Populated by `tabulated-list-init-header'.") (defvar tabulated-list--header-overlay nil) -(defun tabulated-list-line-number-width () - "Return the width taken by `display-line-numbers' in the current buffer." - ;; line-number-display-width returns the value for the selected - ;; window, which might not be the window in which the current buffer - ;; is displayed. - (if (not display-line-numbers) - 0 - (let ((cbuf-window (get-buffer-window (current-buffer) t))) - (if (window-live-p cbuf-window) - (with-selected-window cbuf-window - (line-number-display-width 'columns)) - 4)))) +(define-obsolete-function-alias 'tabulated-list-line-number-width + 'header-line-indent--line-number-width "29.1") +(define-obsolete-function-alias 'tabulated-list-watch-line-number-width + 'header-line-indent--watch-line-number-width "29.1") +(define-obsolete-function-alias 'tabulated-list-watch-line-number-width + 'header-line-indent--watch-line-number-width "29.1") +(define-obsolete-function-alias 'tabulated-list-window-scroll-function + 'header-line-indent--window-scroll-function "29.1") (defun tabulated-list-init-header () "Set up header line for the Tabulated List buffer." @@ -289,9 +285,9 @@ Populated by `tabulated-list-init-header'.") (hcols (mapcar #'car tabulated-list-format)) (tabulated-list--near-rows (list hcols hcols)) (cols nil)) - (if display-line-numbers - (setq x (+ x (tabulated-list-line-number-width)))) - (push (propertize " " 'display `(space :align-to ,x)) cols) + (push (propertize " " 'display + `(space :align-to (+ header-line-indent-width ,x))) + cols) (dotimes (n len) (let* ((col (aref tabulated-list-format n)) (not-last-col (< n (1- len))) @@ -342,20 +338,25 @@ Populated by `tabulated-list-init-header'.") (when (> shift 0) (setq cols (cons (car cols) - (cons (propertize (make-string shift ?\s) - 'display - `(space :align-to ,(+ x shift))) - (cdr cols)))) + (cons + (propertize + (make-string shift ?\s) + 'display + `(space :align-to + (+ header-line-indent-width ,(+ x shift)))) + (cdr cols)))) (setq x (+ x shift))))) (if (>= pad-right 0) - (push (propertize " " - 'display `(space :align-to ,next-x) - 'face 'fixed-pitch) + (push (propertize + " " + 'display `(space :align-to + (+ header-line-indent-width ,next-x)) + 'face 'fixed-pitch) cols)) (setq x next-x))) (setq cols (apply 'concat (nreverse cols))) (if tabulated-list-use-header-line - (setq header-line-format cols) + (setq header-line-format (list "" 'header-line-indent cols)) (setq-local tabulated-list--header-string cols)))) (defun tabulated-list-print-fake-header () @@ -770,23 +771,6 @@ Interactively, N is the prefix numeric argument, and defaults to (interactive "p") (tabulated-list-widen-current-column (- n))) -(defvar tabulated-list--current-lnum-width nil) -(defun tabulated-list-watch-line-number-width (_window) - (if display-line-numbers - (let ((lnum-width (tabulated-list-line-number-width))) - (when (not (= tabulated-list--current-lnum-width lnum-width)) - (setq-local tabulated-list--current-lnum-width lnum-width) - (tabulated-list-init-header))))) - -(defun tabulated-list-window-scroll-function (window _start) - (if display-line-numbers - (let ((lnum-width - (with-selected-window window - (line-number-display-width 'columns)))) - (when (not (= tabulated-list--current-lnum-width lnum-width)) - (setq-local tabulated-list--current-lnum-width lnum-width) - (tabulated-list-init-header))))) - (defun tabulated-list-next-column (&optional arg) "Go to the start of the next column after point on the current line. If ARG is provided, move that many columns." @@ -857,15 +841,7 @@ as the ewoc pretty-printer." ;; Avoid messing up the entries' display just because the first ;; column of the first entry happens to begin with a R2L letter. (setq bidi-paragraph-direction 'left-to-right) - ;; This is for if/when they turn on display-line-numbers - (add-hook 'display-line-numbers-mode-hook #'tabulated-list-revert nil t) - ;; This is for if/when they customize the line-number face or when - ;; the line-number width needs to change due to scrolling. - (setq-local tabulated-list--current-lnum-width 0) - (add-hook 'pre-redisplay-functions - #'tabulated-list-watch-line-number-width nil t) - (add-hook 'window-scroll-functions - #'tabulated-list-window-scroll-function nil t)) + (header-line-indent-mode)) (put 'tabulated-list-mode 'mode-class 'special) diff --git a/src/buffer.c b/src/buffer.c index 57137b2a06..548d7b1c65 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5598,8 +5598,11 @@ the mode line appears at the bottom. */); &BVAR (current_buffer, header_line_format), Qnil, doc: /* Analogous to `mode-line-format', but controls the header line. -The header line appears, optionally, at the top of a window; -the mode line appears at the bottom. */); +The header line appears, optionally, at the top of a window; the mode +line appears at the bottom. + +Also see `header-line-indent-mode' if `display-line-number-mode' is +used. */); DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format), Qnil, commit 72b5b4194106d38432cd9892bc01e95d71bf75db Author: Lars Ingebrigtsen Date: Fri May 13 19:31:46 2022 +0200 Revert mistaken change in help-mode-setup * lisp/help-mode.el (help-mode-setup): Revert mistakenly applied change from cd87a5c7a. diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 0e4d48e153..3bd272b723 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -423,8 +423,7 @@ Commands: (defun help-mode-setup () "Enter Help mode in the current buffer." (declare (obsolete nil "29.1")) - (unless (derived-mode-p 'help-mode) - (help-mode)) + (help-mode) (setq buffer-read-only nil)) ;;;###autoload commit bd464297bde2357bbcc96773355ae439fb567b31 Author: Lars Ingebrigtsen Date: Fri May 13 17:14:21 2022 +0200 Don't overwrite variables set by callback in help--window-setup * lisp/help.el (help--window-setup): Initialize the buffer in the correct order to avoid resetting variables set by the callback. diff --git a/lisp/help.el b/lisp/help.el index 83782a8477..8727b60bfd 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1954,8 +1954,11 @@ The `temp-buffer-window-setup-hook' hook is called." ;; where this should be set to a buffer position is within BODY. (set-marker help-window-point-marker nil) (with-current-buffer (get-buffer-create buffer) + (unless (derived-mode-p 'help-mode) + (help-mode)) (setq buffer-read-only t buffer-file-name nil) + (setq-local help-mode--current-data nil) (buffer-disable-undo) (let ((inhibit-read-only t) (inhibit-modification-hooks t)) @@ -1966,8 +1969,6 @@ The `temp-buffer-window-setup-hook' hook is called." (funcall callback) (run-hooks 'temp-buffer-window-setup-hook)) (help-window-setup (temp-buffer-window-show (current-buffer))) - (unless (derived-mode-p 'help-mode) - (help-mode)) (help-make-xrefs (current-buffer)))))) ;; Called from C, on encountering `help-char' when reading a char. commit cd87a5c7a18ee0fd956ccc151ace85874a8404b1 Author: Lars Ingebrigtsen Date: Fri May 13 16:58:59 2022 +0200 Don't clear out local variables in `with-help-window' * lisp/help-mode.el (help-mode-setup): Declare obsolete. (help-mode-finish): Ditto. * lisp/help.el (with-help-window): Don't be a wrapper around `with-temp-buffer-window', because that made the macro big and difficult to understand. (help--window-setup): Implement the relevant bits from `with-temp-buffer-window'. Also don't clear out local variables, because that makes things like `text-scale-mode' not work (bug#25979). diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 4a65f40507..0e4d48e153 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -422,12 +422,15 @@ Commands: ;;;###autoload (defun help-mode-setup () "Enter Help mode in the current buffer." - (help-mode) + (declare (obsolete nil "29.1")) + (unless (derived-mode-p 'help-mode) + (help-mode)) (setq buffer-read-only nil)) ;;;###autoload (defun help-mode-finish () "Finalize Help mode setup in current buffer." + (declare (obsolete nil "29.1")) (when (derived-mode-p 'help-mode) (setq buffer-read-only t) (help-make-xrefs (current-buffer)))) diff --git a/lisp/help.el b/lisp/help.el index d9f364e1ad..83782a8477 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1938,40 +1938,37 @@ Return VALUE." ;; Return VALUE. value)) -;; `with-help-window' is a wrapper for `with-temp-buffer-window' -;; providing the following additional twists: - -;; (1) It puts the buffer in `help-mode' (via `help-mode-setup') and -;; adds cross references (via `help-mode-finish'). - -;; (2) It issues a message telling how to scroll and quit the help -;; window (via `help-window-setup'). - -;; (3) An option (customizable via `help-window-select') to select the -;; help window automatically. - -;; (4) A marker (`help-window-point-marker') to move point in the help -;; window to an arbitrary buffer position. (defmacro with-help-window (buffer-or-name &rest body) "Evaluate BODY, send output to BUFFER-OR-NAME and show in a help window. -This construct is like `with-temp-buffer-window', which see, but unlike -that, it puts the buffer specified by BUFFER-OR-NAME in `help-mode' and -displays a message about how to delete the help window when it's no -longer needed. The help window will be selected if -`help-window-select' is non-nil. -Most of this is done by `help-window-setup', which see." +The return value from BODY will be returned. + +The help window will be selected if `help-window-select' is +non-nil. + +The `temp-buffer-window-setup-hook' hook is called." (declare (indent 1) (debug t)) - `(progn - ;; Make `help-window-point-marker' point nowhere. The only place - ;; where this should be set to a buffer position is within BODY. - (set-marker help-window-point-marker nil) - (let ((temp-buffer-window-setup-hook - (cons 'help-mode-setup temp-buffer-window-setup-hook)) - (temp-buffer-window-show-hook - (cons 'help-mode-finish temp-buffer-window-show-hook))) - (setq help-window-old-frame (selected-frame)) - (with-temp-buffer-window - ,buffer-or-name nil 'help-window-setup (progn ,@body))))) + `(help--window-setup ,buffer-or-name (lambda () ,@body))) + +(defun help--window-setup (buffer callback) + ;; Make `help-window-point-marker' point nowhere. The only place + ;; where this should be set to a buffer position is within BODY. + (set-marker help-window-point-marker nil) + (with-current-buffer (get-buffer-create buffer) + (setq buffer-read-only t + buffer-file-name nil) + (buffer-disable-undo) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (erase-buffer) + (delete-all-overlays) + (prog1 + (let ((standard-output (current-buffer))) + (funcall callback) + (run-hooks 'temp-buffer-window-setup-hook)) + (help-window-setup (temp-buffer-window-show (current-buffer))) + (unless (derived-mode-p 'help-mode) + (help-mode)) + (help-make-xrefs (current-buffer)))))) ;; Called from C, on encountering `help-char' when reading a char. ;; Don't print to *Help*; that would clobber Help history. commit 9c126cbacb803f07ed002dcbbfd25e41793d2146 Author: Stefan Monnier Date: Fri May 13 10:38:42 2022 -0400 * doc/lispref/help.texi (Keys in Documentation): Typo in last change diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 9b2d63dcbd..bc79033203 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -440,7 +440,7 @@ RET minibuffer-complete-and-exit C-g abort-recursive-edit " -The keymap description will normally exclude menu items, but it +The keymap description will normally exclude menu items, but if @var{include-menus} is non-@code{nil}, include them. @group commit ebfec5c119e5758de0ec9ba1136f3e17268da5c3 Author: Lars Ingebrigtsen Date: Fri May 13 15:54:16 2022 +0200 Allow substitute-command-keys to include menus in \{...} output * doc/lispref/help.texi (Keys in Documentation): Document it. * lisp/help.el (substitute-command-keys): Add an argument to include menus in the \{...-map} output (bug#24236). diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index f029a1c97c..9b2d63dcbd 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -390,7 +390,7 @@ quotes. You can customize it freely according to your personal preference. @end defopt -@defun substitute-command-keys string &optional no-face +@defun substitute-command-keys string &optional no-face include-menus @vindex help-key-binding@r{ (face)} This function scans @var{string} for the above special sequences and replaces them by what they stand for, returning the result as a string. @@ -440,6 +440,9 @@ RET minibuffer-complete-and-exit C-g abort-recursive-edit " +The keymap description will normally exclude menu items, but it +@var{include-menus} is non-@code{nil}, include them. + @group (substitute-command-keys "To abort a recursive edit from the minibuffer, type \ diff --git a/lisp/help.el b/lisp/help.el index 3c0370fee1..d9f364e1ad 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1090,7 +1090,7 @@ strings done by `substitute-command-keys'." :version "29.1" :group 'help) -(defun substitute-command-keys (string &optional no-face) +(defun substitute-command-keys (string &optional no-face include-menus) "Substitute key descriptions for command names in STRING. Each substring of the form \\\\=[COMMAND] is replaced by either a keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND @@ -1100,11 +1100,13 @@ unless the optional argument NO-FACE is non-nil. Each substring of the form \\\\=`KEYBINDING' will be replaced by KEYBINDING and use the `help-key-binding' face. -Each substring of the form \\\\={MAPVAR} is replaced by a summary of -the value of MAPVAR as a keymap. This summary is similar to the one -produced by ‘describe-bindings’. The summary ends in two newlines -(used by the helper function ‘help-make-xrefs’ to find the end of the -summary). +Each substring of the form \\\\={MAPVAR} is replaced by a summary +of the value of MAPVAR as a keymap. This summary is similar to +the one produced by ‘describe-bindings’. This will normally +exclude menu bindings, but if the optional INCLUDE-MENUS argument +is non-nil, also include menu bindings. The summary ends in two +newlines (used by the helper function ‘help-make-xrefs’ to find +the end of the summary). Each substring of the form \\\\= specifies the use of MAPVAR as the keymap for future \\\\=[COMMAND] substrings. @@ -1253,9 +1255,11 @@ Otherwise, return a new string." (t ;; Get the list of active keymaps that precede this one. ;; If this one's not active, get nil. - (let ((earlier-maps (cdr (memq this-keymap (reverse active-maps))))) + (let ((earlier-maps + (cdr (memq this-keymap (reverse active-maps))))) (describe-map-tree this-keymap t (nreverse earlier-maps) - nil nil t nil nil t)))))))) + nil nil (not include-menus) + nil nil t)))))))) ;; 2. Handle quotes. ((and (eq (text-quoting-style) 'curve) (or (and (= (following-char) ?\`) commit 2ec9f025d242cf28098cf01c532d0cf4e6bd1661 Author: Lars Ingebrigtsen Date: Fri May 13 15:31:13 2022 +0200 Include the number of dependencies in the install prompt * lisp/emacs-lisp/package.el (package-menu--list-to-prompt): Add the info to the prompt (bug#23346). (package--dependencies): New function. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 6c77f6f150..7f72caba65 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2180,6 +2180,14 @@ to install it but still mark it as selected." (user-error "Updating aborted")) (mapc #'package-update updateable)))) +(defun package--dependencies (pkg) + "Return a list of all dependencies PKG has. +This is done recursively." + ;; Can we have circular dependencies? Assume "nope". + (when-let* ((desc (cadr (assq pkg package-archive-contents))) + (deps (mapcar #'car (package-desc-reqs desc)))) + (delete-dups (apply #'nconc deps (mapcar #'package--dependencies deps))))) + (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. If the result looks like a dotted numeric version, return it. @@ -3572,17 +3580,34 @@ immediately." (setq package-menu--mark-upgrades-pending t) (message "Waiting for refresh to finish..."))) -(defun package-menu--list-to-prompt (packages) +(defun package-menu--list-to-prompt (packages &optional include-dependencies) "Return a string listing PACKAGES that's usable in a prompt. PACKAGES is a list of `package-desc' objects. Formats the returned string to be usable in a minibuffer -prompt (see `package-menu--prompt-transaction-p')." +prompt (see `package-menu--prompt-transaction-p'). + +If INCLUDE-DEPENDENCIES, also include the number of uninstalled +dependencies." ;; The case where `package' is empty is handled in ;; `package-menu--prompt-transaction-p' below. - (format "%d (%s)" + (format "%d (%s)%s" (length packages) - (mapconcat #'package-desc-full-name packages " "))) - + (mapconcat #'package-desc-full-name packages " ") + (let ((deps + (seq-remove + #'package-installed-p + (delete-dups + (apply + #'nconc + (mapcar (lambda (package) + (package--dependencies + (package-desc-name package))) + packages)))))) + (if (and include-dependencies deps) + (if (length= deps 1) + (format " plus 1 dependency") + (format " plus %d dependencies" (length deps))) + "")))) (defun package-menu--prompt-transaction-p (delete install upgrade) "Prompt the user about DELETE, INSTALL, and UPGRADE. @@ -3591,11 +3616,14 @@ Either may be nil, but not all." (y-or-n-p (concat (when delete - (format "Packages to delete: %s. " (package-menu--list-to-prompt delete))) + (format "Packages to delete: %s. " + (package-menu--list-to-prompt delete))) (when install - (format "Packages to install: %s. " (package-menu--list-to-prompt install))) + (format "Packages to install: %s. " + (package-menu--list-to-prompt install t))) (when upgrade - (format "Packages to upgrade: %s. " (package-menu--list-to-prompt upgrade))) + (format "Packages to upgrade: %s. " + (package-menu--list-to-prompt upgrade))) "Proceed? "))) commit dce5642e86b0ed006a82146126578e6be76869dd Author: Lars Ingebrigtsen Date: Fri May 13 15:04:50 2022 +0200 Allow calling package-update-all from the command line * lisp/emacs-lisp/package.el (package-update-all): Allow calling from the command line with -f package-update-all without any queries. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 72b22a6556..6c77f6f150 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2171,6 +2171,7 @@ to install it but still mark it as selected." (if (not updateable) (message "No packages to update") (when (and (not inhibit-queries) + (not noninteractive) (not (yes-or-no-p (if (length= updateable 1) "One package to update. Do it? " commit f044da7704edfc7e6cf32606328d0735b77e60d9 (refs/remotes/origin/emacs-28) Author: Po Lu Date: Fri May 13 20:57:24 2022 +0800 Fix tooltip face overwriting dragged text strings during mouse DND * lisp/mouse.el (mouse-drag-and-drop-region): Copy `text-tooltip' before showing it. Do not merge to master. diff --git a/lisp/mouse.el b/lisp/mouse.el index 1b9542b9b8..e5ea5475f4 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -3049,7 +3049,7 @@ is copied instead of being cut." ;; Show a tooltip. (if mouse-drag-and-drop-region-show-tooltip - (tooltip-show text-tooltip) + (tooltip-show (copy-sequence text-tooltip)) (tooltip-hide)) ;; Show cursor and highlight the original region. commit 526e9758de7d163ce3b25fde69a4e122ce9c3742 Author: Pieter van Prooijen Date: Sun May 8 16:27:38 2022 +0200 Use gsettings font rendering entries for pgtk builds If present, apply the gsettings font hinting and antialiasing entries when creating a font in cairo. Do this at initialization and when the entries change, re-rendering the frames. * src/ftcrfont.c (ftcrfont_open): Use the font_options derived from gsettings when opening a font. (ftcrfont_cached_font_ok): Report a cached font as invalid if its font options differ from the current options inside gsettings. * src/xsettings.c (apply_gsettings_font_hinting) (apply_gsettings_font_alias, apply_gsettings_font_rgba_order): Convert the settings from GSettings to the cairo_font_options_t object. (init_gsettings, something_changed_gsettingsCB): Invoke the apply functions if the relevant settings changed. (store_font_options_changed): Store an event to re-render the fonts. (xsetting_get_font_options) * src/xsettings.h (xsettings_get_font_options): New function. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 98a28af5f2..6bb41110d5 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -37,6 +37,9 @@ along with GNU Emacs. If not, see . */ #include "font.h" #include "ftfont.h" #include "pdumper.h" +#ifdef HAVE_PGTK +#include "xsettings.h" +#endif #ifdef USE_BE_CAIRO #define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) @@ -168,7 +171,12 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size) cairo_matrix_t font_matrix, ctm; cairo_matrix_init_scale (&font_matrix, pixel_size, pixel_size); cairo_matrix_init_identity (&ctm); + +#ifdef HAVE_PGTK + cairo_font_options_t *options = xsettings_get_font_options (); +#else cairo_font_options_t *options = cairo_font_options_create (); +#endif #ifdef USE_BE_CAIRO if (be_use_subpixel_antialiasing ()) cairo_font_options_set_antialias (options, CAIRO_ANTIALIAS_SUBPIXEL); @@ -624,6 +632,28 @@ ftcrfont_draw (struct glyph_string *s, return len; } +#ifdef HAVE_PGTK +/* Determine if FONT_OBJECT is a valid cached font for ENTITY by + comparing the options used to open it with the user's current + preferences specified via GSettings. */ +static bool +ftcrfont_cached_font_ok (struct frame *f, Lisp_Object font_object, + Lisp_Object entity) +{ + struct font_info *info = (struct font_info *) XFONT_OBJECT (font_object); + + cairo_font_options_t *options = cairo_font_options_create (); + cairo_scaled_font_get_font_options (info->cr_scaled_font, options); + cairo_font_options_t *gsettings_options = xsettings_get_font_options (); + + bool equal = cairo_font_options_equal (options, gsettings_options); + cairo_font_options_destroy (options); + cairo_font_options_destroy (gsettings_options); + + return equal; +} +#endif + #ifdef HAVE_HARFBUZZ static Lisp_Object @@ -694,6 +724,9 @@ struct font_driver const ftcrfont_driver = #endif .filter_properties = ftfont_filter_properties, .combining_capability = ftfont_combining_capability, +#ifdef HAVE_PGTK + .cached_font_ok = ftcrfont_cached_font_ok +#endif }; #ifdef HAVE_HARFBUZZ struct font_driver ftcrhbfont_driver; diff --git a/src/xsettings.c b/src/xsettings.c index 71d02e6152..e71887e03d 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -215,11 +215,116 @@ struct xsettings #define GSETTINGS_FONT_NAME "font-name" #endif +#ifdef HAVE_PGTK +#define GSETTINGS_FONT_ANTIALIASING "font-antialiasing" +#define GSETTINGS_FONT_RGBA_ORDER "font-rgba-order" +#define GSETTINGS_FONT_HINTING "font-hinting" +#endif /* The single GSettings instance, or NULL if not connected to GSettings. */ static GSettings *gsettings_client; +#ifdef HAVE_PGTK + +/* The cairo font_options as obtained using gsettings. */ +static cairo_font_options_t *font_options; + +/* Store an event for re-rendering of the fonts. */ +static void +store_font_options_changed (void) +{ + if (dpyinfo_valid (first_dpyinfo)) + store_config_changed_event (Qfont_render, + XCAR (first_dpyinfo->name_list_element)); +} + +/* Apply changes in the hinting system setting. */ +static void +apply_gsettings_font_hinting (GSettings *settings) +{ + GVariant *val = g_settings_get_value (settings, GSETTINGS_FONT_HINTING); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + const char *hinting = g_variant_get_string (val, NULL); + + if (!strcmp (hinting, "full")) + cairo_font_options_set_hint_style (font_options, + CAIRO_HINT_STYLE_FULL); + else if (!strcmp (hinting, "medium")) + cairo_font_options_set_hint_style (font_options, + CAIRO_HINT_STYLE_MEDIUM); + else if (!strcmp (hinting, "slight")) + cairo_font_options_set_hint_style (font_options, + CAIRO_HINT_STYLE_SLIGHT); + else if (!strcmp (hinting, "none")) + cairo_font_options_set_hint_style (font_options, + CAIRO_HINT_STYLE_NONE); + } + g_variant_unref (val); + } +} + +/* Apply changes in the antialiasing system setting. */ +static void +apply_gsettings_font_antialias (GSettings *settings) +{ + GVariant *val = g_settings_get_value (settings, GSETTINGS_FONT_ANTIALIASING); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + const char *antialias = g_variant_get_string (val, NULL); + + if (!strcmp (antialias, "none")) + cairo_font_options_set_antialias (font_options, + CAIRO_ANTIALIAS_NONE); + else if (!strcmp (antialias, "grayscale")) + cairo_font_options_set_antialias (font_options, + CAIRO_ANTIALIAS_GRAY); + else if (!strcmp (antialias, "rgba")) + cairo_font_options_set_antialias (font_options, + CAIRO_ANTIALIAS_SUBPIXEL); + } + g_variant_unref (val); + } +} + +/* Apply the settings for the rgb element ordering. */ +static void +apply_gsettings_font_rgba_order (GSettings *settings) +{ + GVariant *val = g_settings_get_value (settings, + GSETTINGS_FONT_RGBA_ORDER); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + const char *rgba_order = g_variant_get_string (val, NULL); + + if (!strcmp (rgba_order, "rgb")) + cairo_font_options_set_subpixel_order (font_options, + CAIRO_SUBPIXEL_ORDER_RGB); + else if (!strcmp (rgba_order, "bgr")) + cairo_font_options_set_subpixel_order (font_options, + CAIRO_SUBPIXEL_ORDER_BGR); + else if (!strcmp (rgba_order, "vrgb")) + cairo_font_options_set_subpixel_order (font_options, + CAIRO_SUBPIXEL_ORDER_VRGB); + else if (!strcmp (rgba_order, "vbgr")) + cairo_font_options_set_subpixel_order (font_options, + CAIRO_SUBPIXEL_ORDER_VBGR); + } + g_variant_unref (val); + } +} +#endif /* HAVE_PGTK */ + /* Callback called when something changed in GSettings. */ static void @@ -273,6 +378,23 @@ something_changed_gsettingsCB (GSettings *settings, } } #endif /* USE_CAIRO || HAVE_XFT */ +#ifdef HAVE_PGTK + else if (!strcmp (key, GSETTINGS_FONT_ANTIALIASING)) + { + apply_gsettings_font_antialias (settings); + store_font_options_changed (); + } + else if (!strcmp (key, GSETTINGS_FONT_HINTING)) + { + apply_gsettings_font_hinting (settings); + store_font_options_changed (); + } + else if (!strcmp (key, GSETTINGS_FONT_RGBA_ORDER)) + { + apply_gsettings_font_rgba_order (settings); + store_font_options_changed (); + } +#endif /* HAVE_PGTK */ } #endif /* HAVE_GSETTINGS */ @@ -900,6 +1022,16 @@ init_gsettings (void) dupstring (¤t_font, g_variant_get_string (val, NULL)); g_variant_unref (val); } + + /* Only use the gsettings font entries for the Cairo backend + running on PGTK. */ +#ifdef HAVE_PGTK + font_options = cairo_font_options_create (); + apply_gsettings_font_antialias (gsettings_client); + apply_gsettings_font_hinting (gsettings_client); + apply_gsettings_font_rgba_order (gsettings_client); +#endif /* HAVE_PGTK */ + #endif /* USE_CAIRO || HAVE_XFT */ #endif /* HAVE_GSETTINGS */ @@ -1021,6 +1153,17 @@ xsettings_get_system_normal_font (void) } #endif +#ifdef HAVE_PGTK +/* Return the cairo font options, updated from the gsettings font + config entries. The caller should call cairo_font_options_destroy + on the result. */ +cairo_font_options_t * +xsettings_get_font_options (void) +{ + return cairo_font_options_copy (font_options); +} +#endif + DEFUN ("font-get-system-normal-font", Ffont_get_system_normal_font, Sfont_get_system_normal_font, 0, 0, 0, @@ -1073,6 +1216,10 @@ syms_of_xsettings (void) gconf_client = NULL; PDUMPER_IGNORE (gconf_client); #endif +#ifdef HAVE_PGTK + font_options = NULL; + PDUMPER_IGNORE (font_options); +#endif DEFSYM (Qmonospace_font_name, "monospace-font-name"); DEFSYM (Qfont_name, "font-name"); diff --git a/src/xsettings.h b/src/xsettings.h index ccaa36489d..5e5df37062 100644 --- a/src/xsettings.h +++ b/src/xsettings.h @@ -23,6 +23,8 @@ along with GNU Emacs. If not, see . */ #ifndef HAVE_PGTK #include "dispextern.h" #include +#else +#include #endif struct x_display_info; @@ -41,5 +43,8 @@ extern const char *xsettings_get_system_font (void); extern const char *xsettings_get_system_normal_font (void); #endif +#ifdef HAVE_PGTK +extern cairo_font_options_t *xsettings_get_font_options (void); +#endif #endif /* XSETTINGS_H */ commit 784a3bde24be0637646ad0bf22f695c84b8e3e05 Author: Po Lu Date: Fri May 13 20:48:46 2022 +0800 ; Minor improvements to earlier change * etc/NEWS: * lisp/tooltip.el (tooltip-show): Rename `frame-face' to `default-face' and improve doc about system tooltips. diff --git a/etc/NEWS b/etc/NEWS index a67e136643..d93a79ed36 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2031,7 +2031,7 @@ Use 'buffer-match-p' to gather a list of buffers that match a condition. --- -** New arguments 'text-face' and 'frame-face' for 'tooltip-show'. +** New arguments 'text-face' and 'default-face' for 'tooltip-show'. They allow changing the faces used for the tooltip text and frame colors of the resulting tooltip frame from the default 'tooltip' face. diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 0e7d333f97..3e9c16a445 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -230,16 +230,16 @@ change the existing association. Value is the resulting alist." (declare-function x-show-tip "xfns.c" (string &optional frame parms timeout dx dy)) -(defun tooltip-show (text &optional use-echo-area text-face frame-face) +(defun tooltip-show (text &optional use-echo-area text-face default-face) "Show a tooltip window displaying TEXT. Text larger than `x-max-tooltip-size' is clipped. -If the alist in `tooltip-frame-parameters' includes `left' and `top' -parameters, they determine the x and y position where the tooltip -is displayed. Otherwise, the tooltip pops at offsets specified by -`tooltip-x-offset' and `tooltip-y-offset' from the current mouse -position. +If the alist in `tooltip-frame-parameters' includes `left' and +`top' parameters, they determine the x and y position where the +tooltip is displayed. Otherwise, the tooltip pops at offsets +specified by `tooltip-x-offset' and `tooltip-y-offset' from the +current mouse position. The text properties of TEXT are also modified to add the appropriate faces before displaying the tooltip. If your code @@ -249,21 +249,23 @@ passing it to this function. Optional second arg USE-ECHO-AREA non-nil means to show tooltip in echo area. -The third and fourth args TEXT-FACE and FRAME-FACE specify faces -used to display the tooltip, and default to `tooltip' if not -specified. TEXT-FACE specifies a face used to display text in -the tooltip, while FRAME-FACE specifies a face that provides the -background, foreground and border colors of the tooltip frame. +The third and fourth args TEXT-FACE and DEFAULT-FACE specify +faces used to display the tooltip, and default to `tooltip' if +not specified. TEXT-FACE specifies a face used to display text +in the tooltip, while DEFAULT-FACE specifies a face that provides +the background, foreground and border colors of the tooltip +frame. Note that the last two arguments are not respected when `use-system-tooltips' is non-nil and Emacs is built with support -for system tooltips." +for system tooltips, such as on NS, Haiku, and with the GTK +toolkit." (if use-echo-area (tooltip-show-help-non-mode text) (condition-case error (let ((params (copy-sequence tooltip-frame-parameters)) - (fg (face-attribute (or frame-face 'tooltip) :foreground)) - (bg (face-attribute (or frame-face 'tooltip) :background))) + (fg (face-attribute (or default-face 'tooltip) :foreground)) + (bg (face-attribute (or default-face 'tooltip) :background))) (when (stringp fg) (setf (alist-get 'foreground-color params) fg) (setf (alist-get 'border-color params) fg)) commit 39e9665127a2cc26f4943c6836323da56879b5d9 Author: Lars Ingebrigtsen Date: Fri May 13 14:44:27 2022 +0200 Add a provide in epa-ks * lisp/epa-ks.el (epa-ks): Add a provide (bug#55388). diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index 1078c209ae..f41429f773 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -338,4 +338,6 @@ enough, since keyservers have strict timeout settings." (forward-line)) keys)) +(provide 'epa-ks) + ;;; epa-ks.el ends here commit 7df302d2859b5fa8924b9b2b2dea90fe9f2002b9 Author: Stefan Kangas Date: Fri May 13 12:43:15 2022 +0200 Remove some XEmacs compat code from pascal.el * lisp/progmodes/pascal.el (pascal-outline-map): Remove XEmacs compat code. diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 8dc03b72b1..351ea6e3a9 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -47,8 +47,8 @@ ;; "reset" "rewrite" "write" "writeln") ;; pascal-separator-keywords '("downto" "else" "mod" "div" "then")) -;; KNOWN BUGS / BUGREPORTS -;; ======================= +;; KNOWN BUGS / BUG REPORTS +;; ======================== ;; As far as I know, there are no bugs in the current version of this ;; package. This may not be true however, since I never use this mode ;; myself and therefore would never notice them anyway. If you do @@ -1382,8 +1382,6 @@ The default is a name found in the buffer around point." ;;; (defvar pascal-outline-map (let ((map (make-sparse-keymap))) - (if (fboundp 'set-keymap-name) - (set-keymap-name map 'pascal-outline-map)) (define-key map "\M-\C-a" 'pascal-outline-prev-defun) (define-key map "\M-\C-e" 'pascal-outline-next-defun) (define-key map "\C-c\C-d" 'pascal-outline-goto-defun) commit 87eed0704153bcf3b1b01ff3414f2ccb112457e7 Author: Stefan Kangas Date: Thu May 12 15:53:28 2022 +0200 * lisp/language/thai-util.el (thai-word-mode-map): Prefer defvar-keymap. diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el index d11daf0f83..6c004e9495 100644 --- a/lisp/language/thai-util.el +++ b/lisp/language/thai-util.el @@ -244,15 +244,13 @@ positions (integers or markers) specifying the region." ;; Thai-word-mode requires functions in the feature `thai-word'. (require 'thai-word) -(defvar thai-word-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [remap forward-word] 'thai-forward-word) - (define-key map [remap backward-word] 'thai-backward-word) - (define-key map [remap kill-word] 'thai-kill-word) - (define-key map [remap backward-kill-word] 'thai-backward-kill-word) - (define-key map [remap transpose-words] 'thai-transpose-words) - map) - "Keymap for `thai-word-mode'.") +(defvar-keymap thai-word-mode-map + :doc "Keymap for `thai-word-mode'." + " " #'thai-forward-word + " " #'thai-backward-word + " " #'thai-kill-word + " " #'thai-backward-kill-word + " " #'thai-transpose-words) (define-minor-mode thai-word-mode "Minor mode to make word-oriented commands aware of Thai words. commit d0975d7db03c231a3db5a1cd0edaf41094d43f0d Author: Lars Ingebrigtsen Date: Fri May 13 14:29:48 2022 +0200 Fix dabbrev expansion after recent file-name buffer addition * lisp/dabbrev.el (dabbrev--find-expansion): Remove the now-dead file name buffer from dabbrev--friend-buffer-list, so that we don't trip over the killed buffer later (bug introduced in 2d0085f756). diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 8f8d553cda..215425f136 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -802,7 +802,10 @@ of the start of the occurrence." (progress-reporter-done dabbrev--progress-reporter) expansion)) (when (buffer-live-p file-name-buffer) - (kill-buffer file-name-buffer)))))))) + (kill-buffer file-name-buffer)) + (setq dabbrev--friend-buffer-list + (seq-filter #'buffer-live-p + dabbrev--friend-buffer-list)))))))) ;; Compute the list of buffers to scan. ;; If dabbrev-search-these-buffers-only, then the current buffer commit 36ae1c721ab4bd610087d353d6bd255a20b2f59b Author: Lars Ingebrigtsen Date: Fri May 13 14:07:13 2022 +0200 Make imenu-flush-cache into a function * doc/emacs/programs.texi (Imenu): Remove documentation. * lisp/imenu.el (imenu-flush-cache): Make into a function, since this isn't supposed to be used interactively. diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 2b27d4e13c..2720bdda6f 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -280,11 +280,6 @@ changes in the text. than @code{imenu-auto-rescan-maxout} in bytes, and scanning is stopped if it takes more than @code{imenu-max-index-time} seconds. -@findex imenu-flush-cache - You can force Imenu to forget the buffer's index with @w{@kbd{M-x -imenu-flush-cache @key{RET}}}. This causes Imenu to rescan the -current buffer next time you invoke @kbd{M-g i} in that buffer. - @vindex imenu-sort-function You can customize the way the menus are sorted by setting the variable @code{imenu-sort-function}. By default, names are ordered as diff --git a/etc/NEWS b/etc/NEWS index 267880ef19..a67e136643 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -666,7 +666,7 @@ available options can be restored by enabling this option. *** 'imenu' is now bound to 'M-g i' globally. --- -*** New command 'imenu-flush-cache'. +*** New function 'imenu-flush-cache'. Use it if you want Imenu to forget the buffer's index alist and recreate it anew next time 'imenu' is invoked. diff --git a/lisp/imenu.el b/lisp/imenu.el index a08c58f682..2636e77d08 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -903,9 +903,8 @@ for more information." "Flush the current imenu cache. This forces a full rescan of the buffer to recreate the index alist next time `imenu' is invoked." - (interactive) - (setq imenu--index-alist nil) - (message "Flushed the imenu cache")) + (imenu--cleanup) + (setq imenu--index-alist nil)) (provide 'imenu) commit a769cbfcfb6e9603bcd15e90f387207f8c061bf1 Author: Eli Zaretskii Date: Fri May 13 15:00:21 2022 +0300 Fix lexical-binding fallout in vhdl-mode.el * lisp/progmodes/vhdl-mode.el (arch-alist, pack-alist) (file-alist, unit-alist, rule-alist): Defvar them, since vhdl-aput expects them to be dynamically bound. (Bug#55389) (vhdl-speedbar-insert-hierarchy): Rename the PACK-ALIST argument to PACKAGE-ALIST, to avoid shadowing the global variable. diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index e562a463e1..4e5f5df814 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -153,7 +153,11 @@ (defvar lazy-lock-defer-on-scrolling) (defvar lazy-lock-defer-on-the-fly) (defvar speedbar-attached-frame) - +(defvar arch-alist) +(defvar pack-alist) +(defvar file-alist) +(defvar unit-alist) +(defvar rule-alist) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Variables @@ -14948,10 +14952,10 @@ otherwise use cached data." (vhdl-speedbar-expand-units directory) (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) -(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist - ent-inst-list depth) - "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." - (if (not (or ent-alist conf-alist pack-alist)) +(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg + package-alist ent-inst-list depth) + "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACKAGE-ALIST." + (if (not (or ent-alist conf-alist package-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) (let ((ent-alist ent-alist-arg) (conf-alist conf-alist-arg) @@ -14981,15 +14985,15 @@ otherwise use cached data." 'vhdl-speedbar-configuration-face depth) (setq conf-alist (cdr conf-alist))) ;; insert packages - (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) - (while pack-alist - (setq pack-entry (car pack-alist)) + (when package-alist (vhdl-speedbar-make-title-line "Packages:" depth)) + (while package-alist + (setq pack-entry (car package-alist)) (vhdl-speedbar-make-pack-line (nth 0 pack-entry) (nth 1 pack-entry) (cons (nth 2 pack-entry) (nth 3 pack-entry)) (cons (nth 7 pack-entry) (nth 8 pack-entry)) depth) - (setq pack-alist (cdr pack-alist)))))) + (setq package-alist (cdr package-alist)))))) (declare-function speedbar-line-directory "speedbar" (&optional depth)) @@ -17208,6 +17212,7 @@ specified by a target." (unless (or (assoc directory vhdl-file-alist) (vhdl-load-cache directory)) (vhdl-scan-directory-contents directory)))) + (defvar rule-alist) ; we need it to be dynamically bound (let* ((directory (abbreviate-file-name (vhdl-default-directory))) (project (vhdl-project-p)) (ent-alist (vhdl-aget vhdl-entity-alist (or project directory))) commit 3bd3e005981bea239d396193b9cca1f8919d25ff Author: Po Lu Date: Fri May 13 19:46:43 2022 +0800 Allow changing the face used for text and frame colors in tooltips * etc/NEWS: Announce new arguments to `tooltip-show'. * lisp/tooltip.el (tooltip-show): Accept new arguments `text-face' and `frame-face'. Use them to display text and determine the foreground, background and border colors of the tooltip frame respectively. diff --git a/etc/NEWS b/etc/NEWS index e09834c056..267880ef19 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2030,6 +2030,11 @@ where 'major-mode' is 'shell-mode' or a combined with a condition like Use 'buffer-match-p' to gather a list of buffers that match a condition. +--- +** New arguments 'text-face' and 'frame-face' for 'tooltip-show'. +They allow changing the faces used for the tooltip text and frame +colors of the resulting tooltip frame from the default 'tooltip' face. + ** Text security and suspiciousness +++ diff --git a/lisp/tooltip.el b/lisp/tooltip.el index e24d03b8e8..0e7d333f97 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -230,7 +230,7 @@ change the existing association. Value is the resulting alist." (declare-function x-show-tip "xfns.c" (string &optional frame parms timeout dx dy)) -(defun tooltip-show (text &optional use-echo-area) +(defun tooltip-show (text &optional use-echo-area text-face frame-face) "Show a tooltip window displaying TEXT. Text larger than `x-max-tooltip-size' is clipped. @@ -241,14 +241,29 @@ is displayed. Otherwise, the tooltip pops at offsets specified by `tooltip-x-offset' and `tooltip-y-offset' from the current mouse position. +The text properties of TEXT are also modified to add the +appropriate faces before displaying the tooltip. If your code +depends on them, you should copy the tooltip string before +passing it to this function. + Optional second arg USE-ECHO-AREA non-nil means to show tooltip -in echo area." +in echo area. + +The third and fourth args TEXT-FACE and FRAME-FACE specify faces +used to display the tooltip, and default to `tooltip' if not +specified. TEXT-FACE specifies a face used to display text in +the tooltip, while FRAME-FACE specifies a face that provides the +background, foreground and border colors of the tooltip frame. + +Note that the last two arguments are not respected when +`use-system-tooltips' is non-nil and Emacs is built with support +for system tooltips." (if use-echo-area (tooltip-show-help-non-mode text) (condition-case error (let ((params (copy-sequence tooltip-frame-parameters)) - (fg (face-attribute 'tooltip :foreground)) - (bg (face-attribute 'tooltip :background))) + (fg (face-attribute (or frame-face 'tooltip) :foreground)) + (bg (face-attribute (or frame-face 'tooltip) :background))) (when (stringp fg) (setf (alist-get 'foreground-color params) fg) (setf (alist-get 'border-color params) fg)) @@ -258,7 +273,8 @@ in echo area." ;; faces used in our TEXT. Among other things, this allows ;; tooltips to use the `help-key-binding' face used in ;; `substitute-command-keys' substitutions. - (add-face-text-property 0 (length text) 'tooltip t text) + (add-face-text-property 0 (length text) + (or text-face 'tooltip) t text) (x-show-tip text (selected-frame) params commit 77aba697683de8846c4a73b964e154182221ce67 Author: Po Lu Date: Fri May 13 19:18:17 2022 +0800 Rely solely on device scaling for fonts on PGTK * src/pgtkterm.c (pgtk_get_text_scaling_factor): Delete function. (pgtk_term_init): Stop multiplying dpi by text scale. (bug#55394) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 98567be18c..11ab40a0d3 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -6281,40 +6281,6 @@ same_x_server (const char *name1, const char *name2) && (*name2 == '.' || *name2 == '\0')); } -#define GNOME_INTERFACE_SCHEMA "org.gnome.desktop.interface" - -static gdouble -pgtk_get_text_scaling_factor (void) -{ - GSettingsSchemaSource *schema_source; - GSettingsSchema *schema; - GSettings *settings; - double factor; - - schema_source = g_settings_schema_source_get_default (); - - if (schema_source != NULL) - { - schema = g_settings_schema_source_lookup (schema_source, - GNOME_INTERFACE_SCHEMA, - true); - - if (schema) - { - g_settings_schema_unref (schema); - - settings = g_settings_new (GNOME_INTERFACE_SCHEMA); - factor = g_settings_get_double (settings, - "text-scaling-factor"); - - g_object_unref (settings); - return factor; - } - } - return 1; -} - - /* Open a connection to X display DISPLAY_NAME, and return the structure that describes the open display. If we cannot contact the display, return null. */ @@ -6483,17 +6449,14 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) reset_mouse_highlight (&dpyinfo->mouse_highlight); - { - gscr = gdk_display_get_default_screen (dpyinfo->gdpy); - dpi = gdk_screen_get_resolution (gscr); + gscr = gdk_display_get_default_screen (dpyinfo->gdpy); + dpi = gdk_screen_get_resolution (gscr); - if (dpi < 0) - dpi = 96.0; + if (dpi < 0) + dpi = 96.0; - dpi *= pgtk_get_text_scaling_factor (); - dpyinfo->resx = dpi; - dpyinfo->resy = dpi; - } + dpyinfo->resx = dpi; + dpyinfo->resy = dpi; /* Set up scrolling increments. */ dpyinfo->scroll.x_per_char = 1; commit ebf43cc444ba28dc0a9197ac5a3e1ee403def2b2 Author: Arash Esbati Date: Fri May 13 12:18:15 2022 +0200 ; Fix RefTeX docstrings * lisp/textmodes/reftex-cite.el (reftex-parse-bibitem) (reftex-format-bibitem): Quote backslash. * lisp/textmodes/reftex-vars.el (reftex-cite-cleanup-optional-args): Fix example with 2 optional arguments. diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 47f796dd53..26b14ebc79 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -580,7 +580,7 @@ If FORMAT is non-nil `format' entry accordingly." (concat key "\n " authors " " year " " extra "\n " title "\n\n"))) (defun reftex-parse-bibitem (item) - "Parse a \bibitem entry in ITEM." + "Parse a \\bibitem entry in ITEM." (let ((key "") (text "")) (when (string-match "\\`{\\([^}]+\\)}\\([^\000]*\\)" item) (setq key (match-string 1 item) @@ -596,7 +596,7 @@ If FORMAT is non-nil `format' entry accordingly." (cons "&entry" (concat key " " text))))) (defun reftex-format-bibitem (item) - "Format a \bibitem entry in ITEM so that it is (relatively) nice to look at." + "Format a \\bibitem entry in ITEM so that it is (relatively) nice to look at." (let ((text (reftex-get-bib-field "&text" item)) (key (reftex-get-bib-field "&key" item)) (lines nil)) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index f9d832f155..f9f09825fa 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -1318,7 +1318,7 @@ macro before insertion. For example, it will change \\cite[][]{Jones} -> \\cite{Jones} \\cite[][Chapter 1]{Jones} -> \\cite[Chapter 1]{Jones} \\cite[see][]{Jones} -> \\cite[see][]{Jones} - \\cite[see][Chapter 1]{Jones} -> \\cite{Jones} + \\cite[see][Chapter 1]{Jones} -> \\cite[see][Chapter 1]{Jones} It is possible that other packages have other conventions about which optional argument is interpreted how - that is why this cleaning up can be turned off." commit dae431bf0a8c3114cb06b2f970f6a0c116602fc1 Author: Po Lu Date: Fri May 13 17:08:09 2022 +0800 Fix display of image reliefs for tab bars on NS * src/nsterm.m (ns_draw_image_relief): New function. Synchronize code with X. (ns_dumpglyphs_image): Use that function instead, as on X. diff --git a/src/nsterm.m b/src/nsterm.m index e25f94e5d8..9dff33da50 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3741,6 +3741,92 @@ Function modeled after x_draw_glyph_string_box (). } } +static void +ns_draw_image_relief (struct glyph_string *s) +{ + int x1, y1, thick; + bool raised_p, top_p, bot_p, left_p, right_p; + int extra_x, extra_y; + int x = s->x; + int y = s->ybase - image_ascent (s->img, s->face, &s->slice); + + /* If first glyph of S has a left box line, start drawing it to the + right of that line. */ + if (s->face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p + && s->slice.x == 0) + x += max (s->face->box_vertical_line_width, 0); + + /* If there is a margin around the image, adjust x- and y-position + by that margin. */ + if (s->slice.x == 0) + x += s->img->hmargin; + if (s->slice.y == 0) + y += s->img->vmargin; + + if (s->hl == DRAW_IMAGE_SUNKEN + || s->hl == DRAW_IMAGE_RAISED) + { + if (s->face->id == TAB_BAR_FACE_ID) + thick = (tab_bar_button_relief < 0 + ? DEFAULT_TAB_BAR_BUTTON_RELIEF + : min (tab_bar_button_relief, 1000000)); + else + thick = (tool_bar_button_relief < 0 + ? DEFAULT_TOOL_BAR_BUTTON_RELIEF + : min (tool_bar_button_relief, 1000000)); + raised_p = s->hl == DRAW_IMAGE_RAISED; + } + else + { + thick = eabs (s->img->relief); + raised_p = s->img->relief > 0; + } + + x1 = x + s->slice.width - 1; + y1 = y + s->slice.height - 1; + + extra_x = extra_y = 0; + if (s->face->id == TAB_BAR_FACE_ID) + { + if (CONSP (Vtab_bar_button_margin) + && FIXNUMP (XCAR (Vtab_bar_button_margin)) + && FIXNUMP (XCDR (Vtab_bar_button_margin))) + { + extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)) - thick; + extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)) - thick; + } + else if (FIXNUMP (Vtab_bar_button_margin)) + extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin) - thick; + } + + if (s->face->id == TOOL_BAR_FACE_ID) + { + if (CONSP (Vtool_bar_button_margin) + && FIXNUMP (XCAR (Vtool_bar_button_margin)) + && FIXNUMP (XCDR (Vtool_bar_button_margin))) + { + extra_x = XFIXNUM (XCAR (Vtool_bar_button_margin)); + extra_y = XFIXNUM (XCDR (Vtool_bar_button_margin)); + } + else if (FIXNUMP (Vtool_bar_button_margin)) + extra_x = extra_y = XFIXNUM (Vtool_bar_button_margin); + } + + top_p = bot_p = left_p = right_p = false; + + if (s->slice.x == 0) + x -= thick + extra_x, left_p = true; + if (s->slice.y == 0) + y -= thick + extra_y, top_p = true; + if (s->slice.x + s->slice.width == s->img->width) + x1 += thick + extra_x, right_p = true; + if (s->slice.y + s->slice.height == s->img->height) + y1 += thick + extra_y, bot_p = true; + + ns_draw_relief (NSMakeRect (x, y, x1 - x + 1, y1 - y + 1), thick, + thick, raised_p, top_p, bot_p, left_p, right_p, s); +} static void ns_dumpglyphs_image (struct glyph_string *s, NSRect r) @@ -3752,8 +3838,6 @@ Function modeled after x_draw_glyph_string_box (). int box_line_vwidth = max (s->face->box_horizontal_line_width, 0); int x = s->x, y = s->ybase - image_ascent (s->img, s->face, &s->slice); int bg_x, bg_y, bg_height; - int th; - char raised_p; NSRect br; struct face *face = s->face; NSColor *tdCol; @@ -3847,51 +3931,29 @@ Function modeled after x_draw_glyph_string_box (). if (s->hl == DRAW_CURSOR) { [FRAME_CURSOR_COLOR (s->f) set]; - tdCol = [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]; + tdCol = [NSColor colorWithUnsignedLong: NS_FACE_BACKGROUND (face)]; } else - { - tdCol = [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)]; - } + tdCol = [NSColor colorWithUnsignedLong: NS_FACE_FOREGROUND (face)]; /* Draw underline, overline, strike-through. */ ns_draw_text_decoration (s, face, tdCol, br.size.width, br.origin.x); - /* Draw relief, if requested */ - if (s->img->relief || s->hl ==DRAW_IMAGE_RAISED || s->hl ==DRAW_IMAGE_SUNKEN) - { - if (s->hl == DRAW_IMAGE_SUNKEN || s->hl == DRAW_IMAGE_RAISED) - { - th = (tool_bar_button_relief < 0 - ? DEFAULT_TOOL_BAR_BUTTON_RELIEF - : min (tool_bar_button_relief, 1000000)); - raised_p = (s->hl == DRAW_IMAGE_RAISED); - } - else - { - th = abs (s->img->relief); - raised_p = (s->img->relief > 0); - } - - r.origin.x = x - th; - r.origin.y = y - th; - r.size.width = s->slice.width + 2*th-1; - r.size.height = s->slice.height + 2*th-1; - ns_draw_relief (r, th, th, raised_p, - s->slice.y == 0, - s->slice.y + s->slice.height == s->img->height, - s->slice.x == 0, - s->slice.x + s->slice.width == s->img->width, s); - } + /* If we must draw a relief around the image, do it. */ + if (s->img->relief + || s->hl == DRAW_IMAGE_RAISED + || s->hl == DRAW_IMAGE_SUNKEN) + ns_draw_image_relief (s); - /* If there is no mask, the background won't be seen, - so draw a rectangle on the image for the cursor. - Do this for all images, getting transparency right is not reliable. */ + /* If there is no mask, the background won't be seen, so draw a + rectangle on the image for the cursor. Do this for all images, + getting transparency right is not reliable. */ if (s->hl == DRAW_CURSOR) { int thickness = abs (s->img->relief); if (thickness == 0) thickness = 1; - ns_draw_box (br, thickness, thickness, FRAME_CURSOR_COLOR (s->f), 1, 1); + ns_draw_box (br, thickness, thickness, + FRAME_CURSOR_COLOR (s->f), 1, 1); } } commit 1a6def02cd1ff50e611d23259d7129acc2165dda Author: Po Lu Date: Fri May 13 16:32:10 2022 +0800 Minor cleanups to PGTK code * src/pgtkterm.c (pgtk_text_scaling_factor): Rename to `pgtk_get_text_scaling_factor', clean up coding style, and fix leak of GSettings object. (pgtk_term_init): Clean up coding style and fix scroll increments. diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 4d6221d803..98567be18c 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -6283,18 +6283,32 @@ same_x_server (const char *name1, const char *name2) #define GNOME_INTERFACE_SCHEMA "org.gnome.desktop.interface" -static gdouble pgtk_text_scaling_factor (void) +static gdouble +pgtk_get_text_scaling_factor (void) { - GSettingsSchemaSource *schema_source = g_settings_schema_source_get_default (); + GSettingsSchemaSource *schema_source; + GSettingsSchema *schema; + GSettings *settings; + double factor; + + schema_source = g_settings_schema_source_get_default (); + if (schema_source != NULL) { - GSettingsSchema *schema = g_settings_schema_source_lookup (schema_source, - GNOME_INTERFACE_SCHEMA, true); - if (schema != NULL) + schema = g_settings_schema_source_lookup (schema_source, + GNOME_INTERFACE_SCHEMA, + true); + + if (schema) { g_settings_schema_unref (schema); - GSettings *set = g_settings_new (GNOME_INTERFACE_SCHEMA); - return g_settings_get_double (set, "text-scaling-factor"); + + settings = g_settings_new (GNOME_INTERFACE_SCHEMA); + factor = g_settings_get_double (settings, + "text-scaling-factor"); + + g_object_unref (settings); + return factor; } } return 1; @@ -6317,6 +6331,8 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) char *dpy_name; static void *handle = NULL; Lisp_Object lisp_dpy_name = Qnil; + GdkScreen *gscr; + gdouble dpi; block_input (); @@ -6468,20 +6484,20 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) reset_mouse_highlight (&dpyinfo->mouse_highlight); { - GdkScreen *gscr = gdk_display_get_default_screen (dpyinfo->gdpy); + gscr = gdk_display_get_default_screen (dpyinfo->gdpy); + dpi = gdk_screen_get_resolution (gscr); - gdouble dpi = gdk_screen_get_resolution (gscr); if (dpi < 0) - dpi = 96.0; + dpi = 96.0; - dpi *= pgtk_text_scaling_factor (); + dpi *= pgtk_get_text_scaling_factor (); dpyinfo->resx = dpi; dpyinfo->resy = dpi; } - /* smooth scroll setting */ - dpyinfo->scroll.x_per_char = 2; - dpyinfo->scroll.y_per_line = 2; + /* Set up scrolling increments. */ + dpyinfo->scroll.x_per_char = 1; + dpyinfo->scroll.y_per_line = 1; dpyinfo->connection = -1; commit 7dd4e0b72ebb9682f4042a044b4ba5bf494c996e Author: Po Lu Date: Fri May 13 16:08:54 2022 +0800 Improve test for empty help-echo on NS menu bar items * src/nsmenu.m ([EmacsMenu menu:willHighlightItem:]): Also check if idx is valid. diff --git a/src/nsmenu.m b/src/nsmenu.m index 9f4825ac14..5599d51906 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -782,7 +782,7 @@ - (void) menu: (NSMenu *) menu willHighlightItem: (NSMenuItem *) item } /* Just dismiss any help-echo that might already be in progress if no menu item will be highlighted. */ - else if (item == nil) + else if (item == nil || idx <= 0) help = Qnil; else { commit 62d2db341ce7b8b109d5f284adac8e19d0a6965e Author: Po Lu Date: Fri May 13 16:06:40 2022 +0800 Display help-echo for popup menus on NS * src/nsmenu.m ([EmacsMenu menu:willHighlightItem:]): Display help echo for ordinary popup menus as well. diff --git a/src/nsmenu.m b/src/nsmenu.m index 34864f9408..9f4825ac14 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -765,17 +765,33 @@ - (void) menu: (NSMenu *) menu willHighlightItem: (NSMenuItem *) item NSInteger idx = [item tag]; struct frame *f = SELECTED_FRAME (); Lisp_Object vec = f->menu_bar_vector; - Lisp_Object help, frame; + Lisp_Object help, frame, *client_data; - /* This isn't a menubar, ignore. */ - if (context_menu_value == -1) - return; + XSETFRAME (frame, f); - if (idx >= ASIZE (vec)) - return; + /* This menu isn't a menubar, so use the pointer to the popup menu + data. */ + if (context_menu_value != 0) + { + client_data = (Lisp_Object *) idx; - XSETFRAME (frame, f); - help = AREF (vec, idx + MENU_ITEMS_ITEM_HELP); + if (client_data) + help = client_data[MENU_ITEMS_ITEM_HELP]; + else + help = Qnil; + } + /* Just dismiss any help-echo that might already be in progress if + no menu item will be highlighted. */ + else if (item == nil) + help = Qnil; + else + { + if (idx >= ASIZE (vec)) + return; + + /* Otherwise, get the help data from the menu bar vector. */ + help = AREF (vec, idx + MENU_ITEMS_ITEM_HELP); + } popup_activated_flag++; if (STRINGP (help) || NILP (help)) commit 85ac627ef4096a2d303f1d37c45da05dea1b7781 Author: Po Lu Date: Fri May 13 15:30:22 2022 +0800 Fix extraneous quit events processing GTK native input inside popups * src/gtkutil.c (xg_widget_key_press_event_cb): Return immediately if a popup is active. * src/xterm.c (x_filter_event): Clear `xg_pending_quit_event' if a popup is active. diff --git a/src/gtkutil.c b/src/gtkutil.c index a2ab01d02c..11ccbbd668 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -6395,6 +6395,9 @@ xg_widget_key_press_event_cb (GtkWidget *widget, GdkEvent *event, if (!f) return true; + if (popup_activated ()) + return true; + #ifdef HAVE_XINPUT2 pending_keystroke_time = FRAME_DISPLAY_INFO (f)->pending_keystroke_time; diff --git a/src/xterm.c b/src/xterm.c index 7a570de921..170f65d06f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14014,6 +14014,13 @@ x_filter_event (struct x_display_info *dpyinfo, XEvent *event) result = xg_filter_key (f1, event); unblock_input (); + /* Clear `xg_pending_quit_event' so we don't end up reacting to quit + events sent outside the main event loop (i.e. those sent from + inside a popup menu event loop). */ + + if (popup_activated ()) + xg_pending_quit_event.kind = NO_EVENT; + if (result && f1) /* There will probably be a GDK event generated soon, so exercise the wire to make pselect return. */ commit 875da1dc3a7bc304e9571aad65f8cbc524aaac5b Author: Eli Zaretskii Date: Fri May 13 10:19:56 2022 +0300 ; * configure.ac (-Wbidi-chars): Disable use of these warnings. diff --git a/configure.ac b/configure.ac index 1ba4448d1e..3d5eb7f9c4 100644 --- a/configure.ac +++ b/configure.ac @@ -1079,6 +1079,9 @@ AS_IF([test $gl_gcc_warnings = no], # option problematic. nw="$nw -Wsuggest-attribute=pure" + # Emacs doesn't need this paranoia. + nw="$nw -Wbidi-chars=any,ucn" + if test "$emacs_cv_clang" = yes; then nw="$nw -Wdouble-promotion" fi @@ -1100,6 +1103,7 @@ AS_IF([test $gl_gcc_warnings = no], gl_WARN_ADD([-Wno-type-limits]) # Too many warnings for now gl_WARN_ADD([-Wno-unused-parameter]) # Too many warnings for now gl_WARN_ADD([-Wno-format-nonliteral]) + gl_WARN_ADD([-Wno-bidi-chars]) # clang is unduly picky about some things. if test "$emacs_cv_clang" = yes; then