commit 1bf3afba23799615aecefa7cbfd63fa548187bc1 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Fri May 13 05:34:46 2022 +0000 Add more cursor bitmaps on Haiku * src/haikufns.c (cursor_bitmaps, cursor_bitmaps_for_id): Register crosshair and xterm cursors. * src/haikugui.h (cross_ptr_bits, cross_ptrmask_bits) (ibeam_ptr_bits, ibeam_ptrmask_bits): New cursor bitmaps. diff --git a/src/haikufns.c b/src/haikufns.c index e6bf60e1d9..b628518c26 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1836,56 +1836,56 @@ struct user_cursor_info custom_cursors[] = struct user_cursor_bitmap_info cursor_bitmaps[] = { - { NULL, NULL, 0, 0, 0, 0 }, /* 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 */ - { 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 */ - { NULL, NULL, 0, 0, 0, 0 }, /* top_right_corner_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* right_edge_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* bottom_right_corner_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* bottom_edge_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* bottom_left_corner_cursor */ - { NULL, NULL, 0, 0, 0, 0 }, /* no_cursor */ + { 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 */ + { 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 */ + { NULL, NULL, 0, 0, 0, 0 }, /* top_right_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* right_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_right_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_left_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* no_cursor */ }; /* Array of cursor bitmaps for each system cursor ID. This is used to color in user-specified cursors. */ struct user_cursor_bitmap_info cursor_bitmaps_for_id[28] = { - { NULL, NULL, 0, 0, 0, 0 }, - { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, - { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, + { ibeam_ptr_bits, ibeam_ptrmask_bits, 15, 15, 7, 7 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { cross_ptr_bits, cross_ptrmask_bits, 30, 30, 15, 15 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, }; static void * diff --git a/src/haikugui.h b/src/haikugui.h index a6cf3a4e6c..f197e718c0 100644 --- a/src/haikugui.h +++ b/src/haikugui.h @@ -95,4 +95,53 @@ typedef haiku Drawable; typedef haiku Window; typedef int Display; +/* Cursor bitmaps. These are only used to create colored cursors when + the user specifies a mouse color. */ + +MAYBE_UNUSED static unsigned char cross_ptr_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, + 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, + 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, + 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf0, 0x1f, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, + 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, + 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, + 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char cross_ptrmask_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0xc0, 0x01, + 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, + 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, + 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, + 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0xfc, 0x07, 0xf0, 0x1f, 0xfe, 0x0f, 0xf8, 0x3f, 0xfc, 0x07, + 0xf0, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x80, 0x00, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, + 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, + 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, + 0x01, 0x00, 0x00, 0xc0, 0x01, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char ibeam_ptr_bits[] = + { + 0x00, 0x00, 0x00, 0x00, 0xfc, 0x1f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, + 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, + 0xc0, 0x01, 0xfc, 0x1f, 0x00, 0x00, 0x00, 0x00 + }; + +MAYBE_UNUSED static unsigned char ibeam_ptrmask_bits[] = + { + 0x00, 0x00, 0xfc, 0x1f, 0xfe, 0x3f, 0xfc, 0x1f, 0xe0, 0x03, 0xe0, + 0x03, 0xe0, 0x03, 0xe0, 0x03, 0xe0, 0x03, 0xe0, 0x03, 0xe0, 0x03, + 0xfc, 0x1f, 0xfe, 0x3f, 0xfc, 0x1f, 0x00, 0x00 + }; + #endif /* _HAIKU_GUI_H_ */ commit 78996a113e3b70305afbec1e4220afe27ac8da92 Merge: 62636ea3c1 f03c5d81bd Author: Stefan Kangas Date: Fri May 13 06:30:28 2022 +0200 Merge from origin/emacs-28 f03c5d81bd Fix ControlPath quoting in Tramp commit 62636ea3c1198fe0232842f73dead608a96de171 Author: Po Lu Date: Fri May 13 12:21:32 2022 +0800 Fix disabling frame synchronization on child frames * src/xfns.c (Fx_create_frame): Disable GTK 3's own frame synchronization on child frames, since the CM doesn't send synchronization events to them. diff --git a/src/xfns.c b/src/xfns.c index 6eddf3a494..7b5273e280 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4551,6 +4551,9 @@ This function is an internal primitive--use `make-frame' instead. */) struct x_display_info *dpyinfo = NULL; Lisp_Object parent, parent_frame; struct kboard *kb; +#ifdef HAVE_GTK3 + GdkWindow *gwin; +#endif parms = Fcopy_alist (parms); @@ -4977,6 +4980,10 @@ This function is an internal primitive--use `make-frame' instead. */) if (EQ (x_gtk_resize_child_frames, Qresize_mode)) gtk_container_set_resize_mode (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f)), GTK_RESIZE_IMMEDIATE); +#endif +#ifdef HAVE_GTK3 + gwin = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); + gdk_x11_window_set_frame_sync_enabled (gwin, false); #endif unblock_input (); } commit 53ed3ad5945411162dc514f439ad7f499daa30be Author: Po Lu Date: Fri May 13 04:03:36 2022 +0000 Allow setting cursor colors for custom cursors on Haiku * src/haikufns.c: (struct user_cursor_bitmap_info): (cursor_bitmaps): Fix hotspot for left arrow pointer. (cursor_bitmaps_for_id): New array. (haiku_set_mouse_color): If a color was specified, consult `cursor_bitmaps_for_id' for user-specified cursors. diff --git a/src/haikufns.c b/src/haikufns.c index 9bf672f1d8..e6bf60e1d9 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1795,8 +1795,8 @@ struct user_cursor_info struct user_cursor_bitmap_info { - /* The name of a bitmap to use instead of the font cursor if a - cursor color was set. */ + /* A bitmap to use instead of the font cursor to create cursors in a + certain color. */ const void *bits; /* The mask for that bitmap. */ @@ -1837,8 +1837,8 @@ struct user_cursor_info custom_cursors[] = struct user_cursor_bitmap_info cursor_bitmaps[] = { { NULL, NULL, 0, 0, 0, 0 }, /* text_cursor */ - { left_ptr_bits, left_ptrmsk_bits, 16, 16, 4, 1 }, /* nontext_cursor */ - { left_ptr_bits, left_ptrmsk_bits, 16, 16, 4, 1 }, /* modeline_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 */ @@ -1854,6 +1854,40 @@ struct user_cursor_bitmap_info cursor_bitmaps[] = { NULL, NULL, 0, 0, 0, 0 }, /* no_cursor */ }; +/* Array of cursor bitmaps for each system cursor ID. This is used to + color in user-specified cursors. */ +struct user_cursor_bitmap_info cursor_bitmaps_for_id[28] = + { + { NULL, NULL, 0, 0, 0, 0 }, + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + }; + static void * haiku_create_colored_cursor (struct user_cursor_bitmap_info *info, uint32_t foreground, uint32_t background) @@ -1973,6 +2007,20 @@ haiku_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) n = XFIXNUM (*custom_cursors[i].lisp_cursor); + if (color_specified_p && cursor_bitmaps_for_id[n].bits) + { + recolored + = haiku_create_colored_cursor (&cursor_bitmaps_for_id[n], + color.pixel, + FRAME_BACKGROUND_PIXEL (f)); + + if (recolored) + { + *frame_cursor = recolored; + continue; + } + } + /* Create and set the custom cursor. */ *frame_cursor = BCursor_from_id (n); } commit 119f613cf5a39db1712c87ebcc21d7600ef79e5f Author: Po Lu Date: Fri May 13 03:14:26 2022 +0000 Allow actually setting cursor colors on Haiku * src/haiku_support.cc (be_create_pixmap_cursor): New function. * src/haiku_support.h: Update prototypes. * src/haikufns.c (haiku_create_frame): Change default cursor color to "font-color". (haiku_create_tip_frame): Likewise. (struct user_cursor_bitmap_info): New struct. (cursor_bitmaps): New list of bitmaps corresponding to cursors. (haiku_create_colored_cursor): New function. (haiku_free_custom_cursors): Set current cursor to the default cursor before freeing the original value. (haiku_set_mouse_color): Actually recolor cursors based on built-in bitmaps. * src/haikuterm.c (haiku_defined_color): Clean up coding style. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 39e8daa826..c0bd3c1b0e 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -5122,3 +5122,21 @@ be_roster_launch (const char *type, const char *file, char **cargs, ? INT_MAX : nargs), cargs, team_id); } + +void * +be_create_pixmap_cursor (void *bitmap, int x, int y) +{ + BBitmap *bm; + BCursor *cursor; + + bm = (BBitmap *) bitmap; + cursor = new BCursor (bm, BPoint (x, y)); + + if (cursor->InitCheck () != B_OK) + { + delete cursor; + return NULL; + } + + return cursor; +} diff --git a/src/haiku_support.h b/src/haiku_support.h index 3ea6e838d7..b9cbd6ca4c 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -563,6 +563,7 @@ extern void *BCursor_create_i_beam (void); extern void *BCursor_create_progress_cursor (void); extern void *BCursor_create_grab (void); extern void BCursor_delete (void *); +extern void *be_create_pixmap_cursor (void *, int, int); extern void *BScrollBar_make_for_view (void *, int, int, int, int, int, void *); extern void BScrollBar_delete (void *); diff --git a/src/haikufns.c b/src/haikufns.c index 13432785bd..9bf672f1d8 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -34,6 +34,9 @@ along with GNU Emacs. If not, see . */ #include "haiku_support.h" #include "termhooks.h" +#include "bitmaps/leftptr.xbm" +#include "bitmaps/leftpmsk.xbm" + #include #include @@ -763,7 +766,7 @@ haiku_create_frame (Lisp_Object parms) "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"), + gui_default_parameter (f, parms, Qmouse_color, build_string ("font-color"), "pointerColor", "Foreground", RES_TYPE_STRING); gui_default_parameter (f, parms, Qline_spacing, Qnil, "lineSpacing", "LineSpacing", RES_TYPE_NUMBER); @@ -1056,7 +1059,10 @@ haiku_create_tip_frame (Lisp_Object parms) 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"), + + /* FIXME: is there a better method to tell Emacs to not recolor the + cursors other than setting the color to a special value? */ + gui_default_parameter (f, parms, Qmouse_color, build_string ("font-color"), "pointerColor", "Foreground", RES_TYPE_STRING); gui_default_parameter (f, parms, Qcursor_color, build_string ("black"), "cursorColor", "Foreground", RES_TYPE_STRING); @@ -1787,6 +1793,23 @@ struct user_cursor_info ptrdiff_t default_offset; }; +struct user_cursor_bitmap_info +{ + /* The name of a bitmap to use instead of the font cursor if a + cursor color was set. */ + const void *bits; + + /* The mask for that bitmap. */ + const void *mask; + + /* The dimensions of the cursor bitmap. */ + int width, height; + + /* The position inside the cursor bitmap corresponding to the + position of the mouse pointer. */ + int x, y; +}; + #define INIT_USER_CURSOR(lisp, cursor) \ { (lisp), offsetof (struct haiku_output, cursor), \ offsetof (struct haiku_display_info, cursor) } @@ -1811,7 +1834,70 @@ struct user_cursor_info custom_cursors[] = INIT_USER_CURSOR (NULL, no_cursor), }; -/* Free all cursors not default in F. */ +struct user_cursor_bitmap_info cursor_bitmaps[] = + { + { NULL, NULL, 0, 0, 0, 0 }, /* text_cursor */ + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 4, 1 }, /* nontext_cursor */ + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 4, 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 */ + { 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 */ + { NULL, NULL, 0, 0, 0, 0 }, /* top_right_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* right_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_right_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_left_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* no_cursor */ + }; + +static void * +haiku_create_colored_cursor (struct user_cursor_bitmap_info *info, + uint32_t foreground, uint32_t background) +{ + const char *bits, *mask; + void *bitmap, *cursor; + int width, height, bytes_per_line, x, y; + + bits = info->bits; + mask = info->mask; + width = info->width; + height = info->height; + bytes_per_line = (width + 7) / 8; + + bitmap = BBitmap_new (width, height, false); + + if (!bitmap) + memory_full (SIZE_MAX); + + for (y = 0; y < height; ++y) + { + for (x = 0; x < width; ++x) + { + if (mask[x / 8] >> (x % 8) & 1) + haiku_put_pixel (bitmap, x, y, + (bits[x / 8] >> (x % 8) & 1 + ? (foreground | 255u << 24) + : (background | 255u << 24))); + else + haiku_put_pixel (bitmap, x, y, 0); + } + + mask += bytes_per_line; + bits += bytes_per_line; + } + + cursor = be_create_pixmap_cursor (bitmap, info->x, info->y); + BBitmap_free (bitmap); + + return cursor; +} + +/* Free all cursors on F that were allocated specifically for the + frame. */ void haiku_free_custom_cursors (struct frame *f) { @@ -1833,13 +1919,12 @@ haiku_free_custom_cursors (struct frame *f) display_cursor = (Emacs_Cursor *) ((char *) dpyinfo + cursor->default_offset); - if (*frame_cursor != *display_cursor - && *frame_cursor) + if (*frame_cursor != *display_cursor && *frame_cursor) { - BCursor_delete (*frame_cursor); - if (output->current_cursor == *frame_cursor) output->current_cursor = *display_cursor; + + BCursor_delete (*frame_cursor); } *frame_cursor = *display_cursor; @@ -1850,8 +1935,21 @@ static void haiku_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { struct haiku_output *output; - Emacs_Cursor *frame_cursor, old; - int i, n; + Emacs_Cursor *frame_cursor, old, *recolored; + int i, n, rc; + bool color_specified_p; + Emacs_Color color; + + CHECK_STRING (arg); + color_specified_p = true; + + if (!strcmp (SSDATA (arg), "font-color")) + color_specified_p = false; + else + rc = haiku_get_color (SSDATA (arg), &color); + + if (color_specified_p && rc) + signal_error ("Invalid color", arg); output = FRAME_OUTPUT_DATA (f); @@ -1876,24 +1974,30 @@ haiku_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) n = XFIXNUM (*custom_cursors[i].lisp_cursor); /* Create and set the custom cursor. */ - block_input (); *frame_cursor = BCursor_from_id (n); - unblock_input (); + } + else if (color_specified_p && cursor_bitmaps[i].bits) + { + recolored + = haiku_create_colored_cursor (&cursor_bitmaps[i], color.pixel, + FRAME_BACKGROUND_PIXEL (f)); - /* This function can be called before the frame's window is - created. */ - if (FRAME_HAIKU_WINDOW (f)) - { - if (output->current_cursor == old) - { - output->current_cursor = *frame_cursor; + if (recolored) + *frame_cursor = recolored; + } + } - block_input (); - BView_set_view_cursor (FRAME_HAIKU_VIEW (f), - *frame_cursor); - unblock_input (); - } - } + /* This function can be called before the frame's window is + created. */ + if (FRAME_HAIKU_WINDOW (f)) + { + if (output->current_cursor == old + && old != *frame_cursor) + { + output->current_cursor = *frame_cursor; + + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + *frame_cursor); } } diff --git a/src/haikuterm.c b/src/haikuterm.c index 49121629b3..3ef3f58495 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -577,11 +577,8 @@ haiku_query_frame_background_color (struct frame *f, Emacs_Color *bgcolor) } static bool -haiku_defined_color (struct frame *f, - const char *name, - Emacs_Color *color, - bool alloc, - bool make_index) +haiku_defined_color (struct frame *f, const char *name, + Emacs_Color *color, bool alloc, bool make_index) { return !haiku_get_color (name, color); } commit 6d31ac596165f4d57204af1ee87a7badd79c8697 Author: Po Lu Date: Fri May 13 09:15:42 2022 +0800 Fix quitting during drag-and-drop when GTK native input is on * src/xterm.c (x_dnd_begin_drag_and_drop): Also look in `xg_pending_quit_event' when GTK native input is on. diff --git a/src/xterm.c b/src/xterm.c index 165b0a6b01..7a570de921 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10233,6 +10233,7 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, current_finish = X_EVENT_NORMAL; current_hold_quit = &hold_quit; current_count = 0; + xg_pending_quit_event.kind = NO_EVENT; #endif block_input (); @@ -10397,7 +10398,80 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection); quit (); } -#ifndef USE_GTK + +#ifdef USE_GTK + if (xg_pending_quit_event.kind != NO_EVENT) + { + xg_pending_quit_event.kind = NO_EVENT; + + if (x_dnd_in_progress) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (f, x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) + && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE + && x_dnd_motif_setup_p) + { + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.timestamp = xg_pending_quit_event.timestamp; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, + xg_pending_quit_event.timestamp); + xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), + x_dnd_last_seen_window, &dmsg); + } + + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_frame = NULL; + } + + x_set_dnd_targets (NULL, 0); + x_dnd_waiting_for_finish = false; + + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (); + + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; + + FRAME_DISPLAY_INFO (f)->grabbed = 0; + current_hold_quit = NULL; + + /* Restore the old event mask. */ + XSelectInput (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + root_window_attrs.your_event_mask); +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, 0); +#endif + /* Delete the Motif drag initiator info if it was set up. */ + if (x_dnd_motif_setup_p) + XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection); + quit (); + } +#else } else { commit 06c1eea1738fd829e9b4ac637156ad6b09aab7c3 Author: Paul Eggert Date: Thu May 12 17:19:35 2022 -0700 Update from gnulib diff --git a/build-aux/config.guess b/build-aux/config.guess index 7f76b6228f..160ecf0951 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -4,7 +4,7 @@ # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2022-01-09' +timestamp='2022-05-08' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1151,16 +1151,27 @@ EOF ;; x86_64:Linux:*:*) set_cc_for_build + CPU=$UNAME_MACHINE LIBCABI=$LIBC if test "$CC_FOR_BUILD" != no_compiler_found; then - if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_X32 >/dev/null - then - LIBCABI=${LIBC}x32 - fi + ABI=64 + sed 's/^ //' << EOF > "$dummy.c" + #ifdef __i386__ + ABI=x86 + #else + #ifdef __ILP32__ + ABI=x32 + #endif + #endif +EOF + cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'` + eval "$cc_set_abi" + case $ABI in + x86) CPU=i686 ;; + x32) LIBCABI=${LIBC}x32 ;; + esac fi - GUESS=$UNAME_MACHINE-pc-linux-$LIBCABI + GUESS=$CPU-pc-linux-$LIBCABI ;; xtensa*:Linux:*:*) GUESS=$UNAME_MACHINE-unknown-linux-$LIBC diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index bbb05fdba5..bf0df878a5 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -208,7 +208,6 @@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ CRYPTOLIB = @CRYPTOLIB@ CXX = @CXX@ -CXXCPP = @CXXCPP@ CXXFLAGS = @CXXFLAGS@ CYGWIN_OBJ = @CYGWIN_OBJ@ C_SWITCH_MACHINE = @C_SWITCH_MACHINE@ diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 253393e51b..f4b5853f02 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -167,11 +167,13 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], # them here so that the above 'comm' command doesn't report a false match. gl_AS_VAR_APPEND([$1], [' -Warray-bounds=2']) gl_AS_VAR_APPEND([$1], [' -Wattribute-alias=2']) + gl_AS_VAR_APPEND([$1], [' -Wbidi-chars=any,ucn']) gl_AS_VAR_APPEND([$1], [' -Wformat-overflow=2']) gl_AS_VAR_APPEND([$1], [' -Wformat=2']) gl_AS_VAR_APPEND([$1], [' -Wformat-truncation=2']) gl_AS_VAR_APPEND([$1], [' -Wimplicit-fallthrough=5']) gl_AS_VAR_APPEND([$1], [' -Wshift-overflow=2']) + gl_AS_VAR_APPEND([$1], [' -Wuse-after-free=3']) gl_AS_VAR_APPEND([$1], [' -Wunused-const-variable=2']) gl_AS_VAR_APPEND([$1], [' -Wvla-larger-than=4031']) commit 0f731c49e6a8ccf3aa4c30c3f8ca82ed0a2cefb7 Author: Paul Eggert Date: Thu May 12 17:01:10 2022 -0700 Pacify GCC 12 in default developer build This lets ‘./configure; make’ work on Fedora 36 x86-64 from a Git checkout without generating false-alarm warnings. * lib-src/etags.c (main): There appeared to be false alarm with GCC 12. However, the code was wrong anyway, as it mishandled file names containing "'" so fix that bug. This pacifies GCC. (mercury_decl): Omit tests ‘s + pos != NULL’ that were apparently intended to be ‘s[pos] != '\0'’ but which were miscoded to always be true and which were mostly not needed anyway. In one place, though, a test was needed, so fix that by using strchr instead. * src/alloc.c (lisp_free) [!GC_MALLOC_CHECK]: * src/term.c (Fsuspend_tty): Don’t look at a pointer after freeing it, even just to test it for equality with some other pointer, as this has undefined behavior in C and GCC 12 diagnoses this. * src/dbusbind.c (xd_read_message_1): Rework the code a bit so that it has fewer tests. This pacifies GCC 12 which was complaining incorrectly about dereferencing a null pointer. * src/intervals.c (copy_properties): Remove an eassume that should no longer be needed even to pacify older GCCs, due to ... * src/intervals.h (split_interval_left): ... this addition of ATTRIBUTE_RETURNS_NONNULL to pacify a GCC 12 warning about dereferencing a null pointer. * src/regex-emacs.c (EXTEND_BUFFER): Use negative values rather than auxiliary booleans to indicate null pointers. This pacifies GCC 12 false alarms about using uninitialized variables. * src/xdisp.c (clear_position): New function. (append_space_for_newline, extend_face_to_end_of_line): Use it to work around false alarms from GCC 12. (display_and_set_cursor): Add an UNINIT to pacify GCC 12. * src/xterm.c (x_draw_glyphless_glyph_string_foreground): Defend against hypothetical bad code elsewhere; this also pacifies GCC 12. (x_term_init): Use fixed-size auto array rather than alloca, as the array is small; this also pacifies GCC 12. diff --git a/lib-src/etags.c b/lib-src/etags.c index 65b9fae8d5..ea99ed9f39 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -1427,14 +1427,19 @@ main (int argc, char **argv) if (CTAGS) if (append_to_tagfile || update) { - char *cmd = xmalloc (2 * strlen (tagfile) + sizeof "sort -u -o.."); /* Maybe these should be used: setenv ("LC_COLLATE", "C", 1); setenv ("LC_ALL", "C", 1); */ - char *z = stpcpy (cmd, "sort -u -o "); - z = stpcpy (z, tagfile); - *z++ = ' '; - strcpy (z, tagfile); + char *cmd = xmalloc (8 * strlen (tagfile) + sizeof "sort -u -o '' ''"); + char *z = stpcpy (cmd, "sort -u -o '"); + char *escaped_tagfile = z; + for (; *tagfile; *z++ = *tagfile++) + if (*tagfile == '\'') + z = stpcpy (z, "'\\'"); + ptrdiff_t escaped_tagfile_len = z - escaped_tagfile; + z = stpcpy (z, "' '"); + z = mempcpy (z, escaped_tagfile, escaped_tagfile_len); + strcpy (z, "'"); return system (cmd); } return EXIT_SUCCESS; @@ -6396,7 +6401,8 @@ mercury_decl (char *s, size_t pos) size_t origpos; origpos = pos; - while (s + pos != NULL && (c_isalnum (s[pos]) || s[pos] == '_')) ++pos; + while (c_isalnum (s[pos]) || s[pos] == '_') + pos++; unsigned char decl_type_length = pos - origpos; char buf[decl_type_length + 1]; @@ -6440,9 +6446,9 @@ mercury_decl (char *s, size_t pos) so this is the hard case. */ if (strcmp (buf, "solver") == 0) { - ++pos; - while (s + pos != NULL && (c_isalnum (s[pos]) || s[pos] == '_')) - ++pos; + do + pos++; + while (c_isalnum (s[pos]) || s[pos] == '_'); decl_type_length = pos - origpos; char buf2[decl_type_length + 1]; @@ -6492,7 +6498,6 @@ mercury_decl (char *s, size_t pos) while (c_isalnum (s[pos]) || s[pos] == '_' || (s[pos] == '.' /* A module dot. */ - && s + pos + 1 != NULL && (c_isalnum (s[pos + 1]) || s[pos + 1] == '_') && (module_dot_pos = pos))) /* Record module dot position. Erase module from name. */ @@ -6536,10 +6541,10 @@ mercury_decl (char *s, size_t pos) } else if (is_mercury_quantifier && s[pos] == '[') /* :- some [T] pred/func. */ { - for (++pos; s + pos != NULL && s[pos] != ']'; ++pos) {} - if (s + pos == NULL) return null_pos; - ++pos; - pos = skip_spaces (s + pos) - s; + char *close_bracket = strchr (s + pos + 1, ']'); + if (!close_bracket) + return null_pos; + pos = skip_spaces (close_bracket + 1) - s; mercury_pos_t position = mercury_decl (s, pos); position.totlength += pos - origpos; return position; diff --git a/src/alloc.c b/src/alloc.c index 43fbbb79be..3cfc3d61dd 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1032,9 +1032,12 @@ lisp_free (void *block) return; MALLOC_BLOCK_INPUT; +#ifndef GC_MALLOC_CHECK + struct mem_node *m = mem_find (block); +#endif free (block); #ifndef GC_MALLOC_CHECK - mem_delete (mem_find (block)); + mem_delete (m); #endif MALLOC_UNBLOCK_INPUT; } diff --git a/src/dbusbind.c b/src/dbusbind.c index 7cfdbbe23c..943a4aff8e 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1690,29 +1690,30 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) value = Fgethash (key, Vdbus_registered_objects_table, Qnil); /* Loop over the registered functions. Construct an event. */ - while (!NILP (value)) + for (; !NILP (value); value = CDR_SAFE (value)) { key = CAR_SAFE (value); + Lisp_Object key_uname = CAR_SAFE (key); /* key has the structure (UNAME SERVICE PATH HANDLER). */ - if (((uname == NULL) - || (NILP (CAR_SAFE (key))) - || (strcmp (uname, SSDATA (CAR_SAFE (key))) == 0)) - && ((path == NULL) - || (NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (key))))) - || (strcmp (path, - SSDATA (CAR_SAFE (CDR_SAFE (CDR_SAFE (key))))) - == 0)) - && (!NILP (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key))))))) - { - EVENT_INIT (event); - event.kind = DBUS_EVENT; - event.frame_or_window = Qnil; - /* Handler. */ - event.arg - = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (key)))), args); - break; - } - value = CDR_SAFE (value); + if (uname && !NILP (key_uname) + && strcmp (uname, SSDATA (key_uname)) != 0) + continue; + Lisp_Object key_service_etc = CDR_SAFE (key); + Lisp_Object key_path_etc = CDR_SAFE (key_service_etc); + Lisp_Object key_path = CAR_SAFE (key_path_etc); + if (path && !NILP (key_path) + && strcmp (path, SSDATA (key_path)) != 0) + continue; + Lisp_Object handler = CAR_SAFE (CDR_SAFE (key_path_etc)); + if (NILP (handler)) + continue; + + /* Construct an event and exit the loop. */ + EVENT_INIT (event); + event.kind = DBUS_EVENT; + event.frame_or_window = Qnil; + event.arg = Fcons (handler, args); + break; } if (NILP (value)) diff --git a/src/intervals.c b/src/intervals.c index 687b237b9e..9e28637d6b 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -121,7 +121,6 @@ copy_properties (INTERVAL source, INTERVAL target) { if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target)) return; - eassume (source && target); COPY_INTERVAL_CACHE (source, target); set_interval_plist (target, Fcopy_sequence (source->plist)); diff --git a/src/intervals.h b/src/intervals.h index 484fca2e75..0ce581208e 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -251,7 +251,7 @@ extern void traverse_intervals_noorder (INTERVAL, void (*) (INTERVAL, void *), void *); extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t) ATTRIBUTE_RETURNS_NONNULL; -extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); +extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t) ATTRIBUTE_RETURNS_NONNULL; extern INTERVAL find_interval (INTERVAL, ptrdiff_t); extern INTERVAL next_interval (INTERVAL); extern INTERVAL previous_interval (INTERVAL); diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 700a6c357d..8662fe8d6d 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -1244,21 +1244,22 @@ static int analyze_first (re_char *p, re_char *pend, return REG_ESIZE; \ ptrdiff_t b_off = b - old_buffer; \ ptrdiff_t begalt_off = begalt - old_buffer; \ - bool fixup_alt_jump_set = !!fixup_alt_jump; \ - bool laststart_set = !!laststart; \ - bool pending_exact_set = !!pending_exact; \ - ptrdiff_t fixup_alt_jump_off, laststart_off, pending_exact_off; \ - if (fixup_alt_jump_set) fixup_alt_jump_off = fixup_alt_jump - old_buffer; \ - if (laststart_set) laststart_off = laststart - old_buffer; \ - if (pending_exact_set) pending_exact_off = pending_exact - old_buffer; \ + ptrdiff_t fixup_alt_jump_off = \ + fixup_alt_jump ? fixup_alt_jump - old_buffer : -1; \ + ptrdiff_t laststart_off = laststart ? laststart - old_buffer : -1; \ + ptrdiff_t pending_exact_off = \ + pending_exact ? pending_exact - old_buffer : -1; \ bufp->buffer = xpalloc (bufp->buffer, &bufp->allocated, \ requested_extension, MAX_BUF_SIZE, 1); \ unsigned char *new_buffer = bufp->buffer; \ b = new_buffer + b_off; \ begalt = new_buffer + begalt_off; \ - if (fixup_alt_jump_set) fixup_alt_jump = new_buffer + fixup_alt_jump_off; \ - if (laststart_set) laststart = new_buffer + laststart_off; \ - if (pending_exact_set) pending_exact = new_buffer + pending_exact_off; \ + if (0 <= fixup_alt_jump_off) \ + fixup_alt_jump = new_buffer + fixup_alt_jump_off; \ + if (0 <= laststart_off) \ + laststart = new_buffer + laststart_off; \ + if (0 <= pending_exact_off) \ + pending_exact = new_buffer + pending_exact_off; \ } while (false) diff --git a/src/term.c b/src/term.c index bad1127c93..3bea621dbd 100644 --- a/src/term.c +++ b/src/term.c @@ -2287,9 +2287,9 @@ A suspended tty may be resumed by calling `resume-tty' on it. */) delete_keyboard_wait_descriptor (fileno (f)); #ifndef MSDOS - fclose (f); if (f != t->display_info.tty->output) fclose (t->display_info.tty->output); + fclose (f); #endif t->display_info.tty->input = 0; diff --git a/src/xdisp.c b/src/xdisp.c index 82a018485d..5ff54b2884 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -22471,6 +22471,13 @@ compute_line_metrics (struct it *it) } +static void +clear_position (struct it *it) +{ + it->position.charpos = 0; + it->position.bytepos = 0; +} + /* Append one space to the glyph row of iterator IT if doing a window-based redisplay. The space has the same face as IT->face_id. Value is true if a space was added. @@ -22506,7 +22513,7 @@ append_space_for_newline (struct it *it, bool default_face_p) struct face *face; it->what = IT_CHARACTER; - memset (&it->position, 0, sizeof it->position); + clear_position (it); it->object = Qnil; it->len = 1; @@ -22835,7 +22842,7 @@ extend_face_to_end_of_line (struct it *it) const int stretch_width = indicator_column - it->current_x - char_width; - memset (&it->position, 0, sizeof it->position); + clear_position (it); /* Only generate a stretch glyph if there is distance between current_x and the indicator position. */ @@ -22869,7 +22876,7 @@ extend_face_to_end_of_line (struct it *it) if (stretch_width > 0) { - memset (&it->position, 0, sizeof it->position); + clear_position (it); append_stretch_glyph (it, Qnil, stretch_width, it->ascent + it->descent, stretch_ascent); @@ -22919,7 +22926,7 @@ extend_face_to_end_of_line (struct it *it) (((it->ascent + it->descent) * FONT_BASE (font)) / FONT_HEIGHT (font)); saved_pos = it->position; - memset (&it->position, 0, sizeof it->position); + clear_position (it); saved_avoid_cursor = it->avoid_cursor_p; it->avoid_cursor_p = true; saved_face_id = it->face_id; @@ -22957,7 +22964,7 @@ extend_face_to_end_of_line (struct it *it) enum display_element_type saved_what = it->what; it->what = IT_CHARACTER; - memset (&it->position, 0, sizeof it->position); + clear_position (it); it->object = Qnil; it->c = it->char_to_display = ' '; it->len = 1; @@ -32651,7 +32658,7 @@ display_and_set_cursor (struct window *w, bool on, { struct frame *f = XFRAME (w->frame); int new_cursor_type; - int new_cursor_width; + int new_cursor_width UNINIT; bool active_cursor; struct glyph_row *glyph_row; struct glyph *glyph; diff --git a/src/xterm.c b/src/xterm.c index 5c5de191dc..165b0a6b01 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6621,6 +6621,10 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) glyph->ascent + glyph->descent - 1); x += glyph->pixel_width; } + + /* Defend against hypothetical bad code elsewhere that uses + s->char2b after this function returns. */ + s->char2b = NULL; } #ifdef USE_X_TOOLKIT @@ -23521,7 +23525,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #ifdef USE_XCB xcb_connection_t *xcb_conn; #endif - char *cm_atom_sprintf; + static char const cm_atom_fmt[] = "_NET_WM_CM_S%d"; + char cm_atom_sprintf[sizeof cm_atom_fmt - 2 + INT_STRLEN_BOUND (int)]; block_input (); @@ -24212,14 +24217,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->resx = (mm < 1) ? 100 : pixels * 25.4 / mm; } - { - int n = snprintf (NULL, 0, "_NET_WM_CM_S%d", - XScreenNumberOfScreen (dpyinfo->screen)); - cm_atom_sprintf = alloca (n + 1); - - snprintf (cm_atom_sprintf, n + 1, "_NET_WM_CM_S%d", - XScreenNumberOfScreen (dpyinfo->screen)); - } + sprintf (cm_atom_sprintf, cm_atom_fmt, + XScreenNumberOfScreen (dpyinfo->screen)); { static const struct commit 454caf858d92a87dc781bc35b421d5014a312bb9 Author: Eli Zaretskii Date: Thu May 12 19:58:39 2022 +0300 ; Improve doc string of 'sh-indent-statement-after-and' * lisp/progmodes/sh-script.el (sh-indent-statement-after-and): Clarify the doc string. (Bug#22645) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 379224dbce..e48fa0668b 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -642,8 +642,9 @@ implemented as aliases. See `sh-feature'." :group 'sh-script) (defcustom sh-indent-statement-after-and t - "How to indent statements following &&. -If t, indent to the &&. If nil, indent to the parent." + "How to indent statements following && in Shell-Script mode. +If t, indent to align with &&. +If nil, indent to align with the previous line's indentation." :type 'boolean :version "29.1") commit 7a8bed255398e181378f59262534c7a36ec43ddb Author: Lars Ingebrigtsen Date: Thu May 12 18:16:43 2022 +0200 Add new user option 'sh-indent-statement-after-and' * lisp/progmodes/sh-script.el (sh-indent-statement-after-and): New user option (bug#22645). (sh-smie-sh-rules): Use it. diff --git a/etc/NEWS b/etc/NEWS index 3bdc497f18..e09834c056 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -799,6 +799,15 @@ so automatically. * Changes in Specialized Modes and Packages in Emacs 29.1 +** Shell Script Mode + +--- +*** New user option 'sh-indent-statement-after-and'. +This controls how statements like the following are indented: + + foo && + bar + --- *** New user option 'cperl-file-style'. This option determines the indentation style to be used. It can also diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 9151fd0a34..379224dbce 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -641,7 +641,11 @@ implemented as aliases. See `sh-feature'." :version "24.4" ; bash4 additions :group 'sh-script) - +(defcustom sh-indent-statement-after-and t + "How to indent statements following &&. +If t, indent to the &&. If nil, indent to the parent." + :type 'boolean + :version "29.1") (defcustom sh-leading-keywords '((bash sh-append sh @@ -1990,7 +1994,9 @@ May return nil if the line should not be treated as continued." (current-column) (smie-indent-calculate))))) (`(:before . ,(or "|" "&&" "||")) - (unless (smie-rule-parent-p token) + (when (and (not (smie-rule-parent-p token)) + (or (not (equal token "&&")) + sh-indent-statement-after-and)) (smie-backward-sexp token) `(column . ,(+ (funcall smie-rules-function :elem 'basic) (smie-indent-virtual))))) commit f03c5d81bd4a7af1364558b406e2b87a78b3af73 (refs/remotes/origin/emacs-28) Author: Michael Albinus Date: Thu May 12 15:46:20 2022 +0200 Fix ControlPath quoting in Tramp * lisp/net/tramp-sh.el (tramp-ssh-controlmaster-options): Adapt docstring. Do not quote ControlPath. Reported by Daniel Kessler . diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index c4fbe4673b..b0e98a31e1 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -115,7 +115,7 @@ configuration." "Which ssh Control* arguments to use. If it is a string, it should have the form -\"-o ControlMaster=auto -o ControlPath=\\='tramp.%%r@%%h:%%p\\=' +\"-o ControlMaster=auto -o ControlPath=tramp.%%C -o ControlPersist=no\". Percent characters in the ControlPath spec must be doubled, because the string is used as format string. @@ -4785,13 +4785,13 @@ Goes through the list `tramp-inline-compress-commands'." (if (zerop (tramp-call-process vec "ssh" nil nil nil - "-G" "-o" "ControlPath='tramp.%C'" "0.0.0.1")) + "-G" "-o" "ControlPath=tramp.%C" "0.0.0.1")) (setq tramp-ssh-controlmaster-options (concat tramp-ssh-controlmaster-options - " -o ControlPath='tramp.%%C'")) + " -o ControlPath=tramp.%%C")) (setq tramp-ssh-controlmaster-options (concat tramp-ssh-controlmaster-options - " -o ControlPath='tramp.%%r@%%h:%%p'"))) + " -o ControlPath=tramp.%%r@%%h:%%p"))) (when (zerop (tramp-call-process vec "ssh" nil nil nil commit c8d7a27438b294e20ca0f8f6f1dd74d4a273dc96 Author: Po Lu Date: Thu May 12 13:08:26 2022 +0000 Remove unused RIF method * src/haikuterm.c (haiku_update_window_end): Delete function. (haiku_redisplay_interface): Remove RIF method. diff --git a/src/haikuterm.c b/src/haikuterm.c index b74584e2dc..49121629b3 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2926,13 +2926,6 @@ haiku_define_frame_cursor (struct frame *f, Emacs_Cursor cursor) FRAME_OUTPUT_DATA (f)->current_cursor = cursor; } -static void -haiku_update_window_end (struct window *w, bool cursor_on_p, - bool mouse_face_overwritten_p) -{ - -} - static void haiku_default_font_parameter (struct frame *f, Lisp_Object parms) { @@ -3001,8 +2994,8 @@ static struct redisplay_interface haiku_redisplay_interface = gui_clear_end_of_line, haiku_scroll_run, haiku_after_update_window_line, - NULL, - haiku_update_window_end, + NULL, /* update_window_begin */ + NULL, /* update_window_end */ haiku_flush, gui_clear_window_mouse_face, gui_get_glyph_overhangs, @@ -3018,7 +3011,7 @@ static struct redisplay_interface haiku_redisplay_interface = haiku_draw_window_cursor, haiku_draw_vertical_window_border, haiku_draw_window_divider, - 0, /* shift glyphs for insert */ + NULL, /* shift glyphs for insert */ haiku_show_hourglass, haiku_hide_hourglass, haiku_default_font_parameter, commit 3b7315d011316ebb962c42df48bfa268207005ea Author: Lars Ingebrigtsen Date: Thu May 12 14:15:12 2022 +0200 Make prompt read-only in inferior-scheme-mode * lisp/cmuscheme.el (inferior-scheme-mode): Make the prompt read-only to be more consistent with other inferior modes (bug#21118). diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index e64d9d28dd..22a465f5b6 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -195,6 +195,7 @@ to continue it." (scheme-mode-variables) (setq mode-line-process '(":%s")) (setq comint-input-filter (function scheme-input-filter)) + (setq-local comint-prompt-read-only t) (setq comint-get-old-input (function scheme-get-old-input))) (defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'" commit 9c248f4cd903d4b1f3b792d5e80620643921b77c Author: Lars Ingebrigtsen Date: Thu May 12 14:07:29 2022 +0200 Fix retrieving images that contain ) characters in shr * lisp/net/shr.el (shr-save-contents, shr-get-image-data): Don't call. (shr-encode-url): Make obsolete. (This function makes no sense.) (shr-tag-img): Don't call. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 43d34a9d4d..6b05cbcf4f 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -994,8 +994,7 @@ the mouse click event." (let ((url (get-text-property (point) 'shr-url))) (if (not url) (message "No link under point") - (url-retrieve (shr-encode-url url) - #'shr-store-contents (list url directory))))) + (url-retrieve url #'shr-store-contents (list url directory))))) (defun shr-store-contents (status url directory) (unless (plist-get status :error) @@ -1154,7 +1153,7 @@ Return a string with image data." (with-temp-buffer (set-buffer-multibyte nil) (when (ignore-errors - (url-cache-extract (url-cache-create-filename (shr-encode-url url))) + (url-cache-extract (url-cache-create-filename url)) t) (when (re-search-forward "\r?\n\r?\n" nil t) (shr-parse-image-data))))) @@ -1252,6 +1251,7 @@ START, and END. Note that START and END should be markers." (defun shr-encode-url (url) "Encode URL." + (declare (obsolete nil "29.1")) (browse-url-url-encode-chars url "[)$ ]")) (autoload 'shr-color-visible "shr-color") @@ -1672,13 +1672,13 @@ The preference is a float determined from `shr-prefer-media-type'." (setq shr-start (point)) (shr-insert alt)) ((and (not shr-ignore-cache) - (url-is-cached (shr-encode-url url))) + (url-is-cached url)) (funcall shr-put-image-function (shr-get-image-data url) alt (list :width width :height height))) (t (when (and shr-ignore-cache - (url-is-cached (shr-encode-url url))) - (let ((file (url-cache-create-filename (shr-encode-url url)))) + (url-is-cached url)) + (let ((file (url-cache-create-filename url))) (when (file-exists-p file) (delete-file file)))) (when (image-type-available-p 'svg) @@ -1687,7 +1687,7 @@ The preference is a float determined from `shr-prefer-media-type'." (or alt ""))) (insert " ") (url-queue-retrieve - (shr-encode-url url) #'shr-image-fetched + url #'shr-image-fetched (list (current-buffer) start (set-marker (make-marker) (point)) (list :width width :height height)) t commit d22bd210afc5b95d2e4dd1c04ffe26f1f488a3f4 Author: Lars Ingebrigtsen Date: Thu May 12 13:11:45 2022 +0200 Improve url-http debugging * lisp/url/url-http.el (url-http-parse-headers): Output the headers we receive in the debug output. * lisp/url/url-vars.el (url-extensions-header): Remove useless header. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index b950a8994f..4e5d017036 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -589,6 +589,13 @@ should be shown to the user." (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name)) (url-http-parse-response) (mail-narrow-to-head) + (when url-debug + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (url-http-debug "Response: %s" + (buffer-substring (point) (line-end-position))) + (forward-line 1)))) ;;(narrow-to-region (point-min) url-http-end-of-headers) (let ((connection (mail-fetch-field "Connection"))) ;; In HTTP 1.0, keep the connection only if there is a diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 922f26d65b..1012525568 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -396,7 +396,7 @@ Should be one of: (defvar url-lazy-message-time 0) ;; Fixme: We may not be able to run SSL. -(defvar url-extensions-header "Security/Digest Security/SSL") +(defvar url-extensions-header nil) (defvar url-parse-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table) commit aeefa3a732c9dd815e23ed10c4582082acb0e29b Author: Arash Esbati Date: Thu May 12 12:52:00 2022 +0200 ; lisp/textmodes/reftex-cite.el: Fix docstring * lisp/textmodes/reftex-cite.el (reftex-extract-bib-entries-from-thebibliography): Quote backslash in docstring. diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 4e487d745c..47f796dd53 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -360,7 +360,7 @@ The name of the first different author/editor is used." ;; Parse the bibliography environment (defun reftex-extract-bib-entries-from-thebibliography (files) - "Extract bib-entries from the \begin{thebibliography} environment. + "Extract bib-entries from the \\begin{thebibliography} environment. Parsing is not as good as for the BibTeX database stuff. The environment should be located in FILES." (let* (start end buf entries re re-list file default) commit b6aff96a747930e49017b20203fffec1ea70a1b1 Author: Po Lu Date: Thu May 12 17:21:39 2022 +0800 Fix build on Mac OS X 10.11 * src/nsterm.h (NSButtonTypeMomentaryPushIn): New define. diff --git a/src/nsterm.h b/src/nsterm.h index 9d8a6f486f..ce2355e6b1 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1329,5 +1329,6 @@ enum NSWindowTabbingMode #define NSControlStateValueOn NSOnState #define NSControlStateValueOff NSOffState #define NSBezelStyleRounded NSRoundedBezelStyle +#define NSButtonTypeMomentaryPushIn NSMomentaryPushInButton #endif #endif /* HAVE_NS */ commit dc662f21f42fc6226c5a6424399caec32329dbc1 Author: Stefan Kangas Date: Thu May 12 11:07:51 2022 +0200 * lisp/array.el (array-mode-map): Prefer defvar-keymap. diff --git a/lisp/array.el b/lisp/array.el index 31cf9cf302..08c5ff45dd 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -767,29 +767,27 @@ Return COLUMN." ;;; Array mode. -(defvar array-mode-map - (let ((map (make-keymap))) - (define-key map "\M-ad" #'array-display-local-variables) - (define-key map "\M-am" #'array-make-template) - (define-key map "\M-ae" #'array-expand-rows) - (define-key map "\M-ar" #'array-reconfigure-rows) - (define-key map "\M-a=" #'array-what-position) - (define-key map "\M-ag" #'array-goto-cell) - (define-key map "\M-af" #'array-fill-rectangle) - (define-key map "\C-n" #'array-next-row) - (define-key map "\C-p" #'array-previous-row) - (define-key map "\C-f" #'array-forward-column) - (define-key map "\C-b" #'array-backward-column) - (define-key map "\M-n" #'array-copy-down) - (define-key map "\M-p" #'array-copy-up) - (define-key map "\M-f" #'array-copy-forward) - (define-key map "\M-b" #'array-copy-backward) - (define-key map "\M-\C-n" #'array-copy-row-down) - (define-key map "\M-\C-p" #'array-copy-row-up) - (define-key map "\M-\C-f" #'array-copy-column-forward) - (define-key map "\M-\C-b" #'array-copy-column-backward) - map) - "Keymap used in array mode.") +(defvar-keymap array-mode-map + :doc "Keymap used in array mode." + "M-a d" #'array-display-local-variables + "M-a m" #'array-make-template + "M-a e" #'array-expand-rows + "M-a r" #'array-reconfigure-rows + "M-a =" #'array-what-position + "M-a g" #'array-goto-cell + "M-a f" #'array-fill-rectangle + "C-n" #'array-next-row + "C-p" #'array-previous-row + "C-f" #'array-forward-column + "C-b" #'array-backward-column + "M-n" #'array-copy-down + "M-p" #'array-copy-up + "M-f" #'array-copy-forward + "M-b" #'array-copy-backward + "C-M-n" #'array-copy-row-down + "C-M-p" #'array-copy-row-up + "C-M-f" #'array-copy-column-forward + "C-M-b" #'array-copy-column-backward) (put 'array-mode 'mode-class 'special) commit 89c6e412dd6bcb3a8e5e90d9a52cf6f6fd233776 Author: Po Lu Date: Thu May 12 07:39:11 2022 +0000 Fix searching the bitmap file path on Haiku * src/image.c (image_create_bitmap_from_file): [HAVE_HAIKU]: Look for the bitmap inside `x-bitmap-file-path' as well. diff --git a/src/image.c b/src/image.c index 0c14173d83..dfa5327992 100644 --- a/src/image.c +++ b/src/image.c @@ -750,8 +750,28 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) int fd, width, height, rc, bytes_per_line, x, y; char *contents, *data, *tmp; void *bitmap; + Lisp_Object found; - if (!STRINGP (image_find_image_fd (file, &fd))) + /* Look for an existing bitmap with the same name. */ + for (id = 0; id < dpyinfo->bitmaps_last; ++id) + { + if (dpyinfo->bitmaps[id].refcount + && dpyinfo->bitmaps[id].file + && !strcmp (dpyinfo->bitmaps[id].file, SSDATA (file))) + { + ++dpyinfo->bitmaps[id].refcount; + return id + 1; + } + } + + /* Search bitmap-file-path for the file, if appropriate. */ + if (openp (Vx_bitmap_file_path, file, Qnil, &found, + make_fixnum (R_OK), false, false) + < 0) + return -1; + + if (!STRINGP (image_find_image_fd (file, &fd)) + && !STRINGP (image_find_image_fd (found, &fd))) return -1; contents = slurp_file (fd, &size); commit 0e5623b491cb4158d8055b9c2ee7963fee8c75de Author: Stefan Kangas Date: Thu May 12 09:32:10 2022 +0200 ; * src/bytecode.c (exec_byte_code): Fix white space. diff --git a/src/bytecode.c b/src/bytecode.c index 74b7d16aff..a0bcbb4848 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1209,7 +1209,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object v2 = POP; Lisp_Object v1 = TOP; if (FIXNUMP (v1) && FIXNUMP (v2)) - TOP = BASE_EQ(v1, v2) ? Qt : Qnil; + TOP = BASE_EQ (v1, v2) ? Qt : Qnil; else TOP = arithcompare (v1, v2, ARITH_EQUAL); NEXT; commit 14e445047918321ee19a87283a1c32df5530f4fb Author: Michael Albinus Date: Thu May 12 09:03:45 2022 +0200 Improve Tramp's write-region * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Use `tramp-handle-write-region'. (tramp-sudoedit-handle-write-region): Remove. * lisp/net/tramp.el (tramp-skeleton-write-region): Set extended attributes. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index fb885ebd05..420a593644 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -147,7 +147,7 @@ See `tramp-actions-before-shell' for more info.") (unlock-file . tramp-handle-unlock-file) (vc-registered . ignore) (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime) - (write-region . tramp-sudoedit-handle-write-region)) + (write-region . tramp-handle-write-region)) "Alist of handler functions for Tramp SUDOEDIT method.") ;; It must be a `defsubst' in order to push the whole code into @@ -739,38 +739,6 @@ ID-FORMAT valid values are `string' and `integer'." (or gid (tramp-get-remote-gid v 'integer))) (tramp-unquote-file-local-name filename)))) -(defun tramp-sudoedit-handle-write-region - (start end filename &optional append visit lockname mustbenew) - "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - (let* ((uid (or (file-attribute-user-id (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (file-attribute-group-id (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer))) - (flag (and (eq mustbenew 'excl) 'nofollow)) - (modes (tramp-default-file-modes filename flag)) - (attributes (file-extended-attributes filename))) - (prog1 - (tramp-handle-write-region - start end filename append visit lockname mustbenew) - - ;; Set the ownership, modes and extended attributes. This is - ;; not performed in `tramp-handle-write-region'. - (unless (and (= (file-attribute-user-id - (file-attributes filename 'integer)) - uid) - (= (file-attribute-group-id - (file-attributes filename 'integer)) - gid)) - (tramp-set-file-uid-gid filename uid gid)) - (tramp-compat-set-file-modes filename modes flag) - ;; We ignore possible errors, because ACL strings could be - ;; incompatible. - (when attributes - (ignore-errors - (set-file-extended-attributes filename attributes))))))) - ;; Internal functions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b26346443d..b06147599c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3415,6 +3415,7 @@ BODY is the backend specific code." (gid (or (file-attribute-group-id (file-attributes filename 'integer)) (tramp-get-remote-gid v 'integer))) + (attributes (file-extended-attributes filename)) (curbuf (current-buffer))) ;; Lock file. @@ -3453,6 +3454,12 @@ BODY is the backend specific code." (when need-chown (tramp-set-file-uid-gid filename uid gid))) + ;; Set extended attributes. We ignore possible errors, + ;; because ACL strings could be incompatible. + (when attributes + (ignore-errors + (set-file-extended-attributes filename attributes))) + ;; Unlock file. (when file-locked ;; `unlock-file' exists since Emacs 28.1. commit a4a229dfff3ede3d083ba874a4119db501118063 Author: Po Lu Date: Thu May 12 14:55:41 2022 +0800 Fix merging of anonymous faces with an `:extend' property on unexec * src/emacs.c (main): Unconditionally call `init_xfaces'. * src/lisp.h: Enable `init_xfaces' on unexec builds too. * src/xfaces.c (init_xfaces): Move fix for bug#34226 into pdumper-specific section leaving the initialization of `face_attr_sym' intact. diff --git a/src/emacs.c b/src/emacs.c index ca99a8c787..fe138366f3 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1952,15 +1952,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_threads (); init_eval (); #ifdef HAVE_PGTK - init_pgtkterm (); /* before init_atimer(). */ + init_pgtkterm (); /* Must come before `init_atimer'. */ #endif running_asynch_code = 0; init_random (); - -#ifdef HAVE_PDUMPER - if (dumped_with_pdumper_p ()) - init_xfaces (); -#endif + init_xfaces (); #if defined HAVE_JSON && !defined WINDOWSNT init_json (); diff --git a/src/lisp.h b/src/lisp.h index b00f3f7e2e..e76a36d269 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5093,9 +5093,7 @@ extern void syms_of_w32cygwinx (void); extern Lisp_Object Vface_alternative_font_family_alist; extern Lisp_Object Vface_alternative_font_registry_alist; extern void syms_of_xfaces (void); -#ifdef HAVE_PDUMPER extern void init_xfaces (void); -#endif #ifdef HAVE_X_WINDOWS /* Defined in xfns.c. */ diff --git a/src/xfaces.c b/src/xfaces.c index 05e0df4b7d..7395ce157e 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -6871,7 +6871,6 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources, Initialization ***********************************************************************/ -#ifdef HAVE_PDUMPER /* All the faces defined during loadup are recorded in face-new-frame-defaults. We need to set next_lface_id to the next face ID number, so that any new faces defined in this session will @@ -6881,26 +6880,35 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources, void init_xfaces (void) { - int nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults)); - if (nfaces > 0) - { - /* Allocate the lface_id_to_name[] array. */ - lface_id_to_name_size = next_lface_id = nfaces; - lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name); +#ifdef HAVE_PDUMPER + int nfaces; - /* Store the faces. */ - struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults); - for (ptrdiff_t idx = 0; idx < nfaces; ++idx) + if (dumped_with_pdumper_p ()) + { + nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults)); + if (nfaces > 0) { - Lisp_Object lface = HASH_KEY (table, idx); - Lisp_Object face_id = CAR (HASH_VALUE (table, idx)); - if (FIXNATP (face_id)) { - int id = XFIXNAT (face_id); - eassert (id >= 0); - lface_id_to_name[id] = lface; - } + /* Allocate the lface_id_to_name[] array. */ + lface_id_to_name_size = next_lface_id = nfaces; + lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name); + + /* Store the faces. */ + struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults); + for (ptrdiff_t idx = 0; idx < nfaces; ++idx) + { + Lisp_Object lface = HASH_KEY (table, idx); + Lisp_Object face_id = CAR (HASH_VALUE (table, idx)); + if (FIXNATP (face_id)) + { + int id = XFIXNAT (face_id); + eassert (id >= 0); + lface_id_to_name[id] = lface; + } + } } } +#endif + face_attr_sym[0] = Qface; face_attr_sym[LFACE_FOUNDRY_INDEX] = QCfoundry; face_attr_sym[LFACE_SWIDTH_INDEX] = QCwidth; @@ -6921,7 +6929,6 @@ init_xfaces (void) face_attr_sym[LFACE_DISTANT_FOREGROUND_INDEX] = QCdistant_foreground; face_attr_sym[LFACE_EXTEND_INDEX] = QCextend; } -#endif void syms_of_xfaces (void) commit 5743b74d4b2e06ace233d6b170f193a72633f218 Author: Po Lu Date: Thu May 12 13:31:08 2022 +0800 Improve mouse dragging * lisp/mouse.el (mouse-drag-and-drop-region-display-tooltip): Respect foreground and background parameters. (mouse-drag-and-drop-region): Enable fine grained tracking. diff --git a/lisp/mouse.el b/lisp/mouse.el index 0446bc6dd8..4b5f6ed223 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -3017,7 +3017,15 @@ highlight the original region when "Display TOOLTIP, a tooltip string, using `x-show-tip'. Call `tooltip-show-help-non-mode' instead on non-graphical displays." (if (display-graphic-p) - (x-show-tip tooltip) + (let ((params (copy-sequence tooltip-frame-parameters)) + (fg (face-attribute 'tooltip :foreground)) + (bg (face-attribute 'tooltip :background))) + (when (stringp fg) + (setf (alist-get 'foreground-color params) fg) + (setf (alist-get 'border-color params) fg)) + (when (stringp bg) + (setf (alist-get 'background-color params) bg)) + (x-show-tip tooltip nil params)) (tooltip-show-help-non-mode tooltip))) (declare-function x-hide-tip "xfns.c") @@ -3059,6 +3067,7 @@ is copied instead of being cut." (cdr bounds))) (region-bounds))) (region-noncontiguous (region-noncontiguous-p)) + (mouse-fine-grained-tracking t) ;; Whether or not some text was ``cut'' from Emacs to another ;; program and the cleaanup code should not try modifying the ;; region. commit 7d0d87ec51f066aaa27cd3d2d995d56f1f41c67c Author: Eli Zaretskii Date: Thu May 12 09:47:25 2022 +0300 ; Improve documentation of 'restore-buffer-modified-p' * src/buffer.c (Frestore_buffer_modified_p): * doc/lispref/buffers.texi (Buffer Modification): Fix doc wording. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 9f3808a45b..1cbe8bc093 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -566,9 +566,9 @@ function @code{force-mode-line-update} works by doing this: @defun restore-buffer-modified-p flag Like @code{set-buffer-modified-p}, but does not force redisplay of -mode lines. This function also allows a @var{flag} value of -@code{autosaved}, which also marks the buffer as having been autosaved -after the last modification. +mode lines. This function also allows @var{flag}'s value to be +the symbol @code{autosaved}, which marks the buffer as modified and +auto-saved after the last modification. @end defun @deffn Command not-modified &optional arg diff --git a/src/buffer.c b/src/buffer.c index 89b04a4280..57137b2a06 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1449,8 +1449,8 @@ DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p, doc: /* Like `set-buffer-modified-p', but doesn't redisplay buffer's mode line. A nil FLAG means to mark the buffer as unmodified. A non-nil FLAG means mark the buffer as modified. A special value of `autosaved' -will mark the buffer modified, and also as having been autosaved since -it was last modified. +will mark the buffer as modified and also as autosaved since it was +last modified. This function also locks or unlocks the file visited by the buffer, if both `buffer-file-truename' and `buffer-file-name' are non-nil. commit 36e84d228965b08c9a1e95e8e661bd50df4713be Author: Eli Zaretskii Date: Thu May 12 09:29:53 2022 +0300 ; Improve documentation of 'switch-to-prev-buffer-skip-regexp' * lisp/window.el (switch-to-prev-buffer-skip-regexp): * etc/NEWS: * doc/lispref/windows.texi (Window History): Improve wording of the documentation of 'switch-to-prev-buffer-skip-regexp'. (Bug#19070) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f0d5f9fc20..4ff71a3575 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4174,9 +4174,9 @@ these functions can switch to. @end defopt @defopt switch-to-prev-buffer-skip-regexp -This user option should be either a regular expression, or a list of -regular expressions, and buffers that have names that match this -option will be ignored by @code{switch-to-prev-buffer} and +This user option should be either a regular expression or a list of +regular expressions. Buffers whose names match one of those regular +expressions will be ignored by @code{switch-to-prev-buffer} and @code{switch-to-next-buffer} (except when there's no other buffer to switch to). @end defopt diff --git a/etc/NEWS b/etc/NEWS index 258fa499b7..3bdc497f18 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -258,8 +258,8 @@ startup. Previously, these functions ignored +++ *** New user option 'switch-to-prev-buffer-skip-regexp'. -This should be a regexp or a list of regexps, and buffers with names -matching this will be ignored by 'switch-to-prev-buffer' and +This should be a regexp or a list of regexps; buffers whose names +match those regexps will be ignored by 'switch-to-prev-buffer' and 'switch-to-next-buffer'. ** Menus diff --git a/lisp/window.el b/lisp/window.el index 1495b2e0ad..0787e6390c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4592,10 +4592,10 @@ Also see `switch-to-prev-buffer-skip-regexp'." :group 'windows) (defcustom switch-to-prev-buffer-skip-regexp nil - "Regexp matching buffers that should be skipped by `switch-to-prev-buffer'. -This also affects `switch-to-next-buffer'. - -This can either be a regexp or a list of regexps. + "Buffers that `switch-to-prev-buffer' and `switch-to-next-buffer' should skip. +The value can either be a regexp or a list of regexps. Buffers whose +names match these regexps are skipped by `switch-to-prev-buffer' +and `switch-to-next-buffer'. Also see `switch-to-prev-buffer-skip'." :type '(choice regexp commit ba20b68d558e67fe72cb47398e4decf261c45d7a Author: Eli Zaretskii Date: Thu May 12 09:16:24 2022 +0300 ; Improve documentation of 'imenu-flush-cache' * etc/NEWS: Expand the description of 'imenu-flush-cache'. * doc/emacs/programs.texi (Imenu): Document 'imenu-flush-cache'. * lisp/imenu.el (imenu-flush-cache): Doc fix. (Bug#20589) diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 45bc4c79b4..2b27d4e13c 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -250,10 +250,10 @@ where it treats each chapter, section, etc., as a definition. together.) @findex imenu - If you type @kbd{M-g i}, it reads the name of a definition using the -minibuffer, then moves point to that definition. You can use -completion to specify the name; the command always displays the whole -list of valid names. + If you type @kbd{M-g i} (@code{imenu}), it reads the name of a +definition using the minibuffer, then moves point to that definition. +You can use completion to specify the name; the command always +displays the whole list of valid names. @findex imenu-add-menubar-index Alternatively, you can bind the command @code{imenu} to a mouse @@ -280,6 +280,11 @@ 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 cf2ae19ce7..258fa499b7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -667,6 +667,8 @@ available options can be restored by enabling this option. --- *** New command '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. * Editing Changes in Emacs 29.1 diff --git a/lisp/imenu.el b/lisp/imenu.el index e452b1bb8b..a08c58f682 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -900,7 +900,9 @@ for more information." (_ (error "Unknown imenu item: %S" index-item))))) (defun imenu-flush-cache () - "Flush the current imenu cache." + "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")) commit ec1a14ab331c0abc57bc34972a8a6f69c6ffa17a Author: Po Lu Date: Thu May 12 04:11:12 2022 +0000 Make cursor display on Haiku consistent with X * src/haikuterm.c (haiku_draw_image_glyph_string): Merge cursor foregrounds correctly. (haiku_draw_hollow_cursor, haiku_draw_bar_cursor): New functions. Port code from X. (haiku_draw_window_cursor): Port code from X so bar cursors on top of images are treated right. diff --git a/src/haikuterm.c b/src/haikuterm.c index 58855d07fb..b74584e2dc 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -1631,12 +1631,13 @@ static void haiku_draw_image_glyph_string (struct glyph_string *s) { struct face *face = s->face; - + void *view, *bitmap, *mask; int box_line_hwidth = max (face->box_vertical_line_width, 0); int box_line_vwidth = max (face->box_horizontal_line_width, 0); - - int x, y; - int height, width; + int x, y, height, width, relief; + struct haiku_rect nr; + Emacs_Rectangle cr, ir, r; + unsigned long background; height = s->height; if (s->slice.y == 0) @@ -1657,20 +1658,22 @@ haiku_draw_image_glyph_string (struct glyph_string *s) if (s->slice.y == 0) y += box_line_vwidth; - void *view = FRAME_HAIKU_VIEW (s->f); - void *bitmap = s->img->pixmap; + view = FRAME_HAIKU_VIEW (s->f); + bitmap = s->img->pixmap; /* TODO: implement stipples for images with masks. */ s->stippled_p = face->stipple != 0; - BView_SetHighColor (view, face->background); + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, NULL, &background); + else + background = face->background; + + BView_SetHighColor (view, background); BView_FillRectangle (view, x, y, width, height); if (bitmap) { - struct haiku_rect nr; - Emacs_Rectangle cr, ir, r; - get_glyph_string_clip_rect (s, &nr); CONVERT_TO_EMACS_RECT (cr, nr); x = s->x; @@ -1692,7 +1695,7 @@ haiku_draw_image_glyph_string (struct glyph_string *s) ir.height = s->slice.height; r = ir; - void *mask = s->img->mask; + mask = s->img->mask; if (gui_intersect_rectangles (&cr, &ir, &r)) { @@ -1726,11 +1729,25 @@ haiku_draw_image_glyph_string (struct glyph_string *s) BBitmap_free (bitmap); } - if (s->hl == DRAW_CURSOR) + if (!s->img->mask) { - BView_SetPenSize (view, 1); - BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); - BView_StrokeRectangle (view, r.x, r.y, r.width, r.height); + /* When the image has a mask, we can expect that at + least part of a mouse highlight or a block cursor will + be visible. If the image doesn't have a mask, make + a block cursor visible by drawing a rectangle around + the image. I believe it's looking better if we do + nothing here for mouse-face. */ + + if (s->hl == DRAW_CURSOR) + { + relief = eabs (s->img->relief); + + BView_SetPenSize (view, 1); + BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + BView_StrokeRectangle (view, x - relief, y - relief, + s->slice.width + relief * 2, + s->slice.height + relief * 2); + } } } @@ -2000,132 +2017,201 @@ haiku_set_window_size (struct frame *f, bool change_gravity, } static void -haiku_draw_window_cursor (struct window *w, - struct glyph_row *glyph_row, - int x, int y, - enum text_cursor_kinds cursor_type, - int cursor_width, bool on_p, bool active_p) +haiku_draw_hollow_cursor (struct window *w, struct glyph_row *row) { - struct frame *f = XFRAME (WINDOW_FRAME (w)); - struct face *face; - struct glyph *phys_cursor_glyph; + struct frame *f; + int x, y, wd, h; struct glyph *cursor_glyph; + uint32_t foreground; + void *view; - void *view = FRAME_HAIKU_VIEW (f); - - int fx, fy, h, cursor_height; + f = XFRAME (WINDOW_FRAME (w)); + view = FRAME_HAIKU_VIEW (f); - if (!on_p) + /* Get the glyph the cursor is on. If we can't tell because + the current matrix is invalid or such, give up. */ + cursor_glyph = get_phys_cursor_glyph (w); + if (cursor_glyph == NULL) return; - if (cursor_type == NO_CURSOR) - { - w->phys_cursor_width = 0; - return; - } + /* Compute frame-relative coordinates for phys cursor. */ + get_phys_cursor_geometry (w, row, cursor_glyph, &x, &y, &h); + wd = w->phys_cursor_width; - w->phys_cursor_on_p = true; - w->phys_cursor_type = cursor_type; + /* The foreground of cursor_gc is typically the same as the normal + background color, which can cause the cursor box to be invisible. */ + foreground = FRAME_CURSOR_COLOR (f).pixel; - phys_cursor_glyph = get_phys_cursor_glyph (w); + /* When on R2L character, show cursor at the right edge of the + glyph, unless the cursor box is as wide as the glyph or wider + (the latter happens when x-stretch-cursor is non-nil). */ + if ((cursor_glyph->resolved_level & 1) != 0 + && cursor_glyph->pixel_width > wd) + x += cursor_glyph->pixel_width - wd; - if (!phys_cursor_glyph) - { - if (glyph_row->exact_window_width_line_p - && w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]) - { - glyph_row->cursor_in_fringe_p = 1; - draw_fringe_bitmap (w, glyph_row, 0); - } - return; - } + /* Set clipping, draw the rectangle, and reset clipping again. + This also marks the region as invalidated. */ - get_phys_cursor_geometry (w, glyph_row, phys_cursor_glyph, &fx, &fy, &h); + BView_draw_lock (view, true, x, y, wd, h); + BView_StartClip (view); + haiku_clip_to_row (w, row, TEXT_AREA); - if (cursor_type == BAR_CURSOR) + /* Now set the foreground color and pen size. */ + BView_SetHighColor (view, foreground); + BView_SetPenSize (view, 1); + + /* Actually draw the rectangle. */ + BView_StrokeRectangle (view, x, y, wd, h); + + /* Reset clipping. */ + BView_EndClip (view); + BView_draw_unlock (view); +} + +static void +haiku_draw_bar_cursor (struct window *w, struct glyph_row *row, + int width, enum text_cursor_kinds kind) +{ + struct frame *f; + struct glyph *cursor_glyph; + struct glyph_row *r; + struct face *face; + uint32_t foreground; + void *view; + int x, y, dummy_x, dummy_y, dummy_h; + + f = XFRAME (w->frame); + + /* If cursor is out of bounds, don't draw garbage. This can happen + in mini-buffer windows when switching between echo area glyphs + and mini-buffer. */ + cursor_glyph = get_phys_cursor_glyph (w); + if (cursor_glyph == NULL) + return; + + /* If on an image, draw like a normal cursor. That's usually better + visible than drawing a bar, esp. if the image is large so that + the bar might not be in the window. */ + if (cursor_glyph->type == IMAGE_GLYPH) { - if (cursor_width < 1) - cursor_width = max (FRAME_CURSOR_WIDTH (f), 1); - if (cursor_width < w->phys_cursor_width) - w->phys_cursor_width = cursor_width; + r = MATRIX_ROW (w->current_matrix, w->phys_cursor.vpos); + draw_phys_cursor_glyph (w, r, DRAW_CURSOR); } - else if (cursor_type == HBAR_CURSOR) + else { - cursor_height = (cursor_width < 1) ? lrint (0.25 * h) : cursor_width; - if (cursor_height > glyph_row->height) - cursor_height = glyph_row->height; - if (h > cursor_height) - fy += h - cursor_height; - h = cursor_height; - } + view = FRAME_HAIKU_VIEW (f); + face = FACE_FROM_ID (f, cursor_glyph->face_id); - BView_draw_lock (view, false, 0, 0, 0, 0); - BView_StartClip (view); + /* If the glyph's background equals the color we normally draw + the bars cursor in, the bar cursor in its normal color is + invisible. Use the glyph's foreground color instead in this + case, on the assumption that the glyph's colors are chosen so + that the glyph is legible. */ + if (face->background == FRAME_CURSOR_COLOR (f).pixel) + foreground = face->foreground; + else + foreground = FRAME_CURSOR_COLOR (f).pixel; - if (cursor_type == BAR_CURSOR) - { - cursor_glyph = get_phys_cursor_glyph (w); - face = FACE_FROM_ID (f, cursor_glyph->face_id); - } + BView_draw_lock (view, false, 0, 0, 0, 0); + BView_StartClip (view); + BView_SetHighColor (view, foreground); + haiku_clip_to_row (w, row, TEXT_AREA); - /* If the glyph's background equals the color we normally draw the - bar cursor in, our cursor in its normal color is invisible. Use - the glyph's foreground color instead in this case, on the - assumption that the glyph's colors are chosen so that the glyph - is legible. */ + if (kind == BAR_CURSOR) + { + x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x); + y = WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y); - /* xterm.c only does this for bar cursors, and nobody has - complained, so it would be best to do that here as well. */ - if (cursor_type == BAR_CURSOR - && face->background == FRAME_CURSOR_COLOR (f).pixel) - BView_SetHighColor (view, face->foreground); - else - BView_SetHighColor (view, FRAME_CURSOR_COLOR (f).pixel); - haiku_clip_to_row (w, glyph_row, TEXT_AREA); + if (width < 0) + width = FRAME_CURSOR_WIDTH (f); + width = min (cursor_glyph->pixel_width, width); - switch (cursor_type) - { - default: - case DEFAULT_CURSOR: - case NO_CURSOR: - break; + w->phys_cursor_width = width; - case HBAR_CURSOR: - BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); - BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); - break; + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + if ((cursor_glyph->resolved_level & 1) != 0) + x += cursor_glyph->pixel_width - width; - case BAR_CURSOR: - if (cursor_glyph->resolved_level & 1) + BView_FillRectangle (view, x, y, width, row->height); + BView_invalidate_region (view, x, y, width, row->height); + } + else /* HBAR_CURSOR */ { - BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, - fy, w->phys_cursor_width, h); - BView_invalidate_region (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, - fy, w->phys_cursor_width, h); + x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x); + y = WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y + + row->height - width); + + if (width < 0) + width = row->height; + + width = min (row->height, width); + + get_phys_cursor_geometry (w, row, cursor_glyph, &dummy_x, + &dummy_y, &dummy_h); + + if ((cursor_glyph->resolved_level & 1) != 0 + && cursor_glyph->pixel_width > w->phys_cursor_width - 1) + x += cursor_glyph->pixel_width - w->phys_cursor_width + 1; + + BView_FillRectangle (view, x, y, w->phys_cursor_width - 1, + width); + BView_invalidate_region (view, x, y, w->phys_cursor_width - 1, + width); } - else - BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); - BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); - break; + BView_EndClip (view); + BView_draw_unlock (view); + } +} - case HOLLOW_BOX_CURSOR: - if (phys_cursor_glyph->type != IMAGE_GLYPH) +static void +haiku_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, + int x, int y, enum text_cursor_kinds cursor_type, + int cursor_width, bool on_p, bool active_p) +{ + if (on_p) + { + w->phys_cursor_type = cursor_type; + w->phys_cursor_on_p = true; + + if (glyph_row->exact_window_width_line_p + && (glyph_row->reversed_p + ? (w->phys_cursor.hpos < 0) + : (w->phys_cursor.hpos >= glyph_row->used[TEXT_AREA]))) { - BView_SetPenSize (view, 1); - BView_StrokeRectangle (view, fx, fy, w->phys_cursor_width, h); + glyph_row->cursor_in_fringe_p = true; + draw_fringe_bitmap (w, glyph_row, glyph_row->reversed_p); } else - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + { + switch (cursor_type) + { + case HOLLOW_BOX_CURSOR: + haiku_draw_hollow_cursor (w, glyph_row); + break; - BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); - break; + case FILLED_BOX_CURSOR: + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + break; + + case BAR_CURSOR: + haiku_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR); + break; + + case HBAR_CURSOR: + haiku_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR); + break; - case FILLED_BOX_CURSOR: - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + case NO_CURSOR: + w->phys_cursor_width = 0; + break; + + default: + emacs_abort (); + } + } } - BView_EndClip (view); - BView_draw_unlock (view); } static void commit e2bb618ea7599548d8f6e0f9e23db5a15a90d8ac Author: Lars Ingebrigtsen Date: Thu May 12 04:44:47 2022 +0200 Fix cperl-file-style defcustom type * lisp/progmodes/cperl-mode.el (cperl-file-style): Fix the type. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5ed4832481..4804b13ded 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -567,7 +567,8 @@ This way enabling/disabling of menu items is more correct." (const "C++") (const "K&R") (const "BSD") - (const "Whitesmith")) + (const "Whitesmith") + (const :tag "Default" nil)) :version "29.1") ;;;###autoload(put 'cperl-file-style 'safe-local-variable 'stringp) commit 2e2efe77226453ef76abc18f38a38b3fe069d314 Author: Po Lu Date: Thu May 12 02:29:15 2022 +0000 Clean up Haiku display opening code * src/haikufns.c (Fx_open_connection): (Fhaiku_frame_list_z_order): Improve error messages and fix coding style. diff --git a/src/haikufns.c b/src/haikufns.c index 0abb418895..13432785bd 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1998,34 +1998,28 @@ DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, } DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, - 1, 3, 0, - doc: /* SKIP: real doc in xfns.c. */) + 1, 3, 0, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) { - struct haiku_display_info *dpyinfo; CHECK_STRING (display); if (NILP (Fstring_equal (display, build_string ("be")))) { if (!NILP (must_succeed)) - fatal ("Bad display"); + fatal ("Invalid display %s", SDATA (display)); else - error ("Bad display"); + signal_error ("Invalid display", display); } if (x_display_list) - return Qnil; - - dpyinfo = haiku_term_init (); - - if (!dpyinfo) { if (!NILP (must_succeed)) - fatal ("Display not responding"); + fatal ("A display is already open"); else - error ("Display not responding"); + error ("A display is already open"); } + haiku_term_init (); return Qnil; } @@ -2687,6 +2681,7 @@ Frames are listed from topmost (first) to bottommost (last). */) if (NILP (sel)) return frames; + return Fcons (sel, frames); } commit 30fa6da5529f80df25fcba49d10cd8a806774868 Author: Lars Ingebrigtsen Date: Thu May 12 04:24:32 2022 +0200 Add new command 'imenu-flush-cache' * lisp/imenu.el (imenu-flush-cache): New command (bug#20589). diff --git a/etc/NEWS b/etc/NEWS index 672260ca82..cf2ae19ce7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -660,8 +660,13 @@ Rcirc will use the default 'completion-at-point' mechanism. The conventional IRC behaviour of completing by cycling through the available options can be restored by enabling this option. +** imenu + +++ -** 'imenu' is now bound to 'M-g i' globally. +*** 'imenu' is now bound to 'M-g i' globally. + +--- +*** New command 'imenu-flush-cache'. * Editing Changes in Emacs 29.1 diff --git a/lisp/imenu.el b/lisp/imenu.el index a87860f006..e452b1bb8b 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -899,6 +899,12 @@ for more information." (`(,name . ,pos) (imenu (list name pos imenu-default-goto-function))) (_ (error "Unknown imenu item: %S" index-item))))) +(defun imenu-flush-cache () + "Flush the current imenu cache." + (interactive) + (setq imenu--index-alist nil) + (message "Flushed the imenu cache")) + (provide 'imenu) ;;; imenu.el ends here commit 42001f843bb7ca687bf5096543a5d478dab38b87 Author: Lars Ingebrigtsen Date: Thu May 12 03:59:16 2022 +0200 New command 'package-update-all' * lisp/emacs-lisp/package.el (package-update-all): New function (bug#19146). (package--updateable-packages): Factored out... (package-update): ... from here. diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index fc2a093ec4..eb4f5b0eda 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -329,12 +329,14 @@ version of the package, a newer version is also installed. @findex package-install @findex package-update +@findex package-update-all Packages are most conveniently installed using the package menu (@pxref{Package Menu}), but you can also use the command @kbd{M-x package-install}. This prompts for the name of a package with the @samp{available} status, then downloads and installs it. Similarly, if you want to update a package, you can use the @kbd{M-x -package-update} command. +package-update} command, and if you just want to update all the +packages, you can use the @kbd{M-x package-update-all} command. @cindex package requirements A package may @dfn{require} certain other packages to be installed, diff --git a/etc/NEWS b/etc/NEWS index d9777eecd6..672260ca82 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -829,6 +829,10 @@ this includes "binary" buffers like 'archive-mode' and 'image-mode'. ** Package ++++ +*** New command 'package-update-all'. +This command allows updating all packages without any queries. + +++ *** New command 'package-update'. This command allows you to upgrade packages without using 'M-x diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c1e14a4acb..72b22a6556 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2140,26 +2140,44 @@ to install it but still mark it as selected." (defun package-update (name) "Update package NAME if a newer version exists." (interactive - (progn - ;; Initialize the package system to get the list of package - ;; symbols for completion. - (package--archives-initialize) - (list (completing-read - "Update package: " - (mapcar - #'car - (seq-filter - (lambda (elt) - (let ((available - (assq (car elt) package-archive-contents))) - (and available - (version-list-< - (package-desc-priority-version (cadr elt)) - (package-desc-priority-version (cadr available)))))) - package-alist)) - nil t)))) - (package-delete (cadr (assq (intern name) package-alist)) 'force) - (package-install (intern name) 'dont-select)) + (list (completing-read + "Update package: " (package--updateable-packages) nil t))) + (let ((package (if (symbolp name) + name + (intern name)))) + (package-delete (cadr (assq package package-alist)) 'force) + (package-install package 'dont-select))) + +(defun package--updateable-packages () + ;; Initialize the package system to get the list of package + ;; symbols for completion. + (package--archives-initialize) + (mapcar + #'car + (seq-filter + (lambda (elt) + (let ((available + (assq (car elt) package-archive-contents))) + (and available + (version-list-< + (package-desc-priority-version (cadr elt)) + (package-desc-priority-version (cadr available)))))) + package-alist))) + +(defun package-update-all (&optional inhibit-queries) + "Upgrade all packages." + (interactive "P") + (let ((updateable (package--updateable-packages))) + (if (not updateable) + (message "No packages to update") + (when (and (not inhibit-queries) + (not (yes-or-no-p + (if (length= updateable 1) + "One package to update. Do it? " + (format "%s packages to update. Do it?" + (length updateable)))))) + (user-error "Updating aborted")) + (mapc #'package-update updateable)))) (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. commit 2dc996a95dce3435ff50017bfc4e3a7609e594df Author: Po Lu Date: Thu May 12 09:36:43 2022 +0800 Port some stuff to XCB to avoid confusing Xlib behavior * src/xterm.c (x_set_frame_alpha, handle_one_xevent): Port retrieving the opacity property to XCB. diff --git a/src/xterm.c b/src/xterm.c index 1c2b727c0f..5c5de191dc 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5310,6 +5310,20 @@ x_set_frame_alpha (struct frame *f) unsigned long opac; Window parent; +#ifndef USE_XCB + unsigned char *data = NULL; + Atom actual; + int rc, format; + unsigned long n, left; + unsigned long value; +#else + xcb_get_property_cookie_t opacity_cookie; + xcb_get_property_reply_t *opacity_reply; + xcb_generic_error_t *error; + bool rc; + uint32_t value; +#endif + if (dpyinfo->highlight_frame == f) alpha = f->alpha[0]; else @@ -5348,11 +5362,7 @@ x_set_frame_alpha (struct frame *f) /* return unless necessary */ { - unsigned char *data = NULL; - Atom actual; - int rc, format; - unsigned long n, left; - +#ifndef USE_XCB rc = XGetWindowProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, 0, 1, False, XA_CARDINAL, &actual, &format, &n, &left, @@ -5361,7 +5371,7 @@ x_set_frame_alpha (struct frame *f) if (rc == Success && actual != None && n && format == XA_CARDINAL && data) { - unsigned long value = *(unsigned long *) data; + value = *(unsigned long *) data; /* Xlib sign-extends values greater than 0x7fffffff on 64-bit machines. Get the low bits by ourself. */ @@ -5378,6 +5388,37 @@ x_set_frame_alpha (struct frame *f) if (data) XFree (data); +#else + /* Avoid the confusing Xlib sign-extension mess by using XCB + instead. */ + opacity_cookie + = xcb_get_property (dpyinfo->xcb_connection, 0, (xcb_window_t) win, + (xcb_atom_t) dpyinfo->Xatom_net_wm_window_opacity, + XCB_ATOM_CARDINAL, 0, 1); + opacity_reply + = xcb_get_property_reply (dpyinfo->xcb_connection, + opacity_cookie, &error); + + rc = opacity_reply; + + if (!opacity_reply) + free (error); + else + { + rc = (opacity_reply->format == 32 + && opacity_reply->type == XCB_ATOM_CARDINAL + && (xcb_get_property_value_length (opacity_reply) >= 4)); + + if (rc) + value = *(uint32_t *) xcb_get_property_value (opacity_reply); + } + + if (opacity_reply) + free (opacity_reply); + + if (rc && value == opac) + return; +#endif } XChangeProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, @@ -14924,12 +14965,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, && (event->xproperty.atom == dpyinfo->Xatom_net_wm_window_opacity)) { +#ifndef USE_XCB int rc, actual_format; Atom actual; unsigned char *tmp_data; unsigned long n, left, opacity; tmp_data = NULL; +#else + xcb_get_property_cookie_t opacity_cookie; + xcb_get_property_reply_t *opacity_reply; + xcb_generic_error_t *error; + bool rc; + uint32_t value; +#endif if (event->xproperty.state == PropertyDelete) { @@ -14940,6 +14989,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } else { +#ifndef USE_XCB rc = XGetWindowProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), dpyinfo->Xatom_net_wm_window_opacity, 0, 1, False, AnyPropertyType, &actual, @@ -14966,10 +15016,50 @@ handle_one_xevent (struct x_display_info *dpyinfo, store_frame_param (f, Qalpha, Qnil); } +#else + opacity_cookie + = xcb_get_property (dpyinfo->xcb_connection, 0, + (xcb_window_t) FRAME_OUTER_WINDOW (f), + (xcb_atom_t) dpyinfo->Xatom_net_wm_window_opacity, + XCB_ATOM_CARDINAL, 0, 1); + opacity_reply + = xcb_get_property_reply (dpyinfo->xcb_connection, + opacity_cookie, &error); + + if (!opacity_reply) + free (error), rc = false; + else + rc = (opacity_reply->format == 32 + && (opacity_reply->type == XCB_ATOM_CARDINAL + || opacity_reply->type == XCB_ATOM_ATOM + || opacity_reply->type == XCB_ATOM_WINDOW) + && (xcb_get_property_value_length (opacity_reply) >= 4)); + + if (rc) + { + value = *(uint32_t *) xcb_get_property_value (opacity_reply); + + f->alpha[0] = (double) value / (double) OPAQUE; + f->alpha[1] = (double) value / (double) OPAQUE; + store_frame_param (f, Qalpha, make_float (f->alpha[0])); + } + else + { + f->alpha[0] = 1.0; + f->alpha[1] = 1.0; + + store_frame_param (f, Qalpha, Qnil); + } + + if (opacity_reply) + free (opacity_reply); +#endif } +#ifndef USE_XCB if (tmp_data) XFree (tmp_data); +#endif } if (event->xproperty.window == dpyinfo->root_window commit 0d0dc1af591c2cb687462e88631561fbf2690ba4 Author: Lars Ingebrigtsen Date: Thu May 12 03:35:21 2022 +0200 Add new user option switch-to-prev-buffer-skip-regexp * doc/lispref/windows.texi (Window History): Document it. * lisp/window.el (switch-to-prev-buffer-skip): Mention it. (switch-to-prev-buffer-skip-regexp): New user option (bug#19070). (switch-to-prev-buffer-skip-p): Use it. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 57763c146d..f0d5f9fc20 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4173,6 +4173,13 @@ ignore this option, for example, when there is only one buffer left these functions can switch to. @end defopt +@defopt switch-to-prev-buffer-skip-regexp +This user option should be either a regular expression, or a list of +regular expressions, and buffers that have names that match this +option will be ignored by @code{switch-to-prev-buffer} and +@code{switch-to-next-buffer} (except when there's no other buffer to +switch to). +@end defopt @node Dedicated Windows @section Dedicated Windows diff --git a/etc/NEWS b/etc/NEWS index 5e4e2e98ec..d9777eecd6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -256,6 +256,12 @@ startup. Previously, these functions ignored * Changes in Emacs 29.1 ++++ +*** New user option 'switch-to-prev-buffer-skip-regexp'. +This should be a regexp or a list of regexps, and buffers with names +matching this will be ignored by 'switch-to-prev-buffer' and +'switch-to-next-buffer'. + ** Menus --- diff --git a/lisp/window.el b/lisp/window.el index dd16b83377..1495b2e0ad 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4578,7 +4578,9 @@ as well. In that case, if this option specifies a function, it will be called with the third argument nil. Under certain circumstances `switch-to-prev-buffer' may ignore -this option, for example, when there is only one buffer left." +this option, for example, when there is only one buffer left. + +Also see `switch-to-prev-buffer-skip-regexp'." :type '(choice (const :tag "Never" nil) (const :tag "This frame" this) @@ -4589,16 +4591,37 @@ this option, for example, when there is only one buffer left." :version "27.1" :group 'windows) +(defcustom switch-to-prev-buffer-skip-regexp nil + "Regexp matching buffers that should be skipped by `switch-to-prev-buffer'. +This also affects `switch-to-next-buffer'. + +This can either be a regexp or a list of regexps. + +Also see `switch-to-prev-buffer-skip'." + :type '(choice regexp + (repeat regexp)) + :version "29.1" + :group 'windows) + (defun switch-to-prev-buffer-skip-p (skip window buffer &optional bury-or-kill) "Return non-nil if `switch-to-prev-buffer' should skip BUFFER. SKIP is a value derived from `switch-to-prev-buffer-skip', WINDOW the window `switch-to-prev-buffer' acts upon. Optional argument BURY-OR-KILL is passed unchanged by `switch-to-prev-buffer' and omitted in calls from `switch-to-next-buffer'." - (when skip - (if (functionp skip) - (funcall skip window buffer bury-or-kill) - (get-buffer-window buffer skip)))) + (or (and skip + (if (functionp skip) + (funcall skip window buffer bury-or-kill) + (get-buffer-window buffer skip))) + (and switch-to-prev-buffer-skip-regexp + (or (and (stringp switch-to-prev-buffer-skip-regexp) + (string-match-p switch-to-prev-buffer-skip-regexp + (buffer-name buffer))) + (and (consp switch-to-prev-buffer-skip-regexp) + (catch 'found + (dolist (regexp switch-to-prev-buffer-skip-regexp) + (when (string-match-p regexp (buffer-name buffer)) + (throw 'tag t))))))))) (defun switch-to-prev-buffer (&optional window bury-or-kill) "In WINDOW switch to previous buffer. commit c74e7f801ec353a52faf59e76245834198abeb28 Author: Lars Ingebrigtsen Date: Thu May 12 03:09:22 2022 +0200 Bind TAB in indent-rigidly-map as a convenience * lisp/indent.el (indent-rigidly): Mention it. (indent-rigidly-map): Bind TAB so that `C-x TAB TAB...' does the logical thing. diff --git a/lisp/indent.el b/lisp/indent.el index 0343439d14..d6dee94016 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -240,21 +240,23 @@ Blank lines are ignored." (current-indentation)))) indent)))) -(defvar indent-rigidly-map - (let ((map (make-sparse-keymap))) - (define-key map [left] 'indent-rigidly-left) - (define-key map [right] 'indent-rigidly-right) - (define-key map [S-left] 'indent-rigidly-left-to-tab-stop) - (define-key map [S-right] 'indent-rigidly-right-to-tab-stop) - map) - "Transient keymap for adjusting indentation interactively. -It is activated by calling `indent-rigidly' interactively.") +(defvar-keymap indent-rigidly-map + :doc "Transient keymap for adjusting indentation interactively. +It is activated by calling `indent-rigidly' interactively." + "TAB" #'indent-rigidly-right + "" #'indent-rigidly-left + "" #'indent-rigidly-right + "S-" #'indent-rigidly-left-to-tab-stop + "S-" #'indent-rigidly-right-to-tab-stop) +(put 'indent-rigidly-right :advertised-binding (kbd "")) (defun indent-rigidly (start end arg &optional interactive) "Indent all lines starting in the region. If called interactively with no prefix argument, activate a transient mode in which the indentation can be adjusted interactively by typing \\\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]. +In addition, \\`TAB' is also bound (and calls `indent-rigidly-right'). + Typing any other key exits this mode, and this key is then acted upon as normally. If `transient-mark-mode' is enabled, exiting also deactivates the mark. commit 69d3a84c8326e12a37d4f4f5acd7616b35143335 Author: Po Lu Date: Thu May 12 09:07:59 2022 +0800 Only handle SelectionRequest events from the DND display during DND * src/xterm.c (handle_one_xevent): Handle only SelectionRequest events from the DND frame's display via hold_quit. diff --git a/src/xterm.c b/src/xterm.c index a250fce9b0..1c2b727c0f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14794,7 +14794,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, events immediately, by setting hold_quit to the input event. */ - if (x_dnd_in_progress || x_dnd_waiting_for_finish) + if ((x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + || (x_dnd_waiting_for_finish + && dpyinfo->display == x_dnd_finish_display)) { eassume (hold_quit); commit 3c5b332f1a4d9849c5de93236d33329f95952421 Author: Lars Ingebrigtsen Date: Thu May 12 02:54:24 2022 +0200 Make message load eudc-capf more lazily * lisp/gnus/message.el (eudc-capf): Remove require, because all the relevant eudc-capf functions are autoloaded, apparently. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 3cef247522..5936d29c9d 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -51,7 +51,6 @@ (require 'yank-media) (require 'mailcap) (require 'sendmail) -(require 'eudc-capf) (autoload 'mailclient-send-it "mailclient") commit a9d226dea4d0cc190ab6d9dcc430e94b41115fc4 Author: Lars Ingebrigtsen Date: Thu May 12 02:51:53 2022 +0200 Make anchored regexps work in image-dired-mark-tagged-files * lisp/image-dired.el (image-dired-mark-tagged-files): Make anchored regexps work (bug#55375). diff --git a/lisp/image-dired.el b/lisp/image-dired.el index d8bd2937db..30bf5ee108 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -2261,23 +2261,26 @@ Optionally use old comment from FILE as initial value." comment))) ;;;###autoload -(defun image-dired-mark-tagged-files () - "Use regexp to mark files with matching tag. +(defun image-dired-mark-tagged-files (regexp) + "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." - (interactive) + (interactive "sMark tagged files (regexp): ") (image-dired-sane-db-file) - (let ((tag (read-string "Mark tagged files (regexp): ")) - (hits 0) + (let ((hits 0) files) (image-dired--with-db-file - ;; Collect matches - (while (search-forward-regexp - (concat "\\(^[^;\n]+\\);.*" tag ".*$") nil t) - (push (match-string 1) files))) + ;; Collect matches + (while (search-forward-regexp "\\(^[^;\n]+\\);\\(.*\\)" nil t) + (let ((file (match-string 1)) + (tags (split-string (match-string 2) ";"))) + (when (seq-find (lambda (tag) + (string-match-p regexp tag)) + tags) + (push file files))))) ;; Mark files (dolist (curr-file files) ;; I tried using `dired-mark-files-regexp' but it was waaaay to commit dcbe8267834dca80e94d4f96d61e76517e8c0022 Author: Lars Ingebrigtsen Date: Thu May 12 02:27:22 2022 +0200 Fix non-variable widgets in the 'H' command in Cus-mode * lisp/cus-edit.el (custom-mode-map): (custom-commands): Adjust. (custom-toggle-hide-all-widgets): Rename and work for all widget types, not just variables. diff --git a/etc/NEWS b/etc/NEWS index 7037f1ebeb..5e4e2e98ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -799,7 +799,7 @@ the run/continue command. ** Customize --- -*** New command 'custom-toggle-hide-all-variables'. +*** New command 'custom-toggle-hide-all-widgets'. This is bound to 'H' and toggles whether to hide or show the widget contents. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index a7d06d5e42..df4edb78a1 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -441,7 +441,7 @@ Use group `text' for this instead. This group is deprecated." (define-key map "u" 'Custom-goto-parent) (define-key map "n" 'widget-forward) (define-key map "p" 'widget-backward) - (define-key map "H" 'custom-toggle-hide-all-variables) + (define-key map "H" 'custom-toggle-hide-all-widgets) map) "Keymap for `Custom-mode'.") @@ -746,7 +746,7 @@ groups after non-groups, if nil do not order groups at all." (or custom-file user-init-file) "Un-customize settings in this and future sessions." "delete" "Uncustomize" (modified set changed rogue saved)) - (" Toggle hiding all values " custom-toggle-hide-all-variables + (" Toggle hiding all values " custom-toggle-hide-all-widgets t "Toggle hiding all values." "hide" "Hide" t) (" Help for Customize " Custom-help t "Get help for using Customize." @@ -2840,7 +2840,7 @@ try matching its doc string against `custom-guess-doc-alist'." (defvar custom--hidden-state) -(defun custom-toggle-hide-all-variables () +(defun custom-toggle-hide-all-widgets () "Hide or show details of all customizable settings in a Custom buffer. This command is for use in a Custom buffer that shows many customizable settings, like \"*Customize Group*\" or \"*Customize Faces*\". @@ -2862,7 +2862,7 @@ else." (setq state 'standard)) (when (and (eq (widget-type widget) 'custom-visibility) (eq state custom--hidden-state)) - (custom-toggle-hide-variable widget))) + (custom-toggle-parent widget))) (forward-line 1))) (setq custom--hidden-state (if (eq custom--hidden-state 'hidden) 'standard commit 1642a5ffcdf734c629e5aec963a0b190997704d6 Author: Lars Ingebrigtsen Date: Thu May 12 02:16:38 2022 +0200 Adjust restore-buffer-modified-p autosaved logic * doc/lispref/buffers.texi (Buffer Modification): Adjust documentation. * src/buffer.c (Frestore_buffer_modified_p): Fix up the logic around `autosaved': It means "the buffer is modified, and also autosaved". diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 2e5771f347..9f3808a45b 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -565,9 +565,9 @@ function @code{force-mode-line-update} works by doing this: @end defun @defun restore-buffer-modified-p flag -Like @code{set-buffer-modified-p}, but does not force redisplay -of mode lines. This function also allows a @var{flag} value of -@code{autosaved}, which marks the buffer as having been autosaved +Like @code{set-buffer-modified-p}, but does not force redisplay of +mode lines. This function also allows a @var{flag} value of +@code{autosaved}, which also marks the buffer as having been autosaved after the last modification. @end defun diff --git a/src/buffer.c b/src/buffer.c index 0af14a1060..89b04a4280 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1448,9 +1448,9 @@ DEFUN ("restore-buffer-modified-p", Frestore_buffer_modified_p, Srestore_buffer_modified_p, 1, 1, 0, doc: /* Like `set-buffer-modified-p', but doesn't redisplay buffer's mode line. A nil FLAG means to mark the buffer as unmodified. A non-nil FLAG -means mark the buffer as modified, but the special value -`autosaved' will instead mark the buffer as having been -autosaved since it was last modified. +means mark the buffer as modified. A special value of `autosaved' +will mark the buffer modified, and also as having been autosaved since +it was last modified. This function also locks or unlocks the file visited by the buffer, if both `buffer-file-truename' and `buffer-file-name' are non-nil. @@ -1496,13 +1496,13 @@ state of the current buffer. Use with care. */) SAVE_MODIFF = MODIFF; else { - if (EQ (flag, Qautosaved)) - BUF_AUTOSAVE_MODIFF (b) = MODIFF; /* If SAVE_MODIFF == auto_save_modified == MODIFF, we can either decrease SAVE_MODIFF and auto_save_modified or increase MODIFF. */ - else if (SAVE_MODIFF >= MODIFF) + if (SAVE_MODIFF >= MODIFF) SAVE_MODIFF = modiff_incr (&MODIFF); + if (EQ (flag, Qautosaved)) + BUF_AUTOSAVE_MODIFF (b) = MODIFF; } return flag; } diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 10dac68f9f..f6a18acaa6 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1515,6 +1515,16 @@ with parameters from the *Messages* buffer modification." (should (eq (buffer-modified-p) 'autosaved)) (insert "zot") (restore-buffer-modified-p 'autosaved) + (should (eq (buffer-modified-p) 'autosaved)))) + + (ert-with-temp-file file + (with-current-buffer (find-file file) + (auto-save-mode 1) + (should-not (buffer-modified-p)) + (insert "foo") + (should (buffer-modified-p)) + (should-not (eq (buffer-modified-p) 'autosaved)) + (restore-buffer-modified-p 'autosaved) (should (eq (buffer-modified-p) 'autosaved))))) ;;; buffer-tests.el ends here commit dce85743b6856132a64709cd191951f9d190ce6e Author: Lars Ingebrigtsen Date: Thu May 12 01:48:40 2022 +0200 Make C-u M-x apropos-user-option include buttons * lisp/apropos.el (apropos-user-option): Include buttons in the output always (bug#55376). (apropos-print-doc): Don't insert three spaces in the non-apropos-multi-type case. diff --git a/lisp/apropos.el b/lisp/apropos.el index 28184476e6..c57ca37e68 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -518,7 +518,7 @@ variables, not just user options." (if (or current-prefix-arg apropos-do-all) "variable" "user option")) current-prefix-arg)) - (apropos-command pattern nil + (apropos-command pattern (or do-all apropos-do-all) (if (or do-all apropos-do-all) (lambda (symbol) (and (boundp symbol) @@ -1275,12 +1275,13 @@ as a heading." (let ((doc (nth i apropos-item))) (when (stringp doc) (if apropos-compact-layout - (insert (propertize "\t" 'display '(space :align-to 32)) " ") - (insert " ")) + (insert (propertize "\t" 'display '(space :align-to 32))) + (insert " ")) (if apropos-multi-type (let ((button-face (button-type-get type 'face))) (unless (consp button-face) (setq button-face (list button-face))) + (insert " ") (insert-text-button (if apropos-compact-layout (format "<%s>" (button-type-get type 'apropos-short-label)) commit ed0b589480a1e0a20364e1349fa8fa957ecb1efc Author: Stefan Monnier Date: Wed May 11 17:17:10 2022 -0400 (byte-compile-eval): Avoid some false positive "noruntime" warnings * lisp/emacs-lisp/bytecomp.el (byte-compile-eval): Loosen the check before refraining from adding a function to noruntime. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cbf2659109..1fef9b00d8 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1056,8 +1056,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (dolist (s xs) (pcase s (`(defun . ,f) - (unless (seq-some #'autoloadp - (get (cdr s) 'function-history)) + ;; If `f' has a history, it's presumably because + ;; it was already defined beforehand (typically + ;; as an autoload). It could also be because it + ;; was defined twice during `form', in which case + ;; we arguably should add it to b-c-noruntime-functions, + ;; but it's not clear it's worth the trouble + ;; trying to recognize that case. + (unless (get f 'function-history) (push f byte-compile-noruntime-functions))))))))))))) (defun byte-compile-eval-before-compile (form) commit f0e08e49145b3602fb73390217f94a6a79a5d632 Author: Lars Ingebrigtsen Date: Wed May 11 21:16:23 2022 +0200 Fix regression in edmacro-finish-edit when parsing "none" * lisp/edmacro.el (edmacro-finish-edit): Use `kbd' here because we're comparing the result to a string (bug#55372). diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 179fea786d..26f3ae02ab 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -251,8 +251,7 @@ or nil, use a compact 80-column format." ((looking-at "Key:\\(.*\\)$") (when edmacro-store-hook (error "\"Key\" line not allowed in this context")) - (let ((key (edmacro-parse-keys - (match-string 1)))) + (let ((key (kbd (match-string 1)))) (unless (equal key "") (if (equal key "none") (setq no-keys t) commit 4f27e4ff02d9d96b5cfbd196dd724e4a056cd8ef Author: Paul Eggert Date: Wed May 11 10:13:09 2022 -0700 functionp doc improvement * doc/lispref/eval.texi, doc/lispref/functions.texi, src/eval.c: Document functionp a bit more carefully. It can return t on non-functions. diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index e94e222e6a..ed3cf56e09 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -435,7 +435,7 @@ expansion. @cindex forms, special @cindex evaluation of special forms - A @dfn{special form} is a primitive function specially marked so that + A @dfn{special form} is a primitive specially marked so that its arguments are not all evaluated. Most special forms define control structures or perform variable bindings---things which functions cannot do. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 2f386eaa47..55bbf8fd5a 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -146,7 +146,12 @@ function: This function returns @code{t} if @var{object} is any kind of function, i.e., can be passed to @code{funcall}. Note that @code{functionp} returns @code{t} for symbols that are function names, -and returns @code{nil} for special forms. +and returns @code{nil} for symbols that are macros or special forms. + +If @var{object} is not a function, this function ordinarily returns +@code{nil}. However, the representation of function objects is +complicated, and for efficiency reasons in rare cases this function +can return @code{t} even when @var{object} is not a function. @end defun It is also possible to find out how many arguments an arbitrary diff --git a/src/eval.c b/src/eval.c index 950338bf79..29c122e2fb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2805,9 +2805,11 @@ apply1 (Lisp_Object fn, Lisp_Object arg) DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, doc: /* Return t if OBJECT is a function. -An object is a function if it is callable via `funcall'; -this includes primitive functions, byte-code functions, closures, and -symbols with function bindings. */) +An object is a function if it is callable via `funcall'; this includes +symbols with function bindings, but excludes macros and special forms. + +Ordinarily return nil if OBJECT is not a function, although t might be +returned in rare cases. */) (Lisp_Object object) { if (FUNCTIONP (object)) commit 678e05e851af9e5b1fdc50d7d2a661b33ad663d5 Author: Eli Zaretskii Date: Wed May 11 19:31:16 2022 +0300 ; * etc/NEWS: Fix a typo. diff --git a/etc/NEWS b/etc/NEWS index ddb83ce410..7037f1ebeb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -788,8 +788,8 @@ so automatically. --- *** New user option 'cperl-file-style'. -The determines the indentation style to be used. This can also be -used as a file-local variable. +This option determines the indentation style to be used. It can also +be used as a file-local variable. --- *** 'gud-go' is now bound to 'C-c C-v'. commit 7f2fb992110a60a8b583db76fd3b3ee0f1c7efb9 Author: Tino Calancha Date: Wed May 11 18:01:11 2022 +0200 char-uppercase-p: New predicate Return non-nil if its argument is an uppercase character. Suggested in Bug#54804. * lisp/subr.el (char-uppercase-p): New defun. * etc/NEWS (Lisp Changes in Emacs 29.1): Announce it * doc/lispref/display.texi (Size of Displayed Text): Document it. * test/lisp/subr-tests.el (test-char-uppercase-p): Add a test. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 0ab683d234..f428fb858b 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2010,6 +2010,11 @@ Tables}). The width of a tab character is usually @code{tab-width} (@pxref{Usual Display}). @end defun +@defun char-uppercase-p char +Return non-@code{nil} if @var{char} is an uppercase character +according to Unicode. +@end defun + @defun string-width string &optional from to This function returns the width in columns of the string @var{string}, if it were displayed in the current buffer and the selected window. diff --git a/etc/NEWS b/etc/NEWS index 991088a067..ddb83ce410 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1781,6 +1781,10 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** New predicate 'char-uppercase-p'. +This returns non-nil if its argument its an uppercase character. + ** Byte compilation --- @@ -1793,7 +1797,6 @@ I.e., double-quoting the 'bar', which is almost never the correct value. The byte compiler will now issue a warning if it encounters these forms. - +++ *** 'restore-buffer-modified-p' can now alter buffer auto-save state. With a FLAG value of 'autosaved', it will mark the buffer as having diff --git a/lisp/simple.el b/lisp/simple.el index 89fb0ea97e..3812f6d8c6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6054,6 +6054,14 @@ and KILLP is t if a prefix arg was specified." ;; Avoid warning about delete-backward-char (with-no-warnings (delete-backward-char n killp)))) +(defun char-uppercase-p (char) + "Return non-nil if CHAR is an upper-case character. +If the Unicode tables are not yet available, e.g. during bootstrap, +then gives correct answers only for ASCII characters." + (cond ((unicode-property-table-internal 'lowercase) + (characterp (get-char-code-property char 'lowercase))) + ((and (>= char ?A) (<= char ?Z))))) + (defun zap-to-char (arg char) "Kill up to and including ARGth occurrence of CHAR. Case is ignored if `case-fold-search' is non-nil in the current buffer. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 89803e5ce2..a25eb363b0 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1074,5 +1074,12 @@ final or penultimate step during initialization.")) (should (= subr-test--local 2)) (should-not (boundp 'subr-test--unexist))))) +(ert-deftest test-char-uppercase-p () + "Tests for `char-uppercase-p'." + (dolist (c (list ?R ?S ?Ω ?Ψ)) + (should (char-uppercase-p c))) + (dolist (c (list ?a ?b ?α ?β)) + (should-not (char-uppercase-p c)))) + (provide 'subr-tests) ;;; subr-tests.el ends here commit 4e7879f807b43416568154d31bc49d3e7393d583 Author: Michael Albinus Date: Wed May 11 18:02:13 2022 +0200 Improve handling of `tramp-set-file-uid-gid' * lisp/net/tramp.el (tramp-skeleton-write-region): Call `tramp-set-file-uid-gid' properly. (tramp-set-file-uid-gid): Handle also `tramp-crypt-file-name-handler'. * test/lisp/net/tramp-tests.el (tramp-test27-load): Adapt test. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 74155d1722..1851047ccf 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -6133,4 +6133,5 @@ function cell is returned to be applied on a buffer." ;; * Support hostname canonicalization in ~/.ssh/config. ;; + ;;; tramp-sh.el ends here diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9413f7954f..b26346443d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3435,7 +3435,7 @@ BODY is the backend specific code." ;; We must protect `last-coding-system-used', now we have ;; set it to its correct value. - (let (last-coding-system-used) + (let (last-coding-system-used (need-chown t)) ;; Set file modification time. (when (or (eq ,visit t) (stringp ,visit)) (when-let ((file-attr (file-attributes filename 'integer))) @@ -3445,10 +3445,13 @@ BODY is the backend specific code." ;; `file-precious-flag' is set. (or (file-attribute-modification-time file-attr) (current-time))) - ;; Set the ownership. (unless (and (= (file-attribute-user-id file-attr) uid) (= (file-attribute-group-id file-attr) gid)) - (tramp-set-file-uid-gid filename uid gid))))) + (setq need-chown nil)))) + + ;; Set the ownership. + (when need-chown + (tramp-set-file-uid-gid filename uid gid))) ;; Unlock file. (when file-locked @@ -5627,7 +5630,9 @@ If FILENAME is remote, a file name handler is called." (setq gid (file-attribute-group-id (file-attributes dir))))) (if (tramp-tramp-file-p filename) - (tramp-file-name-handler #'tramp-set-file-uid-gid filename uid gid) + (funcall (if (tramp-crypt-file-name-p filename) + #'tramp-crypt-file-name-handler #'tramp-file-name-handler) + #'tramp-set-file-uid-gid filename uid gid) ;; On W32 systems, "chown" does not work. (unless (memq system-type '(ms-dos windows-nt)) (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 643e19c1d2..fa5a614fbf 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4474,7 +4474,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect (progn - (load tmp-name 'noerror 'nomessage) + ;; Ange-FTP does not tolerate a missing file, even with `noerror'. + (unless (tramp--test-ange-ftp-p) + (load tmp-name 'noerror 'nomessage)) (should-not (featurep 'tramp-test-load)) (write-region "(provide 'tramp-test-load)" nil tmp-name) ;; `load' in lread.c does not pass `must-suffix'. Why? commit 3bc34ef635734f72abd584fe3c8a6b3dea76f656 Author: Lars Ingebrigtsen Date: Wed May 11 17:51:05 2022 +0200 Clarify precedence rules in Active Display Table manual node * doc/lispref/display.texi (Active Display Table): Say what "takes precedence" means here (bug#18546). diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 9650d22790..0ab683d234 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -8228,7 +8228,10 @@ help buffer. The window's display table, if there is one, takes precedence over the buffer's display table. If neither exists, Emacs tries to use the standard display table; if that is @code{nil}, Emacs uses the usual -character display conventions (@pxref{Usual Display}). +character display conventions (@pxref{Usual Display}). (Emacs does +not ``merge'' display tables: For instance, if the window has a +display table, the buffer's display table and the standard display +table are completely ignored.) Note that display tables affect how the mode line is displayed, so if you want to force redisplay of the mode line using a new display commit 43b7759b093cb6b10dd0d4dcb2aff72212b6070d Author: Lars Ingebrigtsen Date: Wed May 11 17:10:30 2022 +0200 Allow giving switches to the program in `M-x term' * lisp/term.el (term, ansi-term): Allow giving switches to the program (bug#18105). diff --git a/lisp/term.el b/lisp/term.el index 54e19a3ea9..f81cbf7293 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1581,7 +1581,8 @@ commands to use in that buffer. (or explicit-shell-file-name (getenv "ESHELL") shell-file-name)))) - (set-buffer (make-term "terminal" program)) + (let ((prog (split-string-shell-command program))) + (set-buffer (apply #'make-term "terminal" (car prog) nil (cdr prog)))) (term-char-mode) (pop-to-buffer-same-window "*terminal*")) @@ -4399,7 +4400,10 @@ and `C-x' being marked as a `term-escape-char'." ;; for now they have the *term-ansi-term* form but we'll see... (setq term-ansi-buffer-name (generate-new-buffer-name term-ansi-buffer-name)) - (setq term-ansi-buffer-name (term-ansi-make-term term-ansi-buffer-name program)) + (let ((prog (split-string-shell-command program))) + (setq term-ansi-buffer-name + (apply #'term-ansi-make-term term-ansi-buffer-name (car prog) + nil (cdr prog)))) (set-buffer term-ansi-buffer-name) (term-mode) commit 9e131744fb17f18da23c18d4f91a140573cb1ad3 Author: Lars Ingebrigtsen Date: Wed May 11 16:47:53 2022 +0200 Fix previous cperl-file-style change * lisp/progmodes/cperl-mode.el (cperl--set-file-style): New function. (cperl-mode): Add it to hack-local-variables-hook to really set the cperl style. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 7678456208..5ed4832481 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1812,8 +1812,13 @@ or as help on variables `cperl-tips', `cperl-problems', (cperl-find-pods-heres)) (when cperl-file-style (cperl-set-style cperl-file-style)) + (add-hook 'hack-local-variables-hook #'cperl--set-file-style nil t) ;; Setup Flymake (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) + +(defun cperl--set-file-style () + (when cperl-file-style + (cperl-set-style cperl-file-style))) ;; Fix for perldb - make default reasonable (defun cperl-db () commit ca52b127809e4c518118f724ba3580fface86566 Author: Lars Ingebrigtsen Date: Wed May 11 16:29:14 2022 +0200 Regenerated ldefs-boot.el diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 8f8795196c..977b743f39 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5981,6 +5981,7 @@ If FIX is non-nil, run `copyright-fix-years' instead. (put 'cperl-continued-statement-offset 'safe-local-variable 'integerp) (put 'cperl-extra-newline-before-brace 'safe-local-variable 'booleanp) (put 'cperl-merge-trailing-else 'safe-local-variable 'booleanp) +(put 'cperl-file-style 'safe-local-variable 'stringp) (autoload 'cperl-mode "cperl-mode" "\ Major mode for editing Perl code. @@ -6132,9 +6133,11 @@ Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith `cperl-continued-statement-offset' 5 4 2 4 4 CPerl knows several indentation styles, and may bulk set the -corresponding variables. Use \\[cperl-set-style] to do this. Use -\\[cperl-set-style-back] to restore the memorized preexisting values -\(both available from menu). See examples in `cperl-style-examples'. +corresponding variables. Use \\[cperl-set-style] to do this or +set the `cperl-file-style' user option. Use +\\[cperl-set-style-back] to restore the memorized preexisting +values (both available from menu). See examples in +`cperl-style-examples'. Part of the indentation style is how different parts of if/elsif/else statements are broken into lines; in CPerl, this is reflected on how commit cf1e1584d99dc249f194c023f64f1129ebc528f2 Author: Lars Ingebrigtsen Date: Wed May 11 16:29:01 2022 +0200 Add new user option 'cperl-file-style' * lisp/progmodes/cperl-mode.el (cperl-file-style): New user option (bug#17948). (cperl-mode): Mention it. (cperl-style-alist): Mention it. diff --git a/etc/NEWS b/etc/NEWS index 926f5d6464..991088a067 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -786,6 +786,11 @@ so automatically. * Changes in Specialized Modes and Packages in Emacs 29.1 +--- +*** New user option 'cperl-file-style'. +The determines the indentation style to be used. This can also be +used as a file-local variable. + --- *** 'gud-go' is now bound to 'C-c C-v'. If given a prefix, it will query the user for an argument to use for diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 3742286e5d..7678456208 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -558,6 +558,19 @@ This way enabling/disabling of menu items is more correct." :type 'boolean :group 'cperl-speed) +(defcustom cperl-file-style nil + "Indentation style to use in cperl-mode." + :type '(choice (const "CPerl") + (const "PBP") + (const "PerlStyle") + (const "GNU") + (const "C++") + (const "K&R") + (const "BSD") + (const "Whitesmith")) + :version "29.1") +;;;###autoload(put 'cperl-file-style 'safe-local-variable 'stringp) + (defcustom cperl-ps-print-face-properties '((font-lock-keyword-face nil nil bold shadow) (font-lock-variable-name-face nil nil bold) @@ -1660,9 +1673,11 @@ Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith `cperl-continued-statement-offset' 5 4 2 4 4 CPerl knows several indentation styles, and may bulk set the -corresponding variables. Use \\[cperl-set-style] to do this. Use -\\[cperl-set-style-back] to restore the memorized preexisting values -\(both available from menu). See examples in `cperl-style-examples'. +corresponding variables. Use \\[cperl-set-style] to do this or +set the `cperl-file-style' user option. Use +\\[cperl-set-style-back] to restore the memorized preexisting +values \(both available from menu). See examples in +`cperl-style-examples'. Part of the indentation style is how different parts of if/elsif/else statements are broken into lines; in CPerl, this is reflected on how @@ -1795,6 +1810,8 @@ or as help on variables `cperl-tips', `cperl-problems', (when (and cperl-pod-here-scan (not cperl-syntaxify-by-font-lock)) (cperl-find-pods-heres)) + (when cperl-file-style + (cperl-set-style cperl-file-style)) ;; Setup Flymake (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) @@ -6313,7 +6330,7 @@ else ) ("Current")) "List of variables to set to get a particular indentation style. -Should be used via `cperl-set-style' or via Perl menu. +Should be used via `cperl-set-style', `cperl-file-style' or via Perl menu. See examples in `cperl-style-examples'.") commit 45ccad3569536b018dfd9b97a5b4fd2c1a5212ea Author: Lars Ingebrigtsen Date: Wed May 11 16:11:23 2022 +0200 Fix fontification of multi-line declarations in f90-mode * lisp/progmodes/f90.el (f90-font-lock-keywords-2): Fontify multi-line declarations (bug#17222). diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 263cd0ef29..ce8824b85c 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -600,6 +600,7 @@ and variable-name parts, respectively." (append f90-font-lock-keywords-1 (list + '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face)) ;; Variable declarations (avoid the real function call). ;; NB by accident (?), this correctly fontifies the "integer" in: ;; integer () function foo () @@ -611,8 +612,8 @@ and variable-name parts, respectively." '("^[ \t0-9]*\\(?:pure\\|elemental\\)?[ \t]*\ \\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ enumerator\\|generic\\|procedure\\|logical\\|double[ \t]*precision\\)\ -\\(.*::\\|[ \t]*(.*)\\)?\\([^&!\n]*\\)" - (1 font-lock-type-face t) (4 font-lock-variable-name-face t)) +\\(.*::\\|[ \t]*(.*)\\)?\\(\\(?:[^&!\n]*\\(?:&\n\\)?\\)+\\)" + (1 font-lock-type-face t) (4 font-lock-variable-name-face append)) ;; Derived type/class variables. ;; TODO ? If we just highlighted the "type" part, rather than ;; "type(...)", this could be in the previous expression. And this @@ -654,7 +655,6 @@ logical\\|double[ \t]*precision\\|type[ \t]*(\\(?:\\sw\\|\\s_\\)+)\\|none\\)[ \t '("\\_<\\(namelist\\|common\\)[ \t]*/\\(\\(?:\\sw\\|\\s_\\)+\\)?/" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) "\\_" - '("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face)) "\\_<\\(then\\|continue\\|format\\|include\\|\\(?:error[ \t]+\\)?stop\\|\ return\\)\\_>" '("\\_<\\(exit\\|cycle\\)[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>" commit c874916d8d27226dcfd97ee2b78c911b0fb60e25 Author: Stefan Kangas Date: Wed May 11 06:22:57 2022 +0200 * etc/NEWS: Improve some entries. diff --git a/etc/NEWS b/etc/NEWS index 68c7490e56..926f5d6464 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -121,7 +121,7 @@ This will output a string identifying the current Emacs build. +++ ** New hook 'after-pdump-load-hook'. -This is run at the end of the Emacs startup process, and it meant to +This is run at the end of the Emacs startup process, and is meant to be used to reinitialize structures that would normally be done at load time. @@ -158,10 +158,10 @@ newline. --- ** 'TAB' and '' are now bound in 'button-map'. -This means that if your cursor is on a button, 'TAB' will take you to -the next button, even if the mode has bound it to something else. -This also means that 'TAB' on a button in an 'outline-minor-mode' -heading will move point instead of collapsing the outline. +This means that if point is on a button, 'TAB' will take you to the +next button, even if the mode has bound it to something else. This +also means that 'TAB' on a button in an 'outline-minor-mode' heading +will move point instead of collapsing the outline. --- ** 'Info-default-directory-list' is no longer populated at Emacs startup. @@ -171,7 +171,7 @@ If you have code in your init file that removes directories from --- ** 'C-k' no longer deletes files in 'ido-mode'. To get the previous action back, put something like the following in -your init file: +your Init file: (require 'ido) (keymap-set ido-file-completion-map "C-k" #'ido-delete-file-at-head) @@ -235,8 +235,8 @@ use the new 'tamil-itrans-digits' and 'tamil-inscript-digits' input methods instead. +++ -** New variable current-time-list governing default timestamp form. -Functions like current-time now yield (TICKS . HZ) timestamps if this +** New variable 'current-time-list' governing default timestamp form. +Functions like 'current-time' now yield (TICKS . HZ) timestamps if this new variable is nil. The variable defaults to t, which means these functions default to timestamps of the forms (HI LO US PS), (HI LO US) or (HI LO), which are less regular and less efficient. This is part @@ -403,8 +403,8 @@ make it more convenient to inspect and modify them. Running 'with-connection-local-variables' defaults to application 'tramp'. This can be changed by let-binding 'connection-local-default-application' to another symbol. This is -useful when running code in a buffer, where Tramp has already set some -connection local variables. +useful when running code in a buffer where Tramp has already set some +connection-local variables. --- ** New minor mode 'pixel-scroll-precision-mode'. @@ -573,7 +573,7 @@ or is itself too long. +++ *** New user option 'outline-minor-mode-use-buttons'. If non-nil, Outline Minor Mode will use buttons to hide/show outlines -in addition to the ellipsis. Default nil. +in addition to the ellipsis. The default is nil. --- *** New user option 'outline-minor-mode-buttons'. @@ -582,8 +582,8 @@ This is a list of pairs of open/close strings used to display buttons. +++ ** Support for the WebP image format. This support is built by default when the libwebp library is -available. (This also includes support for animated WebP images.) To -disable WebP support, use the '--without-webp' configure flag. Image +available, and includes support for animated WebP images. To disable +WebP support, use the '--without-webp' configure flag. Image specifiers can now use ':type webp'. ** Windows @@ -681,7 +681,7 @@ This change also affects 'cl-macrolet', 'cl-flet*' and +++ ** New user option 'translate-upper-case-key-bindings'. -This can be set to nil to inhibit translating upper case keys to lower +Set this option to nil to inhibit translating upper case keys to lower case keys. +++ @@ -691,8 +691,8 @@ point. --- ** Improved mouse behavior with auto-scrolling modes. -When clicking inside the 'scroll-margin' or 'hscroll-margin' region -the point is now moved only when releasing the mouse button. This no +When clicking inside the 'scroll-margin' or 'hscroll-margin' region, +point is now moved only when releasing the mouse button. This no longer results in a bogus selection, unless the mouse has been effectively dragged. @@ -713,9 +713,9 @@ Customize this option to limit the number of entries in the menu *** New user option 'show-paren-context-when-offscreen'. When non-nil, if the point is in a closing delimiter and the opening delimiter is offscreen, shows some context around the opening -delimiter in the echo area. Default nil. +delimiter in the echo area. The default is nil. -May also be set to the symbols 'overlay' or 'child-frame' in which +May also be set to the symbols 'overlay' or 'child-frame', in which case the context is shown in an overlay or child-frame at the top-left of the current window. The latter option requires a graphical frame. On non-graphical frames, the context is shown in the echo area. @@ -724,7 +724,7 @@ On non-graphical frames, the context is shown in the echo area. +++ *** 'comint-term-environment' is now aware of connection-local variables. -The user option 'comint-terminfo-terminal' and variable +The user option 'comint-terminfo-terminal' and the variable 'system-uses-terminfo' can now be set as connection-local variables to change the terminal used on a remote host. @@ -1108,7 +1108,7 @@ allowed images. *** New user option 'shr-use-xwidgets-for-media'. If non-nil (and Emacs has been built with support for xwidgets), display