commit 2363366862d0ed7334aff38ebcd5f02d26e33402 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Mon Apr 18 10:05:15 2022 +0300 Fix 'restart-emacs' in -nw mode on MS-Windows * src/w32.c (openat): #ifdef away: not used. (w32_reexec_emacs): Kludgey solution for restarting Emacs in the "-nw" mode. diff --git a/src/w32.c b/src/w32.c index ae1d77a021..e4237579d8 100644 --- a/src/w32.c +++ b/src/w32.c @@ -4640,6 +4640,9 @@ sys_open (const char * path, int oflag, int mode) return res; } +/* This is not currently used, but might be needed again at some + point; DO NOT DELETE! */ +#if 0 int openat (int fd, const char * path, int oflag, int mode) { @@ -4660,6 +4663,7 @@ openat (int fd, const char * path, int oflag, int mode) return sys_open (path, oflag, mode); } +#endif int fchmod (int fd, mode_t mode) @@ -10623,12 +10627,6 @@ realpath (const char *file_name, char *resolved_name) int w32_reexec_emacs (char *cmd_line, const char *wdir) { - if (inhibit_window_system) - { - errno = ENOSYS; - return -1; /* FIXME! */ - } - STARTUPINFO si; SECURITY_ATTRIBUTES sec_attrs; BOOL status; @@ -10643,12 +10641,28 @@ w32_reexec_emacs (char *cmd_line, const char *wdir) line specifies the program as a relative file name. */ chdir (wdir); + /* This is a kludge: it causes the restarted "emacs -nw" to have a + new console window created for it, and that new window might have + different (default) properties, not the ones of the parent + process's console window. But without this, restarting Emacs in + the -nw mode simply doesn't work. FIXME! */ + if (inhibit_window_system) + { + if (!FreeConsole ()) + { + errno = ENOEXEC; + return -1; + } + } + status = CreateProcess (NULL, /* program */ cmd_line, /* command line */ &sec_attrs, /* process attributes */ NULL, /* thread attributes */ TRUE, /* inherit handles? */ - NORMAL_PRIORITY_CLASS, + inhibit_window_system + ? 0 /* inherit parent's console */ + : NORMAL_PRIORITY_CLASS, NULL, /* environment */ wdir, /* initial directory */ &si, /* startup info */ commit 5b5608c61446d78be3415fe8fce6a09142989f3f Author: Po Lu Date: Mon Apr 18 13:23:23 2022 +0800 Fix glyph skipping optimization when a tab line is enabled * src/dispnew.c (update_text_area): Compute vpos of header line correctly when window has tab line. diff --git a/src/dispnew.c b/src/dispnew.c index 0d959047f3..3cfe1b86f6 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3928,9 +3928,12 @@ update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) However, it causes excessive flickering when mouse is moved across the mode line. Luckily, turning it off for the mode line doesn't seem to hurt anything. -- cyd. - But it is still needed for the header line. -- kfs. */ + But it is still needed for the header line. -- kfs. + The header line vpos is 1 if a tab line is enabled. (18th + Apr 2022) */ || (current_row->mouse_face_p - && !(current_row->mode_line_p && vpos > 0)) + && !(current_row->mode_line_p + && (vpos > w->current_matrix->tab_line_p))) || current_row->x != desired_row->x) { output_cursor_to (w, vpos, 0, desired_row->y, desired_row->x); commit a9b2206def69623606faced9900de180adfb2e2b Author: Po Lu Date: Mon Apr 18 09:26:12 2022 +0800 ; Fix typo in last change * src/xterm.c (x_wm_set_size_hint): Fix typo. diff --git a/src/xterm.c b/src/xterm.c index 2e905b5799..ef00e027f8 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -22161,7 +22161,7 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) XSetWMNormalHints (FRAME_X_DISPLAY (f), window, &size_hints); #else - xg_wm_set_size_size_hint (f, flags, user_position); + xg_wm_set_size_hint (f, flags, user_position); #endif /* USE_GTK */ } commit d1f315751d960f003317713a65cc480b3d0ee726 Author: Po Lu Date: Mon Apr 18 09:21:45 2022 +0800 Minor cleanups to PGTK code * src/gtkutil.c (xg_set_geometry): (xg_frame_set_char_size): (x_wm_set_size_hint): Rename to `xg_wm_set_size_hint'. All callers changed. * src/gtkutil.h: Update prototypes. * src/pgtkfns.c (unwind_create_frame): (Fx_create_frame): (compute_tip_xy): * src/pgtkterm.c (x_free_frame_resources): (x_destroy_window): (x_calc_absolute_position): (x_set_offset): (pgtk_set_window_size): (x_display_pixel_height): (x_display_pixel_width): (x_set_parent_frame): Rename `x_foo' functions to `pgtk_foo'. Get rid of some copy-pasted code from various places. (pgtk_create_terminal): Clean up coding style. * src/pgtkterm.h: Update prototypes. diff --git a/src/gtkutil.c b/src/gtkutil.c index 718da171f4..a2ab01d02c 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1061,6 +1061,7 @@ xg_set_geometry (struct frame *f) /* Handle negative positions without consulting gtk_window_parse_geometry (Bug#25851). The position will be off by scrollbar width + window manager decorations. */ +#ifndef HAVE_PGTK if (f->size_hint_flags & XNegative) f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) - FRAME_PIXEL_WIDTH (f) + f->left_pos); @@ -1068,6 +1069,15 @@ xg_set_geometry (struct frame *f) if (f->size_hint_flags & YNegative) f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - FRAME_PIXEL_HEIGHT (f) + f->top_pos); +#else + if (f->size_hint_flags & XNegative) + f->left_pos = (pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f)) + - FRAME_PIXEL_WIDTH (f) + f->left_pos); + + if (f->size_hint_flags & YNegative) + f->top_pos = (pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f)) + - FRAME_PIXEL_HEIGHT (f) + f->top_pos); +#endif /* GTK works in scaled pixels, so convert from X pixels. */ gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), @@ -1182,7 +1192,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) outer_height /= xg_get_scale (f); outer_width /= xg_get_scale (f); - x_wm_set_size_hint (f, 0, 0); + xg_wm_set_size_hint (f, 0, 0); /* Resize the top level widget so rows and columns remain constant. @@ -1898,7 +1908,7 @@ xg_free_frame_widgets (struct frame *f) flag (this is useful when FLAGS is 0). */ void -x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) +xg_wm_set_size_hint (struct frame *f, long int flags, bool user_position) { /* Must use GTK routines here, otherwise GTK resets the size hints to its own defaults. */ diff --git a/src/gtkutil.h b/src/gtkutil.h index 63ecac0790..190d662831 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -153,6 +153,8 @@ extern bool xg_event_is_for_scrollbar (struct frame *, const EVENT *, extern int xg_get_default_scrollbar_width (struct frame *f); extern int xg_get_default_scrollbar_height (struct frame *f); +extern void xg_wm_set_size_hint (struct frame *, long int, bool); + extern void update_frame_tool_bar (struct frame *f); extern void free_frame_tool_bar (struct frame *f); extern void xg_change_toolbar_position (struct frame *f, Lisp_Object pos); @@ -222,7 +224,7 @@ extern bool xg_is_menu_window (Display *dpy, Window); extern bool xg_filter_key (struct frame *frame, XEvent *xkey); #endif -/* Mark all callback data that are Lisp_object:s during GC. */ +/* Mark all callback data that are Lisp_Objects during GC. */ extern void xg_mark_data (void); /* Initialize GTK specific parts. */ diff --git a/src/pgtkfns.c b/src/pgtkfns.c index e677f04629..1cab954a07 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -1053,7 +1053,7 @@ unwind_create_frame (Lisp_Object frame) && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount) FRAME_IMAGE_CACHE (f)->refcount++; - x_free_frame_resources (f); + pgtk_free_frame_resources (f); free_glyphs (f); return Qt; } @@ -1692,7 +1692,7 @@ This function is an internal primitive--use `make-frame' instead. */ ) badly we want them. This should be done after we have the menu bar so that its size can be taken into account. */ block_input (); - x_wm_set_size_hint (f, window_prompting, false); + xg_wm_set_size_hint (f, window_prompting, false); unblock_input (); adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), @@ -3026,8 +3026,8 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, { min_x = 0; min_y = 0; - max_x = x_display_pixel_width (FRAME_DISPLAY_INFO (f)); - max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)); + max_x = pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f)); + max_y = pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f)); } if (INTEGERP (top)) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index a59abba625..2b04699fb3 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -410,7 +410,7 @@ pgtk_frame_raise_lower (struct frame *f, bool raise_flag) /* Free X resources of frame F. */ void -x_free_frame_resources (struct frame *f) +pgtk_free_frame_resources (struct frame *f) { struct pgtk_display_info *dpyinfo; Mouse_HLInfo *hlinfo; @@ -511,7 +511,7 @@ x_free_frame_resources (struct frame *f) } void -x_destroy_window (struct frame *f) +pgtk_destroy_window (struct frame *f) /* -------------------------------------------------------------------------- External: Delete the window -------------------------------------------------------------------------- */ @@ -520,7 +520,7 @@ x_destroy_window (struct frame *f) check_window_system (f); if (dpyinfo->gdpy != NULL) - x_free_frame_resources (f); + pgtk_free_frame_resources (f); dpyinfo->reference_count--; } @@ -529,7 +529,7 @@ x_destroy_window (struct frame *f) from its current recorded position values and gravity. */ static void -x_calc_absolute_position (struct frame *f) +pgtk_calc_absolute_position (struct frame *f) { int flags = f->size_hint_flags; struct frame *p = FRAME_PARENT_FRAME (f); @@ -563,7 +563,7 @@ x_calc_absolute_position (struct frame *f) f->left_pos = (FRAME_PIXEL_WIDTH (p) - width - 2 * f->border_width + f->left_pos); else - f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) + f->left_pos = (pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f)) - width + f->left_pos); } @@ -589,7 +589,7 @@ x_calc_absolute_position (struct frame *f) f->top_pos = (FRAME_PIXEL_HEIGHT (p) - height - 2 * f->border_width + f->top_pos); else - f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) + f->top_pos = (pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height + f->top_pos); } @@ -620,18 +620,16 @@ pgtk_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) f->win_gravity = NorthWestGravity; } - x_calc_absolute_position (f); + pgtk_calc_absolute_position (f); block_input (); - x_wm_set_size_hint (f, 0, false); + xg_wm_set_size_hint (f, 0, false); if (change_gravity != 0) { if (FRAME_GTK_OUTER_WIDGET (f)) - { - gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - f->left_pos, f->top_pos); - } + gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + f->left_pos, f->top_pos); else { GtkWidget *fixed = FRAME_GTK_WIDGET (f); @@ -672,7 +670,7 @@ pgtk_set_window_size (struct frame *f, bool change_gravity, f->output_data.pgtk->preferred_width = pixelwidth; f->output_data.pgtk->preferred_height = pixelheight; - x_wm_set_size_hint (f, 0, 0); + xg_wm_set_size_hint (f, 0, 0); xg_frame_set_char_size (f, pixelwidth, pixelheight); gtk_widget_queue_resize (FRAME_WIDGET (f)); @@ -881,18 +879,20 @@ pgtk_new_font (struct frame *f, Lisp_Object font_object, int fontset) } int -x_display_pixel_height (struct pgtk_display_info *dpyinfo) +pgtk_display_pixel_height (struct pgtk_display_info *dpyinfo) { GdkDisplay *gdpy = dpyinfo->gdpy; GdkScreen *gscr = gdk_display_get_default_screen (gdpy); + return gdk_screen_get_height (gscr); } int -x_display_pixel_width (struct pgtk_display_info *dpyinfo) +pgtk_display_pixel_width (struct pgtk_display_info *dpyinfo) { GdkDisplay *gdpy = dpyinfo->gdpy; GdkScreen *gscr = gdk_display_get_default_screen (gdpy); + return gdk_screen_get_width (gscr); } @@ -962,7 +962,7 @@ pgtk_set_parent_frame (struct frame *f, Lisp_Object new_value, gtk_box_pack_start (GTK_BOX (f->output_data.pgtk->hbox_widget), fixed, TRUE, TRUE, 0); f->output_data.pgtk->preferred_width = alloc.width; f->output_data.pgtk->preferred_height = alloc.height; - x_wm_set_size_hint (f, 0, 0); + xg_wm_set_size_hint (f, 0, 0); xg_frame_set_char_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, alloc.width), FRAME_PIXEL_TO_TEXT_HEIGHT (f, alloc.height)); gtk_widget_queue_resize (FRAME_WIDGET (f)); @@ -4860,7 +4860,7 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo) terminal->redeem_scroll_bar_hook = pgtk_redeem_scroll_bar; terminal->judge_scroll_bars_hook = pgtk_judge_scroll_bars; terminal->get_string_resource_hook = pgtk_get_string_resource; - terminal->delete_frame_hook = x_destroy_window; + terminal->delete_frame_hook = pgtk_destroy_window; terminal->delete_terminal_hook = pgtk_delete_terminal; terminal->query_frame_background_color = pgtk_query_frame_background_color; terminal->defined_color_hook = pgtk_defined_color; @@ -4868,10 +4868,10 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo) terminal->set_bitmap_icon_hook = pgtk_bitmap_icon; terminal->implicit_set_name_hook = pgtk_implicitly_set_name; terminal->iconify_frame_hook = pgtk_iconify_frame; - terminal->set_scroll_bar_default_width_hook = - pgtk_set_scroll_bar_default_width; - terminal->set_scroll_bar_default_height_hook = - pgtk_set_scroll_bar_default_height; + terminal->set_scroll_bar_default_width_hook + = pgtk_set_scroll_bar_default_width; + terminal->set_scroll_bar_default_height_hook + = pgtk_set_scroll_bar_default_height; terminal->set_window_size_hook = pgtk_set_window_size; terminal->query_colors = pgtk_query_colors; terminal->get_focus_frame = x_get_focus_frame; diff --git a/src/pgtkterm.h b/src/pgtkterm.h index cc763f00f0..16fd688288 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -62,9 +62,9 @@ struct pgtk_device_t #define ARGB_TO_ULONG(a, r, g, b) (((a) << 24) | ((r) << 16) | ((g) << 8) | (b)) #define ALPHA_FROM_ULONG(color) ((color) >> 24) -#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) #define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) -#define BLUE_FROM_ULONG(color) ((color) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) struct scroll_bar { @@ -518,11 +518,10 @@ extern void pgtk_clear_under_internal_border (struct frame *f); extern void pgtk_set_event_handler (struct frame *f); /* Implemented in pgtkterm.c */ -extern int x_display_pixel_height (struct pgtk_display_info *); -extern int x_display_pixel_width (struct pgtk_display_info *); +extern int pgtk_display_pixel_height (struct pgtk_display_info *); +extern int pgtk_display_pixel_width (struct pgtk_display_info *); -/* Implemented in pgtkterm.c */ -extern void x_destroy_window (struct frame *f); +extern void pgtk_destroy_window (struct frame *f); extern void pgtk_set_parent_frame (struct frame *f, Lisp_Object, Lisp_Object); extern void pgtk_set_no_focus_on_map (struct frame *, Lisp_Object, Lisp_Object); extern void pgtk_set_no_accept_focus (struct frame *, Lisp_Object, Lisp_Object); @@ -562,8 +561,7 @@ extern void pgtk_delete_terminal (struct terminal *terminal); extern void pgtk_make_frame_visible (struct frame *f); extern void pgtk_make_frame_invisible (struct frame *f); -extern void x_wm_set_size_hint (struct frame *, long, bool); -extern void x_free_frame_resources (struct frame *); +extern void pgtk_free_frame_resources (struct frame *); extern void pgtk_iconify_frame (struct frame *f); extern void pgtk_focus_frame (struct frame *f, bool noactivate); extern void pgtk_set_scroll_bar_default_width (struct frame *f); diff --git a/src/xterm.c b/src/xterm.c index e00b38a681..2e905b5799 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -22000,10 +22000,10 @@ x_destroy_window (struct frame *f) flag (this is useful when FLAGS is 0). The GTK version is in gtkutils.c. */ -#ifndef USE_GTK void x_wm_set_size_hint (struct frame *f, long flags, bool user_position) { +#ifndef USE_GTK XSizeHints size_hints; Window window = FRAME_OUTER_WINDOW (f); #ifdef USE_X_TOOLKIT @@ -22160,8 +22160,10 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) #endif /* PWinGravity */ XSetWMNormalHints (FRAME_X_DISPLAY (f), window, &size_hints); +#else + xg_wm_set_size_size_hint (f, flags, user_position); +#endif /* USE_GTK */ } -#endif /* not USE_GTK */ /* Used for IconicState or NormalState */ commit 0bb8e127b08dcddc67c7fd62b966d89db5135a79 Author: Paul Eggert Date: Sun Apr 17 17:54:25 2022 -0700 Port sqlite.c to OS X 10.6.8 with Xcode 3.2.6 Problem reported by Keith David Bershatsky in: https://lists.gnu.org/r/emacs-devel/2022-04/msg00923.html * src/sqlite.c (Fsqlite_open): Don’t assume SQLITE_OPEN_MEMORY is defined. diff --git a/src/sqlite.c b/src/sqlite.c index 1ca8669931..7388b576e9 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -240,38 +240,36 @@ DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0, If FILE is nil, an in-memory database will be opened instead. */) (Lisp_Object file) { - char *name; + Lisp_Object name; + int flags = (SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX + | SQLITE_OPEN_READWRITE); +#ifdef SQLITE_OPEN_URI + flags |= SQLITE_OPEN_URI; +#endif + if (!init_sqlite_functions ()) xsignal1 (Qerror, build_string ("sqlite support is not available")); if (!NILP (file)) + name = ENCODE_FILE (Fexpand_file_name (file, Qnil)); + else { - CHECK_STRING (file); - file = ENCODE_FILE (Fexpand_file_name (file, Qnil)); - name = xstrdup (SSDATA (file)); +#ifdef SQLITE_OPEN_MEMORY + /* In-memory database. These have to have different names to + refer to different databases. */ + AUTO_STRING (memory_fmt, ":memory:%d"); + name = CALLN (Fformat, memory_fmt, make_int (++db_count)); + flags |= SQLITE_OPEN_MEMORY; +#else + xsignal1 (Qerror, build_string ("sqlite in-memory is not available")); +#endif } - else - /* In-memory database. These have to have different names to - refer to different databases. */ - name = xstrdup (SSDATA (CALLN (Fformat, build_string (":memory:%d"), - make_int (++db_count)))); sqlite3 *sdb; - int ret = sqlite3_open_v2 (name, - &sdb, - SQLITE_OPEN_FULLMUTEX - | SQLITE_OPEN_READWRITE - | SQLITE_OPEN_CREATE - | (NILP (file) ? SQLITE_OPEN_MEMORY : 0) -#ifdef SQLITE_OPEN_URI - | SQLITE_OPEN_URI -#endif - | 0, NULL); - - if (ret != SQLITE_OK) + if (sqlite3_open_v2 (SSDATA (name), &sdb, flags, NULL) != SQLITE_OK) return Qnil; - return make_sqlite (false, sdb, NULL, name); + return make_sqlite (false, sdb, NULL, xstrdup (SSDATA (name))); } DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0, commit 29bf6e64fdad648642a79915d63fe543fdeaff8b Author: Po Lu Date: Mon Apr 18 00:50:15 2022 +0000 Fix Haiku menu bars when redisplay happens immediately after activation * src/haiku_support.cc (MessageReceived): Make `REPLAY_MENU_BAR' messages synchronous. (be_replay_menu_bar_event): Return whether or not the menu bar really opened. * src/haiku_support.h: Update prototypes. * src/haikumenu.c (haiku_activate_menubar): Immediately activate menu bar after replaying event. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 673ae02ac9..1feea6c450 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1335,7 +1335,7 @@ class EmacsMenuBar : public BMenuBar window->menus_begun = &menus_begun; set_mouse_position (pt.x, pt.y); - MouseDown (l); + BMenuBar::MouseDown (l); window->menus_begun = NULL; if (!menus_begun) @@ -1345,8 +1345,19 @@ class EmacsMenuBar : public BMenuBar } else if (msg->what == REPLAY_MENU_BAR) { + window = (EmacsWindow *) Window (); + menus_begun = false; + window->menus_begun = &menus_begun; + if (msg->FindPoint ("emacs:point", &pt) == B_OK) BMenuBar::MouseDown (pt); + + window->menus_begun = NULL; + + if (!menus_begun) + msg->SendReply (msg); + else + msg->SendReply (BE_MENU_BAR_OPEN); } else BMenuBar::MessageReceived (msg); @@ -4261,14 +4272,17 @@ be_drag_and_drop_in_progress (void) return drag_and_drop_in_progress; } -void +/* Replay the menu bar click event EVENT. Return whether or not the + menu bar actually opened. */ +bool be_replay_menu_bar_event (void *menu_bar, struct haiku_menu_bar_click_event *event) { BMenuBar *m = (BMenuBar *) menu_bar; BMessenger messenger (m); - BMessage msg (REPLAY_MENU_BAR); + BMessage reply, msg (REPLAY_MENU_BAR); msg.AddPoint ("emacs:point", BPoint (event->x, event->y)); - messenger.SendMessage (&msg); + messenger.SendMessage (&msg, &reply); + return reply.what == BE_MENU_BAR_OPEN; } diff --git a/src/haiku_support.h b/src/haiku_support.h index 6b285cf3e0..4718be4f84 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -636,7 +636,7 @@ extern bool be_drag_message (void *, void *, bool, void (*) (void), bool (*) (void)); extern bool be_drag_and_drop_in_progress (void); -extern void be_replay_menu_bar_event (void *, struct haiku_menu_bar_click_event *); +extern bool be_replay_menu_bar_event (void *, struct haiku_menu_bar_click_event *); #ifdef __cplusplus extern void *find_appropriate_view_for_draw (void *); diff --git a/src/haikumenu.c b/src/haikumenu.c index 46dde6496b..54ee3f160f 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -783,11 +783,17 @@ haiku_activate_menubar (struct frame *f) if (FRAME_OUTPUT_DATA (f)->saved_menu_event) { block_input (); - be_replay_menu_bar_event (FRAME_HAIKU_MENU_BAR (f), - FRAME_OUTPUT_DATA (f)->saved_menu_event); + rc = be_replay_menu_bar_event (FRAME_HAIKU_MENU_BAR (f), + FRAME_OUTPUT_DATA (f)->saved_menu_event); xfree (FRAME_OUTPUT_DATA (f)->saved_menu_event); FRAME_OUTPUT_DATA (f)->saved_menu_event = NULL; unblock_input (); + + if (!rc) + return; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; } else { commit 4b2b3c45d39721a60f8ed63c2a3e3ec9ff7e5004 Author: Po Lu Date: Mon Apr 18 08:25:45 2022 +0800 Some minor fixes to Motif DND support * src/xterm.c (xm_write_drag_initiator_info): Swap cardinal values if wrong byteorder. (xm_setup_dnd_targets): Read LONG_MAX amount of drag targets. diff --git a/src/xterm.c b/src/xterm.c index 4241b4d0d6..e00b38a681 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1353,6 +1353,12 @@ xm_write_drag_initiator_info (Display *dpy, Window wdesc, buf[0] = info->byteorder; buf[1] = info->protocol; + if (info->byteorder != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD16 (info->table_index); + SWAPCARD16 (info->selection); + } + *((uint16_t *) (buf + 2)) = info->table_index; *((uint32_t *) (buf + 4)) = info->selection; @@ -1473,8 +1479,7 @@ xm_setup_dnd_targets (struct x_display_info *dpyinfo, XGrabServer (dpyinfo->display); rc = XGetWindowProperty (dpyinfo->display, drag_window, dpyinfo->Xatom_MOTIF_DRAG_TARGETS, - /* Do larger values occur in practice? */ - 0L, 20000L, False, + 0L, LONG_MAX, False, dpyinfo->Xatom_MOTIF_DRAG_TARGETS, &actual_type, &actual_format, &nitems, &bytes_remaining, &tmp_data) == Success; commit 6cd43d62055c9ec27cacdcaff13d4a52b7efdff2 Merge: 27a4db9318 65c04e7115 Author: Paul Eggert Date: Sun Apr 17 13:10:19 2022 -0700 Merge from origin/emacs-28 65c04e7115 Update to Org 9.5.2-38-g682ccd commit 27a4db931898b8fe3164b329658ca33a1e3c1d4c Merge: 6662079b90 c2f94f32b5 Author: Paul Eggert Date: Sun Apr 17 13:10:19 2022 -0700 ; Merge from origin/emacs-28 The following commit was skipped: c2f94f32b5 Revert "Don’t assume openat" commit 6662079b9025d437477e58a81af994a6513d7408 Merge: 1dd8a00325 3cccf0a910 Author: Paul Eggert Date: Sun Apr 17 13:10:19 2022 -0700 Merge from origin/emacs-28 3cccf0a910 Don’t assume openat commit 1dd8a003253db74ccb724b5f0573fb2005fac07c Author: Jim Porter Date: Sun Apr 17 21:51:17 2022 +0200 Fix Eshell predicate tests when running from 'make check' * test/lisp/eshell/em-pred-tests.el (eshell-partial-let-func): Get original function after macro-expansion. diff --git a/test/lisp/eshell/em-pred-tests.el b/test/lisp/eshell/em-pred-tests.el index fbf8945215..7f88ac4475 100644 --- a/test/lisp/eshell/em-pred-tests.el +++ b/test/lisp/eshell/em-pred-tests.el @@ -95,13 +95,13 @@ behavior for real files. `(cl-letf ,(mapcar (lambda (override) - (let ((orig-function (symbol-function (car override)))) - `((symbol-function #',(car override)) + `((symbol-function #',(car override)) + (let ((orig-function (symbol-function #',(car override)))) (lambda (file &rest rest) (apply (if (and (stringp file) (string-prefix-p "/fake/" file)) ,(cadr override) - ,orig-function) + orig-function) file rest))))) overrides) ,@body)) commit 65c04e7115f329a083a16a364a8400e1685def61 (refs/remotes/origin/emacs-28) Author: Kyle Meyer Date: Sun Apr 17 15:30:39 2022 -0400 Update to Org 9.5.2-38-g682ccd diff --git a/doc/misc/org.org b/doc/misc/org.org index 60af81ea2c..3dce83c936 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -6405,7 +6405,7 @@ special repeaters =++= and =.+=. For example: Marking this DONE shifts the date to one month after today. ,** TODO Wash my hands - DEADLINE: <2019-04-05 08:00 Sun .+1h> + DEADLINE: <2019-04-05 08:00 Fri .+1h> Marking this DONE shifts the date to exactly one hour from now. #+end_example diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el index 81b7e4471f..775690f176 100644 --- a/lisp/org/oc-basic.el +++ b/lisp/org/oc-basic.el @@ -233,6 +233,8 @@ Return a hash table with citation references as keys and fields alist as values. entries))) entries)) +(defvar org-cite-basic--file-id-cache nil + "Hash table linking files to their hash.") (defun org-cite-basic--parse-bibliography (&optional info) "List all entries available in the buffer. @@ -245,14 +247,19 @@ table where keys are references and values are association lists between fields, as symbols, and values as strings or nil. Optional argument INFO is the export state, as a property list." + (unless (hash-table-p org-cite-basic--file-id-cache) + (setq org-cite-basic--file-id-cache (make-hash-table :test #'equal))) (if (plist-member info :cite-basic/bibliography) (plist-get info :cite-basic/bibliography) (let ((results nil)) (dolist (file (org-cite-list-bibliography-files)) (when (file-readable-p file) (with-temp-buffer - (insert-file-contents file) - (let* ((file-id (cons file (org-buffer-hash))) + (when (or (org-file-has-changed-p file) + (not (gethash file org-cite-basic--file-id-cache))) + (insert-file-contents file) + (puthash file (org-buffer-hash) org-cite-basic--file-id-cache)) + (let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache))) (entries (or (cdr (assoc file-id org-cite-basic--bibliography-cache)) (let ((table @@ -727,19 +734,24 @@ Return nil if there are no bibliography files or no entries." (t (clrhash org-cite-basic--completion-cache) (dolist (key (org-cite-basic--all-keys)) - (let ((completion - (concat - (let ((author (org-cite-basic--get-field 'author key nil t))) - (if author - (truncate-string-to-width - (replace-regexp-in-string " and " "; " author) - org-cite-basic-author-column-end nil ?\s) - (make-string org-cite-basic-author-column-end ?\s))) - org-cite-basic-column-separator - (let ((date (org-cite-basic--get-year key nil 'no-suffix))) - (format "%4s" (or date ""))) - org-cite-basic-column-separator - (org-cite-basic--get-field 'title key nil t)))) + (let* ((entry (org-cite-basic--get-entry + key + ;; Supply pre-calculated bibliography to avoid + ;; performance degradation. + (list :cite-basic/bibliography entries))) + (completion + (concat + (let ((author (org-cite-basic--get-field 'author entry nil 'raw))) + (if author + (truncate-string-to-width + (replace-regexp-in-string " and " "; " author) + org-cite-basic-author-column-end nil ?\s) + (make-string org-cite-basic-author-column-end ?\s))) + org-cite-basic-column-separator + (let ((date (org-cite-basic--get-year entry nil 'no-suffix))) + (format "%4s" (or date ""))) + org-cite-basic-column-separator + (org-cite-basic--get-field 'title entry nil t)))) (puthash completion key org-cite-basic--completion-cache))) (unless (map-empty-p org-cite-basic--completion-cache) ;no key (puthash entries t org-cite-basic--completion-cache) diff --git a/lisp/org/oc-biblatex.el b/lisp/org/oc-biblatex.el index 3cc157ec93..174725b424 100644 --- a/lisp/org/oc-biblatex.el +++ b/lisp/org/oc-biblatex.el @@ -164,12 +164,7 @@ INFO is the export state, as a property list." (mapconcat (lambda (r) (org-cite-biblatex--atomic-arguments (list r) info)) (org-cite-get-references citation) - "") - ;; According to BibLaTeX manual, left braces or brackets - ;; following a multicite command could be parsed as other - ;; arguments. So we stop any further parsing by inserting - ;; a \relax unconditionally. - "\\relax"))) + "")))) (defun org-cite-biblatex--command (citation info base &optional multi no-opt) "Return biblatex command using BASE name for CITATION object. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index ae0058e037..71aac271f7 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -4859,7 +4859,7 @@ Press `\\[org-agenda-manipulate-query-add]', \ ;;;###autoload (defun org-todo-list (&optional arg) - "Show all (not done) TODO entries from all agenda file in a single list. + "Show all (not done) TODO entries from all agenda files in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using `\\[universal-argument]', you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in @@ -5732,7 +5732,7 @@ displayed in agenda view." (org-before-first-heading-p) (and org-agenda-include-inactive-timestamps (org-at-clock-log-p)) - (not (eq 'timestamp (org-element-type (org-element-context))))) + (not (org-at-timestamp-p 'agenda))) (throw :skip nil)) (org-agenda-skip)) (let* ((pos (match-beginning 0)) @@ -7180,12 +7180,13 @@ The optional argument TYPE tells the agenda type." (concat (substring x 0 (match-end 1)) (unless (string= org-agenda-todo-keyword-format "") - (format org-agenda-todo-keyword-format - (match-string 2 x))) - ;; Remove `display' property as the icon could leak - ;; on the white space. - (org-add-props " " (org-plist-delete (text-properties-at 0 x) - 'display)) + (format org-agenda-todo-keyword-format + (match-string 2 x))) + (unless (string= org-agenda-todo-keyword-format "") + ;; Remove `display' property as the icon could leak + ;; on the white space. + (org-add-props " " (org-plist-delete (text-properties-at 0 x) + 'display))) (substring x (match-end 3))))))) x))) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 4ad87c84d0..c26eb6f10a 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -71,6 +71,35 @@ (defvar org-table-tab-recognizes-table.el) (defvar org-table1-hline-regexp) + +;;; Emacs < 29 compatibility + +(defvar org-file-has-changed-p--hash-table (make-hash-table :test #'equal) + "Internal variable used by `org-file-has-changed-p'.") + +(if (fboundp 'file-has-changed-p) + (defalias 'org-file-has-changed-p #'file-has-changed-p) + (defun org-file-has-changed-p (file &optional tag) + "Return non-nil if FILE has changed. +The size and modification time of FILE are compared to the size +and modification time of the same FILE during a previous +invocation of `org-file-has-changed-p'. Thus, the first invocation +of `org-file-has-changed-p' always returns non-nil when FILE exists. +The optional argument TAG, which must be a symbol, can be used to +limit the comparison to invocations with identical tags; it can be +the symbol of the calling function, for example." + (let* ((file (directory-file-name (expand-file-name file))) + (remote-file-name-inhibit-cache t) + (fileattr (file-attributes file 'integer)) + (attr (and fileattr + (cons (file-attribute-size fileattr) + (file-attribute-modification-time fileattr)))) + (sym (concat (symbol-name tag) "@" file)) + (cachedattr (gethash sym org-file-has-changed-p--hash-table))) + (when (not (equal attr cachedattr)) + (puthash sym attr org-file-has-changed-p--hash-table))))) + + ;;; Emacs < 28.1 compatibility diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index c4daed1665..860fd6e560 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -462,14 +462,14 @@ This may be useful when columns have been shrunk." (when pos (goto-char pos)) (goto-char (line-beginning-position)) (let ((end (line-end-position)) str) - (backward-char) + (goto-char (1- pos)) (while (progn (forward-char 1) (< (point) end)) (let ((ov (car (overlays-at (point))))) (if (not ov) (push (char-to-string (char-after)) str) (push (overlay-get ov 'display) str) (goto-char (1- (overlay-end ov)))))) - (format "%s" (mapconcat #'identity (reverse str) ""))))) + (format "|%s" (mapconcat #'identity (reverse str) ""))))) (defvar-local org-table-header-overlay nil) (defun org-table-header-set-header () diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index e82dbbf398..5cc98e3806 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5.2-25-gaf6f12")) + (let ((org-git-version "release_9.5.2-38-g682ccd")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index d656a51591..4524812c55 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -199,6 +199,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-update-radio-target-regexp "ol" ()) (defvar org-element-paragraph-separate) +(defvar org-element--timestamp-regexp) (defvar org-indent-indentation-per-level) (defvar org-radio-target-regexp) (defvar org-target-link-regexp) @@ -15020,7 +15021,11 @@ When matching, the match groups are the following: group 4: day name group 5: hours, if any group 6: minutes, if any" - (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2)) + (let* ((regexp (if extended + (if (eq extended 'agenda) + org-element--timestamp-regexp + org-ts-regexp3) + org-ts-regexp2)) (pos (point)) (match? (let ((boundaries (org-in-regexp regexp))) @@ -15051,7 +15056,8 @@ When matching, the match groups are the following: ((org-pos-in-match-range pos 8) 'minute) ((or (org-pos-in-match-range pos 4) (org-pos-in-match-range pos 5)) 'day) - ((and (> pos (or (match-end 8) (match-end 5))) + ((and (or (match-end 8) (match-end 5)) + (> pos (or (match-end 8) (match-end 5))) (< pos (match-end 0))) (- pos (or (match-end 8) (match-end 5)))) (t 'day)))) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 5de0b5d675..81ef002a05 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -442,7 +442,7 @@ property on the headline itself.") { font-size: 10px; font-weight: bold; white-space: nowrap; } .org-info-js_search-highlight { background-color: #ffff00; color: #000000; font-weight: bold; } - .org-svg { width: 90%; } + .org-svg { } " "The default style specification for exported HTML files. You can use `org-html-head' and `org-html-head-extra' to add to commit c2f94f32b5e8f57e2b4e723c9799cf0e5f5e5bcc Author: Eli Zaretskii Date: Sun Apr 17 22:03:52 2022 +0300 Revert "Don’t assume openat" This reverts commit 3cccf0a9107d585173e527550bbc45253624ca2e. This is a change with far-reaching effects on MS-Windows at the least, where file-related APIs are shadowed to support transparent support for UTF-8 encoded file names. Making such changes on a stable branch for the benefit of a proprietary platform with a 13-year old OS is a tail wagging the dog. Please don't do that without discussing first. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 217a38bc07..57a5eff3bf 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1412,7 +1412,8 @@ local_sockname (int s, char sockname[socknamesize], int tmpdirlen, char *emacsdirend = sockname + tmpdirlen + suffixlen - strlen(server_name) - 1; *emacsdirend = '\0'; - int dir = open (sockname, O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC); + int dir = openat (AT_FDCWD, sockname, + O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC); *emacsdirend = '/'; if (dir < 0) return errno; diff --git a/src/sysdep.c b/src/sysdep.c index f6d139421a..72be25f661 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2302,20 +2302,6 @@ emacs_fstatat (int dirfd, char const *filename, void *st, int flags) return r; } -static int -sys_openat (int dirfd, char const *file, int oflags, int mode) -{ -#ifdef O_PATH - return openat (dirfd, file, oflags, mode); -#else - /* On platforms without O_PATH, emacs_openat's callers arrange for - DIRFD to be AT_FDCWD, so it should be safe to just call 'open'. - This ports to old platforms like OS X 10.9 that lack openat. */ - eassert (dirfd == AT_FDCWD); - return open (file, oflags, mode); -#endif -} - /* Assuming the directory DIRFD, open FILE for Emacs use, using open flags OFLAGS and mode MODE. Use binary I/O on systems that care about text vs binary I/O. @@ -2331,7 +2317,7 @@ emacs_openat (int dirfd, char const *file, int oflags, int mode) if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; - while ((fd = sys_openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) + while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) maybe_quit (); return fd; } @@ -2344,19 +2330,26 @@ emacs_open (char const *file, int oflags, int mode) /* Same as above, but doesn't allow the user to quit. */ -int -emacs_open_noquit (char const *file, int oflags, int mode) +static int +emacs_openat_noquit (int dirfd, const char *file, int oflags, + int mode) { int fd; if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; do - fd = open (file, oflags, mode); + fd = openat (dirfd, file, oflags, mode); while (fd < 0 && errno == EINTR); return fd; } +int +emacs_open_noquit (char const *file, int oflags, int mode) +{ + return emacs_openat_noquit (AT_FDCWD, file, oflags, mode); +} + /* Open FILE as a stream for Emacs use, with mode MODE. Act like emacs_open with respect to threads, signals, and quits. */ commit c5253aa01eef0f080fdfa53e4b0ada20a6782e53 Author: Lars Ingebrigtsen Date: Sun Apr 17 20:21:40 2022 +0200 Make desktop.el use local-minor-modes when saving * lisp/desktop.el (desktop-buffer-info): Use a more reliable way to get minor modes (bug#29972). diff --git a/lisp/desktop.el b/lisp/desktop.el index 7e3d66bdf1..cd581e028b 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -847,15 +847,16 @@ buffer, which is (in order): ,(buffer-name) ,major-mode ;; minor modes - ,(let (ret) - (dolist (minor-mode (mapcar #'car minor-mode-alist) ret) - (and (boundp minor-mode) - (symbol-value minor-mode) - (let* ((special (assq minor-mode desktop-minor-mode-table)) - (value (cond (special (cadr special)) - ((get minor-mode :minor-mode-function)) - ((functionp minor-mode) minor-mode)))) - (when value (cl-pushnew value ret)))))) + ,(seq-filter + (lambda (minor-mode) + ;; Just two sanity checks. + (and (boundp minor-mode) + (symbol-value minor-mode) + (let ((special + (assq minor-mode desktop-minor-mode-table))) + (or (not special) + (cadr special))))) + local-minor-modes) ;; point and mark, and read-only status ,(point) ,(list (mark t) mark-active) commit 3cccf0a9107d585173e527550bbc45253624ca2e Author: Paul Eggert Date: Sun Apr 17 10:41:17 2022 -0700 Don’t assume openat Use openat only on platforms with O_PATH. This ports to OS X 10.9 and earlier. Problem reported by Keith David Bershatsky in: https://lists.gnu.org/r/emacs-devel/2022-04/msg00805.html * lib-src/emacsclient.c (local_sockname): Use open, not openat. * src/sysdep.c (sys_openat): New static function, which uses openat only if O_PATH is defined. (emacs_openat): Use it instead of openat. (emacs_openat_noquit): Remove. (emacs_open_noquit): Reimplement as per the old emacs_openat_noquit, but use plain 'open'. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 57a5eff3bf..217a38bc07 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1412,8 +1412,7 @@ local_sockname (int s, char sockname[socknamesize], int tmpdirlen, char *emacsdirend = sockname + tmpdirlen + suffixlen - strlen(server_name) - 1; *emacsdirend = '\0'; - int dir = openat (AT_FDCWD, sockname, - O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC); + int dir = open (sockname, O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC); *emacsdirend = '/'; if (dir < 0) return errno; diff --git a/src/sysdep.c b/src/sysdep.c index 72be25f661..f6d139421a 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2302,6 +2302,20 @@ emacs_fstatat (int dirfd, char const *filename, void *st, int flags) return r; } +static int +sys_openat (int dirfd, char const *file, int oflags, int mode) +{ +#ifdef O_PATH + return openat (dirfd, file, oflags, mode); +#else + /* On platforms without O_PATH, emacs_openat's callers arrange for + DIRFD to be AT_FDCWD, so it should be safe to just call 'open'. + This ports to old platforms like OS X 10.9 that lack openat. */ + eassert (dirfd == AT_FDCWD); + return open (file, oflags, mode); +#endif +} + /* Assuming the directory DIRFD, open FILE for Emacs use, using open flags OFLAGS and mode MODE. Use binary I/O on systems that care about text vs binary I/O. @@ -2317,7 +2331,7 @@ emacs_openat (int dirfd, char const *file, int oflags, int mode) if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; - while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) + while ((fd = sys_openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) maybe_quit (); return fd; } @@ -2330,26 +2344,19 @@ emacs_open (char const *file, int oflags, int mode) /* Same as above, but doesn't allow the user to quit. */ -static int -emacs_openat_noquit (int dirfd, const char *file, int oflags, - int mode) +int +emacs_open_noquit (char const *file, int oflags, int mode) { int fd; if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; do - fd = openat (dirfd, file, oflags, mode); + fd = open (file, oflags, mode); while (fd < 0 && errno == EINTR); return fd; } -int -emacs_open_noquit (char const *file, int oflags, int mode) -{ - return emacs_openat_noquit (AT_FDCWD, file, oflags, mode); -} - /* Open FILE as a stream for Emacs use, with mode MODE. Act like emacs_open with respect to threads, signals, and quits. */ commit 58a0c2e9c3df70079f0839a5c204b6ee29f2d087 Author: Eli Zaretskii Date: Sun Apr 17 20:36:36 2022 +0300 Improve the support for the Brahmi script * lisp/leim/quail/indian.el ("brahmi"): New input method. * lisp/language/indian.el ("Brahmi"): Add sample-text and input-method. (Bug#54914) * etc/NEWS: Mention the brahmi input method. * etc/HELLO: Add a Brahmi greeting. diff --git a/etc/HELLO b/etc/HELLO index da9b388f36..dbbcc0493b 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -27,9 +27,11 @@ Arabic (العربيّة) السّلام عليكم Armenian (հայերեն) Բարև ձեզ Belarusian (беларуская) Прывітанне Bengali (বাংলা) নমস্কার +Brahmi (𑀩𑁆𑀭𑀸𑀳𑁆𑀫𑀻) 𑀦𑀫𑀲𑁆𑀢𑁂 + Braille ⠓⠑⠇⠇⠕ Burmese (မြန်မာ) မင်္ဂလာပါ -C printf ("Hello, world!\n"); +C printf (orange red"Hello, world!\n"); Cham (ꨌꩌ) ꨦꨤꩌ ꨦꨁꨰ Cherokee (ᏣᎳᎩ ᎦᏬᏂᎯᏍᏗ) ᎣᏏᏲ / ᏏᏲ Comanche /kəˈmæntʃiː/ Haa marʉ́awe diff --git a/etc/NEWS b/etc/NEWS index a59c9691b2..ec56839c06 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -622,7 +622,8 @@ This uses the Tai Tham script, whose support has been enhanced. *** New language environment "Brahmi". This language environment supports Brahmi, which is a historical -script that was used in ancient South Asia. +script that was used in ancient South Asia. A new input method, +'brahmi', is provided to type text in this script. * Changes in Specialized Modes and Packages in Emacs 29.1 diff --git a/lisp/language/indian.el b/lisp/language/indian.el index ef095ddc3b..c3d59b6f77 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -130,7 +130,8 @@ South Indian language Malayalam is supported in this language environment.")) "Brahmi" '((charset unicode) (coding-system utf-8) (coding-priority utf-8) - ; (input-method . "brahmi") ; FIXME + (input-method . "brahmi") + (sample-text . "Brahmi (𑀩𑁆𑀭𑀸𑀳𑁆𑀫𑀻) 𑀦𑀫𑀲𑁆𑀢𑁂") (documentation . "\ The ancient Brahmi script is supported in this language environment.")) '("Indian")) ; Should we have an "Old" category? diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index 6641aa6b2e..f2d5f9bad4 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -696,4 +696,144 @@ Full key sequences are listed below:") (quail-defrule "|" ?‌) (quail-defrule "||" ?​) +(quail-define-package + "brahmi" "Brahmi" "𑀲" t "Brahmi phonetic input method. + + `\\=`' is used to switch levels instead of Alt-Gr. +" nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("``" ?₹) + ("1" ?𑁧) + ("`1" ?1) + ("`!" ?𑁒) + ("2" ?𑁨) + ("`2" ?2) + ("`@" ?𑁓) + ("3" ?𑁩) + ("`3" ?3) + ("`#" ?𑁔) + ("4" ?𑁪) + ("`4" ?4) + ("`$" ?𑁕) + ("5" ?𑁫) + ("`5" ?5) + ("`%" ?𑁖) + ("6" ?𑁬) + ("`6" ?6) + ("`^" ?𑁗) + ("7" ?𑁭) + ("`7" ?7) + ("`&" ?𑁘) + ("8" ?𑁮) + ("`8" ?8) + ("`*" ?𑁙) + ("9" ?𑁯) + ("`9" ?9) + ("`\(" ?𑁚) + ("0" ?𑁦) + ("`0" ?0) + ("`\)" ?𑁛) + ("`-" ?𑁜) + ("`_" ?𑁝) + ("`=" ?𑁞) + ("`+" ?𑁟) + ("`\\" ?𑁇) + ("`|" ?𑁈) + ("`" ?𑀝) + ("q" ?𑀝) + ("Q" ?𑀞) + ("`q" ?𑀃) + ("`Q" ?𑁠) + ("w" ?𑀟) + ("W" ?𑀠) + ("`w" ?𑀄) + ("`W" ?𑁡) + ("e" ?𑁂) + ("E" ?𑁃) + ("`e" ?𑀏) + ("`E" ?𑀐) + ("r" ?𑀭) + ("R" ?𑀾) + ("`r" ?𑀋) + ("`R" ?𑀶) + ("t" ?𑀢) + ("T" ?𑀣) + ("`t" ?𑁢) + ("y" ?𑀬) + ("Y" ?𑁣) + ("`y" ?𑁤) + ("`Y" ?𑁥) + ("u" ?𑀼) + ("U" ?𑀽) + ("`u" ?𑀉) + ("`U" ?𑀊) + ("i" ?𑀺) + ("I" ?𑀻) + ("`i" ?𑀇) + ("`I" ?𑀈) + ("o" ?𑁄) + ("O" ?𑁅) + ("`o" ?𑀑) + ("`O" ?𑀒) + ("p" ?𑀧) + ("P" ?𑀨) + ("`p" ?𑁳) + ("`P" ?𑁱) + ("`\[" ?𑁴) + ("`\{" ?𑁲) + ("a" ?𑀸) + ("A" ?𑀆) + ("`a" ?𑀅) + ("`A" ?𑀹) + ("s" ?𑀲) + ("S" ?𑀰) + ("`s" ?𑀱) + ("d" ?𑀤) + ("D" ?𑀥) + ("`d" ?𑀶) + ("f" ?𑁆) + ("F" ?𑀿) + ("`f" ?𑀌) + ("`F" ?𑁰) + ("g" ?𑀕) + ("G" ?𑀖) + ("h" ?𑀳) + ("H" ?𑀂) + ("j" ?𑀚) + ("J" ?𑀛) + ("k" ?𑀓) + ("K" ?𑀔) + ("l" ?𑀮) + ("L" ?𑀴) + ("`l" ?𑀵) + ("`L" ?𑁵) + ("z" ?𑁀) + ("Z" ?𑀍) + ("`z" ?𑁁) + ("`Z" ?𑀎) + ("x" ?𑁉) + ("X" ?𑁊) + ("`x" ?𑁋) + ("`X" ?𑁌) + ("c" ?𑀘) + ("C" ?𑀙) + ("`c" #x200C) ; ZWNJ + ("`C" #x200D) ; ZWJ + ("v" ?𑀯) + ("V" ?𑀷) + ("b" ?𑀩) + ("B" ?𑀪) + ("n" ?𑀦) + ("N" ?𑀡) + ("`n" ?𑀗) + ("`N" ?𑀜) + ("m" ?𑀫) + ("M" ?𑀁) + ("`m" ?𑀀) + ("<" ?𑁍) + ("`/" ?𑁿) + ) + + ;;; indian.el ends here commit 078e1f289cfeec95db8fb0a5338383edb094e018 Author: kobarity Date: Sun Apr 17 19:28:15 2022 +0200 Fix fontifying type hints in python-mode * lisp/progmodes/python.el (python-font-lock-keywords-maximum-decoration): Avoid fontifying type hints as variable names (bug#54992). Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index c4d8b123a8..f355055806 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -706,7 +706,8 @@ avoid '==' being treated as an assignment." ;; [a] = 5 ;; [*a] = 5, 6 (,(python-font-lock-assignment-matcher - (python-rx (or "[" "(") (* space) + (python-rx (or line-start ?\;) (* space) + (or "[" "(") (* space) grouped-assignment-target (* space) (or ")" "]") (* space) assignment-operator)) commit 01282cbd801a2f09316c35fca37a7501b92992a1 Author: Lars Ingebrigtsen Date: Sun Apr 17 18:59:59 2022 +0200 Allow editing variable values in *Help* buffers * lisp/help-fns.el (help-enable-variable-value-editing): New user option. (describe-variable): Tag values for editing. (help-fns--editable-variable, help-fns-edit-variable): New functions (bug#36826). (help-fns--edit-value-mode-map, help-fns--edit-value-mode) (help-fns-edit-mode-done): New mode and commands. diff --git a/etc/NEWS b/etc/NEWS index 3821dac179..a59c9691b2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -405,6 +405,12 @@ command also works for non-Emoji characters.) ** Help +--- +*** New user option 'help-enable-variable-value-editing'. +If enabled, 'e' on a value in *Help* will pop you to a new buffer +where you can edit the value. This is not enabled by default, because +it's easy to make an edit that yields an invalid result. + --- *** 'C-h b' uses outlining by default. Set 'describe-bindings-outline' to nil to get the old behavior. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 309cf0b85a..72d773403f 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -133,6 +133,14 @@ with the current prefix. The files are chosen according to :group 'help :version "26.3") +(defcustom help-enable-variable-value-editing nil + "If non-nil, allow editing values in *Help* buffers. +Values that aren't readable by the Emacs Lisp reader can't be +edited even if this option is enabled." + :type 'boolean + :group 'help + :version "29.1") + (defcustom help-enable-symbol-autoload nil "Perform autoload if docs are missing from autoload objects." :type 'boolean @@ -1167,10 +1175,11 @@ it is displayed along with the global value." (let ((rep (let ((print-quoted t) (print-circle t)) - (cl-prin1-to-string val)))) - (if (and (symbolp val) (not (booleanp val))) + (cl-prin1-to-string val)))) + (if (and (symbolp val) (not (booleanp val))) (format-message "`%s'" rep) - rep)))) + rep))) + (start (point))) (if (< (+ (length print-rep) (point) (- line-beg)) 68) (insert " " print-rep) (terpri) @@ -1185,6 +1194,8 @@ it is displayed along with the global value." (insert-buffer-substring pp-buffer))))) ;; Remove trailing newline. (and (= (char-before) ?\n) (delete-char -1))) + (help-fns--editable-variable start (point) + variable val buffer) (let* ((sv (get variable 'standard-value)) (origval (and (consp sv) (condition-case nil @@ -1204,6 +1215,8 @@ it is displayed along with the global value." (save-restriction (narrow-to-region from (point)) (save-excursion (pp-buffer))) + (help-fns--editable-variable from (point) + variable origval buffer) (if (< (point) (+ from 20)) (delete-region (1- from) from))))))) (terpri) @@ -1236,7 +1249,9 @@ it is displayed along with the global value." ;; See previous comment for this function. ;; (help-xref-on-pp from (point)) (if (< (point) (+ from 20)) - (delete-region (1- from) from))))))) + (delete-region (1- from) from)) + (help-fns--editable-variable + from (point) variable global-val buffer)))))) (terpri)) ;; If the value is large, move it to the end. @@ -1286,6 +1301,62 @@ it is displayed along with the global value." ;; Return the text we displayed. (buffer-string)))))))) +(defun help-fns--editable-variable (start end variable value buffer) + (when (and (readablep value) help-enable-variable-value-editing) + (add-text-properties + start end + (list 'help-echo "`e' to edit the value" + 'help-fns--edit-variable (list variable value buffer + (current-buffer)) + 'keymap (define-keymap + "e" #'help-fns-edit-variable))))) + +(defvar help-fns--edit-variable) + +(put 'help-fns-edit-variable 'disabled t) +(defun help-fns-edit-variable () + "Edit the variable under point." + (interactive) + (declare (completion ignore)) + (let ((var (get-text-property (point) 'help-fns--edit-variable))) + (unless var + (error "No variable under point")) + (pop-to-buffer-same-window (format "*edit %s*" (nth 0 var))) + (prin1 (nth 1 var) (current-buffer)) + (pp-buffer) + (goto-char (point-min)) + (insert (format ";; Edit the `%s' variable.\n" (nth 0 var)) + ";; C-c C-c to update the value and exit.\n\n") + (help-fns--edit-value-mode) + (setq-local help-fns--edit-variable var))) + +(defvar-keymap help-fns--edit-value-mode-map + "C-c C-c" #'help-fns-edit-mode-done) + +(define-derived-mode help-fns--edit-value-mode emacs-lisp-mode "Elisp" + :interactive nil) + +(defun help-fns-edit-mode-done (&optional kill) + "Update the value of the variable and kill the buffer. +If KILL (the prefix), don't update the value, but just kill the +current buffer." + (interactive "P" help-fns--edit-value-mode) + (unless help-fns--edit-variable + (error "Invalid buffer")) + (goto-char (point-min)) + (cl-destructuring-bind (variable _ buffer help-buffer) + help-fns--edit-variable + (unless (buffer-live-p buffer) + (error "Original buffer is gone; can't update")) + (unless kill + (let ((value (read (current-buffer)))) + (with-current-buffer buffer + (set variable value)))) + (kill-buffer (current-buffer)) + (when (buffer-live-p help-buffer) + (with-current-buffer help-buffer + (revert-buffer))))) + (defun help-fns--run-describe-functions (functions &rest args) (with-current-buffer standard-output (unless (bolp) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index d1b9357f3c..cb87035281 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -393,7 +393,8 @@ The format is (FUNCTION ARGS...).") ;;;###autoload (define-derived-mode help-mode special-mode "Help" "Major mode for viewing help text and navigating references in it. -Entry to this mode runs the normal hook `help-mode-hook'. +Also see the `help-enable-editing' variable. + Commands: \\{help-mode-map}" (setq-local revert-buffer-function commit b49cca70128246a4e9a226bfc6eb08e934a7043f Author: Lars Ingebrigtsen Date: Sun Apr 17 17:36:58 2022 +0200 Make :filters run in the correct buffer in describe-buffer-bindings * lisp/help.el (describe-map-tree): Take an optional buffer parameter. (describe-map): Ditto, and use it to run `lookup-key' in the correct buffer. This fixes problems of filters being run in the wrong buffer (bug#39149). * src/keymap.c (Fdescribe_buffer_bindings): Pass in BUFFER to describe-map-tree. diff --git a/lisp/help.el b/lisp/help.el index 9cde65f797..0d516cf9f6 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1274,7 +1274,8 @@ Otherwise, return a new string." (defvar help--keymaps-seen nil) (defun describe-map-tree (startmap &optional partial shadow prefix title - no-menu transl always-title mention-shadow) + no-menu transl always-title mention-shadow + buffer) "Insert a description of the key bindings in STARTMAP. This is followed by the key bindings of all maps reachable through STARTMAP. @@ -1300,7 +1301,10 @@ maps to look through. If MENTION-SHADOW is non-nil, then when something is shadowed by SHADOW, don't omit it; instead, mention it but say it is -shadowed." +shadowed. + +If BUFFER, lookup keys while in that buffer. This only affects +things like :filters for menu bindings." (let* ((amaps (accessible-keymaps startmap prefix)) (orig-maps (if no-menu (progn @@ -1341,7 +1345,8 @@ shadowed." (setq sub-shadows (cons (cdr (car tail)) sub-shadows))) (setq tail (cdr tail)))) (describe-map (cdr elt) elt-prefix transl partial - sub-shadows no-menu mention-shadow))) + sub-shadows no-menu mention-shadow + buffer))) (setq maps (cdr maps))) ;; Print title... (when (and print-title @@ -1419,13 +1424,13 @@ Return nil if the key sequence is too long." (t nil)))) (defun describe-map (map &optional prefix transl partial shadow - nomenu mention-shadow) + nomenu mention-shadow buffer) "Describe the contents of keymap MAP. Assume that this keymap itself is reached by the sequence of prefix keys PREFIX (a string or vector). -TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in -`describe-map-tree'." +TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW and BUFFER are as +in `describe-map-tree'." ;; Converted from describe_map in keymap.c. (let* ((suppress (and partial 'suppress-keymap)) (map (keymap-canonicalize map)) @@ -1476,7 +1481,10 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in ((and mention-shadow (not (eq tem definition))) (setq this-shadowed t)) (t nil)))) - (eq definition (lookup-key tail (vector event) t)) + (eq definition (if buffer + (with-current-buffer buffer + (lookup-key tail (vector event) t)) + (lookup-key tail (vector event) t))) (push (list event definition this-shadowed) vect)))) ((eq (car tail) 'keymap) ;; The same keymap might be in the structure twice, if diff --git a/src/keymap.c b/src/keymap.c index 83c54e2630..da0a52bd2c 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2867,7 +2867,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, Vkey_translation_map, Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } /* Print the (major mode) local map. */ @@ -2881,7 +2881,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); start1 = Qnil; } @@ -2894,7 +2894,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); } else @@ -2917,7 +2917,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); } @@ -2950,7 +2950,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, maps[i], Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (maps[i], shadow); SAFE_FREE (); } @@ -2968,7 +2968,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); } else { @@ -2976,7 +2976,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); } shadow = Fcons (start1, shadow); @@ -2987,7 +2987,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, current_global_map, Qt, shadow, prefix, - msg, nomenu, Qnil, Qt, Qnil); + msg, nomenu, Qnil, Qt, Qnil, buffer); /* Print the function-key-map translations under this prefix. */ if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) @@ -2996,7 +2996,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, KVAR (current_kboard, Vlocal_function_key_map), Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } /* Print the input-decode-map translations under this prefix. */ @@ -3006,7 +3006,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, KVAR (current_kboard, Vinput_decode_map), Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } return Qnil; } commit dd451a37ddf9e1358c56bdb9c65606c1a7967f07 Author: Eli Zaretskii Date: Sun Apr 17 18:45:23 2022 +0300 ; Minor fix for 'restart-emacs' on MS-Windows * src/w32.c (w32_reexec_emacs): Fail if in -nw session. * src/emacs.c (Fkill_emacs): Fix a typo. diff --git a/src/emacs.c b/src/emacs.c index 8c897762a2..fd79963ed9 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2820,7 +2820,7 @@ killed. */ if (initial_argc < 1) error ("No command line arguments known; unable to re-execute Emacs"); #ifdef WINDOWSNT - if (w32_reexec_emacs (initial_cmdline, initial_wd) < 1) + if (w32_reexec_emacs (initial_cmdline, initial_wd) < 0) #else if (execvp (*initial_argv, initial_argv) < 1) #endif diff --git a/src/w32.c b/src/w32.c index acd7d004e5..ae1d77a021 100644 --- a/src/w32.c +++ b/src/w32.c @@ -10623,6 +10623,12 @@ realpath (const char *file_name, char *resolved_name) int w32_reexec_emacs (char *cmd_line, const char *wdir) { + if (inhibit_window_system) + { + errno = ENOSYS; + return -1; /* FIXME! */ + } + STARTUPINFO si; SECURITY_ATTRIBUTES sec_attrs; BOOL status; commit 988325f95a12a4cb4c746f41fd457476fa175260 Author: Eli Zaretskii Date: Sun Apr 17 17:48:13 2022 +0300 ; * lisp/language/indian.el ("Brahmi"): Fix display of vowels. diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 0a50dd999f..ef095ddc3b 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -397,7 +397,7 @@ The ancient Brahmi script is supported in this language environment.")) ;; Brahmi composition rules (let ((consonant "[\U00011013-\U00011034]") (non-consonant "[^\U00011013-\U00011034\U00011046\U0001107F]") - (vowel "[\U00011038-\U0001103D\U00011042-\U00011045]") + (vowel "[\U00011038-\U00011045]") (numeral "[\U00011052-\U00011065]") (multiplier "[\U00011064\U00011065]") (virama "\U00011046") commit 5a63af876bc131b07e066aa9d60780de0562bcb0 Author: Eli Zaretskii Date: Sun Apr 17 17:20:03 2022 +0300 Fix 'restart-emacs' on MS-Windows * src/w32.c (w32_reexec_emacs): New function, emulation of 'execvp' on Posix systems. * src/w32.h (w32_reexec_emacs): Add prototype. * src/emacs.c (main) [WINDOWSNT]: Save the original command line and working directory. (Fkill_emacs) [WINDOWSNT]: Call 'w32_reexec_emacs' instead of 'execvp'. (Bug#17036) diff --git a/src/emacs.c b/src/emacs.c index a16e702ab7..8c897762a2 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -159,6 +159,10 @@ Lisp_Object empty_unibyte_string, empty_multibyte_string; #ifdef WINDOWSNT /* Cache for externally loaded libraries. */ Lisp_Object Vlibrary_cache; +/* Original command line string as received from the OS. */ +static char *initial_cmdline; +/* Original working directory when invoked. */ +static const char *initial_wd; #endif struct gflags gflags; @@ -1319,6 +1323,7 @@ main (int argc, char **argv) } } init_heap (use_dynamic_heap); + initial_cmdline = GetCommandLine (); #endif #if defined WINDOWSNT || defined HAVE_NTGUI /* Set global variables used to detect Windows version. Do this as @@ -1465,6 +1470,9 @@ main (int argc, char **argv) #endif emacs_wd = emacs_get_current_dir_name (); +#ifdef WINDOWSNT + initial_wd = emacs_wd; +#endif #ifdef HAVE_PDUMPER if (dumped_with_pdumper_p ()) pdumper_record_wd (emacs_wd); @@ -2811,7 +2819,11 @@ killed. */ (on some systems) with no argv. */ if (initial_argc < 1) error ("No command line arguments known; unable to re-execute Emacs"); +#ifdef WINDOWSNT + if (w32_reexec_emacs (initial_cmdline, initial_wd) < 1) +#else if (execvp (*initial_argv, initial_argv) < 1) +#endif error ("Unable to re-execute Emacs"); } diff --git a/src/w32.c b/src/w32.c index 0dc874eac4..acd7d004e5 100644 --- a/src/w32.c +++ b/src/w32.c @@ -10614,6 +10614,49 @@ realpath (const char *file_name, char *resolved_name) return xstrdup (tgt); } +/* A replacement for Posix execvp, used to restart Emacs. This is + needed because the low-level Windows API to start processes accepts + the command-line arguments as a single string, so we cannot safely + use the MSVCRT execvp emulation, because elements of argv[] that + have embedded blanks and tabs will not be passed correctly to the + restarted Emacs. */ +int +w32_reexec_emacs (char *cmd_line, const char *wdir) +{ + STARTUPINFO si; + SECURITY_ATTRIBUTES sec_attrs; + BOOL status; + PROCESS_INFORMATION proc_info; + + GetStartupInfo (&si); /* Use the same startup info as the caller. */ + sec_attrs.nLength = sizeof (sec_attrs); + sec_attrs.lpSecurityDescriptor = NULL; + sec_attrs.bInheritHandle = FALSE; + + /* Make sure we are in the original directory, in case the command + line specifies the program as a relative file name. */ + chdir (wdir); + + status = CreateProcess (NULL, /* program */ + cmd_line, /* command line */ + &sec_attrs, /* process attributes */ + NULL, /* thread attributes */ + TRUE, /* inherit handles? */ + NORMAL_PRIORITY_CLASS, + NULL, /* environment */ + wdir, /* initial directory */ + &si, /* startup info */ + &proc_info); + if (status) + { + CloseHandle (proc_info.hThread); + CloseHandle (proc_info.hProcess); + exit (0); + } + errno = ENOEXEC; + return -1; +} + /* globals_of_w32 is used to initialize those global variables that must always be initialized on startup even when the global variable diff --git a/src/w32.h b/src/w32.h index 4941170bdc..dc91c595c4 100644 --- a/src/w32.h +++ b/src/w32.h @@ -244,6 +244,9 @@ extern int w32_init_random (void *, ptrdiff_t); extern Lisp_Object w32_read_registry (HKEY, Lisp_Object, Lisp_Object); +/* Used instead of execvp to restart Emacs. */ +extern int w32_reexec_emacs (char *, const char *); + #ifdef HAVE_GNUTLS #include commit 56d5a4079423aa22d2203a342439df7359eb1c18 Author: Lars Ingebrigtsen Date: Sun Apr 17 15:46:24 2022 +0200 Add a `restart-emacs' sanity check * src/emacs.c (Fkill_emacs): Add a sanity check for argv. diff --git a/src/emacs.c b/src/emacs.c index 173e8e8923..a16e702ab7 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2807,6 +2807,10 @@ killed. */ if (!NILP (restart)) { + /* This is very unlikely, but it's possible to execute a binary + (on some systems) with no argv. */ + if (initial_argc < 1) + error ("No command line arguments known; unable to re-execute Emacs"); if (execvp (*initial_argv, initial_argv) < 1) error ("Unable to re-execute Emacs"); } commit ec025f22ef9642aa6d1d8b4ced6820aeb708d7d7 Author: Po Lu Date: Sun Apr 17 21:23:35 2022 +0800 Handle bad actual actions during DND * src/xterm.c (x_dnd_begin_drag_and_drop): Behave correctly when the target gives us a bad atom. diff --git a/src/xterm.c b/src/xterm.c index ab4dcc3841..4241b4d0d6 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9844,10 +9844,18 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (x_dnd_action != None) { block_input (); + x_catch_errors (FRAME_X_DISPLAY (f)); atom_name = XGetAtomName (FRAME_X_DISPLAY (f), x_dnd_action); - action = intern (atom_name); - XFree (atom_name); + x_uncatch_errors (); + + if (atom_name) + { + action = intern (atom_name); + XFree (atom_name); + } + else + action = Qnil; unblock_input (); return action; commit b38c3fe8632ec0ee4f180dae2938959bd8b4c46e Author: Lars Ingebrigtsen Date: Sun Apr 17 15:00:00 2022 +0200 Check whether we can restart in Fkill_emacs * src/emacs.c (Fkill_emacs): Report an error if we can't restart. diff --git a/src/emacs.c b/src/emacs.c index 50b1628d20..173e8e8923 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2807,7 +2807,8 @@ killed. */ if (!NILP (restart)) { - execvp (*initial_argv, initial_argv); + if (execvp (*initial_argv, initial_argv) < 1) + error ("Unable to re-execute Emacs"); } if (FIXNUMP (arg)) commit 38c2a4588295a910b38736f0bfcc1cc5e5624520 Author: Lars Ingebrigtsen Date: Sun Apr 17 14:23:00 2022 +0200 Explain what "pending" means in isearch * doc/emacs/search.texi (Regexp Search): Explain what "Pending" usually means (bug#10148). diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index f2d82324e9..c990f5d766 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -899,11 +899,13 @@ character folding during incremental regexp search with @kbd{M-s '}, the search becomes a non-regexp search and the search pattern you typed is interpreted as a literal string.) +@cindex pending, in incremental search In some cases, adding characters to the regexp in an incremental regexp search can make the cursor move back and start again. For example, if you have searched for @samp{foo} and you add @samp{\|bar}, the cursor backs up in case the first @samp{bar} precedes the first -@samp{foo}. @xref{Regexps}. +@samp{foo}. (The prompt will change to say ``Pending'' to notify the +user that this recalculation has happened.) @xref{Regexps}. Forward and backward regexp search are not symmetrical, because regexp matching in Emacs always operates forward, starting with the commit 37bccf19caa6ad245bb4c8adacfb1a1d203d1d2d Author: Philip Kaludercic Date: Sun Apr 17 14:21:14 2022 +0200 Handle connection errors in rcirc-keepalive * rcirc.el (rcirc-reconnect-delay): Declare variable before it is defined. (rcirc-keepalive): Handle rcirc-closed-connection, respecting rcirc-reconnect-delay. (rcirc-closed-connection): Add new error type. (rcirc-send-string): Throw rcirc-closed-connection instead of a generic error. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 5fe65cc7b3..f34be6daf3 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -771,18 +771,26 @@ SERVER-PLIST is the property list for the server." (yes-or-no-p "Encrypt connection?")) 'tls 'plain)) +(defvar rcirc-reconnect-delay) (defun rcirc-keepalive () "Send keep alive pings to active rcirc processes. Kill processes that have not received a server message since the last ping." (if (rcirc-process-list) (mapc (lambda (process) - (with-rcirc-process-buffer process - (when (not rcirc-connecting) - (rcirc-send-ctcp process - rcirc-nick - (format "KEEPALIVE %f" - (float-time)))))) + (with-rcirc-process-buffer process + (when (not rcirc-connecting) + (condition-case nil + (rcirc-send-ctcp process + rcirc-nick + (format "KEEPALIVE %f" + (float-time))) + (rcirc-closed-connection + (if (zerop rcirc-reconnect-delay) + (message "rcirc: Connection to %s closed" + (process-name process)) + (rcirc-reconnect process)) + (message "")))))) (rcirc-process-list)) ;; no processes, clean up timer (when (timerp rcirc-keepalive-timer) @@ -1136,6 +1144,8 @@ used as the message body." "Check if PROCESS is open or running." (memq (process-status process) '(run open))) +(define-error 'rcirc-closed-connection "Network connection not open") + (defun rcirc-send-string (process &rest parts) "Send PROCESS a PARTS plus a newline. PARTS may contain a `:' symbol, to designate that the next string @@ -1153,8 +1163,7 @@ element in PARTS is a list, append it to PARTS." rcirc-encode-coding-system) "\n"))) (unless (rcirc--connection-open-p process) - (error "Network connection to %s is not open" - (process-name process))) + (signal 'rcirc-closed-connection process)) (rcirc-debug process string) (process-send-string process string))) commit 2136db067f4292d84553ebfddab30d88b862262e Author: Lars Ingebrigtsen Date: Sun Apr 17 14:04:34 2022 +0200 Add new function `flush-standard-output'. * doc/lispref/streams.texi (Output Functions): Document it. * src/print.c (Fflush_standard_output): New function (bug#15180). diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index 8f8562cadc..781a50f5c4 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -685,6 +685,15 @@ This function outputs @var{character} to @var{stream}. It returns @var{character}. @end defun +@defun flush-standard-output +If you have Emacs-based batch scripts that send output to the +terminal, Emacs will automatically display the output whenever you +write a newline characters to @code{standard-output}. This function +allows you to flush to @code{standard-output} without sending a +newline character first, which enables you to display incomplete +lines. +@end defun + @defun prin1-to-string object &optional noescape @cindex object to string This function returns a string containing the text that @code{prin1} diff --git a/etc/NEWS b/etc/NEWS index 071fdd7aee..3821dac179 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1423,6 +1423,11 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** New function 'flush-standard-output'. +This enables you do display incomplete lines from batch-based Emacs +scripts. + +++ ** New convenience function 'buttonize-region'. This works like 'buttonize', but for a region instead of a string. diff --git a/src/print.c b/src/print.c index 4a68d15fe0..baf515047b 100644 --- a/src/print.c +++ b/src/print.c @@ -768,6 +768,16 @@ is used instead. */) return object; } +DEFUN ("flush-standard-output", Fflush_standard_output, Sflush_standard_output, + 0, 0, 0, + doc: /* Flush standard-output. +This can be useful after using `princ' and the like in scripts. */) + (void) +{ + fflush (stdout); + return Qnil; +} + DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, doc: /* Write CHARACTER to stderr. You can call `print' while debugging emacs, and pass it this function @@ -2549,4 +2559,6 @@ printed. If the function returns anything else, the object will not be printed. */); Vprint_unreadable_function = Qnil; DEFSYM (Qprint_unreadable_function, "print-unreadable-function"); + + defsubr (&Sflush_standard_output); } commit 2a848209df79b717b4a309ec6e1b21d021519b16 Author: Philip Kaludercic Date: Sun Apr 17 14:03:33 2022 +0200 ; * subr.el (buffer-match-p): Ensure that (and) is always satisfied diff --git a/lisp/subr.el b/lisp/subr.el index d0b73db019..9623ea63b5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6690,7 +6690,7 @@ CONDITION is either: (funcall match (cdr condition))) ((eq (car-safe condition) 'and) (catch 'fail - (dolist (c conditions) + (dolist (c (cdr conditions)) (unless (funcall match c) (throw 'fail nil))) t))) commit b5f70c239e87e5f38fd70181ef75cd28a43a8b41 Author: Philip Kaludercic Date: Sun Apr 17 01:11:06 2022 +0200 Further improve buffer-match-p related documentation * doc/lispref/buffers.texi (Buffer List): Add entries for * buffer-match-p and match-buffers * etc/NEWS: Give examples for buffer-match-p conditions * lisp/window.el (display-buffer-assq-regexp): Mention what happens when no entry in the alist satisfies a condition. diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 1fe5a60b35..d8cf3d7919 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -953,15 +953,59 @@ with a @code{nil} @var{norecord} argument since this may lead to infinite recursion. @end defvar +@defun buffer-match-p condition buffer-or-name &optional arg +This function checks if a buffer designated by @code{buffer-or-name} +satisfies a @code{condition}. Optional third argument @var{arg} is +passed to the predicate function in @var{condition}. A condition can +be one of the following: +@itemize @bullet{} +@item +A string, interpreted as a regular expression. The buffer +satisfies the condition if the regular expression matches the buffer +name. +@item +A predicate function, which should return non-@code{nil} if the buffer +matches. If the function expects one argument, it is called with +@var{buffer-or-name} as the argument; if it expects 2 arguments, the +first argument is @var{buffer-or-name} and the second is @var{arg} +(or @code{nil} if @var{arg} is omitted). +@item +A cons-cell @code{(@var{oper} . @var{expr})} where @var{oper} is one +of +@table @code +@item not +Satisfied if @var{expr} doesn't satisfy @code{buffer-match-p} with +the same buffer and @code{arg}. +@item or +Satisfied if @var{oper} is a list and @emph{any} condition if +@var{expr} satisfies @code{buffer-match-p}, with the same buffer and +@code{arg}. +@item and +Satisfied if @var{oper} is a list and @emph{all} condition if +@var{expr} satisfies @code{buffer-match-p}, with the same buffer and +@code{arg}. +@end table +@end itemize +@end defun + +@defun match-buffers condition &optional buffer-list arg +This function returns a list of all buffers that satisfy a +@code{condition}, as defined for @code{buffer-match-p}. By default +all buffers are considered, but this can be restricted via the second +optional @code{buffer-list} argument. Optional third argument +@var{arg} will be used by @var{condition} in the same way as +@code{buffer-match-p} does. +@end defun + @node Creating Buffers @section Creating Buffers @cindex creating buffers @cindex buffers, creating This section describes the two primitives for creating buffers. -@code{get-buffer-create} creates a buffer if it finds no existing buffer -with the specified name; @code{generate-new-buffer} always creates a new -buffer and gives it a unique name. +@code{get-buffer-create} creates a buffer if it finds no existing +buffer with the specified name; @code{generate-new-buffer} always +creates a new buffer and gives it a unique name. Both functions accept an optional argument @var{inhibit-buffer-hooks}. If it is non-@code{nil}, the buffer they create does not run the hooks diff --git a/etc/NEWS b/etc/NEWS index 0245ec8c68..071fdd7aee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1548,7 +1548,11 @@ This hook is run before 'x-popup-menu' is about to display a deck-of-cards menu on screen. ** New function 'buffer-match-p' -Check if a buffer matches a condition, specified using a DSL. +Check if a buffer satisfies some condition. Some examples for +conditions can be regular expressions that match a buffer name, a +cons-cell like (major-mode . shell-mode) that matches any buffer where +major-mode is shell-mode or a combined with a condition like (and +"\\`\\*.+\\*\\'" (major-mode . special-mode)). ** New function 'match-buffers' Use 'buffer-match-p' to gather a list of buffers that match a commit 5be9a9cacfaae1959c4b95c45c146044a181ad20 Author: Lars Ingebrigtsen Date: Sun Apr 17 13:37:51 2022 +0200 Add a new command `restart-emacs' * doc/lispref/os.texi (Killing Emacs): Document it. * lisp/files.el (save-buffers-kill-emacs): Add new RESTART parameter. (restart-emacs): New function. * src/emacs.c (terminate_due_to_signal, Fkill_emacs): Take an optional RESTART parameter. * test/lisp/files-tests.el (files-tests-save-buffers-kill-emacs--confirm-kill-processes): * src/xterm.c (x_connection_closed): * src/xsmfns.c (Fhandle_save_session): * src/keyboard.c (Fcommand_error_default_function, command_loop) (command_loop_1, read_menu_command, read_event_from_main_queue) (read_key_sequence, quit_throw_to_read_char): * src/eval.c (process_quit_flag): Adjust Fkill_emacs callers. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 8366689640..eea0ab8f6b 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -699,7 +699,7 @@ If you started Emacs from a terminal, the parent process normally resumes control. The low-level primitive for killing Emacs is @code{kill-emacs}. -@deffn Command kill-emacs &optional exit-data +@deffn Command kill-emacs &optional exit-data restart This command calls the hook @code{kill-emacs-hook}, then exits the Emacs process and kills it. @@ -714,6 +714,10 @@ input) can read them. If @var{exit-data} is neither an integer nor a string, or is omitted, that means to use the (system-specific) exit status which indicates successful program termination. + +If @var{restart} is non-@code{nil}, instead of just exiting at the +end, start a new Emacs process, using the same command line arguments +as the currently running Emacs process. @end deffn @cindex SIGTERM @@ -756,6 +760,13 @@ the remaining functions in this hook. Calling @code{kill-emacs} directly does not run this hook. @end defopt +@deffn Command restart-emacs +This command does the same as @code{save-buffers-kill-emacs}, but +instead of just killing the current Emacs process at the end, it'll +restart a new Emacs process, using the same command line arguments as +the currently running Emacs process. +@end deffn + @node Suspending Emacs @subsection Suspending Emacs @cindex suspending Emacs diff --git a/etc/NEWS b/etc/NEWS index 71d1e90d83..0245ec8c68 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -194,6 +194,15 @@ methods instead. * Changes in Emacs 29.1 ++++ +** New command 'restart-emacs'. +This is like 'save-buffers-kill-emacs', but instead of just killing +the current Emacs process at the end, it starts a new Emacs process +(using the same command line arguments as the running Emacs process). +'kill-emacs' and 'save-buffers-kill-emacs' have also gained new +optional parameters to restart instead of just killing the current +process. + +++ ** New user option 'mouse-drag-and-drop-region-cross-program'. If non-nil, this option allows dragging text in the region from Emacs @@ -1451,7 +1460,8 @@ compliant. +++ ** New macro 'setopt'. This is like 'setq', but is meant to be used for user options instead -of plain variables, and uses 'custom-set'/'set-default' to set them. +of plain variables, and +uses 'custom-set'/'set-default' to set them. +++ ** New utility predicate 'mode-line-window-selected-p'. diff --git a/lisp/files.el b/lisp/files.el index b5ec7d4500..80180276a9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7762,14 +7762,17 @@ prompt the user before killing them." :group 'convenience :version "26.1") -(defun save-buffers-kill-emacs (&optional arg) +(defun save-buffers-kill-emacs (&optional arg restart) "Offer to save each buffer, then kill this Emacs process. With prefix ARG, silently save all file-visiting buffers without asking. If there are active processes where `process-query-on-exit-flag' returns non-nil and `confirm-kill-processes' is non-nil, asks whether processes should be killed. + Runs the members of `kill-emacs-query-functions' in turn and stops -if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." +if any returns nil. If `confirm-kill-emacs' is non-nil, calls it. + +If RESTART, restart Emacs after killing the current Emacs process." (interactive "P") ;; Don't use save-some-buffers-default-predicate, because we want ;; to ask about all the buffers before killing Emacs. @@ -7823,7 +7826,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (run-hook-with-args-until-failure 'kill-emacs-query-functions) (or (null confirm) (funcall confirm "Really exit Emacs? ")) - (kill-emacs)))) + (kill-emacs nil restart)))) (defun save-buffers-kill-terminal (&optional arg) "Offer to save each buffer, then kill the current connection. @@ -7838,6 +7841,16 @@ only these files will be asked to be saved." (if (frame-parameter nil 'client) (server-save-buffers-kill-terminal arg) (save-buffers-kill-emacs arg))) + +(defun restart-emacs () + "Kill the current Emacs process and start a new one. +This goes through the same shutdown procedure as +`save-buffers-kill-emacs', but instead of killing Emacs and +exiting, it re-executes Emacs (using the same command line +arguments as the running Emacs)." + (interactive) + (save-buffers-kill-emacs nil t)) + ;; We use /: as a prefix to "quote" a file name ;; so that magic file name handlers will not apply to it. diff --git a/src/emacs.c b/src/emacs.c index a35996c07a..50b1628d20 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -427,7 +427,7 @@ terminate_due_to_signal (int sig, int backtrace_limit) don't care about the message stack. */ if (sig == SIGINT && noninteractive) clear_message_stack (); - Fkill_emacs (make_fixnum (sig)); + Fkill_emacs (make_fixnum (sig), Qnil); } shut_down_emacs (sig, Qnil); @@ -2740,21 +2740,25 @@ sort_args (int argc, char **argv) xfree (priority); } -DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P", +DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 2, "P", doc: /* Exit the Emacs job and kill it. If ARG is an integer, return ARG as the exit program code. If ARG is a string, stuff it as keyboard input. Any other value of ARG, or ARG omitted, means return an exit code that indicates successful program termination. +If RESTART is non-nil, instead of just exiting at the end, start a new +Emacs process, using the same command line arguments as the currently +running Emacs process. + This function is called upon receipt of the signals SIGTERM or SIGHUP, and upon SIGINT in batch mode. -The value of `kill-emacs-hook', if not void, -is a list of functions (of no args), -all of which are called before Emacs is actually killed. */ +The value of `kill-emacs-hook', if not void, is a list of functions +(of no args), all of which are called before Emacs is actually +killed. */ attributes: noreturn) - (Lisp_Object arg) + (Lisp_Object arg, Lisp_Object restart) { int exit_code; @@ -2801,6 +2805,11 @@ all of which are called before Emacs is actually killed. */ eln_load_path_final_clean_up (); #endif + if (!NILP (restart)) + { + execvp (*initial_argv, initial_argv); + } + if (FIXNUMP (arg)) exit_code = (XFIXNUM (arg) < 0 ? XFIXNUM (arg) | INT_MIN diff --git a/src/eval.c b/src/eval.c index a1cebcd025..6b1e12b823 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1613,7 +1613,7 @@ process_quit_flag (void) Lisp_Object flag = Vquit_flag; Vquit_flag = Qnil; if (EQ (flag, Qkill_emacs)) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (EQ (Vthrow_on_input, flag)) Fthrow (Vthrow_on_input, Qt); quit (); diff --git a/src/keyboard.c b/src/keyboard.c index e569f8f34c..19c8fdf1dc 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1059,7 +1059,7 @@ Default value of `command-error-function'. */) print_error_message (data, Qexternal_debugging_output, SSDATA (context), signal); Fterpri (Qexternal_debugging_output, Qnil); - Fkill_emacs (make_fixnum (-1)); + Fkill_emacs (make_fixnum (-1), Qnil); } else { @@ -1122,7 +1122,7 @@ command_loop (void) /* End of file in -batch run causes exit here. */ if (noninteractive) - Fkill_emacs (Qt); + Fkill_emacs (Qt, Qnil); } } @@ -1331,7 +1331,7 @@ command_loop_1 (void) Lisp_Object cmd; if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); /* Make sure the current window's buffer is selected. */ set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents)); @@ -1402,7 +1402,7 @@ command_loop_1 (void) /* A filter may have run while we were reading the input. */ if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents)); ++num_input_keys; @@ -1660,7 +1660,7 @@ read_menu_command (void) unbind_to (count, Qnil); if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (i == 0 || i == -1) return Qt; @@ -2259,7 +2259,7 @@ read_event_from_main_queue (struct timespec *end_time, /* Terminate Emacs in batch mode if at eof. */ if (noninteractive && FIXNUMP (c) && XFIXNUM (c) < 0) - Fkill_emacs (make_fixnum (1)); + Fkill_emacs (make_fixnum (1), Qnil); if (FIXNUMP (c)) { @@ -10039,7 +10039,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, if (fix_current_buffer) { if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (XBUFFER (XWINDOW (selected_window)->contents) != current_buffer) Fset_buffer (XWINDOW (selected_window)->contents); @@ -10163,7 +10163,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, record_unwind_current_buffer (); if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); set_buffer_internal (XBUFFER (XWINDOW (window)->contents)); goto replay_sequence; } @@ -11393,7 +11393,7 @@ quit_throw_to_read_char (bool from_signal) /* When not called from a signal handler it is safe to call Lisp. */ if (!from_signal && EQ (Vquit_flag, Qkill_emacs)) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); /* Prevent another signal from doing this before we finish. */ clear_waiting_for_input (); diff --git a/src/xdisp.c b/src/xdisp.c index 2dbc68f657..a3a4338eb4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -12143,7 +12143,7 @@ setup_echo_area_for_printing (bool multibyte_p) { /* If we can't find an echo area any more, exit. */ if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); ensure_echo_area_buffers (); diff --git a/src/xsmfns.c b/src/xsmfns.c index 199e3ded3d..7015a8eb63 100644 --- a/src/xsmfns.c +++ b/src/xsmfns.c @@ -522,7 +522,7 @@ Do not call this function yourself. */) { /* We should not do user interaction here, but it is not easy to prevent. Fix this in next version. */ - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); #if false /* This will not be reached, but we want kill-emacs-hook to be run. */ diff --git a/src/xterm.c b/src/xterm.c index 89dd28c0d5..ab4dcc3841 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -19773,7 +19773,7 @@ For details, see etc/PROBLEMS.\n", if (terminal_list == 0) { fprintf (stderr, "%s\n", error_msg); - Fkill_emacs (make_fixnum (70)); + Fkill_emacs (make_fixnum (70), Qnil); } totally_unblock_input (); diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 42b09201de..e4424f3cbe 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -263,7 +263,7 @@ form.") nil)) (kill-emacs-args nil) ((symbol-function #'kill-emacs) - (lambda (&optional arg) (push arg kill-emacs-args))) + (lambda (&optional arg arg) (push arg kill-emacs-args))) (process (make-process :name "sleep" commit 0829c6836eff14dda0cf8b3047376967f7b000f4 Author: Nacho Barrientos Date: Sun Apr 17 13:00:12 2022 +0200 Fix chunked encoding connections in url-http * lisp/url/url-http.el (url-http-chunked-encoding-after-change-function): Ensure that chunked encoding is interpreted correctly (bug#54989). As per [0], the last chunk of 0 bytes is always accompanied by a last CRLF that signals the end of the message: chunked-body = *chunk last-chunk trailer-part CRLF ^ this one chunk = chunk-size [ chunk-ext ] CRLF chunk-data CRLF chunk-size = 1*HEXDIG last-chunk = 1*("0") [ chunk-ext ] CRLF chunk-data = 1*OCTET ; a sequence of chunk-size octets `url-http-chunked-encoding-after-change-function' is able to process (and remove) that terminator IF AVAILABLE in the buffer when processing the response, however it won't wait for it if it's not yet there. In other words: | Bottom of the response buffer | Bottom of the full response | | (visible to url-http) | (to be delivered to Emacs) | | ------------------------------+-----------------------------| | 0\r\n | 0\r\n | | | \r\n | If the last chunk is processed when the bottom of the response buffer is as above (note that the whole response has not yet been delivered to Emacs), url-http will call the user callback without waiting for the final terminator to be read from the socket. This is normally not an issue when doing one-shot requests, but it's problematic when the connection is reused immediately. As there are 2 bytes from the request N that have not been dealt with, they'll be considered as part of the response of the request N+1. On top, it turns out that when processing the headers of request N+1, `url-http-wait-for-headers-change-function' will consider the request a "headerless malformed response" delivering it broken to the caller. The proposed fix implements a state in which `url-http-chunked-encoding-after-change-function` properly waits for the very last element of the message preventing the problem explained above from happening. For additional context, this bug was found when debugging magit/ghub (see [1] for details). [0] https://datatracker.ietf.org/doc/html/rfc7230#section-4.1 [1] https://github.com/magit/ghub/issues/81 Copyright-paperwork-exempt: yes diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index b5bcd123c7..7f55866eec 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -36,6 +36,7 @@ (defvar url-current-object) (defvar url-http-after-change-function) (defvar url-http-chunked-counter) +(defvar url-http-chunked-last-crlf-missing nil) (defvar url-http-chunked-length) (defvar url-http-chunked-start) (defvar url-http-connection-opened) @@ -1071,90 +1072,105 @@ the callback to be triggered." Cannot give a sophisticated percentage, but we need a different function to look for the special 0-length chunk that signifies the end of the document." - (save-excursion - (goto-char st) - (let ((read-next-chunk t) - (case-fold-search t) - (regexp nil) - (no-initial-crlf nil)) - ;; We need to loop thru looking for more chunks even within - ;; one after-change-function call. - (while read-next-chunk - (setq no-initial-crlf (= 0 url-http-chunked-counter)) - (if url-http-content-type + (if url-http-chunked-last-crlf-missing + (progn + (goto-char url-http-chunked-last-crlf-missing) + (if (not (looking-at "\r\n")) + (url-http-debug + "Still spinning for the terminator of last chunk...") + (url-http-debug "Saw the last CRLF.") + (delete-region (match-beginning 0) (match-end 0)) + (when (url-http-parse-headers) + (url-http-activate-callback)))) + (save-excursion + (goto-char st) + (let ((read-next-chunk t) + (case-fold-search t) + (regexp nil) + (no-initial-crlf nil)) + ;; We need to loop thru looking for more chunks even within + ;; one after-change-function call. + (while read-next-chunk + (setq no-initial-crlf (= 0 url-http-chunked-counter)) + (if url-http-content-type + (url-display-percentage nil + "Reading [%s]... chunk #%d" + url-http-content-type url-http-chunked-counter) (url-display-percentage nil - "Reading [%s]... chunk #%d" - url-http-content-type url-http-chunked-counter) - (url-display-percentage nil - "Reading... chunk #%d" - url-http-chunked-counter)) - (url-http-debug "Reading chunk %d (%d %d %d)" - url-http-chunked-counter st nd length) - (setq regexp (if no-initial-crlf - "\\([0-9a-z]+\\).*\r?\n" - "\r?\n\\([0-9a-z]+\\).*\r?\n")) - - (if url-http-chunked-start - ;; We know how long the chunk is supposed to be, skip over - ;; leading crap if possible. - (if (> nd (+ url-http-chunked-start url-http-chunked-length)) - (progn - (url-http-debug "Got to the end of chunk #%d!" - url-http-chunked-counter) - (goto-char (+ url-http-chunked-start - url-http-chunked-length))) - (url-http-debug "Still need %d bytes to hit end of chunk" - (- (+ url-http-chunked-start - url-http-chunked-length) - nd)) - (setq read-next-chunk nil))) - (if (not read-next-chunk) - (url-http-debug "Still spinning for next chunk...") - (if no-initial-crlf (skip-chars-forward "\r\n")) - (if (not (looking-at regexp)) - (progn - ;; Must not have received the entirety of the chunk header, - ;; need to spin some more. - (url-http-debug "Did not see start of chunk @ %d!" (point)) - (setq read-next-chunk nil)) - ;; The data we got may have started in the middle of the - ;; initial chunk header, so move back to the start of the - ;; line and re-compute. - (when (= url-http-chunked-counter 0) - (beginning-of-line) - (looking-at regexp)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'chunked-encoding t - 'face 'cursor - 'invisible t)) - (setq url-http-chunked-length (string-to-number (buffer-substring - (match-beginning 1) - (match-end 1)) - 16) - url-http-chunked-counter (1+ url-http-chunked-counter) - url-http-chunked-start (set-marker - (or url-http-chunked-start - (make-marker)) - (match-end 0))) - (delete-region (match-beginning 0) (match-end 0)) - (url-http-debug "Saw start of chunk %d (length=%d, start=%d" - url-http-chunked-counter url-http-chunked-length - (marker-position url-http-chunked-start)) - (if (= 0 url-http-chunked-length) - (progn - ;; Found the end of the document! Wheee! - (url-http-debug "Saw end of stream chunk!") - (setq read-next-chunk nil) - (url-display-percentage nil nil) - ;; Every chunk, even the last 0-length one, is - ;; terminated by CRLF. Skip it. - (when (looking-at "\r?\n") - (url-http-debug "Removing terminator of last chunk") - (delete-region (match-beginning 0) (match-end 0))) - (if (re-search-forward "^\r?\n" nil t) - (url-http-debug "Saw end of trailers...")) - (if (url-http-parse-headers) - (url-http-activate-callback)))))))))) + "Reading... chunk #%d" + url-http-chunked-counter)) + (url-http-debug "Reading chunk %d (%d %d %d)" + url-http-chunked-counter st nd length) + (setq regexp (if no-initial-crlf + "\\([0-9a-z]+\\).*\r?\n" + "\r?\n\\([0-9a-z]+\\).*\r?\n")) + + (if url-http-chunked-start + ;; We know how long the chunk is supposed to be, skip over + ;; leading crap if possible. + (if (> nd (+ url-http-chunked-start url-http-chunked-length)) + (progn + (url-http-debug "Got to the end of chunk #%d!" + url-http-chunked-counter) + (goto-char (+ url-http-chunked-start + url-http-chunked-length))) + (url-http-debug "Still need %d bytes to hit end of chunk" + (- (+ url-http-chunked-start + url-http-chunked-length) + nd)) + (setq read-next-chunk nil))) + (if (not read-next-chunk) + (url-http-debug "Still spinning for next chunk...") + (if no-initial-crlf (skip-chars-forward "\r\n")) + (if (not (looking-at regexp)) + (progn + ;; Must not have received the entirety of the chunk header, + ;; need to spin some more. + (url-http-debug "Did not see start of chunk @ %d!" (point)) + (setq read-next-chunk nil)) + ;; The data we got may have started in the middle of the + ;; initial chunk header, so move back to the start of the + ;; line and re-compute. + (when (= url-http-chunked-counter 0) + (beginning-of-line) + (looking-at regexp)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'chunked-encoding t + 'face 'cursor + 'invisible t)) + (setq url-http-chunked-length + (string-to-number (buffer-substring (match-beginning 1) + (match-end 1)) + 16) + url-http-chunked-counter (1+ url-http-chunked-counter) + url-http-chunked-start (set-marker + (or url-http-chunked-start + (make-marker)) + (match-end 0))) + (delete-region (match-beginning 0) (match-end 0)) + (url-http-debug "Saw start of chunk %d (length=%d, start=%d" + url-http-chunked-counter url-http-chunked-length + (marker-position url-http-chunked-start)) + (if (= 0 url-http-chunked-length) + (progn + ;; Found the end of the document! Wheee! + (url-http-debug "Saw end of stream chunk!") + (setq read-next-chunk nil) + (url-display-percentage nil nil) + ;; Every chunk, even the last 0-length one, is + ;; terminated by CRLF. Skip it. + (if (not (looking-at "\r?\n")) + (progn + (url-http-debug + "Spinning for the terminator of last chunk...") + (setq-local url-http-chunked-last-crlf-missing + (point))) + (url-http-debug "Removing terminator of last chunk") + (delete-region (match-beginning 0) (match-end 0)) + (when (re-search-forward "^\r?\n" nil t) + (url-http-debug "Saw end of trailers...")) + (when (url-http-parse-headers) + (url-http-activate-callback)))))))))))) (defun url-http-wait-for-headers-change-function (_st nd _length) ;; This will wait for the headers to arrive and then splice in the commit 60a3c94a14da8c9f4fa591bea25ea5189d92fe7a Author: Oleh Krehel Date: Sun Apr 17 12:50:05 2022 +0200 Remove duplicates from Info-read-node-name-2 * lisp/info.el (Info-read-node-name-2): Remove duplicates from completions (bug#20365). diff --git a/lisp/info.el b/lisp/info.el index ac4169b550..380a8e2780 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1822,41 +1822,22 @@ directories to search if FILENAME is not absolute; SUFFIXES is a list of valid filename suffixes for Info files. See `try-completion' for a description of the remaining arguments." (setq suffixes (remove "" suffixes)) - (when (file-name-absolute-p string) - (setq dirs (list (file-name-directory string)))) (let ((names nil) - (names-sans-suffix nil) - (suffix (concat (regexp-opt suffixes t) "\\'")) - (string-dir (file-name-directory string))) + (suffix (concat (regexp-opt suffixes t) "\\'"))) (dolist (dir dirs) - (unless dir - (setq dir default-directory)) - (if string-dir (setq dir (expand-file-name string-dir dir))) (when (file-directory-p dir) - (dolist (file (file-name-all-completions - (file-name-nondirectory string) dir)) - ;; If the file name has no suffix or a standard suffix, - ;; include it. - (and (or (null (file-name-extension file)) - (string-match suffix file)) - ;; But exclude subfiles of split Info files. - (not (string-match "-[0-9]+\\'" file)) - ;; And exclude backup files. - (not (string-match "~\\'" file)) - (push (if string-dir (concat string-dir file) file) names)) - ;; If the file name ends in a standard suffix, - ;; add the unsuffixed name as a completion option. - (when (string-match suffix file) - (setq file (substring file 0 (match-beginning 0))) - (push (if string-dir (concat string-dir file) file) - names-sans-suffix))))) - ;; If there is just one file, don't duplicate it with suffixes, - ;; so `Info-read-node-name-1' will be able to complete a single - ;; candidate and to add the terminating ")". - (if (and (= (length names) 1) (= (length names-sans-suffix) 1)) - (setq names names-sans-suffix) - (setq names (append names-sans-suffix names))) - (complete-with-action action names string pred))) + (dolist (file (directory-files dir)) + ;; If the file name has a standard suffix, + ;; include it (without the suffix). + (when (and (string-match suffix file) + ;; But exclude subfiles of split Info files. + (not (string-match "\.info-[0-9]+" file)) + ;; And exclude backup files. + (not (string-match "~\\'" file))) + (push (substring file 0 (match-beginning 0)) + names))))) + (complete-with-action action (delete-dups (nreverse names)) + string pred))) (defun Info-read-node-name-1 (string predicate code) "Internal function used by `Info-read-node-name'. commit 6019ca9dd20825fe6645419d775f9113c44f9309 Author: Lars Ingebrigtsen Date: Sun Apr 17 12:39:41 2022 +0200 Fix instructions on how to enable password-store * doc/misc/auth.texi (Help for users): Give the correct instructions on how to enable password store (bug#30900). diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index c2a9aa4437..829d7f4fa0 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -191,7 +191,7 @@ get fancy, the default and simplest configuration is: (setq auth-sources '("secrets:Login")) ;;; use pass (@file{~/.password-store}) ;;; (@pxref{The Unix password store}) -(setq auth-sources '(password-store)) +(auth-source-pass-enable) ;;; JSON data in format [@{ "machine": "SERVER", ;;; "login": "USER", "password": "PASSWORD" @}...] (setq auth-sources '("~/.authinfo.json.gpg")) commit 3ec06a1685c09f698a1b95d2692bb8e96531a096 Author: Lars Ingebrigtsen Date: Sun Apr 17 12:27:40 2022 +0200 Clarify setopt NEWS entry diff --git a/etc/NEWS b/etc/NEWS index 12931814f7..71d1e90d83 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1450,8 +1450,8 @@ compliant. +++ ** New macro 'setopt'. -This is like 'setq', but uses 'customize-set-variable' to set the -variable(s). +This is like 'setq', but is meant to be used for user options instead +of plain variables, and uses 'custom-set'/'set-default' to set them. +++ ** New utility predicate 'mode-line-window-selected-p'. commit 93d73d836dc2a01b5c288975eb00597c64e76dd4 Author: Lars Ingebrigtsen Date: Sun Apr 17 12:18:58 2022 +0200 Do some NEWS tagging diff --git a/etc/NEWS b/etc/NEWS index 445e3ae89f..12931814f7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -954,6 +954,7 @@ matches. --- *** New variable 'xref-current-item' (renamed from a private version). +--- *** New function 'xref-show-xrefs'. ** File notifications commit 4d60d9face04bbbd22b4ecf69db208165b670b4f Author: Lars Ingebrigtsen Date: Sun Apr 17 12:17:30 2022 +0200 Add a doc string to xref-current-item * lisp/progmodes/xref.el (xref-after-jump-hook): Link to it. (xref-current-item): Add a doc string to the now-public variable. diff --git a/etc/NEWS b/etc/NEWS index 560d3eecfd..445e3ae89f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -942,12 +942,16 @@ to enable the display of the buffer list. It is bound to 'C-M-,' and jumps to the location where 'xref-go-back' ('M-,', also known as 'xref-pop-marker-stack') was invoked previously. -*** 'xref-query-replace-in-results' does not prompt for FROM when -called without prefix argument, to make the most common case faster: -replacing entire matches. ++++ +*** 'xref-query-replace-in-results' prompting change. +This command no longer prompts for FROM when called without prefix +argument. This makes the most common case faster: replacing entire +matches. ++++ *** New command 'xref-find-references-and-replace' to rename one identifier. +--- *** New variable 'xref-current-item' (renamed from a private version). *** New function 'xref-show-xrefs'. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 277934c08a..958d4e8b9d 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -381,7 +381,8 @@ elements is negated: these commands will NOT prompt." (defcustom xref-after-jump-hook '(recenter xref-pulse-momentarily) - "Functions called after jumping to an xref." + "Functions called after jumping to an xref. +Also see `xref-current-item'." :type 'hook) (defcustom xref-after-return-hook '(xref-pulse-momentarily) @@ -490,7 +491,9 @@ To undo, use \\[xref-go-forward]." 'xref-current-item "29.1") -(defvar xref-current-item nil) +(defvar xref-current-item nil + "Dynamically bound to the current item being processed. +This can be used from `xref-after-jump-hook', for instance.") (defun xref-pulse-momentarily () (pcase-let ((`(,beg . ,end) commit d951e9e650aed1fbe9a587282a8614a4a3b9d35b Author: Lars Ingebrigtsen Date: Sun Apr 17 12:11:36 2022 +0200 Clarify emacs-news--heading-p logic * lisp/textmodes/emacs-news-mode.el (emacs-news--heading-p): Clarify the logic. diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index e31a7105b8..d9c5b15bf4 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -131,11 +131,14 @@ untagged NEWS entry." (defun emacs-news--heading-p () (save-excursion (beginning-of-line) + ;; A heading starts with * characters, and then a blank line, and + ;; then paragraphs with more * characters than in the heading. (and (looking-at "\\(\\*+\\) ") (let ((level (length (match-string 1)))) - (goto-char (match-end 0)) - (when (re-search-forward "^\\(\\*+\\) " nil t) - (> (length (match-string 1)) level)))))) + (forward-line 1) + (and (looking-at "$") + (re-search-forward "^\\(\\*+\\) " nil t) + (> (length (match-string 1)) level)))))) (defun emacs-news-previous-untagged-entry () "Go to the previous untagged NEWS entry." commit b8c50fe9108b466e9c88c7c5ff9f2c40b9234199 Author: Lars Ingebrigtsen Date: Sun Apr 17 11:06:23 2022 +0200 Move some entries around in the NEWS file diff --git a/etc/NEWS b/etc/NEWS index cc0a8849ec..560d3eecfd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -814,6 +814,14 @@ phrase part will be automatically quoted if necessary. ** eww/shr ++++ +*** New user option to automatically rename EWW buffers. +The 'eww-auto-rename-buffer' user option can be configured to rename +rendered web pages by using their title, URL, or a user-defined +function which returns a string. For the first two cases, the length +of the resulting name is controlled by 'eww-buffer-name-length'. By +default, no automatic renaming is performed. + +++ *** New user option 'shr-allowed-images'. This complements 'shr-blocked-images', but allows specifying just the @@ -876,16 +884,6 @@ M-x align' for it to work. This has now been changed. The default regexp for 'C-u M-x align-regexp' has also been changed to be easier for inexperienced users to use. -** eww - -+++ -*** New user option to automatically rename EWW buffers. -The 'eww-auto-rename-buffer' user option can be configured to rename -rendered web pages by using their title, URL, or a user-defined -function which returns a string. For the first two cases, the length -of the resulting name is controlled by 'eww-buffer-name-length'. By -default, no automatic renaming is performed. - ** Help --- commit 7da0289c367ba650f6aa4b86470da48d14943211 Author: Lars Ingebrigtsen Date: Sun Apr 17 11:00:08 2022 +0200 Fix up the NEWS entry for emacs-news*-mode diff --git a/etc/NEWS b/etc/NEWS index bd2545f4be..cc0a8849ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -613,11 +613,9 @@ script that was used in ancient South Asia. * Changes in Specialized Modes and Packages in Emacs 29.1 --- -** New mode for editing and viewing the NEWS file. -It's called 'emacs-news-mode', and adds some highlighting, fixes the -'M-q' command, and has commands for doing maintenance. When in read -only mode (which you get when doing 'C-h N', for instance), it also -adds buttons to manual entries and symbol references. +** New mode, 'emacs-news-mode', for editing the NEWS file. +This mode adds some highlighting, fixes the 'M-q' command, and has +commands for doing maintenance. --- ** kmacro @@ -890,6 +888,11 @@ default, no automatic renaming is performed. ** Help +--- +*** New mode, 'emacs-news-view-mode', for viewing the NEWS file. +This mode is used by the 'C-h N' command, and adds buttons to manual +entries and symbol references. + --- *** New user option 'help-link-key-to-documentation'. When this option is non-nil (which is the default), key bindings commit 0353c6fd08d20421c96133db54950c00411fb8dc Author: Paul Eggert Date: Sun Apr 17 01:50:59 2022 -0700 * src/filelock.c (Fcreate_lockfiles): Doc string fix. diff --git a/src/filelock.c b/src/filelock.c index 8fa86e64eb..67948e1f09 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -898,8 +898,8 @@ syms_of_filelock (void) DEFVAR_BOOL ("create-lockfiles", create_lockfiles, doc: /* Non-nil means use lockfiles to avoid editing collisions. -The name of the (per-buffer) lockfile is constructed by prepending a -'.#' to the name of the file being locked. See also `lock-buffer' and +The name of the (per-buffer) lockfile is constructed by prepending +".#" to the name of the file being locked. See also `lock-buffer' and Info node `(emacs)Interlocking'. */); create_lockfiles = true; commit ff7bc018307681564235583722675997dc309915 Merge: 5bc3ed492b 4641bc1c55 Author: Paul Eggert Date: Sun Apr 17 01:44:30 2022 -0700 Merge from origin/emacs-28 4641bc1c55 Fix GC bug in filelock.c commit 5bc3ed492bffa962ef326387f2476b66442a006c Author: Po Lu Date: Sun Apr 17 08:13:49 2022 +0000 Fix race conditions waiting for menu bar resize events on Haiku * src/haikufns.c (haiku_create_frame, haiku_create_tip_frame): Clear `wait_for_event_type'. (haiku_set_menu_bar_lines): Clean up coding style. * src/haikuterm.c (haiku_wait_for_event): New function. (haiku_read_socket): Implement waiting for MENU_BAR_RESIZE events. * src/haikuterm.h (struct haiku_output): New field `wait_for_event_type'. diff --git a/src/haikufns.c b/src/haikufns.c index b040e6cafa..151874e26f 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -635,6 +635,7 @@ haiku_create_frame (Lisp_Object parms) f->output_method = output_haiku; f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + f->output_data.haiku->wait_for_event_type = -1; fset_icon_name (f, gui_display_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", @@ -946,6 +947,7 @@ haiku_create_tip_frame (Lisp_Object parms) counts etc. */ f->output_method = output_haiku; f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + f->output_data.haiku->wait_for_event_type = -1; f->tooltip = true; fset_icon_name (f, Qnil); @@ -1264,9 +1266,11 @@ haiku_set_override_redirect (struct frame *f, Lisp_Object new_value, static void haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { + int nlines; + if (FRAME_TOOLTIP_P (f)) return; - int nlines; + if (TYPE_RANGED_FIXNUMP (int, value)) nlines = XFIXNUM (value); else diff --git a/src/haikuterm.c b/src/haikuterm.c index 8499dad932..203bfa3f81 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2766,6 +2766,40 @@ flush_dirty_back_buffers (void) unblock_input (); } +/* N.B. that support for TYPE must be explictly added to + haiku_read_socket. */ +void +haiku_wait_for_event (struct frame *f, int type) +{ + int input_blocked_to; + object_wait_info info; + specpdl_ref depth; + + input_blocked_to = interrupt_input_blocked; + info.object = port_application_to_emacs; + info.type = B_OBJECT_TYPE_PORT; + info.events = B_EVENT_READ; + + depth = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); + + FRAME_OUTPUT_DATA (f)->wait_for_event_type = type; + + while (FRAME_OUTPUT_DATA (f)->wait_for_event_type == type) + { + if (wait_for_objects (&info, 1) < B_OK) + continue; + + pending_signals = true; + /* This will call the read_socket_hook. */ + totally_unblock_input (); + interrupt_input_blocked = input_blocked_to; + info.events = B_EVENT_READ; + } + + unbind_to (depth, Qnil); +} + static int haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) { @@ -3453,7 +3487,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) break; } - case MENU_BAR_RESIZE: { struct haiku_menu_bar_resize_event *b = buf; @@ -3462,13 +3495,17 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) continue; + if (FRAME_OUTPUT_DATA (f)->wait_for_event_type + == MENU_BAR_RESIZE) + FRAME_OUTPUT_DATA (f)->wait_for_event_type = -1; + int old_height = FRAME_MENU_BAR_HEIGHT (f); FRAME_MENU_BAR_HEIGHT (f) = b->height + 1; - FRAME_MENU_BAR_LINES (f) = - (b->height + FRAME_LINE_HEIGHT (f)) / FRAME_LINE_HEIGHT (f); + FRAME_MENU_BAR_LINES (f) + = (b->height + FRAME_LINE_HEIGHT (f)) / FRAME_LINE_HEIGHT (f); - if (old_height != b->height) + if (old_height != b->height + 1) { adjust_frame_size (f, -1, -1, 3, true, Qmenu_bar_lines); haiku_clear_under_internal_border (f); diff --git a/src/haikuterm.h b/src/haikuterm.h index df4e7d47e8..903a21d29f 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -179,6 +179,9 @@ struct haiku_output /* If non-NULL, the last menu bar click event received. */ struct haiku_menu_bar_click_event *saved_menu_event; + + /* The type of any event that's being waited for. */ + int wait_for_event_type; }; struct x_output @@ -295,6 +298,7 @@ extern Lisp_Object haiku_menu_show (struct frame *, int, int, int, Lisp_Object, const char **); extern Lisp_Object haiku_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); extern void haiku_activate_menubar (struct frame *); +extern void haiku_wait_for_event (struct frame *, int); extern void haiku_note_drag_motion (void); extern void initialize_frame_menubar (struct frame *); commit 9a7430ce8414f68de1022b3b6068ba60e8cd87cf Author: Po Lu Date: Sun Apr 17 08:10:01 2022 +0000 Fix race conditions waiting for menu bar resize events on Haiku * src/haikufns.c (haiku_create_frame, haiku_create_tip_frame) (haiku_set_menu_bar_lines): Clear `wait_for_event_type'. * src/haikumenu.c (set_frame_menubar): Wait for menu bar resize event. * src/haikuterm.c (haiku_wait_for_event): New function. (haiku_read_socket): Handle waiting for MENU_BAR_RESIZE. * src/haikuterm.h (struct haiku_output): New field `wait_for_event_type'. diff --git a/src/haikumenu.c b/src/haikumenu.c index 5b370f8f99..46dde6496b 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -521,8 +521,15 @@ set_frame_menubar (struct frame *f, bool deep_p) if (!mbar) { + block_input (); mbar = FRAME_HAIKU_MENU_BAR (f) = BMenuBar_new (view); first_time_p = 1; + + /* Now wait for the MENU_BAR_RESIZE event informing us of the + initial dimensions of that menu bar. */ + if (FRAME_VISIBLE_P (f)) + haiku_wait_for_event (f, MENU_BAR_RESIZE); + unblock_input (); } Lisp_Object items; commit 38d72d8d888c4d0714b9ec783160d4e45215eb71 Author: Po Lu Date: Sun Apr 17 07:29:36 2022 +0000 Get rid of unused flags on Haiku * src/haikufns.c (haiku_free_frame_resources): Syntax fixes. * src/haikumenu.c (set_frame_menubar, run_menu_bar_help_event): * src/haikuterm.c (haiku_read_socket): Stop setting and consulting `menu_up_to_date_p'. * src/haikuterm.h (struct haiku_output): Delete `menu_up_to_date_p'. diff --git a/src/haikufns.c b/src/haikufns.c index 128831dec2..b040e6cafa 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1545,7 +1545,7 @@ haiku_free_frame_resources (struct frame *f) BWindow_quit (window); if (FRAME_OUTPUT_DATA (f)->saved_menu_event) - xfree (FRAME_OUTPUT_DATA (f))->saved_menu_event; + xfree (FRAME_OUTPUT_DATA (f)->saved_menu_event); xfree (FRAME_OUTPUT_DATA (f)); FRAME_OUTPUT_DATA (f) = NULL; diff --git a/src/haikumenu.c b/src/haikumenu.c index 8aced5f9d4..5b370f8f99 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -541,7 +541,6 @@ set_frame_menubar (struct frame *f, bool deep_p) if (!deep_p) { - FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 0; items = FRAME_MENU_BAR_ITEMS (f); Lisp_Object string; @@ -654,8 +653,6 @@ set_frame_menubar (struct frame *f, bool deep_p) set_buffer_internal_1 (prev); - FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 1; - /* If there has been no change in the Lisp-level contents of the menu bar, skip redisplaying it. Just exit. */ @@ -705,19 +702,11 @@ set_frame_menubar (struct frame *f, bool deep_p) void run_menu_bar_help_event (struct frame *f, int mb_idx) { - Lisp_Object frame; - Lisp_Object vec; - Lisp_Object help; - - block_input (); - if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) - { - unblock_input (); - return; - } + Lisp_Object frame, vec, help; XSETFRAME (frame, f); + block_input (); if (mb_idx < 0) { kbd_buffer_store_help_event (frame, Qnil); diff --git a/src/haikuterm.c b/src/haikuterm.c index 45d22ce22f..8499dad932 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3525,9 +3525,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) continue; - if (FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) - find_and_call_menu_selection (f, f->menu_bar_items_used, - f->menu_bar_vector, b->ptr); + find_and_call_menu_selection (f, f->menu_bar_items_used, + f->menu_bar_vector, b->ptr); break; } case FILE_PANEL_EVENT: @@ -3551,12 +3550,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) continue; struct frame *f = haiku_window_to_frame (b->window); - if (!f || !FRAME_EXTERNAL_MENU_BAR (f) || - !FRAME_OUTPUT_DATA (f)->menu_bar_open_p) + if (!f || !FRAME_EXTERNAL_MENU_BAR (f) + || !FRAME_OUTPUT_DATA (f)->menu_bar_open_p) continue; run_menu_bar_help_event (f, b->mb_idx); - break; } case ZOOM_EVENT: diff --git a/src/haikuterm.h b/src/haikuterm.h index e922743b18..df4e7d47e8 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -154,13 +154,13 @@ struct haiku_output haiku view; haiku menubar; - int menu_up_to_date_p; - int zoomed_p; - int hourglass_p; - int menu_bar_open_p; int fontset; int baseline_offset; + bool_bf zoomed_p : 1; + bool_bf hourglass_p : 1; + bool_bf menu_bar_open_p : 1; + /* Whether or not there is data in a back buffer that hasn't been displayed yet. */ bool dirty_p; commit 5a18cd8821783b9503452496eab42fa4f8b436cd Author: Po Lu Date: Sun Apr 17 07:16:03 2022 +0000 * src/haikufns.c (haiku_free_frame_resources): Free saved menu event. diff --git a/src/haikufns.c b/src/haikufns.c index 874ebaaf91..128831dec2 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1544,6 +1544,9 @@ haiku_free_frame_resources (struct frame *f) if (window) BWindow_quit (window); + if (FRAME_OUTPUT_DATA (f)->saved_menu_event) + xfree (FRAME_OUTPUT_DATA (f))->saved_menu_event; + xfree (FRAME_OUTPUT_DATA (f)); FRAME_OUTPUT_DATA (f) = NULL; commit e8b0808e20797f84fb2a720e38f315bfab39bde4 Author: Po Lu Date: Sun Apr 17 07:15:17 2022 +0000 Fix hangs when clicking on Haiku menu bar to activate frame * src/haiku_io.c (haiku_len): Handle new event `MENU_BAR_CLICK'. * src/haiku_support.cc (class EmacsWindow): Remove most of the menu bar cv stuff. (MessageReceived): Handle REPLAY_MENU_BAR message. (EmacsWindow_signal_menu_update_complete): Delete function. (be_replay_menu_bar_event): New function. * src/haiku_support.h (enum haiku_event_type): New event type `MENU_BAR_CLICK'. (struct haiku_menu_bar_click_event): New struct. * src/haikumenu.c (haiku_activate_menubar): New function. * src/haikuterm.c (haiku_read_socket): Save a MENU_BAR_ACTIVATE_EVENT and the menu bar click event instead of handling the menu bar update synchronously. (haiku_create_terminal): Set `activate_menubar_hook'. (syms_of_haikuterm): Remove extraneous newline. * src/haikuterm.h (struct haiku_output): New field `saved_menu_event'. diff --git a/src/haiku_io.c b/src/haiku_io.c index 89f0877eb6..1830ac01e5 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -79,6 +79,8 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_wheel_move_event); case MENU_BAR_RESIZE: return sizeof (struct haiku_menu_bar_resize_event); + case MENU_BAR_CLICK: + return sizeof (struct haiku_menu_bar_click_event); case MENU_BAR_OPEN: case MENU_BAR_CLOSE: return sizeof (struct haiku_menu_bar_state_event); diff --git a/src/haiku_support.cc b/src/haiku_support.cc index e7c157dac8..673ae02ac9 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -91,6 +91,7 @@ enum SHOW_MENU_BAR = 3004, BE_MENU_BAR_OPEN = 3005, QUIT_APPLICATION = 3006, + REPLAY_MENU_BAR = 3007, }; /* X11 keysyms that we use. */ @@ -496,9 +497,6 @@ class EmacsWindow : public BWindow window_look pre_override_redirect_look; window_feel pre_override_redirect_feel; uint32 pre_override_redirect_workspaces; - pthread_mutex_t menu_update_mutex = PTHREAD_MUTEX_INITIALIZER; - pthread_cond_t menu_update_cv = PTHREAD_COND_INITIALIZER; - bool menu_updated_p = false; int window_id; bool *menus_begun = NULL; @@ -530,9 +528,6 @@ class EmacsWindow : public BWindow if (this->parent) UnparentAndUnlink (); child_frame_lock.Unlock (); - - pthread_cond_destroy (&menu_update_cv); - pthread_mutex_destroy (&menu_update_mutex); } BRect @@ -977,34 +972,13 @@ class EmacsWindow : public BWindow } void - MenusBeginning () + MenusBeginning (void) { struct haiku_menu_bar_state_event rq; - int lock_count; rq.window = this; - lock_count = 0; - if (!menus_begun) - { - haiku_write (MENU_BAR_OPEN, &rq); - while (IsLocked ()) - { - ++lock_count; - UnlockLooper (); - } - pthread_mutex_lock (&menu_update_mutex); - while (!menu_updated_p) - pthread_cond_wait (&menu_update_cv, - &menu_update_mutex); - menu_updated_p = false; - pthread_mutex_unlock (&menu_update_mutex); - for (; lock_count; --lock_count) - { - if (!LockLooper ()) - gui_abort ("Failed to lock after cv signal denoting menu update"); - } - } + haiku_write (MENU_BAR_OPEN, &rq); else *menus_begun = true; @@ -1278,6 +1252,8 @@ class EmacsWindow : public BWindow class EmacsMenuBar : public BMenuBar { + bool tracking_p; + public: EmacsMenuBar () : BMenuBar (BRect (0, 0, 0, 0), NULL) { @@ -1303,6 +1279,22 @@ class EmacsMenuBar : public BMenuBar BMenuBar::FrameResized (newWidth, newHeight); } + void + MouseDown (BPoint point) + { + struct haiku_menu_bar_click_event rq; + EmacsWindow *ew = (EmacsWindow *) Window (); + + rq.window = ew; + rq.x = std::lrint (point.x); + rq.y = std::lrint (point.y); + + if (!ew->menu_bar_active_p) + haiku_write (MENU_BAR_CLICK, &rq); + else + BMenuBar::MouseDown (point); + } + void MouseMoved (BPoint point, uint32 transit, const BMessage *msg) { @@ -1351,6 +1343,11 @@ class EmacsMenuBar : public BMenuBar else msg->SendReply (BE_MENU_BAR_OPEN); } + else if (msg->what == REPLAY_MENU_BAR) + { + if (msg->FindPoint ("emacs:point", &pt) == B_OK) + BMenuBar::MouseDown (pt); + } else BMenuBar::MessageReceived (msg); } @@ -4147,17 +4144,6 @@ be_find_setting (const char *name) return value; } -void -EmacsWindow_signal_menu_update_complete (void *window) -{ - EmacsWindow *w = (EmacsWindow *) window; - - pthread_mutex_lock (&w->menu_update_mutex); - w->menu_updated_p = true; - pthread_cond_signal (&w->menu_update_cv); - pthread_mutex_unlock (&w->menu_update_mutex); -} - void BMessage_delete (void *message) { @@ -4274,3 +4260,15 @@ be_drag_and_drop_in_progress (void) { return drag_and_drop_in_progress; } + +void +be_replay_menu_bar_event (void *menu_bar, + struct haiku_menu_bar_click_event *event) +{ + BMenuBar *m = (BMenuBar *) menu_bar; + BMessenger messenger (m); + BMessage msg (REPLAY_MENU_BAR); + + msg.AddPoint ("emacs:point", BPoint (event->x, event->y)); + messenger.SendMessage (&msg); +} diff --git a/src/haiku_support.h b/src/haiku_support.h index 9935906f0e..6b285cf3e0 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -80,6 +80,7 @@ enum haiku_event_type SCROLL_BAR_DRAG_EVENT, WHEEL_MOVE_EVENT, MENU_BAR_RESIZE, + MENU_BAR_CLICK, MENU_BAR_OPEN, MENU_BAR_SELECT_EVENT, MENU_BAR_CLOSE, @@ -168,6 +169,12 @@ struct haiku_menu_bar_left_event int x, y; }; +struct haiku_menu_bar_click_event +{ + void *window; + int x, y; +}; + struct haiku_button_event { void *window; @@ -577,7 +584,6 @@ extern void EmacsWindow_unparent (void *); extern void EmacsWindow_move_weak_child (void *, void *, int, int); extern void EmacsWindow_make_fullscreen (void *, int); extern void EmacsWindow_unzoom (void *); -extern void EmacsWindow_signal_menu_update_complete (void *); extern void be_get_version_string (char *, int); extern int be_get_display_planes (void); @@ -630,6 +636,8 @@ extern bool be_drag_message (void *, void *, bool, void (*) (void), bool (*) (void)); extern bool be_drag_and_drop_in_progress (void); +extern void be_replay_menu_bar_event (void *, struct haiku_menu_bar_click_event *); + #ifdef __cplusplus extern void *find_appropriate_view_for_draw (void *); } diff --git a/src/haikumenu.c b/src/haikumenu.c index 22e9c4ecad..8aced5f9d4 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -774,6 +774,39 @@ the position of the last non-menu event instead. */) return Qnil; } +void +haiku_activate_menubar (struct frame *f) +{ + int rc; + + if (!FRAME_HAIKU_MENU_BAR (f)) + return; + + set_frame_menubar (f, true); + + if (FRAME_OUTPUT_DATA (f)->saved_menu_event) + { + block_input (); + be_replay_menu_bar_event (FRAME_HAIKU_MENU_BAR (f), + FRAME_OUTPUT_DATA (f)->saved_menu_event); + xfree (FRAME_OUTPUT_DATA (f)->saved_menu_event); + FRAME_OUTPUT_DATA (f)->saved_menu_event = NULL; + unblock_input (); + } + else + { + block_input (); + rc = BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); + unblock_input (); + + if (!rc) + return; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; + } +} + void syms_of_haikumenu (void) { diff --git a/src/haikuterm.c b/src/haikuterm.c index 559ec58926..45d22ce22f 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3475,34 +3475,40 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) } break; } + case MENU_BAR_CLICK: + { + struct haiku_menu_bar_click_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + if (!FRAME_OUTPUT_DATA (f)->saved_menu_event) + FRAME_OUTPUT_DATA (f)->saved_menu_event = xmalloc (sizeof *b); + *FRAME_OUTPUT_DATA (f)->saved_menu_event = *b; + inev.kind = MENU_BAR_ACTIVATE_EVENT; + XSETFRAME (inev.frame_or_window, f); + break; + } case MENU_BAR_OPEN: case MENU_BAR_CLOSE: { struct haiku_menu_bar_state_event *b = buf; struct frame *f = haiku_window_to_frame (b->window); - int was_waiting_for_input_p; if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) continue; if (type == MENU_BAR_OPEN) { - was_waiting_for_input_p = waiting_for_input; - if (waiting_for_input) - waiting_for_input = 0; - - set_frame_menubar (f, 1); - waiting_for_input = was_waiting_for_input_p; - FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; popup_activated_p += 1; - - EmacsWindow_signal_menu_update_complete (b->window); } else { if (!popup_activated_p) emacs_abort (); + if (FRAME_OUTPUT_DATA (f)->menu_bar_open_p) { FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 0; @@ -3873,6 +3879,7 @@ haiku_create_terminal (struct haiku_display_info *dpyinfo) terminal->toggle_invisible_pointer_hook = haiku_toggle_invisible_pointer; terminal->fullscreen_hook = haiku_fullscreen; terminal->toolkit_position_hook = haiku_toolkit_position; + terminal->activate_menubar_hook = haiku_activate_menubar; return terminal; } @@ -4184,7 +4191,6 @@ This is either one of the symbols `shift', `control', `command', and Setting it to any other value is equivalent to `shift'. */); Vhaiku_shift_keysym = Qnil; - DEFSYM (Qx_use_underline_position_properties, "x-use-underline-position-properties"); diff --git a/src/haikuterm.h b/src/haikuterm.h index 7022ea77de..e922743b18 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -176,6 +176,9 @@ struct haiku_output /* The default cursor foreground color. */ uint32_t cursor_fg; + + /* If non-NULL, the last menu bar click event received. */ + struct haiku_menu_bar_click_event *saved_menu_event; }; struct x_output @@ -291,6 +294,7 @@ extern void haiku_put_pixel (haiku, int, int, unsigned long); extern Lisp_Object haiku_menu_show (struct frame *, int, int, int, Lisp_Object, const char **); extern Lisp_Object haiku_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_activate_menubar (struct frame *); extern void haiku_note_drag_motion (void); extern void initialize_frame_menubar (struct frame *); commit 4641bc1c550a81c71798c0176a6bfc34c8947c74 Author: Paul Eggert Date: Sun Apr 17 01:06:46 2022 -0700 Fix GC bug in filelock.c Fix a bug where if GC occurred at the wrong moment when locking a file, the lock file’s name was trashed so file locking did not work. This bug was introduced in Emacs 28.1. The bug sometimes caused filelock-tests-detect-external-change test failures on Fedora 35 x86-64 in an en_US.utf8 locale. * src/filelock.c (lock_file_1, current_lock_owner, lock_if_free) (lock_file, unlock_file, Ffile_locked_p): Use Lisp_Object, not char *, for string, so that GC doesn’t trash string contents. (make_lock_file_name): Return the encoded name, not the original. All callers changed. diff --git a/src/filelock.c b/src/filelock.c index e1e2cc1b23..25b35feb02 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -413,14 +413,13 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) Return 0 if successful, an error number on failure. */ static int -lock_file_1 (char *lfname, bool force) +lock_file_1 (Lisp_Object lfname, bool force) { - /* Call this first because it can GC. */ intmax_t boot = get_boot_time (); - Lisp_Object luser_name = Fuser_login_name (Qnil); - char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; Lisp_Object lhost_name = Fsystem_name (); + + char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : ""; char lock_info_str[MAX_LFINFO + 1]; intmax_t pid = getpid (); @@ -439,7 +438,7 @@ lock_file_1 (char *lfname, bool force) user_name, host_name, pid)) return ENAMETOOLONG; - return create_lock_file (lfname, lock_info_str, force); + return create_lock_file (SSDATA (lfname), lock_info_str, force); } /* Return true if times A and B are no more than one second apart. */ @@ -496,7 +495,7 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) or an errno value if something is wrong with the locking mechanism. */ static int -current_lock_owner (lock_info_type *owner, char *lfname) +current_lock_owner (lock_info_type *owner, Lisp_Object lfname) { int ret; lock_info_type local_owner; @@ -510,7 +509,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) owner = &local_owner; /* If nonexistent lock file, all is well; otherwise, got strange error. */ - lfinfolen = read_lock_data (lfname, owner->user); + lfinfolen = read_lock_data (SSDATA (lfname), owner->user); if (lfinfolen < 0) return errno == ENOENT || errno == ENOTDIR ? 0 : errno; if (MAX_LFINFO < lfinfolen) @@ -581,7 +580,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* The owner process is dead or has a strange pid, so try to zap the lockfile. */ else - return unlink (lfname) < 0 ? errno : 0; + return unlink (SSDATA (lfname)) < 0 ? errno : 0; } else { /* If we wanted to support the check for stale locks on remote machines, @@ -600,7 +599,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) Return positive errno value if cannot lock for any other reason. */ static int -lock_if_free (lock_info_type *clasher, char *lfname) +lock_if_free (lock_info_type *clasher, Lisp_Object lfname) { int err; while ((err = lock_file_1 (lfname, 0)) == EEXIST) @@ -619,10 +618,14 @@ lock_if_free (lock_info_type *clasher, char *lfname) return err; } +/* Return the encoded name of the lock file for FN, or nil if none. */ + static Lisp_Object make_lock_file_name (Lisp_Object fn) { - return call1 (Qmake_lock_file_name, Fexpand_file_name (fn, Qnil)); + Lisp_Object lock_file_name = call1 (Qmake_lock_file_name, + Fexpand_file_name (fn, Qnil)); + return !NILP (lock_file_name) ? ENCODE_FILE (lock_file_name) : Qnil; } /* lock_file locks file FN, @@ -646,7 +649,6 @@ make_lock_file_name (Lisp_Object fn) static Lisp_Object lock_file (Lisp_Object fn) { - char *lfname = NULL; lock_info_type lock_info; /* Don't do locking while dumping Emacs. @@ -655,13 +657,13 @@ lock_file (Lisp_Object fn) if (will_dump_p ()) return Qnil; + Lisp_Object lfname = Qnil; if (create_lockfiles) { /* Create the name of the lock-file for file fn */ - Lisp_Object lock_filename = make_lock_file_name (fn); - if (NILP (lock_filename)) + lfname = make_lock_file_name (fn); + if (NILP (lfname)) return Qnil; - lfname = SSDATA (ENCODE_FILE (lock_filename)); } /* See if this file is visited and has changed on disk since it was @@ -670,11 +672,11 @@ lock_file (Lisp_Object fn) if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn)) - && !(lfname && current_lock_owner (NULL, lfname) == -2)) + && !(!NILP (lfname) && current_lock_owner (NULL, lfname) == -2)) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); /* Don't do locking if the user has opted out. */ - if (lfname) + if (!NILP (lfname)) { /* Try to lock the lock. FIXME: This ignores errors when lock_if_free returns a positive errno value. */ @@ -702,15 +704,12 @@ lock_file (Lisp_Object fn) static Lisp_Object unlock_file (Lisp_Object fn) { - char *lfname; - - Lisp_Object lock_filename = make_lock_file_name (fn); - if (NILP (lock_filename)) + Lisp_Object lfname = make_lock_file_name (fn); + if (NILP (lfname)) return Qnil; - lfname = SSDATA (ENCODE_FILE (lock_filename)); int err = current_lock_owner (0, lfname); - if (err == -2 && unlink (lfname) != 0 && errno != ENOENT) + if (err == -2 && unlink (SSDATA (lfname)) != 0 && errno != ENOENT) err = errno; if (0 < err) report_file_errno ("Unlocking file", fn, err); @@ -854,10 +853,9 @@ t if it is locked by you, else a string saying which user has locked it. */) return call2 (handler, Qfile_locked_p, filename); } - Lisp_Object lock_filename = make_lock_file_name (filename); - if (NILP (lock_filename)) + Lisp_Object lfname = make_lock_file_name (filename); + if (NILP (lfname)) return Qnil; - char *lfname = SSDATA (ENCODE_FILE (lock_filename)); owner = current_lock_owner (&locker, lfname); switch (owner) commit 3dc73569b405d80e89c2965daba31ea4ee6664f0 Author: Jim Porter Date: Fri Apr 1 22:06:02 2022 -0700 Add 'G' argument predicate in Eshell * lisp/eshell/em-pred.el (eshell-predicate-alist): Add 'G' predicate. (eshell-predicate-help-string): Document it. (Bug#54470) * test/lisp/eshell/em-pred-tests.el (em-pred-test/predicate-effective-gid): New test. * doc/misc/eshell.text (Argument Predication): Document 'G' predicate. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 2d57e48ed8..411e696069 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1266,6 +1266,9 @@ Matches files with the sticky bit set. @item @samp{U} Matches files owned by the current effective user ID. +@item @samp{G} +Matches files owned by the current effective group ID. + @item @samp{l@option{[+-]}@var{n}} Matches files with @var{n} links. With @option{+} (or @option{-}), matches files with more than (or less than) @var{n} links, diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 8afc86dd41..eb5109b82d 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -88,10 +88,10 @@ ordinary strings." (if (file-exists-p file) (= (file-attribute-user-id (file-attributes file)) (user-uid))))) - ;; (?G . (lambda (file) ; owned by effective gid - ;; (if (file-exists-p file) - ;; (= (file-attribute-user-id (file-attributes file)) - ;; (user-uid))))) + (?G . (lambda (file) ; owned by effective gid + (if (file-exists-p file) + (= (file-attribute-group-id (file-attributes file)) + (group-gid))))) (?* . (lambda (file) (and (file-regular-p file) (not (file-symlink-p file)) @@ -161,6 +161,7 @@ PERMISSION BITS (for owner/group/world): OWNERSHIP: U owned by effective uid + G owned by effective gid u(UID|\\='user\\=') owned by UID/user g(GID|\\='group\\=') owned by GID/group diff --git a/test/lisp/eshell/em-pred-tests.el b/test/lisp/eshell/em-pred-tests.el index 74dad9f8b8..fbf8945215 100644 --- a/test/lisp/eshell/em-pred-tests.el +++ b/test/lisp/eshell/em-pred-tests.el @@ -225,6 +225,14 @@ read, write, and execute predicates to query the file's modes." (should (equal (eshell-eval-predicate files "U") '("/fake/uid=1"))))))) +(ert-deftest em-pred-test/predicate-effective-gid () + "Test that \"G\" matches files owned by the effective GID." + (eshell-with-file-attributes-from-name + (cl-letf (((symbol-function 'group-gid) (lambda () 1))) + (let ((files '("/fake/gid=1" "/fake/gid=2"))) + (should (equal (eshell-eval-predicate files "G") + '("/fake/gid=1"))))))) + (ert-deftest em-pred-test/predicate-links () "Test that \"l\" filters by number of links." (eshell-with-file-attributes-from-name commit 6358cbc21a816ac95c2e6e22e087ccd3736874bc Author: Jim Porter Date: Sat Mar 19 12:41:13 2022 -0700 Add unit tests and documentation for Eshell predicates/modifiers * lisp/eshell/esh-cmd.el (eshell-eval-argument): New function. * lisp/eshell/esh-util.el (eshell-file-attributes): Pass original value of FILE to 'file-attributes'. * lisp/eshell/em-pred.el (eshell-predicate-alist): Change socket char to '=', since 's' conflicts with setuid. (eshell-modifier-alist): Fix 'E' (eval) modifier by using 'eshell-eval-argument'. Also improve performance of 'O' (reversed sort) modifier. (eshell-modifier-help-string): Fix documentation of global substitution modifier. (eshell-pred-substitute): Fix infinite loop in some global substitutions. (eshell-join-members): Fix joining with implicit " " delimiter. (Bug#54470) * test/lisp/eshell/em-pred-tests.el: New file. * doc/misc/eshell.texi (Argument Predication): New section. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 648917f62d..2d57e48ed8 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1002,6 +1002,7 @@ is equivalent to entering the value of @code{var} at the prompt.} @menu * Dollars Expansion:: * Globbing:: +* Argument Predication and Modification:: @end menu @node Dollars Expansion @@ -1175,6 +1176,245 @@ like @samp{(@var{x}~@var{y})}. @end table +@node Argument Predication and Modification +@section Argument Predication and Modification +@cindex argument predication +@cindex argument modification +Eshell supports @dfn{argument predication}, to filter elements of a +glob, and @dfn{argument modification}, to manipulate argument values. +These are similar to glob qualifiers in Zsh (@pxref{Glob Qualifiers, , +, zsh, The Z Shell Manual}). + +Predicates and modifiers are introduced with @samp{(@var{filters})} +after any list argument, where @var{filters} is a list of predicates +or modifiers. For example, @samp{*(.)} expands to all regular files +in the current directory and @samp{*(^@@:U^u0)} expands to all +non-symlinks not owned by @code{root}, upper-cased. + +You can customize the syntax and behavior of predicates and modifiers +in Eshell via the Customize group ``eshell-pred'' (@pxref{Easy +Customization, , , emacs, The GNU Emacs Manual}). + +@menu +* Argument Predicates:: +* Argument Modifiers:: +@end menu + +@node Argument Predicates +@subsection Argument Predicates +You can use argument predicates to filter lists of file names based on +various properties of those files. This is most useful when combined +with globbing, but can be used on any list of files names. Eshell +supports the following argument predicates: + +@table @asis + +@item @samp{/} +Matches directories. + +@item @samp{.} @r{(Period)} +Matches regular files. + +@item @samp{@@} +Matches symbolic links. + +@item @samp{=} +Matches sockets. + +@item @samp{p} +Matches named pipes. + +@item @samp{%} +Matches block or character devices. + +@item @samp{%b} +Matches block devices. + +@item @samp{%c} +Matches character devices. + +@item @samp{*} +Matches regular files that can be executed by the current user. + +@item @samp{r} +@item @samp{A} +@item @samp{R} +Matches files that are readable by their owners (@samp{r}), their +groups (@samp{A}), or the world (@samp{R}). + +@item @samp{w} +@item @samp{I} +@item @samp{W} +Matches files that are writable by their owners (@samp{w}), their +groups (@samp{I}), or the world (@samp{W}). + +@item @samp{x} +@item @samp{E} +@item @samp{X} +Matches files that are executable by their owners (@samp{x}), their +groups (@samp{E}), or the world (@samp{X}). + +@item @samp{s} +Matches files with the setuid flag set. + +@item @samp{S} +Matches files with the setgid flag set. + +@item @samp{t} +Matches files with the sticky bit set. + +@item @samp{U} +Matches files owned by the current effective user ID. + +@item @samp{l@option{[+-]}@var{n}} +Matches files with @var{n} links. With @option{+} (or @option{-}), +matches files with more than (or less than) @var{n} links, +respectively. + +@item @samp{u@var{uid}} +@item @samp{u'@var{user-name}'} +Matches files owned by user ID @var{uid} or user name @var{user-name}. + +@item @samp{g@var{gid}} +@item @samp{g'@var{group-name}'} +Matches files owned by group ID @var{gid} or group name +@var{group-name}. + +@item @samp{a@option{[@var{unit}]}@option{[+-]}@var{n}} +@item @samp{a@option{[+-]}'@var{file}'} +Matches files last accessed exactly @var{n} days ago. With @option{+} +(or @option{-}), matches files accessed more than (or less than) +@var{n} days ago, respectively. + +With @var{unit}, @var{n} is a quantity in that unit of time, so +@samp{aw-1} matches files last accessed within one week. @var{unit} +can be @samp{M} (30-day months), @samp{w} (weeks), @samp{h} (hours), +@samp{m} (minutes), or @samp{s} (seconds). + +If @var{file} is specified instead, compare against the modification +time of @file{file}. Thus, @samp{a-'hello.txt'} matches all files +accessed after @file{hello.txt} was last accessed. + +@item @samp{m@option{[@var{unit}]}@option{[+-]}@var{n}} +@item @samp{m@option{[+-]}'@var{file}'} +Like @samp{a}, but examines modification time. + +@item @samp{c@option{[@var{unit}]}@option{[+-]}@var{n}} +@item @samp{c@option{[+-]}'@var{file}'} +Like @samp{a}, but examines status change time. + +@item @samp{L@option{[@var{unit}]}@option{[+-]}@var{n}} +Matches files exactly @var{n} bytes in size. With @option{+} (or +@option{-}), matches files larger than (or smaller than) @var{n} +bytes, respectively. + +With @var{unit}, @var{n} is a quantity in that unit of size, so +@samp{Lm+5} matches files larger than 5 MiB in size. @var{unit} can +be one of the following (case-insensitive) characters: @samp{m} +(megabytes), @samp{k} (kilobytes), or @samp{p} (512-byte blocks). + +@end table + +The @samp{^} and @samp{-} operators are not argument predicates +themselves, but they modify the behavior of all subsequent predicates. +@samp{^} inverts the meaning of subsequent predicates, so +@samp{*(^RWX)} expands to all files whose permissions disallow the +world from accessing them in any way (i.e., reading, writing to, or +modifying them). When examining a symbolic link, @samp{-} applies the +subsequent predicates to the link's target instead of the link itself. + +@node Argument Modifiers +@subsection Argument Modifiers +You can use argument modifiers to manipulate argument values. For +example, you can sort lists, remove duplicate values, capitalize +words, etc. All argument modifiers are prefixed by @samp{:}, so +@samp{$exec-path(:h:u:x/^\/home/)} lists all of the unique parent +directories of the elements in @code{exec-path}, excluding those in +@file{/home}. + +@table @samp + +@item E +Re-evaluates the value as an Eshell argument. For example, if +@var{foo} is @code{"$@{echo hi@}"}, then the result of @samp{$foo(:E)} +is @code{hi}. + +@item L +Converts the value to lower case. + +@item U +Converts the value to upper case. + +@item C +Capitalizes the value. + +@item h +Treating the value as a file name, gets the directory name (the +``head''). For example, @samp{foo/bar/baz.el(:h)} expands to +@samp{foo/bar/}. + +@item t +Treating the value as a file name, gets the base name (the ``tail''). +For example, @samp{foo/bar/baz.el(:h)} expands to @samp{baz.el}. + +@item e +Treating the value as a file name, gets the final extension of the +file, excluding the dot. For example, @samp{foo.tar.gz(:e)} +expands to @code{gz}. + +@item r +Treating the value as a file name, gets the file name excluding the +final extension. For example, @samp{foo/bar/baz.tar.gz(:r)} expands +to @samp{foo/bar/baz.tar}. + +@item q +Marks that the value should be interpreted by Eshell literally, so +that any special characters like @samp{$} no longer have any special +meaning. + +@item s/@var{pattern}/@var{replace}/ +Replaces the first instance of the regular expression @var{pattern} +with @var{replace}. Signals an error if no match is found. + +@item gs/@var{pattern}/@var{replace}/ +Replaces all instances of the regular expression @var{pattern} with +@var{replace}. + +@item i/@var{pattern}/ +Filters a list of values to include only the elements matching the +regular expression @var{pattern}. + +@item x/@var{pattern}/ +Filters a list of values to exclude all the elements matching the +regular expression @var{pattern}. + +@item S +@item S/@var{pattern}/ +Splits the value using the regular expression @var{pattern} as a +delimiter. If @var{pattern} is omitted, split on spaces. + +@item j +@item j/@var{delim}/ +Joins a list of values, inserting the string @var{delim} between each +value. If @var{delim} is omitted, use a single space as the +delimiter. + +@item o +Sorts a list of strings in ascending lexicographic order, comparing +pairs of characters according to their character codes (@pxref{Text +Comparison, , , elisp, The Emacs Lisp Reference Manual}). + +@item O +Sorts a list of strings in descending lexicographic order. + +@item u +Removes any duplicate elements from a list of values. + +@item R +Reverses the order of a list of values. + +@end table + @node Input/Output @chapter Input/Output Since Eshell does not communicate with a terminal like most command diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 970329e12a..8afc86dd41 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -68,7 +68,7 @@ ordinary strings." (defcustom eshell-predicate-alist '((?/ . (eshell-pred-file-type ?d)) ; directories (?. . (eshell-pred-file-type ?-)) ; regular files - (?s . (eshell-pred-file-type ?s)) ; sockets + (?= . (eshell-pred-file-type ?s)) ; sockets (?p . (eshell-pred-file-type ?p)) ; named pipes (?@ . (eshell-pred-file-type ?l)) ; symbolic links (?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.) @@ -97,8 +97,8 @@ ordinary strings." (not (file-symlink-p file)) (file-executable-p file)))) (?l . (eshell-pred-file-links)) - (?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id)) - (?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id)) + (?u . (eshell-pred-user-or-group ?u "user" 2 #'eshell-user-id)) + (?g . (eshell-pred-user-or-group ?g "group" 3 #'eshell-group-id)) (?a . (eshell-pred-file-time ?a "access" 4)) (?m . (eshell-pred-file-time ?m "modification" 5)) (?c . (eshell-pred-file-time ?c "change" 6)) @@ -111,12 +111,7 @@ The format of each entry is :risky t) (defcustom eshell-modifier-alist - '((?E . (lambda (lst) - (mapcar - (lambda (str) - (eshell-stringify - (car (eshell-parse-argument str)))) - lst))) + '((?E . (lambda (lst) (mapcar #'eshell-eval-argument lst))) (?L . (lambda (lst) (mapcar #'downcase lst))) (?U . (lambda (lst) (mapcar #'upcase lst))) (?C . (lambda (lst) (mapcar #'capitalize lst))) @@ -129,10 +124,10 @@ The format of each entry is (?q . (lambda (lst) (mapcar #'eshell-escape-arg lst))) (?u . (lambda (lst) (seq-uniq lst))) (?o . (lambda (lst) (sort lst #'string-lessp))) - (?O . (lambda (lst) (nreverse (sort lst #'string-lessp)))) + (?O . (lambda (lst) (sort lst #'string-greaterp))) (?j . (eshell-join-members)) (?S . (eshell-split-members)) - (?R . 'reverse) + (?R . #'reverse) (?g . (progn (forward-char) (if (eq (char-before) ?s) @@ -142,7 +137,7 @@ The format of each entry is "A list of modifiers than can be applied to an argument expansion. The format of each entry is - (CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)" + (CHAR . MODIFIER-FUNC-SEXP)" :type '(repeat (cons character sexp)) :risky t) @@ -217,8 +212,8 @@ FOR LISTS OF ARGUMENTS: i/PAT/ exclude all members not matching PAT x/PAT/ exclude all members matching PAT - s/pat/match/ substitute PAT with MATCH - g/pat/match/ substitute PAT with MATCH for all occurrences + s/pat/match/ substitute PAT with MATCH + gs/pat/match/ substitute PAT with MATCH for all occurrences EXAMPLES: *.c(:o) sorted list of .c files") @@ -534,18 +529,14 @@ that `ls -l' will show in the first column of its display." (lambda (lst) (mapcar (lambda (str) - (let ((i 0)) - (while (setq i (string-match match str i)) - (setq str (replace-match replace t nil str)))) - str) + (replace-regexp-in-string match replace str t)) lst)) (lambda (lst) (mapcar (lambda (str) (if (string-match match str) - (setq str (replace-match replace t nil str)) - (error (concat str ": substitution failed"))) - str) + (replace-match replace t nil str) + (error (concat str ": substitution failed")))) lst))))) (defun eshell-include-members (&optional invert-p) @@ -568,7 +559,7 @@ that `ls -l' will show in the first column of its display." (let ((delim (char-after)) str end) (if (not (memq delim '(?' ?/))) - (setq delim " ") + (setq str " ") (forward-char) (setq end (eshell-find-delimiter delim delim nil nil t) str (buffer-substring-no-properties (point) end)) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 8be1136e31..42616e7037 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1002,6 +1002,14 @@ produced by `eshell-parse-command'." (let ((base (cadr (nth 2 (nth 2 (cadr command)))))) (eshell--invoke-command-directly base))) +(defun eshell-eval-argument (argument) + "Evaluate a single Eshell ARGUMENT and return the result." + (let* ((form (eshell-with-temp-command argument + (eshell-parse-argument))) + (result (eshell-do-eval form t))) + (cl-assert (eq (car result) 'quote)) + (cadr result))) + (defun eshell-eval-command (command &optional input) "Evaluate the given COMMAND iteratively." (if eshell-current-command diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 8089d4d74b..3da712c719 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -592,11 +592,11 @@ list." The optional argument ID-FORMAT specifies the preferred uid and gid format. Valid values are `string' and `integer', defaulting to `integer'. See `file-attributes'." - (let* ((file (expand-file-name file)) + (let* ((expanded-file (expand-file-name file)) entry) - (if (string-equal (file-remote-p file 'method) "ftp") - (let ((base (file-name-nondirectory file)) - (dir (file-name-directory file))) + (if (string-equal (file-remote-p expanded-file 'method) "ftp") + (let ((base (file-name-nondirectory expanded-file)) + (dir (file-name-directory expanded-file))) (if (string-equal "" base) (setq base ".")) (unless entry (setq entry (eshell-parse-ange-ls dir)) diff --git a/test/lisp/eshell/em-pred-tests.el b/test/lisp/eshell/em-pred-tests.el new file mode 100644 index 0000000000..74dad9f8b8 --- /dev/null +++ b/test/lisp/eshell/em-pred-tests.el @@ -0,0 +1,521 @@ +;;; em-pred-tests.el --- em-pred test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for Eshell's argument predicates/modifiers. + +;;; Code: + +(require 'ert) +(require 'esh-mode) +(require 'eshell) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +(defvar eshell-test-value nil) + +(defun eshell-eval-predicate (initial-value predicate) + "Evaluate PREDICATE on INITIAL-VALUE, returning the result. +PREDICATE is an Eshell argument predicate/modifier." + (let ((eshell-test-value initial-value)) + (with-temp-eshell + (eshell-insert-command + (format "setq eshell-test-value $eshell-test-value(%s)" predicate))) + eshell-test-value)) + +(defun eshell-parse-file-name-attributes (file) + "Parse a fake FILE name to determine its attributes. +Fake file names are file names beginning with \"/fake/\". This +allows defining file names for fake files with various properties +to query via predicates. Attributes are written as a +comma-separate list of ATTR=VALUE pairs as the file's base name, +like: + + /fake/type=-,modes=0755.el + +The following attributes are recognized: + + * \"type\": A single character describing the file type; + accepts the same values as the first character of the file + modes in `ls -l'. + * \"modes\": The file's permission modes, in octal. + * \"links\": The number of links to this file. + * \"uid\": The UID of the file's owner. + * \"gid\": The UID of the file's group. + * \"atime\": The time the file was last accessed, in seconds + since the UNIX epoch. + * \"mtime\": As \"atime\", but for modification time. + * \"ctime\": As \"atime\", but for inode change time. + * \"size\": The file's size in bytes." + (mapcar (lambda (i) + (pcase (split-string i "=") + (`("modes" ,modes) + (cons 'modes (string-to-number modes 8))) + (`(,(and (or "links" "uid" "gid" "size") key) ,value) + (cons (intern key) (string-to-number value))) + (`(,(and (or "atime" "mtime" "ctime") key) ,value) + (cons (intern key) (time-convert (string-to-number value)))) + (`(,key ,value) + (cons (intern key) value)) + (_ (error "invalid format %S" i)))) + (split-string (file-name-base file) ","))) + +(defmacro eshell-partial-let-func (overrides &rest body) + "Temporarily bind to FUNCTION-NAMEs and evaluate BODY. +This is roughly analogous to advising functions, but only does so +while BODY is executing, and only calls NEW-FUNCTION if its first +argument is a string beginning with \"/fake/\". + +This allows selectively overriding functions to test file +properties with fake files without altering the functions' +behavior for real files. + +\(fn ((FUNCTION-NAME NEW-FUNCTION) ...) BODY...)" + (declare (indent 1)) + `(cl-letf + ,(mapcar + (lambda (override) + (let ((orig-function (symbol-function (car override)))) + `((symbol-function #',(car override)) + (lambda (file &rest rest) + (apply + (if (and (stringp file) (string-prefix-p "/fake/" file)) + ,(cadr override) + ,orig-function) + file rest))))) + overrides) + ,@body)) + +(defmacro eshell-with-file-attributes-from-name (&rest body) + "Temporarily override file attribute functions and evaluate BODY." + (declare (indent 0)) + `(eshell-partial-let-func + ((file-attributes + (lambda (file &optional _id-format) + (let ((attrs (eshell-parse-file-name-attributes file))) + (list (equal (alist-get 'type attrs) "d") + (or (alist-get 'links attrs) 1) + (or (alist-get 'uid attrs) 0) + (or (alist-get 'gid attrs) 0) + (or (alist-get 'atime attrs) nil) + (or (alist-get 'mtime attrs) nil) + (or (alist-get 'ctime attrs) nil) + (or (alist-get 'size attrs) 0) + (format "%s---------" (or (alist-get 'type attrs) "-")) + nil 0 0)))) + (file-modes + (lambda (file _nofollow) + (let ((attrs (eshell-parse-file-name-attributes file))) + (or (alist-get 'modes attrs) 0)))) + (file-exists-p #'always) + (file-regular-p + (lambda (file) + (let ((attrs (eshell-parse-file-name-attributes file))) + (member (or (alist-get 'type attrs) "-") '("-" "l"))))) + (file-symlink-p + (lambda (file) + (let ((attrs (eshell-parse-file-name-attributes file))) + (equal (alist-get 'type attrs) "l")))) + (file-executable-p + (lambda (file) + (let ((attrs (eshell-parse-file-name-attributes file))) + ;; For simplicity, just return whether the file is + ;; world-executable. + (= (logand (or (alist-get 'modes attrs) 0) 1) 1))))) + ,@body)) + +;;; Tests: + + +;; Argument predicates + +(ert-deftest em-pred-test/predicate-file-types () + "Test file type predicates." + (eshell-with-file-attributes-from-name + (let ((files (mapcar (lambda (i) (format "/fake/type=%s" i)) + '("b" "c" "d/" "p" "s" "l" "-")))) + (should (equal (eshell-eval-predicate files "%") + '("/fake/type=b" "/fake/type=c"))) + (should (equal (eshell-eval-predicate files "%b") '("/fake/type=b"))) + (should (equal (eshell-eval-predicate files "%c") '("/fake/type=c"))) + (should (equal (eshell-eval-predicate files "/") '("/fake/type=d/"))) + (should (equal (eshell-eval-predicate files ".") '("/fake/type=-"))) + (should (equal (eshell-eval-predicate files "p") '("/fake/type=p"))) + (should (equal (eshell-eval-predicate files "=") '("/fake/type=s"))) + (should (equal (eshell-eval-predicate files "@") '("/fake/type=l")))))) + +(ert-deftest em-pred-test/predicate-executable () + "Test that \"*\" matches only regular, non-symlink executable files." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/modes=0777" "/fake/modes=0666" + "/fake/type=d,modes=0777" "/fake/type=l,modes=0777"))) + (should (equal (eshell-eval-predicate files "*") + '("/fake/modes=0777")))))) + +(defmacro em-pred-test--file-modes-deftest (name mode-template predicates + &optional docstring) + "Define NAME as a file-mode test. +MODE-TEMPLATE is a format string to convert an integer from 0 to +7 to an octal file mode. PREDICATES is a list of strings for the +read, write, and execute predicates to query the file's modes." + (declare (indent 4) (doc-string 4)) + `(ert-deftest ,name () + ,docstring + (eshell-with-file-attributes-from-name + (let ((file-template (concat "/fake/modes=" ,mode-template))) + (cl-flet ((make-files (perms) + (mapcar (lambda (i) (format file-template i)) + perms))) + (pcase-let ((files (make-files (number-sequence 0 7))) + (`(,read ,write ,exec) ,predicates)) + (should (equal (eshell-eval-predicate files read) + (make-files '(4 5 6 7)))) + (should (equal (eshell-eval-predicate files (concat "^" read)) + (make-files '(0 1 2 3)))) + (should (equal (eshell-eval-predicate files write) + (make-files '(2 3 6 7)))) + (should (equal (eshell-eval-predicate files (concat "^" write)) + (make-files '(0 1 4 5)))) + (should (equal (eshell-eval-predicate files exec) + (make-files '(1 3 5 7)))) + (should (equal (eshell-eval-predicate files (concat "^" exec)) + (make-files '(0 2 4 6)))))))))) + +(em-pred-test--file-modes-deftest em-pred-test/predicate-file-modes-owner + "0%o00" '("r" "w" "x") + "Test predicates for file permissions for the owner.") + +(em-pred-test--file-modes-deftest em-pred-test/predicate-file-modes-group + "00%o0" '("A" "I" "E") + "Test predicates for file permissions for the group.") + +(em-pred-test--file-modes-deftest em-pred-test/predicate-file-modes-world + "000%o" '("R" "W" "X") + "Test predicates for file permissions for the world.") + +(em-pred-test--file-modes-deftest em-pred-test/predicate-file-modes-flags + "%o000" '("s" "S" "t") + "Test predicates for \"s\" (setuid), \"S\" (setgid), and \"t\" (sticky).") + +(ert-deftest em-pred-test/predicate-effective-uid () + "Test that \"U\" matches files owned by the effective UID." + (eshell-with-file-attributes-from-name + (cl-letf (((symbol-function 'user-uid) (lambda () 1))) + (let ((files '("/fake/uid=1" "/fake/uid=2"))) + (should (equal (eshell-eval-predicate files "U") + '("/fake/uid=1"))))))) + +(ert-deftest em-pred-test/predicate-links () + "Test that \"l\" filters by number of links." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/links=1" "/fake/links=2" "/fake/links=3"))) + (should (equal (eshell-eval-predicate files "l1") + '("/fake/links=1"))) + (should (equal (eshell-eval-predicate files "l+1") + '("/fake/links=2" "/fake/links=3"))) + (should (equal (eshell-eval-predicate files "l-3") + '("/fake/links=1" "/fake/links=2")))))) + +(ert-deftest em-pred-test/predicate-uid () + "Test that \"u\" filters by UID/user name." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/uid=1" "/fake/uid=2")) + (user-names '("root" "one" "two"))) + (should (equal (eshell-eval-predicate files "u1") + '("/fake/uid=1"))) + (cl-letf (((symbol-function 'eshell-user-id) + (lambda (name) (seq-position user-names name)))) + (should (equal (eshell-eval-predicate files "u'one'") + '("/fake/uid=1"))) + (should (equal (eshell-eval-predicate files "u{one}") + '("/fake/uid=1"))))))) + +(ert-deftest em-pred-test/predicate-gid () + "Test that \"g\" filters by GID/group name." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/gid=1" "/fake/gid=2")) + (group-names '("root" "one" "two"))) + (should (equal (eshell-eval-predicate files "g1") + '("/fake/gid=1"))) + (cl-letf (((symbol-function 'eshell-group-id) + (lambda (name) (seq-position group-names name)))) + (should (equal (eshell-eval-predicate files "g'one'") + '("/fake/gid=1"))) + (should (equal (eshell-eval-predicate files "g{one}") + '("/fake/gid=1"))))))) + +(defmacro em-pred-test--time-deftest (name file-attribute predicate + &optional docstring) + "Define NAME as a file-time test. +FILE-ATTRIBUTE is the file's attribute to set (e.g. \"atime\"). +PREDICATE is the predicate used to query that attribute." + (declare (indent 4) (doc-string 4)) + `(ert-deftest ,name () + ,docstring + (eshell-with-file-attributes-from-name + (cl-flet ((make-file (time) + (format "/fake/%s=%d" ,file-attribute time))) + (let* ((now (time-convert nil 'integer)) + (yesterday (- now 86400)) + (files (mapcar #'make-file (list now yesterday)))) + ;; Test comparison against a number of days. + (should (equal (eshell-eval-predicate + files (concat ,predicate "-1")) + (mapcar #'make-file (list now)))) + (should (equal (eshell-eval-predicate + files (concat ,predicate "+1")) + (mapcar #'make-file (list yesterday)))) + (should (equal (eshell-eval-predicate + files (concat ,predicate "+2")) + nil)) + ;; Test comparison against a number of hours. + (should (equal (eshell-eval-predicate + files (concat ,predicate "h-1")) + (mapcar #'make-file (list now)))) + (should (equal (eshell-eval-predicate + files (concat ,predicate "h+1")) + (mapcar #'make-file (list yesterday)))) + (should (equal (eshell-eval-predicate + files (concat ,predicate "+48")) + nil)) + ;; Test comparison against another file. + (should (equal (eshell-eval-predicate + files (format "%s-'%s'" ,predicate (make-file now))) + nil)) + (should (equal (eshell-eval-predicate + files (format "%s+'%s'" ,predicate (make-file now))) + (mapcar #'make-file (list yesterday))))))))) + +(em-pred-test--time-deftest em-pred-test/predicate-access-time + "atime" "a" + "Test that \"a\" filters by access time.") + +(em-pred-test--time-deftest em-pred-test/predicate-modification-time + "mtime" "m" + "Test that \"m\" filters by change time.") + +(em-pred-test--time-deftest em-pred-test/predicate-change-time + "ctime" "c" + "Test that \"c\" filters by change time.") + +(ert-deftest em-pred-test/predicate-size () + "Test that \"L\" filters by file size." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/size=0" + ;; 1 and 2 KiB. + "/fake/size=1024" "/fake/size=2048" + ;; 1 and 2 MiB. + "/fake/size=1048576" "/fake/size=2097152"))) + ;; Size in bytes. + (should (equal (eshell-eval-predicate files "L2048") + '("/fake/size=2048"))) + (should (equal (eshell-eval-predicate files "L+2048") + '("/fake/size=1048576" "/fake/size=2097152"))) + (should (equal (eshell-eval-predicate files "L-2048") + '("/fake/size=0" "/fake/size=1024"))) + ;; Size in blocks. + (should (equal (eshell-eval-predicate files "Lp4") + '("/fake/size=2048"))) + (should (equal (eshell-eval-predicate files "Lp+4") + '("/fake/size=1048576" "/fake/size=2097152"))) + (should (equal (eshell-eval-predicate files "Lp-4") + '("/fake/size=0" "/fake/size=1024"))) + ;; Size in KiB. + (should (equal (eshell-eval-predicate files "Lk2") + '("/fake/size=2048"))) + (should (equal (eshell-eval-predicate files "Lk+2") + '("/fake/size=1048576" "/fake/size=2097152"))) + (should (equal (eshell-eval-predicate files "Lk-2") + '("/fake/size=0" "/fake/size=1024"))) + ;; Size in MiB. + (should (equal (eshell-eval-predicate files "LM1") + '("/fake/size=1048576"))) + (should (equal (eshell-eval-predicate files "LM+1") + '("/fake/size=2097152"))) + (should (equal (eshell-eval-predicate files "LM-1") + '("/fake/size=0" "/fake/size=1024" "/fake/size=2048")))))) + + +;; Argument modifiers + +(ert-deftest em-pred-test/modifier-eval () + "Test that \":E\" re-evaluates the value." + (should (equal (eshell-eval-predicate "${echo hi}" ":E") "hi")) + (should (equal (eshell-eval-predicate + '("${echo hi}" "$(upcase \"bye\")") ":E") + '("hi" "BYE")))) + +(ert-deftest em-pred-test/modifier-downcase () + "Test that \":L\" downcases values." + (should (equal (eshell-eval-predicate "FOO" ":L") "foo")) + (should (equal (eshell-eval-predicate '("FOO" "BAR") ":L") + '("foo" "bar")))) + +(ert-deftest em-pred-test/modifier-upcase () + "Test that \":U\" upcases values." + (should (equal (eshell-eval-predicate "foo" ":U") "FOO")) + (should (equal (eshell-eval-predicate '("foo" "bar") ":U") + '("FOO" "BAR")))) + +(ert-deftest em-pred-test/modifier-capitalize () + "Test that \":C\" capitalizes values." + (should (equal (eshell-eval-predicate "foo bar" ":C") "Foo Bar")) + (should (equal (eshell-eval-predicate '("foo bar" "baz") ":C") + '("Foo Bar" "Baz")))) + +(ert-deftest em-pred-test/modifier-dirname () + "Test that \":h\" returns the dirname." + (should (equal (eshell-eval-predicate "/path/to/file.el" ":h") "/path/to/")) + (should (equal (eshell-eval-predicate + '("/path/to/file.el" "/other/path/") ":h") + '("/path/to/" "/other/path/")))) + +(ert-deftest em-pred-test/modifier-basename () + "Test that \":t\" returns the basename." + (should (equal (eshell-eval-predicate "/path/to/file.el" ":t") "file.el")) + (should (equal (eshell-eval-predicate + '("/path/to/file.el" "/other/path/") ":t") + '("file.el" "")))) + +(ert-deftest em-pred-test/modifier-extension () + "Test that \":e\" returns the extension." + (should (equal (eshell-eval-predicate "/path/to/file.el" ":e") "el")) + (should (equal (eshell-eval-predicate + '("/path/to/file.el" "/other/path/") ":e") + '("el" nil)))) + +(ert-deftest em-pred-test/modifier-sans-extension () + "Test that \":r\" returns the file name san extension." + (should (equal (eshell-eval-predicate "/path/to/file.el" ":r") + "/path/to/file")) + (should (equal (eshell-eval-predicate + '("/path/to/file.el" "/other/path/") ":r") + '("/path/to/file" "/other/path/")))) + +(ert-deftest em-pred-test/modifier-quote () + "Test that \":q\" quotes arguments." + (should (equal-including-properties + (eshell-eval-predicate '("foo" "bar") ":q") + (list (eshell-escape-arg "foo") (eshell-escape-arg "bar"))))) + +(ert-deftest em-pred-test/modifier-substitute () + "Test that \":s/PAT/REP/\" replaces PAT with REP once." + (should (equal (eshell-eval-predicate "bar" ":s/a/*/") "b*r")) + (should (equal (eshell-eval-predicate "bar" ":s|a|*|") "b*r")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":s/[ao]/*/") + '("f*o" "b*r" "b*z"))) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":s|[ao]|*|") + '("f*o" "b*r" "b*z")))) + +(ert-deftest em-pred-test/modifier-global-substitute () + "Test that \":s/PAT/REP/\" replaces PAT with REP for all occurrences." + (should (equal (eshell-eval-predicate "foo" ":gs/a/*/") "foo")) + (should (equal (eshell-eval-predicate "foo" ":gs|a|*|") "foo")) + (should (equal (eshell-eval-predicate "bar" ":gs/a/*/") "b*r")) + (should (equal (eshell-eval-predicate "bar" ":gs|a|*|") "b*r")) + (should (equal (eshell-eval-predicate "foo" ":gs/o/O/") "fOO")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":gs/[aeiou]/*/") + '("f**" "b*r" "b*z"))) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":gs|[aeiou]|*|") + '("f**" "b*r" "b*z")))) + +(ert-deftest em-pred-test/modifier-include () + "Test that \":i/PAT/\" filters elements to include only ones matching PAT." + (should (equal (eshell-eval-predicate "foo" ":i/a/") nil)) + (should (equal (eshell-eval-predicate "foo" ":i|a|") nil)) + (should (equal (eshell-eval-predicate "bar" ":i/a/") "bar")) + (should (equal (eshell-eval-predicate "bar" ":i|a|") "bar")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":i/a/") + '("bar" "baz"))) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":i|a|") + '("bar" "baz")))) + +(ert-deftest em-pred-test/modifier-exclude () + "Test that \":x/PAT/\" filters elements to exclude any matching PAT." + (should (equal (eshell-eval-predicate "foo" ":x/a/") "foo")) + (should (equal (eshell-eval-predicate "foo" ":x|a|") "foo")) + (should (equal (eshell-eval-predicate "bar" ":x/a/") nil)) + (should (equal (eshell-eval-predicate "bar" ":x|a|") nil)) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":x/a/") + '("foo"))) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":x|a|") + '("foo")))) + +(ert-deftest em-pred-test/modifier-split () + "Test that \":S\" and \":S/PAT/\" split elements by spaces (or PAT)." + (should (equal (eshell-eval-predicate "foo bar baz" ":S") + '("foo" "bar" "baz"))) + (should (equal (eshell-eval-predicate '("foo bar" "baz") ":S") + '(("foo" "bar") ("baz")))) + (should (equal (eshell-eval-predicate "foo-bar-baz" ":S/-/") + '("foo" "bar" "baz"))) + (should (equal (eshell-eval-predicate '("foo-bar" "baz") ":S/-/") + '(("foo" "bar") ("baz"))))) + +(ert-deftest em-pred-test/modifier-join () + "Test that \":j\" and \":j/DELIM/\" join elements by spaces (or DELIM)." + (should (equal (eshell-eval-predicate "foo" ":j") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j") + "foo bar baz")) + (should (equal (eshell-eval-predicate "foo" ":j/-/") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j/-/") + "foo-bar-baz"))) + +(ert-deftest em-pred-test/modifier-sort () + "Test that \":o\" sorts elements in lexicographic order." + (should (equal (eshell-eval-predicate "foo" ":o") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":o") + '("bar" "baz" "foo")))) + +(ert-deftest em-pred-test/modifier-sort-reverse () + "Test that \":o\" sorts elements in reverse lexicographic order." + (should (equal (eshell-eval-predicate "foo" ":O") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":O") + '("foo" "baz" "bar")))) + +(ert-deftest em-pred-test/modifier-unique () + "Test that \":u\" filters out duplicate elements." + (should (equal (eshell-eval-predicate "foo" ":u") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":u") + '("foo" "bar" "baz"))) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz" "foo") ":u") + '("foo" "bar" "baz")))) + +(ert-deftest em-pred-test/modifier-reverse () + "Test that \":r\" reverses the order of elements." + (should (equal (eshell-eval-predicate "foo" ":R") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":R") + '("baz" "bar" "foo")))) + + +;; Combinations + +(ert-deftest em-pred-test/combine-predicate-and-modifier () + "Test combination of predicates and modifiers." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/type=-.el" "/fake/type=-.txt" "/fake/type=s.el" + "/fake/subdir/type=-.el"))) + (should (equal (eshell-eval-predicate files ".:e:u") + '("el" "txt")))))) + +;; em-pred-tests.el ends here commit bbb92dde01ec3fc46b24247fb2d181a21dbcc40a Author: Jim Porter Date: Tue Mar 8 17:07:26 2022 -0800 Add unit tests and documentation for Eshell pattern-based globs * lisp/eshell/em-glob.el (eshell-extended-glob): Fix docstring. (eshell-glob-entries): Refer to '**/' in error (technically, '**' can end a glob, but it means the same thing as '*'). (Bug#54470) * test/lisp/eshell/em-glob-tests.el: New file. * doc/misc/eshell.texi (Globbing): Document pattern-based globs. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 372e4c3ffb..648917f62d 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1089,15 +1089,91 @@ the result of @var{expr} is not a string or a sequence. @node Globbing @section Globbing -Eshell's globbing syntax is very similar to that of Zsh. Users coming -from Bash can still use Bash-style globbing, as there are no -incompatibilities. Most globbing is pattern-based expansion, but there -is also predicate-based expansion. @xref{Filename Generation, , , -zsh, The Z Shell Manual}, -for full syntax. To customize the syntax and behavior of globbing in -Eshell see the Customize@footnote{@xref{Easy Customization, , , emacs, -The GNU Emacs Manual}.} -groups ``eshell-glob'' and ``eshell-pred''. +@vindex eshell-glob-case-insensitive +Eshell's globbing syntax is very similar to that of Zsh +(@pxref{Filename Generation, , , zsh, The Z Shell Manual}). Users +coming from Bash can still use Bash-style globbing, as there are no +incompatibilities. + +By default, globs are case sensitive, except on MS-DOS/MS-Windows +systems. You can control this behavior via the +@code{eshell-glob-case-insensitive} option. You can further customize +the syntax and behavior of globbing in Eshell via the Customize group +``eshell-glob'' (@pxref{Easy Customization, , , emacs, The GNU Emacs +Manual}). + +@table @samp + +@item * +Matches any string (including the empty string). For example, +@samp{*.el} matches any file with the @file{.el} extension. + +@item ? +Matches any single character. For example, @samp{?at} matches +@file{cat} and @file{bat}, but not @file{goat}. + +@item **/ +Matches zero or more subdirectories in a file name. For example, +@samp{**/foo.el} matches @file{foo.el}, @file{bar/foo.el}, +@file{bar/baz/foo.el}, etc. Note that this cannot be combined with +any other patterns in the same file name segment, so while +@samp{foo/**/bar.el} is allowed, @samp{foo**/bar.el} is not. + +@item ***/ +Like @samp{**/}, but follows symlinks as well. + +@cindex character sets, in Eshell glob patterns +@cindex character classes, in Eshell glob patterns +@item [ @dots{} ] +Defines a @dfn{character set} (@pxref{Regexps, , , emacs, The GNU +Emacs Manual}). A character set matches characters between the two +brackets; for example, @samp{[ad]} matches @file{a} and @file{d}. You +can also include ranges of characters in the set by separating the +start and end with @samp{-}. Thus, @samp{[a-z]} matches any +lower-case @acronym{ASCII} letter. Note that, unlike in Zsh, +character ranges are interpreted in the Unicode codepoint order, not +in the locale-dependent collation order. + +Additionally, you can include @dfn{character classes} in a character +set. A @samp{[:} and balancing @samp{:]} enclose a character class +inside a character set. For instance, @samp{[[:alnum:]]} +matches any letter or digit. @xref{Char Classes, , , elisp, The Emacs +Lisp Reference Manual}, for a list of character classes. + +@cindex complemented character sets, in Eshell glob patterns +@item [^ @dots{} ] +Defines a @dfn{complemented character set}. This behaves just like a +character set, but matches any character @emph{except} the ones +specified. + +@cindex groups, in Eshell glob patterns +@item ( @dots{} ) +Defines a @dfn{group}. A group matches the pattern between @samp{(} +and @samp{)}. Note that a group can only match a single file name +component, so a @samp{/} inside a group will signal an error. + +@item @var{x}|@var{y} +Inside of a group, matches either @var{x} or @var{y}. For example, +@samp{e(m|sh)-*} matches any file beginning with @file{em-} or +@file{esh-}. + +@item @var{x}# +Matches zero or more copies of the glob pattern @var{x}. For example, +@samp{fo#.el} matches @file{f.el}, @file{fo.el}, @file{foo.el}, etc. + +@item @var{x}## +Matches one or more copies of the glob pattern @var{x}. Thus, +@samp{fo#.el} matches @file{fo.el}, @file{foo.el}, @file{fooo.el}, +etc. + +@item @var{x}~@var{y} +Matches anything that matches the pattern @var{x} but not @var{y}. For +example, @samp{[[:digit:]]#~4?} matches @file{1} and @file{12}, but +not @file{42}. Note that unlike in Zsh, only a single @samp{~} +operator can be used in a pattern, and it cannot be inside of a group +like @samp{(@var{x}~@var{y})}. + +@end table @node Input/Output @chapter Input/Output diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 842f27a492..52531ff893 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -233,7 +233,10 @@ resulting regular expression." "\\'"))) (defun eshell-extended-glob (glob) - "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY. + "Return a list of files matched by GLOB. +If no files match, signal an error (if `eshell-error-if-no-glob' +is non-nil), or otherwise return GLOB itself. + This function almost fully supports zsh style filename generation syntax. Things that are not supported are: @@ -243,12 +246,7 @@ syntax. Things that are not supported are: foo~x(a|b) (a|b) will be interpreted as a predicate/modifier list Mainly they are not supported because file matching is done with Emacs -regular expressions, and these cannot support the above constructs. - -If this routine fails, it returns nil. Otherwise, it returns a list -the form: - - (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))" +regular expressions, and these cannot support the above constructs." (let ((paths (eshell-split-path glob)) eshell-glob-matches message-shown) (unwind-protect @@ -287,7 +285,7 @@ the form: glob (car globs) len (length glob))))) (if (and recurse-p (not glob)) - (error "`**' cannot end a globbing pattern")) + (error "`**/' cannot end a globbing pattern")) (let ((index 1)) (setq incl glob) (while (and (eq incl glob) diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el new file mode 100644 index 0000000000..9976b32ffe --- /dev/null +++ b/test/lisp/eshell/em-glob-tests.el @@ -0,0 +1,171 @@ +;;; em-glob-tests.el --- em-glob test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for Eshell's glob expansion. + +;;; Code: + +(require 'ert) +(require 'em-glob) + +(defmacro with-fake-files (files &rest body) + "Evaluate BODY forms, pretending that FILES exist on the filesystem. +FILES is a list of file names that should be reported as +appropriate by `file-name-all-completions'. Any file name +component ending in \"symlink\" is treated as a symbolic link." + (declare (indent 1)) + `(cl-letf (((symbol-function 'file-name-all-completions) + (lambda (file directory) + (cl-assert (string= file "")) + (setq directory (expand-file-name directory)) + `("./" "../" + ,@(delete-dups + (remq nil + (mapcar + (lambda (file) + (setq file (expand-file-name file)) + (when (string-prefix-p directory file) + (replace-regexp-in-string + "/.*" "/" + (substring file (length directory))))) + ,files)))))) + ((symbol-function 'file-symlink-p) + (lambda (file) + (string-suffix-p "symlink" file)))) + ,@body)) + +;;; Tests: + +(ert-deftest em-glob-test/match-any-string () + "Test that \"*\" pattern matches any string." + (with-fake-files '("a.el" "b.el" "c.txt" "dir/a.el") + (should (equal (eshell-extended-glob "*.el") + '("a.el" "b.el"))))) + +(ert-deftest em-glob-test/match-any-character () + "Test that \"?\" pattern matches any character." + (with-fake-files '("a.el" "b.el" "ccc.el" "d.txt" "dir/a.el") + (should (equal (eshell-extended-glob "?.el") + '("a.el" "b.el"))))) + +(ert-deftest em-glob-test/match-recursive () + "Test that \"**/\" recursively matches directories." + (with-fake-files '("a.el" "b.el" "ccc.el" "d.txt" "dir/a.el" "dir/sub/a.el" + "dir/symlink/a.el" "symlink/a.el" "symlink/sub/a.el") + (should (equal (eshell-extended-glob "**/a.el") + '("a.el" "dir/a.el" "dir/sub/a.el"))))) + +(ert-deftest em-glob-test/match-recursive-follow-symlinks () + "Test that \"***/\" recursively matches directories, following symlinks." + (with-fake-files '("a.el" "b.el" "ccc.el" "d.txt" "dir/a.el" "dir/sub/a.el" + "dir/symlink/a.el" "symlink/a.el" "symlink/sub/a.el") + (should (equal (eshell-extended-glob "***/a.el") + '("a.el" "dir/a.el" "dir/sub/a.el" "dir/symlink/a.el" + "symlink/a.el" "symlink/sub/a.el"))))) + +(ert-deftest em-glob-test/match-recursive-mixed () + "Test combination of \"**/\" and \"***/\"." + (with-fake-files '("dir/a.el" "dir/sub/a.el" "dir/sub2/a.el" + "dir/symlink/a.el" "dir/sub/symlink/a.el" "symlink/a.el" + "symlink/sub/a.el" "symlink/sub/symlink/a.el") + (should (equal (eshell-extended-glob "**/sub/***/a.el") + '("dir/sub/a.el" "dir/sub/symlink/a.el"))) + (should (equal (eshell-extended-glob "***/sub/**/a.el") + '("dir/sub/a.el" "symlink/sub/a.el"))))) + +(ert-deftest em-glob-test/match-character-set-individual () + "Test \"[...]\" for individual characters." + (with-fake-files '("a.el" "b.el" "c.el" "d.el" "dir/a.el") + (should (equal (eshell-extended-glob "[ab].el") + '("a.el" "b.el"))) + (should (equal (eshell-extended-glob "[^ab].el") + '("c.el" "d.el"))))) + +(ert-deftest em-glob-test/match-character-set-range () + "Test \"[...]\" for character ranges." + (with-fake-files '("a.el" "b.el" "c.el" "d.el" "dir/a.el") + (should (equal (eshell-extended-glob "[a-c].el") + '("a.el" "b.el" "c.el"))) + (should (equal (eshell-extended-glob "[^a-c].el") + '("d.el"))))) + +(ert-deftest em-glob-test/match-character-set-class () + "Test \"[...]\" for character classes." + (with-fake-files '("1.el" "a.el" "b.el" "c.el" "dir/a.el") + (should (equal (eshell-extended-glob "[[:alpha:]].el") + '("a.el" "b.el" "c.el"))) + (should (equal (eshell-extended-glob "[^[:alpha:]].el") + '("1.el"))))) + +(ert-deftest em-glob-test/match-character-set-mixed () + "Test \"[...]\" with multiple kinds of members at once." + (with-fake-files '("1.el" "a.el" "b.el" "c.el" "d.el" "dir/a.el") + (should (equal (eshell-extended-glob "[ac-d[:digit:]].el") + '("1.el" "a.el" "c.el" "d.el"))) + (should (equal (eshell-extended-glob "[^ac-d[:digit:]].el") + '("b.el"))))) + +(ert-deftest em-glob-test/match-group-alternative () + "Test \"(x|y)\" matches either \"x\" or \"y\"." + (with-fake-files '("em-alias.el" "em-banner.el" "esh-arg.el" "misc.el" + "test/em-xtra.el") + (should (equal (eshell-extended-glob "e(m|sh)-*.el") + '("em-alias.el" "em-banner.el" "esh-arg.el"))))) + +(ert-deftest em-glob-test/match-n-or-more-characters () + "Test that \"x#\" and \"x#\" match zero or more instances of \"x\"." + (with-fake-files '("h.el" "ha.el" "hi.el" "hii.el" "dir/hi.el") + (should (equal (eshell-extended-glob "hi#.el") + '("h.el" "hi.el" "hii.el"))) + (should (equal (eshell-extended-glob "hi##.el") + '("hi.el" "hii.el"))))) + +(ert-deftest em-glob-test/match-n-or-more-groups () + "Test that \"(x)#\" and \"(x)#\" match zero or more instances of \"(x)\"." + (with-fake-files '("h.el" "ha.el" "hi.el" "hii.el" "dir/hi.el") + (should (equal (eshell-extended-glob "hi#.el") + '("h.el" "hi.el" "hii.el"))) + (should (equal (eshell-extended-glob "hi##.el") + '("hi.el" "hii.el"))))) + +(ert-deftest em-glob-test/match-n-or-more-character-sets () + "Test that \"[x]#\" and \"[x]#\" match zero or more instances of \"[x]\"." + (with-fake-files '("w.el" "wh.el" "wha.el" "whi.el" "whaha.el" "dir/wha.el") + (should (equal (eshell-extended-glob "w[ah]#.el") + '("w.el" "wh.el" "wha.el" "whaha.el"))) + (should (equal (eshell-extended-glob "w[ah]##.el") + '("wh.el" "wha.el" "whaha.el"))))) + +(ert-deftest em-glob-test/match-x-but-not-y () + "Test that \"x~y\" matches \"x\" but not \"y\"." + (with-fake-files '("1" "12" "123" "42" "dir/1") + (should (equal (eshell-extended-glob "[[:digit:]]##~4?") + '("1" "12" "123"))))) + +(ert-deftest em-glob-test/no-matches () + "Test behavior when a glob fails to match any files." + (with-fake-files '("foo.el" "bar.el") + (should (equal (eshell-extended-glob "*.txt") + "*.txt")) + (let ((eshell-error-if-no-glob t)) + (should-error (eshell-extended-glob "*.txt"))))) + +;; em-glob-tests.el ends here