commit ac2708bf6f83dfb965694381c4e9d0c71f61bd0c (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Fri Apr 8 13:37:16 2022 +0800 Implement support for reporting device names on PGTK * lisp/frame.el (device-class): Add new function. * lisp/term/pgtk-win.el (pgtk-device-class): New function. * src/pgtkterm.c (pgtk_device_added_or_removal_cb) (pgtk_seat_added_cb, pgtk_seat_removed_cb) (pgtk_enumerate_devices) (pgtk_free_devices, pgtk_regenerate_devices) (pgtk_get_device_for_event): New functions. (mark_pgtkterm): Mark device data. (pgtk_delete_terminal): Delete device data. (pgtk_handle_event, key_press_event, note_mouse_movement) (construct_mouse_click, button_event, scroll_event) (drag_data_received): Set device correctly. (pgtk_term_init): Initialize device data and seat tracking. (pgtk_delete_display): Delete device data. * src/pgtkterm.h (struct pgtk_device_t): New struct. (struct pgtk_display_info): New field `devices'. Delete lots of unused macros and reformat comments. diff --git a/lisp/frame.el b/lisp/frame.el index 395fe8daad..7b19b8b5d3 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2434,6 +2434,7 @@ monitors." (frames . ,(frames-on-display-list display))))))))) (declare-function x-device-class (name) "x-win.el") +(declare-function pgtk-device-class (name) "pgtk-win.el") (defun device-class (frame name) "Return the class of the device NAME for an event generated on FRAME. @@ -2488,6 +2489,8 @@ symbols." (let ((frame-type (framep-on-display frame))) (cond ((eq frame-type 'x) (x-device-class name)) + ((eq frame-type 'pgtk) + (pgtk-device-class name)) (t (cond ((string= name "Virtual core pointer") 'core-pointer) diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index a9d6db2d45..5317f6ba01 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -367,6 +367,27 @@ This uses `icon-map-list' to map icon file names to stock icon names." (t (popup-menu (mouse-menu-bar-map) last-nonmenu-event)))) +(defun pgtk-device-class (name) + "Return the device class of NAME. +Users should not call this function; see `device-class' instead." + (cond + ((string-match-p "XTEST" name) 'test) + ((string= "Virtual core pointer" name) 'core-pointer) + ((string= "Virtual core keyboard" name) 'core-keyboard) + (t (let ((number (ignore-errors + (string-to-number name)))) + (when number + (cl-case number + (0 'mouse) + (1 'pen) + (2 'eraser) + (3 'puck) + (4 'keyboard) + (5 'touchscreen) + (6 'touchpad) + (7 'trackpoint) + (8 'pad))))))) + (defvaralias 'x-gtk-use-system-tooltips 'use-system-tooltips) (provide 'pgtk-win) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index b2816aa04a..d8c6dad2f9 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -98,15 +98,124 @@ static Time ignore_next_mouse_click_timeout; static Lisp_Object xg_default_icon_file; -static void pgtk_delete_display (struct pgtk_display_info *dpyinfo); -static void pgtk_clear_frame_area (struct frame *f, int x, int y, int width, - int height); -static void pgtk_fill_rectangle (struct frame *f, unsigned long color, int x, - int y, int width, int height, - bool respect_alpha_background); -static void pgtk_clip_to_row (struct window *w, struct glyph_row *row, - enum glyph_row_area area, cairo_t * cr); -static struct frame *pgtk_any_window_to_frame (GdkWindow *window); +static void pgtk_delete_display (struct pgtk_display_info *); +static void pgtk_clear_frame_area (struct frame *, int, int, int, int); +static void pgtk_fill_rectangle (struct frame *, unsigned long, int, int, + int, int, bool); +static void pgtk_clip_to_row (struct window *, struct glyph_row *, + enum glyph_row_area, cairo_t *); +static struct frame *pgtk_any_window_to_frame (GdkWindow *); +static void pgtk_regenerate_devices (struct pgtk_display_info *); + +static void +pgtk_device_added_or_removal_cb (GdkSeat *seat, GdkDevice *device, + gpointer user_data) +{ + pgtk_regenerate_devices (user_data); +} + +static void +pgtk_seat_added_cb (GdkDisplay *dpy, GdkSeat *seat, + gpointer user_data) +{ + pgtk_regenerate_devices (user_data); + + g_signal_connect (G_OBJECT (seat), "device-added", + G_CALLBACK (pgtk_device_added_or_removal_cb), + user_data); + g_signal_connect (G_OBJECT (seat), "device-removed", + G_CALLBACK (pgtk_device_added_or_removal_cb), + user_data); +} + +static void +pgtk_seat_removed_cb (GdkDisplay *dpy, GdkSeat *seat, + gpointer user_data) +{ + pgtk_regenerate_devices (user_data); + + g_signal_handlers_disconnect_by_func (G_OBJECT (seat), + G_CALLBACK (pgtk_device_added_or_removal_cb), + user_data); +} + +static void +pgtk_enumerate_devices (struct pgtk_display_info *dpyinfo, + bool initial_p) +{ + struct pgtk_device_t *rec; + GList *all_seats, *devices_on_seat, *tem, *t1; + GdkSeat *seat; + char printbuf[1026]; /* Believe it or not, some device names are + actually almost this long. */ + + block_input (); + all_seats = gdk_display_list_seats (dpyinfo->gdpy); + + for (tem = all_seats; tem; tem = tem->next) + { + seat = GDK_SEAT (tem->data); + + if (initial_p) + { + g_signal_connect (G_OBJECT (seat), "device-added", + G_CALLBACK (pgtk_device_added_or_removal_cb), + dpyinfo); + g_signal_connect (G_OBJECT (seat), "device-removed", + G_CALLBACK (pgtk_device_added_or_removal_cb), + dpyinfo); + } + + /* We only want slaves, not master devices. */ + devices_on_seat = gdk_seat_get_slaves (seat, + GDK_SEAT_CAPABILITY_ALL); + + for (t1 = devices_on_seat; t1; t1 = t1->next) + { + rec = xmalloc (sizeof *rec); + rec->seat = g_object_ref (seat); + rec->device = GDK_DEVICE (t1->data); + + snprintf (printbuf, 1026, "%u:%s", + gdk_device_get_source (rec->device), + gdk_device_get_name (rec->device)); + + rec->name = build_string (printbuf); + rec->next = dpyinfo->devices; + dpyinfo->devices = rec; + } + + g_list_free (devices_on_seat); + } + + g_list_free (all_seats); + unblock_input (); +} + +static void +pgtk_free_devices (struct pgtk_display_info *dpyinfo) +{ + struct pgtk_device_t *last, *tem; + + tem = dpyinfo->devices; + while (tem) + { + last = tem; + tem = tem->next; + + g_object_unref (last->seat); + xfree (last); + } + + dpyinfo->devices = NULL; +} + +static void +pgtk_regenerate_devices (struct pgtk_display_info *dpyinfo) +{ + pgtk_free_devices (dpyinfo); + pgtk_enumerate_devices (dpyinfo, false); +} static void pgtk_toolkit_position (struct frame *f, int x, int y, @@ -136,6 +245,27 @@ pgtk_toolkit_position (struct frame *f, int x, int y, } } +static Lisp_Object +pgtk_get_device_for_event (struct pgtk_display_info *dpyinfo, + GdkEvent *event) +{ + struct pgtk_device_t *tem; + GdkDevice *device; + + device = gdk_event_get_source_device (event); + + if (!device) + return Qt; + + for (tem = dpyinfo->devices; tem; tem = tem->next) + { + if (tem->device == device) + return tem->name; + } + + return Qt; +} + /* This is not a flip context in the same sense as gpu rendering scenes, it only occurs when a new context was required due to a resize or other fundamental change. This is called when that @@ -205,8 +335,11 @@ evq_flush (struct input_event *hold_quit) void mark_pgtkterm (void) { + struct pgtk_display_info *dpyinfo; + struct pgtk_device_t *device; struct event_queue_t *evq = &event_q; int i, n = evq->nr; + for (i = 0; i < n; i++) { union buffered_input_event *ev = &evq->q[i]; @@ -215,6 +348,14 @@ mark_pgtkterm (void) mark_object (ev->ie.frame_or_window); mark_object (ev->ie.arg); } + + for (dpyinfo = x_display_list; dpyinfo; + dpyinfo = dpyinfo->next) + { + for (device = dpyinfo->devices; device; + device = device->next) + mark_object (device->name); + } } char * @@ -4460,11 +4601,20 @@ pgtk_delete_terminal (struct terminal *terminal) g_clear_object (&dpyinfo->vertical_scroll_bar_cursor); g_clear_object (&dpyinfo->horizontal_scroll_bar_cursor); g_clear_object (&dpyinfo->invisible_cursor); - if (dpyinfo->last_click_event != NULL) { - gdk_event_free (dpyinfo->last_click_event); - dpyinfo->last_click_event = NULL; - } + if (dpyinfo->last_click_event != NULL) + { + gdk_event_free (dpyinfo->last_click_event); + dpyinfo->last_click_event = NULL; + } + /* Disconnect these handlers before the display closes so + useless removal signals don't fire. */ + g_signal_handlers_disconnect_by_func (G_OBJECT (dpyinfo->gdpy), + G_CALLBACK (pgtk_seat_added_cb), + dpyinfo); + g_signal_handlers_disconnect_by_func (G_OBJECT (dpyinfo->gdpy), + G_CALLBACK (pgtk_seat_removed_cb), + dpyinfo); xg_display_close (dpyinfo->gdpy); dpyinfo->gdpy = NULL; @@ -4889,6 +5039,8 @@ pgtk_handle_event (GtkWidget *widget, GdkEvent *event, gpointer *data) make_float (event->touchpad_pinch.angle_delta)); inev.ie.modifiers = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->touchpad_pinch.state); + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); evq_enqueue (&inev); } @@ -5227,7 +5379,7 @@ pgtk_enqueue_preedit (struct frame *f, Lisp_Object preedit) } static gboolean -key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) +key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { struct coding_system coding; union buffered_input_event inev; @@ -5237,8 +5389,6 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) USE_SAFE_ALLOCA; EVENT_INIT (inev.ie); - inev.ie.kind = NO_EVENT; - inev.ie.arg = Qnil; struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); hlinfo = MOUSE_HL_INFO (f); @@ -5321,6 +5471,9 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) { inev.ie.kind = ASCII_KEYSTROKE_EVENT; inev.ie.code = keysym; + + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); goto done; } @@ -5332,6 +5485,9 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) else inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; inev.ie.code = keysym & 0xFFFFFF; + + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); goto done; } @@ -5344,6 +5500,9 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT); inev.ie.code = XFIXNAT (c); + + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); goto done; } @@ -5427,6 +5586,9 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) key. */ inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; inev.ie.code = keysym; + + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); goto done; } @@ -5478,6 +5640,8 @@ key_press_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT); inev.ie.code = ch; + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); evq_enqueue (&inev); } @@ -5859,7 +6023,8 @@ focus_out_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) another motion event, so we can check again the next time it moves. */ static bool -note_mouse_movement (struct frame *frame, const GdkEventMotion * event) +note_mouse_movement (struct frame *frame, + const GdkEventMotion *event) { XRectangle *r; struct pgtk_display_info *dpyinfo; @@ -5879,6 +6044,9 @@ note_mouse_movement (struct frame *frame, const GdkEventMotion * event) dpyinfo->last_mouse_scroll_bar = NULL; note_mouse_highlight (frame, -1, -1); dpyinfo->last_mouse_glyph_frame = NULL; + frame->last_mouse_device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (frame), + (GdkEvent *) event); return true; } @@ -5895,6 +6063,9 @@ note_mouse_movement (struct frame *frame, const GdkEventMotion * event) /* Remember which glyph we're now on. */ remember_mouse_glyph (frame, event->x, event->y, r); dpyinfo->last_mouse_glyph_frame = frame; + frame->last_mouse_device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (frame), + (GdkEvent *) event); return true; } @@ -6010,26 +6181,6 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event, return TRUE; } -/* Mouse clicks and mouse movement. Rah. - - Formerly, we used PointerMotionHintMask (in standard_event_mask) - so that we would have to call XQueryPointer after each MotionNotify - event to ask for another such event. However, this made mouse tracking - slow, and there was a bug that made it eventually stop. - - Simply asking for MotionNotify all the time seems to work better. - - In order to avoid asking for motion events and then throwing most - of them away or busy-polling the server for mouse positions, we ask - the server for pointer motion hints. This means that we get only - one event per group of mouse movements. "Groups" are delimited by - other kinds of events (focus changes and button clicks, for - example), or by XQueryPointer calls; when one of these happens, we - get another MotionNotify event the next time the mouse moves. This - is at least as efficient as getting motion events when mouse - tracking is on, and I suspect only negligibly worse when tracking - is off. */ - /* Prepare a mouse-event in *RESULT for placement in the input queue. If the event is a button press, then note that we have grabbed @@ -6037,7 +6188,8 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event, static Lisp_Object construct_mouse_click (struct input_event *result, - const GdkEventButton * event, struct frame *f) + const GdkEventButton *event, + struct frame *f) { /* Make the event type NO_EVENT; we'll change that when we decide otherwise. */ @@ -6052,11 +6204,15 @@ construct_mouse_click (struct input_event *result, XSETINT (result->y, event->y); XSETFRAME (result->frame_or_window, f); result->arg = Qnil; + result->device = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), + (GdkEvent *) event); return Qnil; } static gboolean -button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) +button_event (GtkWidget *widget, + GdkEvent *event, + gpointer *user_data) { union buffered_input_event inev; struct frame *f, *frame; @@ -6175,7 +6331,7 @@ button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) } static gboolean -scroll_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) +scroll_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { union buffered_input_event inev; struct frame *f, *frame; @@ -6207,6 +6363,8 @@ scroll_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) if (gdk_event_is_scroll_stop_event (event)) { inev.ie.kind = TOUCH_END_EVENT; + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); evq_enqueue (&inev); return TRUE; } @@ -6300,14 +6458,17 @@ scroll_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) } if (inev.ie.kind != NO_EVENT) - evq_enqueue (&inev); + { + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); + evq_enqueue (&inev); + } return TRUE; } static void -drag_data_received (GtkWidget * widget, GdkDragContext * context, - gint x, gint y, - GtkSelectionData * data, +drag_data_received (GtkWidget *widget, GdkDragContext *context, + gint x, gint y, GtkSelectionData *data, guint info, guint time, gpointer user_data) { struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); @@ -6716,6 +6877,12 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) pgtk_im_init (dpyinfo); + g_signal_connect (G_OBJECT (dpyinfo->gdpy), "seat-added", + G_CALLBACK (pgtk_seat_added_cb), dpyinfo); + g_signal_connect (G_OBJECT (dpyinfo->gdpy), "seat-removed", + G_CALLBACK (pgtk_seat_removed_cb), dpyinfo); + pgtk_enumerate_devices (dpyinfo, true); + unblock_input (); return dpyinfo; @@ -6749,6 +6916,7 @@ pgtk_delete_display (struct pgtk_display_info *dpyinfo) tail->next = tail->next->next; } + pgtk_free_devices (dpyinfo); xfree (dpyinfo); } diff --git a/src/pgtkterm.h b/src/pgtkterm.h index b1165752ab..56c5d22e54 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -40,8 +40,6 @@ along with GNU Emacs. If not, see . */ #include #endif -/* could use list to store these, but rest of emacs has a big infrastructure - for managing a table of bitmap "records" */ struct pgtk_bitmap_record { void *img; @@ -51,6 +49,15 @@ struct pgtk_bitmap_record cairo_pattern_t *pattern; }; +struct pgtk_device_t +{ + GdkSeat *seat; + GdkDevice *device; + + Lisp_Object name; + struct pgtk_device_t *next; +}; + #define RGB_TO_ULONG(r, g, b) (((r) << 16) | ((g) << 8) | (b)) #define ARGB_TO_ULONG(a, r, g, b) (((a) << 24) | ((r) << 16) | ((g) << 8) | (b)) @@ -112,8 +119,6 @@ struct scroll_bar bool horizontal; }; - -/* init'd in pgtk_initialize_display_info () */ struct pgtk_display_info { /* Chain of all pgtk_display_info structures. */ @@ -208,13 +213,14 @@ struct pgtk_display_info /* The scroll bar in which the last motion event occurred. */ void *last_mouse_scroll_bar; - /* The invisible cursor used for pointer blanking. - Unused if this display supports Xfixes extension. */ + /* The invisible cursor used for pointer blanking. */ Emacs_Cursor invisible_cursor; /* The GDK cursor for scroll bars and popup menus. */ GdkCursor *xg_cursor; + /* List of all devices for all seats on this display. */ + struct pgtk_device_t *devices; /* The frame where the mouse was last time we reported a mouse position. */ struct frame *last_mouse_glyph_frame; @@ -225,7 +231,7 @@ struct pgtk_display_info /* The last click event. */ GdkEvent *last_click_event; - /* input method */ + /* IM context data. */ struct { GtkIMContext *context; @@ -246,10 +252,6 @@ extern struct pgtk_display_info *x_display_list; struct pgtk_output { -#if 0 - void *view; - void *miniimage; -#endif unsigned long foreground_color; unsigned long background_color; void *toolbar; @@ -406,7 +408,7 @@ struct pgtk_output struct atimer *scale_factor_atimer; }; -/* this dummy decl needed to support TTYs */ +/* Satisfy term.c. */ struct x_output { int unused; @@ -452,59 +454,8 @@ enum /* Turning a lisp vector value into a pointer to a struct scroll_bar. */ #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) -#define PGTK_FACE_FOREGROUND(f) ((f)->foreground) -#define PGTK_FACE_BACKGROUND(f) ((f)->background) #define FRAME_DEFAULT_FACE(f) FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID) - -/* Compute pixel height of the frame's titlebar. */ -#define FRAME_PGTK_TITLEBAR_HEIGHT(f) 0 - -/* Compute pixel size for vertical scroll bars */ -#define PGTK_SCROLL_BAR_WIDTH(f) \ - (FRAME_HAS_VERTICAL_SCROLL_BARS (f) \ - ? rint (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0 \ - ? FRAME_CONFIG_SCROLL_BAR_WIDTH (f) \ - : (FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f))) \ - : 0) - -/* Compute pixel size for horizontal scroll bars */ -#define PGTK_SCROLL_BAR_HEIGHT(f) \ - (FRAME_HAS_HORIZONTAL_SCROLL_BARS (f) \ - ? rint (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) > 0 \ - ? FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) \ - : (FRAME_SCROLL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f))) \ - : 0) - -/* Difference btwn char-column-calculated and actual SB widths. - This is only a concern for rendering when SB on left. */ -#define PGTK_SCROLL_BAR_ADJUST(w, f) \ - (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) ? \ - (FRAME_SCROLL_BAR_COLS (f) * FRAME_COLUMN_WIDTH (f) \ - - PGTK_SCROLL_BAR_WIDTH (f)) : 0) - -/* Difference btwn char-line-calculated and actual SB heights. - This is only a concern for rendering when SB on top. */ -#define PGTK_SCROLL_BAR_ADJUST_HORIZONTALLY(w, f) \ - (WINDOW_HAS_HORIZONTAL_SCROLL_BARS (w) ? \ - (FRAME_SCROLL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f) \ - - PGTK_SCROLL_BAR_HEIGHT (f)) : 0) - #define FRAME_MENUBAR_HEIGHT(f) (FRAME_X_OUTPUT (f)->menubar_height) - -/* Calculate system coordinates of the left and top of the parent - window or, if there is no parent window, the screen. */ -#define PGTK_PARENT_WINDOW_LEFT_POS(f) \ - (FRAME_PARENT_FRAME (f) != NULL \ - ? [[FRAME_PGTK_VIEW (f) window] parentWindow].frame.origin.x : 0) -#define PGTK_PARENT_WINDOW_TOP_POS(f) \ - (FRAME_PARENT_FRAME (f) != NULL \ - ? ([[FRAME_PGTK_VIEW (f) window] parentWindow].frame.origin.y \ - + [[FRAME_PGTK_VIEW (f) window] parentWindow].frame.size.height \ - - FRAME_PGTK_TITLEBAR_HEIGHT (FRAME_PARENT_FRAME (f))) \ - : [[[PGTKScreen screepgtk] objectAtIndex: 0] frame].size.height) - -#define FRAME_PGTK_FONT_TABLE(f) (FRAME_DISPLAY_INFO (f)->font_table) - #define FRAME_TOOLBAR_TOP_HEIGHT(f) ((f)->output_data.pgtk->toolbar_top_height) #define FRAME_TOOLBAR_BOTTOM_HEIGHT(f) \ ((f)->output_data.pgtk->toolbar_bottom_height) commit e9849939549010529e180ffb2509922f1bcc4843 Author: Po Lu Date: Fri Apr 8 12:11:24 2022 +0800 * lisp/term/x-win.el (x-device-class): Detect more keyboards. diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index d10d8d1dbd..4c6fcc904c 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1616,7 +1616,11 @@ Users should not call this function; see `device-class' instead." ((string-match-p "touchpad" downcased-name) 'touchpad) ((or (string-match-p "midi" downcased-name) (string-match-p "piano" downcased-name)) - 'piano)))) + 'piano) + ((or (string-match-p "wskbd" downcased-name) ; NetBSD/OpenBSD + (and (string-match-p "/dev" downcased-name) + (string-match-p "kbd" downcased-name))) + 'keyboard)))) (setq x-dnd-movement-function #'x-dnd-movement) (setq x-dnd-unsupported-drop-function #'x-dnd-handle-unsupported-drop) commit d8b7771418a724c527dafe20a940bcc46705d474 Author: Sean Whitton Date: Wed Apr 6 17:45:55 2022 -0700 ; * src/emacs.c (main): Reword & reflow description of PGTK problem. diff --git a/src/emacs.c b/src/emacs.c index acb409fcb7..a35996c07a 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1742,10 +1742,10 @@ main (int argc, char **argv) window system to avoid referring users to the wrong GTK bug report. */ #ifdef HAVE_PGTK - fputs ("Due to a limitation in GTK 3, Emacs built with PGTK will simply exit when a" - "display connection is closed." - "\nThere is no way to fix this problem, so if you want to use Emacs on Wayland" - "on multiple displays and have Emacs survive disconnects, you lose.", + fputs ("Due to a limitation in GTK 3, Emacs built with PGTK will simply exit when a\n" + "display connection is closed. The problem is especially difficult to fix,\n" + "such that Emacs on Wayland with multiple displays is unlikely ever to be able\n" + "to survive disconnects.\n", stderr); #elif defined USE_GTK fputs ("\nWarning: due to a long standing Gtk+ bug\nhttps://gitlab.gnome.org/GNOME/gtk/issues/221\n\ commit c42ef4e7c142a93e2ccfea904d72735a6030e978 Author: Po Lu Date: Fri Apr 8 11:22:06 2022 +0800 Ignore input extension errors caused by grabbing * src/xterm.c (x_error_handler): Ignore GrabDevice and UngrabDevice errors. diff --git a/src/xterm.c b/src/xterm.c index 9336b9420f..9b0fe6f3f7 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -19200,6 +19200,10 @@ static void x_error_quitter (Display *, XErrorEvent *); static int x_error_handler (Display *display, XErrorEvent *event) { +#ifdef HAVE_XINPUT2 + struct x_display_info *dpyinfo; +#endif + #if defined USE_GTK && defined HAVE_GTK3 if ((event->error_code == BadMatch || event->error_code == BadWindow) && event->request_code == X_SetInputFocus) @@ -19208,6 +19212,20 @@ x_error_handler (Display *display, XErrorEvent *event) } #endif + /* If we try to ungrab or grab a device that doesn't exist anymore + (that happens a lot in xmenu.c), just ignore the error. */ + +#ifdef HAVE_XINPUT2 + dpyinfo = x_display_info_for_display (display); + + /* 51 is X_XIGrabDevice and 52 is X_XIUngrabDevice. */ + if (dpyinfo && dpyinfo->supports_xi2 + && event->request_code == dpyinfo->xi2_opcode + && (event->minor_code == 51 + || event->minor_code == 52)) + return 0; +#endif + if (x_error_message) x_error_catcher (display, event); else commit 598d1a2aa3ffdbc6de3e28797faf3ff68e0475f9 Author: Po Lu Date: Fri Apr 8 11:03:27 2022 +0800 * lisp/term/x-win.el (x-device-class): Detect "USB USB Keykoard"s. diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index ac8b1f5df3..d10d8d1dbd 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1608,7 +1608,10 @@ Users should not call this function; see `device-class' instead." (string-match-p "pointer" downcased-name)) 'mouse) ((string-match-p "cursor" downcased-name) 'puck) - ((string-match-p "keyboard" downcased-name) 'keyboard) + ((or (string-match-p "keyboard" downcased-name) + ;; One of my cheap keyboards is really named this... + (string= name "USB USB Keykoard")) + 'keyboard) ((string-match-p "button" downcased-name) 'power-button) ((string-match-p "touchpad" downcased-name) 'touchpad) ((or (string-match-p "midi" downcased-name) commit 1a1c5a6884a60ef2ffa98f3ee4af793eac985f80 Author: Po Lu Date: Fri Apr 8 09:47:25 2022 +0800 Add code for determining the type of an input device * doc/lispref/commands.texi (Command Loop Info): * etc/NEWS: Update documentation and announce `device-class'. * lisp/frame.el (x-device-class): (device-class): * lisp/term/x-win.el (x-device-class): New functions. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 74bf0f4869..ace0c02551 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1127,6 +1127,23 @@ frame, the value is the frame to which the event was redirected. If the last event came from a keyboard macro, the value is @code{macro}. @end defvar +@cindex input devices +@cindex device names +Input events must come from somewhere; sometimes, that is a keyboard +macro, a signal, or `unread-command-events', but it is usually a +physical input device connected to a computer that is controlled by +the user. Those devices are referred to as @dfn{input devices}, and +Emacs associates each input event with the input device from which it +originated. They are identified by a name that is unique to each +input device. + +The ability to determine the precise input device used depends on the +details of each system. When that information is unavailable, Emacs +reports keyboard events as originating from the @samp{"Virtual core +keyboard"}, and other events as originating from the @samp{"Virtual +core pointer"}. (These values are used on every platform because the +X server reports them when detailed device information is not known.) + @defvar last-event-device This variable records the name of the input device from which the last input event read was generated. It is @code{nil} if no such device @@ -1141,6 +1158,65 @@ keyboard"}, depending on whether the event was generated by a pointing device (such as a mouse) or a keyboard. @end defvar +@defun device-class frame name +There are various different types of devices, which can be determined +from their names. This function can be used to determined the correct +type of the device @var{name} for an event originating from +@var{frame}. + +The return value is one of the following symbols (``device classes''): + +@table @code +@item core-keyboard +The core keyboard; this is means the device is a keyboard-like device, +but no other characteristics are unknown. + +@item core-pointer +The core pointer; this means the device is a pointing device, but no +other characteristics are known. + +@item mouse +A computer mouse. + +@item trackpoint +A trackpoint or joystick (or other similar control.) + +@item eraser +The other end of a stylus on a graphics tablet, or a standalone +eraser. + +@item pen +The pointed end of a pen on a graphics tablet, a stylus, or some other +similar device. + +@item puck +A device that looks like a computer mouse, but reports absolute +coordinates relative to some other surface. + +@item power-button +A power button or volume button (or other similar control.) + +@item keyboard +A computer keyboard. + +@item touchscreen +A computer touchpad. + +@item pad +A collection of sensitive buttons, rings, and strips commonly found +around a drawing tablet. + +@item touchpad +An indirect touch device such as a touchpad. + +@item piano +A musical instrument such as an electronic keyboard. + +@item test +A device used by the XTEST extension to report input. +@end table +@end defun + @node Adjusting Point @section Adjusting Point After Commands @cindex adjusting point diff --git a/etc/NEWS b/etc/NEWS index 1043873f2d..2fac893cc5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1360,9 +1360,10 @@ functions. * Lisp Changes in Emacs 29.1 +++ -** New variable 'last-event-device'. -On X Windows, this specifies the input extension device from which the -last input event originated. +** New variable 'last-event-device' and new function 'device-class'. +On X Windows, 'last-event-device' specifies the input extension device +from which the last input event originated, and 'device-class' can be +used to determine the type of an input device. +++ ** 'track-mouse' can be a new value 'drag-source'. diff --git a/lisp/frame.el b/lisp/frame.el index b681a971aa..395fe8daad 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2433,6 +2433,67 @@ monitors." ,(display-mm-height display))) (frames . ,(frames-on-display-list display))))))))) +(declare-function x-device-class (name) "x-win.el") + +(defun device-class (frame name) + "Return the class of the device NAME for an event generated on FRAME. +NAME is a string that can be the value of `last-event-device', or +nil. FRAME is a window system frame, typically the value of +`last-event-frame' when `last-event-device' was set. On some +window systems, it can also be a display name or a terminal. + +The class of a device is one of the following symbols: + + `core-keyboard' means the device is a keyboard-like device, but + any other characteristics are unknown. + + `core-pointer' means the device is a pointing device, but any + other characteristics are unknown. + + `mouse' means the device is a computer mouse. + + `trackpoint' means the device is a joystick or trackpoint. + + `eraser' means the device is an eraser, which is typically the + other end of a stylus on a graphics tablet. + + `pen' means the device is a stylus or some other similar + device. + + `puck' means the device is a device similar to a mouse, but + reports absolute coordinates. + + `power-button' means the device is a power button, volume + button, or some similar control. + + `keyboard' means the device is a keyboard. + + `touchscreen' means the device is a touchscreen. + + `pad' means the device is a collection of buttons and rings and + strips commonly found in drawing tablets. + + `touchpad' means the device is an indirect touch device, such + as a touchpad. + + `piano' means the device is a piano, or some other kind of + musical instrument. + + `test' means the device is used by the XTEST extension to + report input. + +It can also be nil, which means the class of the device could not +be determined. Individual window systems may also return other +symbols." + (let ((frame-type (framep-on-display frame))) + (cond ((eq frame-type 'x) + (x-device-class name)) + (t (cond + ((string= name "Virtual core pointer") + 'core-pointer) + ((string= name "Virtual core keyboard") + 'core-keyboard)))))) + ;;;; Frame geometry values diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index a71ae87e21..ac8b1f5df3 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1583,6 +1583,38 @@ frames on all displays." (dnd-handle-movement position) (redisplay)) +(defun x-device-class (name) + "Return the device class of NAME. +Users should not call this function; see `device-class' instead." + (let ((downcased-name (downcase name))) + (cond + ((string-match-p "XTEST" name) 'test) + ((string= "Virtual core pointer" name) 'core-pointer) + ((string= "Virtual core keyboard" name) 'core-keyboard) + ((string-match-p "eraser" downcased-name) 'eraser) + ((string-match-p " pad" downcased-name) 'pad) + ((or (or (string-match-p "wacom" downcased-name) + (string-match-p "pen" downcased-name)) + (string-match-p "stylus" downcased-name)) + 'pen) + ((or (string-prefix-p "xwayland-touch:" name) + (string-match-p "touchscreen" downcased-name)) + 'touchscreen) + ((or (string-match-p "trackpoint" downcased-name) + (string-match-p "stick" downcased-name)) + 'trackpoint) + ((or (string-match-p "mouse" downcased-name) + (string-match-p "optical" downcased-name) + (string-match-p "pointer" downcased-name)) + 'mouse) + ((string-match-p "cursor" downcased-name) 'puck) + ((string-match-p "keyboard" downcased-name) 'keyboard) + ((string-match-p "button" downcased-name) 'power-button) + ((string-match-p "touchpad" downcased-name) 'touchpad) + ((or (string-match-p "midi" downcased-name) + (string-match-p "piano" downcased-name)) + 'piano)))) + (setq x-dnd-movement-function #'x-dnd-movement) (setq x-dnd-unsupported-drop-function #'x-dnd-handle-unsupported-drop) commit 6ac7fa7e78b84a6fbdf12a63d927ad55bacd8d91 Author: Po Lu Date: Fri Apr 8 08:22:40 2022 +0800 Fix reporting of last-event-device for synthetic events * src/keyboard.c (read_char): Clear `last-event-device' earlier. diff --git a/src/keyboard.c b/src/keyboard.c index 8142ffec2d..01274b4d4a 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2465,6 +2465,7 @@ read_char (int commandflag, Lisp_Object map, else reread = false; + Vlast_event_device = Qnil; if (CONSP (Vunread_command_events)) { @@ -2525,8 +2526,6 @@ read_char (int commandflag, Lisp_Object map, goto reread_for_input_method; } - Vlast_event_device = Qnil; - if (!NILP (Vexecuting_kbd_macro)) { /* We set this to Qmacro; since that's not a frame, nobody will commit 5414331d07a77d8e72aa44d4dd31f6af09bc161e Author: Po Lu Date: Fri Apr 8 08:13:49 2022 +0800 Make device reporting work for tool bar clicks * src/dispextern.h: Update prototyupes. * src/xdisp.c (handle_tool_bar_click): Pass Qt to that function instead. (handle_tool_bar_click_with_device): New function. * src/xterm.c (handle_one_xevent): Pass device to tool bar click logic. diff --git a/src/dispextern.h b/src/dispextern.h index b7cfde7033..e9b19a7f13 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3460,6 +3460,8 @@ extern Lisp_Object handle_tab_bar_click (struct frame *, int, int, bool, int); extern void handle_tool_bar_click (struct frame *, int, int, bool, int); +extern void handle_tool_bar_click_with_device (struct frame *, int, int, bool, + int, Lisp_Object); extern void expose_frame (struct frame *, int, int, int, int); extern bool gui_intersect_rectangles (const Emacs_Rectangle *, diff --git a/src/xdisp.c b/src/xdisp.c index d731308173..bdefd2b042 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -15114,11 +15114,11 @@ get_tool_bar_item (struct frame *f, int x, int y, struct glyph **glyph, Handle mouse button event on the tool-bar of frame F, at frame-relative coordinates X/Y. DOWN_P is true for a button press, false for button release. MODIFIERS is event modifiers for button - release. */ + release. DEVICE is the device the click came from, or Qt. */ void -handle_tool_bar_click (struct frame *f, int x, int y, bool down_p, - int modifiers) +handle_tool_bar_click_with_device (struct frame *f, int x, int y, bool down_p, + int modifiers, Lisp_Object device) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); struct window *w = XWINDOW (f->tool_bar_window); @@ -15175,11 +15175,18 @@ handle_tool_bar_click (struct frame *f, int x, int y, bool down_p, event.frame_or_window = frame; event.arg = key; event.modifiers = modifiers; + event.device = device; kbd_buffer_store_event (&event); f->last_tool_bar_item = -1; } } +void +handle_tool_bar_click (struct frame *f, int x, int y, bool down_p, + int modifiers) +{ + handle_tool_bar_click_with_device (f, x, y, down_p, modifiers, Qt); +} /* Possibly highlight a tool-bar item on frame F when mouse moves to tool-bar window-relative coordinates X/Y. Called from diff --git a/src/xterm.c b/src/xterm.c index 8c6068e654..9336b9420f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -17038,9 +17038,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, tool_bar_p = EQ (window, f->tool_bar_window); if (tool_bar_p && xev->detail < 4) - handle_tool_bar_click + handle_tool_bar_click_with_device (f, x, y, xev->evtype == XI_ButtonPress, - x_x_to_emacs_modifiers (dpyinfo, bv.state)); + x_x_to_emacs_modifiers (dpyinfo, bv.state), + source ? source->name : Qt); } #endif /* !USE_GTK */ commit 0622df36112e41074dfff432c782e3e3b5de3e47 Author: Po Lu Date: Fri Apr 8 07:47:10 2022 +0800 * src/xterm.c (handle_one_xevent): Fix build warning on non-GTK builds. diff --git a/src/xterm.c b/src/xterm.c index d4a5e0ab3d..8c6068e654 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -16000,8 +16000,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_Leave: { XILeaveEvent *leave = (XILeaveEvent *) xi_event; - struct xi_device_t *source; #ifdef USE_GTK + struct xi_device_t *source; XMotionEvent ev; ev.x = lrint (leave->event_x); @@ -16011,7 +16011,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif any = x_top_window_to_frame (dpyinfo, leave->event); + +#ifdef USE_GTK source = xi_device_from_id (dpyinfo, leave->sourceid); +#endif /* This allows us to catch LeaveNotify events generated by popup menu grabs. FIXME: this is right when there is a commit 3c57867df49314df47178e9e8a8754689c6753b1 Author: Stefan Monnier Date: Thu Apr 7 19:20:54 2022 -0400 lisp/simple.el: Use #' in new code * lisp/simple.el (minibuffer-local-shell-command-map): Use #' to quote function names. diff --git a/lisp/simple.el b/lisp/simple.el index 80c27d6e0e..eb65701803 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3923,12 +3923,12 @@ to the end of the list of defaults just after the default value." (defvar minibuffer-local-shell-command-map (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) - (define-key map "\t" 'completion-at-point) - (define-key map [M-up] 'minibuffer-choose-previous-completion) - (define-key map [M-down] 'minibuffer-choose-next-completion) - (define-key map [M-S-up] 'minibuffer-previous-completion) - (define-key map [M-S-down] 'minibuffer-next-completion) - (define-key map [?\M-\r] 'minibuffer-choose-completion) + (define-key map "\t" #'completion-at-point) + (define-key map [M-up] #'minibuffer-choose-previous-completion) + (define-key map [M-down] #'minibuffer-choose-next-completion) + (define-key map [M-S-up] #'minibuffer-previous-completion) + (define-key map [M-S-down] #'minibuffer-next-completion) + (define-key map [?\M-\r] #'minibuffer-choose-completion) map) "Keymap used for completing shell commands in minibuffer.") commit 43977559838c0c9aa4ab04111ef9a74b08411924 Author: Matthias Meulien Date: Thu Apr 7 00:11:55 2022 +0200 Display file mode information when diff font lock prettify enabled * lisp/vc/diff-mode.el (diff--font-lock-prettify): Make regexp capture file mode information. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 511cc89778..5c13c7fc38 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2634,42 +2634,55 @@ fixed, visit it in a buffer." (binary (concat "Binary files " file4 " and " file5 " \\(?7:differ\\)\n")) - (horb (concat "\\(?:" header "\\|" binary "\\)"))) + (horb (concat "\\(?:" header "\\|" binary "\\)?"))) (concat "diff.*?\\(?: a/\\(.*?\\) b/\\(.*\\)\\)?\n" - "\\(?:\\(?:old\\|new\\) mode .*\n\\)*" "\\(?:" ;; For new/deleted files, there might be no ;; header (and no hunk) if the file is/was empty. - "\\(?3:new\\(?6:\\)\\|deleted\\) file.*\n" - index "\\(?:" horb "\\)?" - ;; Normal case. - "\\|" index horb "\\)"))))) + "\\(?3:new\\(?6:\\)\\|deleted\\) file mode \\(?10:[0-7]\\{6\\}\\)\n" + index horb + ;; Normal case. There might be no header + ;; (and no hunk) if only the file mode + ;; changed. + "\\|" + "\\(?:old mode \\(?8:[0-7]\\{6\\}\\)\n\\)?" + "\\(?:new mode \\(?9:[0-7]\\{6\\}\\)\n\\)?" + index horb "\\)"))))) ;; The file names can be extracted either from the `diff' line ;; or from the two header lines. Prefer the header line info if ;; available since the `diff' line is ambiguous in case the ;; file names include " b/" or " a/". ;; FIXME: This prettification throws away all the information - ;; about file modes (and the index hashes). + ;; about the index hashes. (let ((oldfile (or (match-string 4) (match-string 1))) (newfile (or (match-string 5) (match-string 2))) (kind (if (match-beginning 7) " BINARY" - (unless (or (match-beginning 4) (match-beginning 5)) - " empty")))) + (unless (or (match-beginning 4) + (match-beginning 5) + (not (match-beginning 3))) + " empty"))) + (filemode + (cond + ((match-beginning 10) + (concat " file with mode " (match-string 10) " ")) + ((and (match-beginning 8) (match-beginning 9)) + (concat " file (mode changed from " + (match-string 8) " to " (match-string 9) ") ")) + (t " file ")))) (add-text-properties (match-beginning 0) (1- (match-end 0)) (list 'display (propertize (cond ((match-beginning 3) - (concat (capitalize (match-string 3)) kind " file" - " " + (concat (capitalize (match-string 3)) kind filemode (if (match-beginning 6) newfile oldfile))) - ((null (match-string 4)) - (concat "New" kind " file " newfile)) + ((and (null (match-string 4)) (match-string 5)) + (concat "New " kind filemode newfile)) ((null (match-string 2)) - (concat "Deleted" kind " file " oldfile)) + (concat "Deleted" kind filemode oldfile)) (t - (concat "Modified" kind " file " oldfile))) + (concat "Modified" kind filemode oldfile))) 'face '(diff-file-header diff-header)) 'font-lock-multiline t)))))) nil) commit 39e8fd357dd0a1f3776c05eee2cc5be451686712 Author: Stefan Monnier Date: Thu Apr 7 15:59:09 2022 -0400 OClosure: New function `function-documentation` As mentioned in the original OClosure commit, OClosures (ab)use the bytecode's docstring slot to hold the OClosure's type. This currently prevents OClosures from having their own docstring. Introduce a new generic function `function-documentation` to fetch the docstring of a function, which can then be implemented in various different ways depending on the OClosure's type. * lisp/simple.el (function-documentation): New generic function. (bad-package-check): Strength-reduce `eval` to `symbol-value`. * src/doc.c (Fdocumentation): Use it. * lisp/emacs-lisp/oclosure.el (oclosure--accessor-docstring): New function. * test/lisp/emacs-lisp/oclosure-tests.el (oclosure-test): Add test for accessor's docstrings. diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 10a12940a1..d53bfad8e9 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -158,6 +158,13 @@ the function definition has no documentation string. In that case, @code{documentation} returns @code{nil}. @end defun +@defun function-documentation function +Generic function used by @code{documentation} to extract the raw +docstring from a function object. You can specify how to get the +docstring of a specific function type by adding a corresponding method +to it. +@end defun + @defun face-documentation face This function returns the documentation string of @var{face} as a face. diff --git a/etc/NEWS b/etc/NEWS index 85ed817e05..1043873f2d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1335,6 +1335,12 @@ This change is now applied in 'dired-insert-directory'. 'unify-8859-on-decoding-mode', 'unify-8859-on-encoding-mode', 'vc-arch-command'. ++++ +** New generic function 'function-doumentation'. +Can dynamically generate a raw docstring depending on the type of +a function. +Used mainly for docstrings of OClosures. + +++ ** Base64 encoding no longer tolerates latin-1 input. The functions 'base64-encode-string', 'base64url-encode-string', diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 3df64ad280..90811199f2 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -505,6 +505,12 @@ This has 2 uses: "OClosure function to access a specific slot of an object." type slot) +(defun oclosure--accessor-docstring (f) + ;; This would like to be a (cl-defmethod function-documentation ...) + ;; but for circularity reason the defmethod is in `simple.el'. + (format "Access slot \"%S\" of OBJ of type `%S'.\n\n(fn OBJ)" + (accessor--slot f) (accessor--type f))) + (oclosure-define (oclosure-accessor (:parent accessor) (:copier oclosure--accessor-copy (type slot index))) diff --git a/lisp/simple.el b/lisp/simple.el index ef52006501..80c27d6e0e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2357,6 +2357,38 @@ maps." (with-suppressed-warnings ((interactive-only execute-extended-command)) (execute-extended-command prefixarg command-name typed))) +(cl-defgeneric function-documentation (function) + "Extract the raw docstring info from FUNCTION. +FUNCTION is expected to be a function value rather than, say, a mere symbol. +This is intended to be specialized via `cl-defmethod' but not called directly: +if you need a function's documentation use `documentation' which will call this +function as needed." + (let ((docstring-p (lambda (doc) + ;; A docstring can be either a string or a reference + ;; into either the `etc/DOC' or a `.elc' file. + (or (stringp doc) + (fixnump doc) (fixnump (cdr-safe doc)))))) + (pcase function + ((pred byte-code-function-p) + (when (> (length function) 4) + (let ((doc (aref function 4))) + (when (funcall docstring-p doc) doc)))) + ((or (pred stringp) (pred vectorp)) "Keyboard macro.") + (`(keymap . ,_) + "Prefix command (definition is a keymap associating keystrokes with commands).") + ((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body) + `(autoload ,_file . ,body)) + (let ((doc (car body))) + (when (and (funcall docstring-p doc) + ;; Handle a doc reference--but these never come last + ;; in the function body, so reject them if they are last. + (or (cdr body) (eq 'autoload (car-safe function)))) + doc))) + (_ (signal 'invalid-function (list function)))))) + +(cl-defmethod function-documentation ((function accessor)) + (oclosure--accessor-docstring function)) ;; FIXME: η-reduce! + (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. "Execute CMD as an editor command. @@ -10007,7 +10039,7 @@ warning using STRING as the message.") (and list (boundp symbol) (or (eq symbol t) - (and (stringp (setq symbol (eval symbol))) + (and (stringp (setq symbol (symbol-value symbol))) (string-match-p (nth 2 list) symbol))) (display-warning package (nth 3 list) :warning))) (error nil))) diff --git a/src/doc.c b/src/doc.c index e361a86c1a..5326195c6a 100644 --- a/src/doc.c +++ b/src/doc.c @@ -341,56 +341,8 @@ string is passed through `substitute-command-keys'. */) else if (MODULE_FUNCTIONP (fun)) doc = module_function_documentation (XMODULE_FUNCTION (fun)); #endif - else if (COMPILEDP (fun)) - { - if (PVSIZE (fun) <= COMPILED_DOC_STRING) - return Qnil; - else - { - Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING); - if (STRINGP (tem)) - doc = tem; - else if (FIXNATP (tem) || CONSP (tem)) - doc = tem; - else - return Qnil; - } - } - else if (STRINGP (fun) || VECTORP (fun)) - { - return build_string ("Keyboard macro."); - } - else if (CONSP (fun)) - { - Lisp_Object funcar = XCAR (fun); - if (!SYMBOLP (funcar)) - xsignal1 (Qinvalid_function, fun); - else if (EQ (funcar, Qkeymap)) - return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); - else if (EQ (funcar, Qlambda) - || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1)) - || EQ (funcar, Qautoload)) - { - Lisp_Object tem1 = Fcdr (Fcdr (fun)); - Lisp_Object tem = Fcar (tem1); - if (STRINGP (tem)) - doc = tem; - /* Handle a doc reference--but these never come last - in the function body, so reject them if they are last. */ - else if ((FIXNATP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem)))) - && !NILP (XCDR (tem1))) - doc = tem; - else - return Qnil; - } - else - goto oops; - } else - { - oops: - xsignal1 (Qinvalid_function, fun); - } + doc = call1 (intern ("function-documentation"), fun); /* If DOC is 0, it's typically because of a dumped file missing from the DOC file (bug in src/Makefile.in). */ diff --git a/test/lisp/emacs-lisp/oclosure-tests.el b/test/lisp/emacs-lisp/oclosure-tests.el index d3e2b3870a..b6bdebc0a2 100644 --- a/test/lisp/emacs-lisp/oclosure-tests.el +++ b/test/lisp/emacs-lisp/oclosure-tests.el @@ -65,6 +65,7 @@ (should (member (oclosure-test-gen ocl1) '("#>>" "#>>"))) + (should (stringp (documentation #'oclosure-test--fst))) )) (ert-deftest oclosure-test-limits () commit 3b411417086ceb2ce3838160d01c6f250e47bbf3 Author: Po Lu Date: Thu Apr 7 21:16:11 2022 +0800 Expose the name of an event's input device to Lisp This name can be used to identify the device for special treatment, i.e. only interpolating scrolls coming from mice and not touchpads inside pixel-scroll-precision-mode. * doc/lispref/commands.texi (Command Loop Info): Document new variable `last-event-device'. * etc/NEWS: Announce new variable `last-event-device'. * src/frame.h (struct frame): New field `last_mouse_device'. * src/keyboard.c (read_char): Clear last-event-device. (kbd_buffer_get_event): Set last-event-device to the event's recorded device. (init_keyboard): Clear last-event-device. (syms_of_keyboard): New defvar `last-event-device'. * src/termhooks.h (struct input_event): New field `device'. (EVENT_INIT): Set it to the special value `Qt' by default. * src/xterm.c (x_init_master_valuators): Record the device's name. (x_dnd_begin_drag_and_drop): Only preserve last event device if the mouse ended up in the source frame. (x_note_mouse_movement): New argument `source'. (handle_one_xevent): Set input event sources whenever appropriate. (mark_xterm): Mark device names. * src/xterm.h (struct xi_device_t): New field `name'. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index a4ae68af5b..74bf0f4869 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1127,6 +1127,20 @@ frame, the value is the frame to which the event was redirected. If the last event came from a keyboard macro, the value is @code{macro}. @end defvar +@defvar last-event-device +This variable records the name of the input device from which the last +input event read was generated. It is @code{nil} if no such device +exists, i.e., the last input event was read from +@code{unread-command-events}, or it came from a keyboard macro. + +When the X Input Extension is being used on X Windows, the device name +is a string that is unique to each physical keyboard, pointing device +and touchscreen attached to the X server. Otherwise, it is either the +string @samp{"Virtual core pointer"} or @samp{"Virtual core +keyboard"}, depending on whether the event was generated by a pointing +device (such as a mouse) or a keyboard. +@end defvar + @node Adjusting Point @section Adjusting Point After Commands @cindex adjusting point diff --git a/etc/NEWS b/etc/NEWS index 564bd16022..85ed817e05 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1353,6 +1353,11 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** New variable 'last-event-device'. +On X Windows, this specifies the input extension device from which the +last input event originated. + +++ ** 'track-mouse' can be a new value 'drag-source'. This means the same as 'dropping', but modifies the mouse position diff --git a/src/frame.h b/src/frame.h index 61df57e966..4942e640d2 100644 --- a/src/frame.h +++ b/src/frame.h @@ -102,6 +102,10 @@ struct frame Lisp_Object parent_frame; #endif /* HAVE_WINDOW_SYSTEM */ + /* Last device to move over this frame. Any value that isn't a + string means the "Virtual core pointer". */ + Lisp_Object last_mouse_device; + /* The frame which should receive keystrokes that occur in this frame, or nil if they should go to the frame itself. This is usually nil, but if the frame is minibufferless, we can use this diff --git a/src/keyboard.c b/src/keyboard.c index d99fe4be09..8142ffec2d 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -336,6 +336,11 @@ static struct timespec timer_idleness_start_time; static struct timespec timer_last_idleness_start_time; +/* Predefined strings for core device names. */ + +static Lisp_Object virtual_core_pointer_name; +static Lisp_Object virtual_core_keyboard_name; + /* Global variable declarations. */ @@ -2520,6 +2525,8 @@ read_char (int commandflag, Lisp_Object map, goto reread_for_input_method; } + Vlast_event_device = Qnil; + if (!NILP (Vexecuting_kbd_macro)) { /* We set this to Qmacro; since that's not a frame, nobody will @@ -4118,6 +4125,15 @@ kbd_buffer_get_event (KBOARD **kbp, obj = make_lispy_switch_frame (frame); internal_last_event_frame = frame; + if (EQ (event->ie.device, Qt)) + Vlast_event_device = ((event->ie.kind == ASCII_KEYSTROKE_EVENT + || event->ie.kind == MULTIBYTE_CHAR_KEYSTROKE_EVENT + || event->ie.kind == NON_ASCII_KEYSTROKE_EVENT) + ? virtual_core_keyboard_name + : virtual_core_pointer_name); + else + Vlast_event_device = event->ie.device; + /* If we didn't decide to make a switch-frame event, go ahead and build a real event from the queue entry. */ if (NILP (obj)) @@ -4173,6 +4189,10 @@ kbd_buffer_get_event (KBOARD **kbp, XSETCAR (Fnthcdr (make_fixnum (3), maybe_event->ie.arg), make_float (fmod (pinch_angle, 360.0))); + + if (!EQ (maybe_event->ie.device, Qt)) + Vlast_event_device = maybe_event->ie.device; + maybe_event = next_kbd_event (event); } } @@ -4296,6 +4316,11 @@ kbd_buffer_get_event (KBOARD **kbp, return a mouse-motion event. */ if (!NILP (x) && NILP (obj)) obj = make_lispy_movement (f, bar_window, part, x, y, t); + + if (!NILP (obj)) + Vlast_event_device = (STRINGP (f->last_mouse_device) + ? f->last_mouse_device + : virtual_core_pointer_name); } else /* We were promised by the above while loop that there was @@ -11805,6 +11830,10 @@ init_keyboard (void) interrupt_input_blocked = 0; pending_signals = false; + virtual_core_pointer_name = build_string ("Virtual core pointer"); + virtual_core_keyboard_name = build_string ("Virtual core keyboard"); + Vlast_event_device = Qnil; + /* This means that command_loop_1 won't try to select anything the first time through. */ internal_last_event_frame = Qnil; @@ -12225,6 +12254,12 @@ syms_of_keyboard (void) staticpro (&poll_timer_time); #endif + virtual_core_pointer_name = Qnil; + staticpro (&virtual_core_pointer_name); + + virtual_core_keyboard_name = Qnil; + staticpro (&virtual_core_keyboard_name); + defsubr (&Scurrent_idle_time); defsubr (&Sevent_symbol_parse_modifiers); defsubr (&Sevent_convert_list); @@ -12423,6 +12458,17 @@ This does not include events generated by keyboard macros. */); If the last event came from a keyboard macro, this is set to `macro'. */); Vlast_event_frame = Qnil; + DEFVAR_LISP ("last-event-device", Vlast_event_device, + doc: /* The name of the input device of the most recently read event. +When the input extension is being used on X, this is the name of the X +Input Extension device from which the last event was generated as a +string. Otherwise, this is "Virtual core keyboard" for keyboard input +events, and "Virtual core pointer" for other events. + +It is nil if the last event did not come from an input device (i.e. it +came from `unread-command-events' instead). */); + Vlast_event_device = Qnil; + /* This variable is set up in sysdep.c. */ DEFVAR_LISP ("tty-erase-char", Vtty_erase_char, doc: /* The ERASE character as set by the user with stty. */); diff --git a/src/termhooks.h b/src/termhooks.h index 0f02b56e9e..8c193914ba 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -392,9 +392,17 @@ struct input_event when building events. Unfortunately some events have to pass much more data than it's reasonable to pack directly into this structure. */ Lisp_Object arg; + + /* The name of the device from which this event originated. + + It can either be a string, or Qt, which means to use the name + "Virtual core pointer" for all events other than keystroke + events, and "Virtual core keyboard" for those. */ + Lisp_Object device; }; -#define EVENT_INIT(event) memset (&(event), 0, sizeof (struct input_event)) +#define EVENT_INIT(event) (memset (&(event), 0, sizeof (struct input_event)), \ + (event).device = Qt) /* Bits in the modifiers member of the input_event structure. Note that reorder_modifiers assumes that the bits are in canonical diff --git a/src/xterm.c b/src/xterm.c index 57a64cb5d1..d4a5e0ab3d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3922,6 +3922,7 @@ x_init_master_valuators (struct x_display_info *dpyinfo) #ifdef HAVE_XINPUT2_2 xi_device->direct_p = false; #endif + xi_device->name = build_string (device->name); for (int c = 0; c < device->num_classes; ++c) { @@ -9653,6 +9654,12 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (x_dnd_return_frame == 3 && FRAME_LIVE_P (x_dnd_return_frame_object)) { + /* Deliberately preserve the last device if + x_dnd_return_frame_object is the drag source. */ + + if (x_dnd_return_frame_object != x_dnd_frame) + x_dnd_return_frame_object->last_mouse_device = Qnil; + x_dnd_return_frame_object->mouse_moved = true; XSETFRAME (action, x_dnd_return_frame_object); @@ -10170,7 +10177,8 @@ x_construct_mouse_click (struct input_event *result, XI_Enter and XI_Leave labels inside `handle_one_xevent'. */ static bool -x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) +x_note_mouse_movement (struct frame *frame, const XMotionEvent *event, + Lisp_Object device) { XRectangle *r; struct x_display_info *dpyinfo; @@ -10187,6 +10195,7 @@ x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) if (event->window != FRAME_X_WINDOW (frame)) { frame->mouse_moved = true; + frame->last_mouse_device = device; dpyinfo->last_mouse_scroll_bar = NULL; note_mouse_highlight (frame, -1, -1); dpyinfo->last_mouse_glyph_frame = NULL; @@ -10201,6 +10210,7 @@ x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) || event->y < r->y || event->y >= r->y + r->height) { frame->mouse_moved = true; + frame->last_mouse_device = device; dpyinfo->last_mouse_scroll_bar = NULL; note_mouse_highlight (frame, event->x, event->y); /* Remember which glyph we're now on. */ @@ -14788,12 +14798,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* EnterNotify counts as mouse movement, so update things that depend on mouse position. */ if (f && !f->output_data.x->hourglass_p) - x_note_mouse_movement (f, &event->xmotion); + x_note_mouse_movement (f, &event->xmotion, Qnil); #ifdef USE_GTK /* We may get an EnterNotify on the buttons in the toolbar. In that case we moved out of any highlighted area and need to note this. */ if (!f && dpyinfo->last_mouse_glyph_frame) - x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &event->xmotion); + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &event->xmotion, + Qnil); #endif goto OTHER; @@ -14884,7 +14895,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_GTK /* See comment in EnterNotify above */ else if (dpyinfo->last_mouse_glyph_frame) - x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &event->xmotion); + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, + &event->xmotion, Qnil); #endif goto OTHER; @@ -15123,7 +15135,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, last_mouse_window = window; } - if (!x_note_mouse_movement (f, &xmotion)) + if (!x_note_mouse_movement (f, &xmotion, Qnil)) help_echo_string = previous_help_echo_string; } else @@ -15903,8 +15915,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, { XIEnterEvent *enter = (XIEnterEvent *) xi_event; XMotionEvent ev; + struct xi_device_t *source; any = x_top_window_to_frame (dpyinfo, enter->event); + source = xi_device_from_id (dpyinfo, enter->sourceid); ev.x = lrint (enter->event_x); ev.y = lrint (enter->event_y); ev.window = enter->event; @@ -15972,12 +15986,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* EnterNotify counts as mouse movement, so update things that depend on mouse position. */ if (f && !f->output_data.x->hourglass_p) - x_note_mouse_movement (f, &ev); + x_note_mouse_movement (f, &ev, source ? source->name : Qnil); #ifdef USE_GTK /* We may get an EnterNotify on the buttons in the toolbar. In that case we moved out of any highlighted area and need to note this. */ if (!f && dpyinfo->last_mouse_glyph_frame) - x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev, + source ? source->name : Qnil); #endif goto XI_OTHER; } @@ -15985,6 +16000,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_Leave: { XILeaveEvent *leave = (XILeaveEvent *) xi_event; + struct xi_device_t *source; #ifdef USE_GTK XMotionEvent ev; @@ -15995,6 +16011,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif any = x_top_window_to_frame (dpyinfo, leave->event); + source = xi_device_from_id (dpyinfo, leave->sourceid); /* This allows us to catch LeaveNotify events generated by popup menu grabs. FIXME: this is right when there is a @@ -16098,14 +16115,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_GTK /* See comment in EnterNotify above */ else if (dpyinfo->last_mouse_glyph_frame) - x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev, + source ? source->name : Qnil); #endif goto XI_OTHER; } case XI_Motion: { - struct xi_device_t *device; + struct xi_device_t *device, *source; #ifdef HAVE_XINPUT2_1 XIValuatorState *states; double *values; @@ -16117,6 +16135,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, xm_top_level_enter_message emsg; xm_drag_motion_message dmsg; + source = xi_device_from_id (dpyinfo, xev->sourceid); #ifdef HAVE_XINPUT2_1 states = &xev->valuators; @@ -16333,6 +16352,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, XSETFRAME (inev.ie.frame_or_window, f); } + if (source && source->name) + inev.ie.device = source->name; + goto XI_OTHER; } #ifdef HAVE_XWIDGETS @@ -16588,13 +16610,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, { inev.ie.kind = SELECT_WINDOW_EVENT; inev.ie.frame_or_window = window; + + if (source) + inev.ie.device = source->name; } /* Remember the last window where we saw the mouse. */ last_mouse_window = window; } - if (!x_note_mouse_movement (f, &ev)) + if (!x_note_mouse_movement (f, &ev, source ? source->name : Qnil)) help_echo_string = previous_help_echo_string; } else @@ -16628,7 +16653,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, Lisp_Object tab_bar_arg = Qnil; bool tab_bar_p = false; bool tool_bar_p = false; - struct xi_device_t *device; + struct xi_device_t *device, *source; #ifdef HAVE_XWIDGETS struct xwidget_view *xvw; #endif @@ -16837,6 +16862,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (xev->evtype == XI_ButtonPress) x_display_set_last_user_time (dpyinfo, xev->time); + source = xi_device_from_id (dpyinfo, xev->sourceid); + #ifdef HAVE_XWIDGETS xvw = xwidget_view_from_window (xev->event); if (xvw) @@ -16849,6 +16876,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, { inev.ie.kind = SELECT_WINDOW_EVENT; inev.ie.frame_or_window = xvw->w; + + if (source) + inev.ie.device = source->name; } *finish = X_EVENT_DROP; @@ -16918,6 +16948,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, else inev.ie.kind = HORIZ_WHEEL_EVENT; + if (source) + inev.ie.device = source->name; + inev.ie.timestamp = xev->time; XSETINT (inev.ie.x, real_x); @@ -16953,6 +16986,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, else inev.ie.kind = HORIZ_WHEEL_EVENT; + if (source) + inev.ie.device = source->name; + inev.ie.timestamp = xev->time; XSETINT (inev.ie.x, lrint (xev->event_x)); @@ -17070,6 +17106,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, device->grab &= ~(1 << xev->detail); } + if (source && inev.ie.kind != NO_EVENT) + inev.ie.device = source->name; + if (f) f->mouse_moved = false; @@ -17108,11 +17147,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, char *copy_bufptr = copy_buffer; int copy_bufsiz = sizeof (copy_buffer); ptrdiff_t i; - struct xi_device_t *device; + struct xi_device_t *device, *source; coding = Qlatin_1; device = xi_device_from_id (dpyinfo, xev->deviceid); + source = xi_device_from_id (dpyinfo, xev->sourceid); if (!device) goto XI_OTHER; @@ -17350,6 +17390,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.kind = ASCII_KEYSTROKE_EVENT; inev.ie.code = keysym; + if (source) + inev.ie.device = source->name; + goto xi_done_keysym; } @@ -17360,6 +17403,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.kind = ASCII_KEYSTROKE_EVENT; else inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + + if (source) + inev.ie.device = source->name; + inev.ie.code = keysym & 0xFFFFFF; goto xi_done_keysym; } @@ -17375,6 +17422,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT); inev.ie.code = XFIXNAT (c); + + if (source) + inev.ie.device = source->name; + goto xi_done_keysym; } @@ -17479,6 +17530,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, key. */ inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; inev.ie.code = keysym; + + if (source) + inev.ie.device = source->name; + goto xi_done_keysym; } @@ -17494,6 +17549,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, Fput_text_property (make_fixnum (0), make_fixnum (nbytes), Qcoding, coding, inev.ie.arg); + + if (source) + inev.ie.device = source->name; } goto xi_done_keysym; } @@ -17688,12 +17746,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef HAVE_XINPUT2_2 case XI_TouchBegin: { - struct xi_device_t *device; + struct xi_device_t *device, *source; bool menu_bar_p = false, tool_bar_p = false; #ifdef HAVE_GTK3 GdkRectangle test_rect; #endif device = xi_device_from_id (dpyinfo, xev->deviceid); + source = xi_device_from_id (dpyinfo, xev->sourceid); x_display_set_last_user_time (dpyinfo, xev->time); if (!device) @@ -17741,6 +17800,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, XSETINT (inev.ie.x, lrint (xev->event_x)); XSETINT (inev.ie.y, lrint (xev->event_y)); XSETINT (inev.ie.arg, xev->detail); + + if (source) + inev.ie.device = source->name; } x_uncatch_errors_after_check (); } @@ -17774,11 +17836,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_TouchUpdate: { - struct xi_device_t *device; + struct xi_device_t *device, *source; struct xi_touch_point_t *touchpoint; Lisp_Object arg = Qnil; device = xi_device_from_id (dpyinfo, xev->deviceid); + source = xi_device_from_id (dpyinfo, xev->sourceid); x_display_set_last_user_time (dpyinfo, xev->time); if (!device) @@ -17809,6 +17872,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, arg); } + if (source) + inev.ie.device = source->name; + inev.ie.arg = arg; } @@ -17817,10 +17883,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_TouchEnd: { - struct xi_device_t *device; + struct xi_device_t *device, *source; bool unlinked_p; device = xi_device_from_id (dpyinfo, xev->deviceid); + source = xi_device_from_id (dpyinfo, xev->sourceid); x_display_set_last_user_time (dpyinfo, xev->time); if (!device) @@ -17836,10 +17903,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, { inev.ie.kind = TOUCHSCREEN_END_EVENT; inev.ie.timestamp = xev->time; + XSETFRAME (inev.ie.frame_or_window, f); XSETINT (inev.ie.x, lrint (xev->event_x)); XSETINT (inev.ie.y, lrint (xev->event_y)); XSETINT (inev.ie.arg, xev->detail); + + if (source) + inev.ie.device = source->name; } } @@ -17852,10 +17923,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_GesturePinchBegin: case XI_GesturePinchUpdate: { - x_display_set_last_user_time (dpyinfo, xi_event->time); - XIGesturePinchEvent *pev = (XIGesturePinchEvent *) xi_event; - struct xi_device_t *device = xi_device_from_id (dpyinfo, pev->deviceid); + struct xi_device_t *device, *source; + + device = xi_device_from_id (dpyinfo, pev->deviceid); + source = xi_device_from_id (dpyinfo, pev->sourceid); + x_display_set_last_user_time (dpyinfo, xi_event->time); if (!device) goto XI_OTHER; @@ -17884,6 +17957,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, make_float (pev->delta_y), make_float (pev->scale), make_float (pev->delta_angle)); + + if (source) + inev.ie.device = source->name; } /* Once again GTK seems to crash when confronted by @@ -23142,6 +23218,10 @@ void mark_xterm (void) { Lisp_Object val; +#ifdef HAVE_XINPUT2 + struct x_display_info *dpyinfo; + int i; +#endif if (x_dnd_return_frame_object) { @@ -23154,6 +23234,14 @@ mark_xterm (void) XSETFRAME (val, x_dnd_movement_frame); mark_object (val); } + +#ifdef HAVE_XINPUT2 + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + { + for (i = 0; i < dpyinfo->num_devices; ++i) + mark_object (dpyinfo->devices[i].name); + } +#endif } void diff --git a/src/xterm.h b/src/xterm.h index d8898162d1..c12fd6c3fe 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -244,6 +244,8 @@ struct xi_device_t #ifdef HAVE_XINPUT2_2 struct xi_touch_point_t *touchpoints; #endif + + Lisp_Object name; }; #endif commit c1a6aa0c3eb1029e3f7f5c3b227d7952bee775b8 Author: Po Lu Date: Thu Apr 7 19:43:15 2022 +0800 Fix xwidget smooth scrolling when the default pointer is not a touchpad * xwidget.c (find_suitable_pointer): New argument `need_smooth'. Try to find a touchpad if that is set. (xwidget_button_1, xwidget_button, xwidget_motion_notify) (xwidget_scroll, xwidget_pinch, xw_notify_virtual_upwards_until) (xw_notify_virtual_downwards_until): (xw_maybe_synthesize_crossing): (xwidget_motion_or_crossing, synthesize_focus_in_event): Set parameter accordingly. diff --git a/src/xwidget.c b/src/xwidget.c index 71bc350429..8bdfab02fd 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -857,15 +857,34 @@ to_embedder (GdkWindow *window, double x, double y, } static GdkDevice * -find_suitable_pointer (struct frame *f) +find_suitable_pointer (struct frame *f, bool need_smooth) { GdkSeat *seat = gdk_display_get_default_seat (gtk_widget_get_display (FRAME_GTK_WIDGET (f))); + GList *devices, *tem; + GdkDevice *device; if (!seat) return NULL; - return gdk_seat_get_pointer (seat); + devices = gdk_seat_get_slaves (seat, GDK_SEAT_CAPABILITY_ALL_POINTING); + device = NULL; + tem = NULL; + + if (need_smooth) + { + for (tem = devices; tem; tem = tem->next) + { + device = GDK_DEVICE (tem->data); + + if (gdk_device_get_source (device) == GDK_SOURCE_TOUCHPAD) + break; + } + } + + g_list_free (devices); + + return !tem ? gdk_seat_get_pointer (seat) : device; } static GdkDevice * @@ -1196,7 +1215,7 @@ xwidget_button_1 (struct xwidget_view *view, xg_event->button.button = button; xg_event->button.state = modifier_state; xg_event->button.time = time; - xg_event->button.device = find_suitable_pointer (view->frame); + xg_event->button.device = find_suitable_pointer (view->frame, false); gtk_main_do_event (xg_event); gdk_event_free (xg_event); @@ -1242,7 +1261,8 @@ xwidget_button_1 (struct xwidget_view *view, xg_event->crossing.detail = GDK_NOTIFY_ANCESTOR; xg_event->crossing.mode = GDK_CROSSING_UNGRAB; xg_event->crossing.window = g_object_ref (target_window); - gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); gtk_main_do_event (xg_event); gdk_event_free (xg_event); @@ -1264,7 +1284,8 @@ xwidget_button_1 (struct xwidget_view *view, xg_event->crossing.mode = GDK_CROSSING_UNGRAB; xg_event->crossing.window = g_object_ref (toplevel); - gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); gtk_main_do_event (xg_event); gdk_event_free (xg_event); } @@ -1323,7 +1344,8 @@ xwidget_button (struct xwidget_view *view, else xg_event->scroll.direction = GDK_SCROLL_RIGHT; - xg_event->scroll.device = find_suitable_pointer (view->frame); + xg_event->scroll.device = find_suitable_pointer (view->frame, + false); xg_event->scroll.x = x; xg_event->scroll.x_root = x; @@ -1387,7 +1409,7 @@ xwidget_motion_notify (struct xwidget_view *view, xg_event->motion.y_root = root_y; xg_event->motion.time = time; xg_event->motion.state = state; - xg_event->motion.device = find_suitable_pointer (view->frame); + xg_event->motion.device = find_suitable_pointer (view->frame, false); g_object_ref (xg_event->any.window); @@ -1434,7 +1456,7 @@ xwidget_scroll (struct xwidget_view *view, double x, double y, xg_event->scroll.state = state; xg_event->scroll.delta_x = dx; xg_event->scroll.delta_y = dy; - xg_event->scroll.device = find_suitable_pointer (view->frame); + xg_event->scroll.device = find_suitable_pointer (view->frame, true); xg_event->scroll.is_stop = stop_p; g_object_ref (xg_event->any.window); @@ -1499,7 +1521,7 @@ xwidget_pinch (struct xwidget_view *view, XIGesturePinchEvent *xev) break; } - gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame, false)); g_object_ref (xg_event->any.window); gtk_main_do_event (xg_event); @@ -1624,7 +1646,8 @@ xw_notify_virtual_upwards_until (struct xwidget_view *xv, { xg_event = gdk_event_new (type); - gdk_event_set_device (xg_event, find_suitable_pointer (xv->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (xv->frame, false)); window_coords_from_toplevel (tem, toplevel, x, y, &cx, &cy); xg_event->crossing.x = cx; xg_event->crossing.y = cy; @@ -1670,7 +1693,8 @@ xw_notify_virtual_downwards_until (struct xwidget_view *xv, tem = it->data; xg_event = gdk_event_new (type); - gdk_event_set_device (xg_event, find_suitable_pointer (xv->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (xv->frame, false)); window_coords_from_toplevel (tem, toplevel, x, y, &cx, &cy); xg_event->crossing.x = cx; xg_event->crossing.y = cy; @@ -1775,7 +1799,8 @@ xw_maybe_synthesize_crossing (struct xwidget_view *view, xg_event->crossing.detail = GDK_NOTIFY_ANCESTOR; xg_event->crossing.mode = exit_crossing; xg_event->crossing.window = g_object_ref (view->last_crossing_window); - gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); gtk_main_do_event (xg_event); gdk_event_free (xg_event); @@ -1839,7 +1864,8 @@ xw_maybe_synthesize_crossing (struct xwidget_view *view, exit_crossing); xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); - gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); window_coords_from_toplevel (last_crossing, toplevel, x, y, &cx, &cy); xg_event->crossing.x = cx; @@ -1867,7 +1893,8 @@ xw_maybe_synthesize_crossing (struct xwidget_view *view, entry_crossing); xg_event = gdk_event_new (GDK_ENTER_NOTIFY); - gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); window_coords_from_toplevel (current_window, toplevel, x, y, &cx, &cy); xg_event->crossing.x = cx; @@ -1970,7 +1997,8 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) xg_event->motion.y_root = event->xmotion.y_root; xg_event->motion.time = event->xmotion.time; xg_event->motion.state = event->xmotion.state; - xg_event->motion.device = find_suitable_pointer (view->frame); + xg_event->motion.device + = find_suitable_pointer (view->frame, false); } else { @@ -2017,7 +2045,8 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) return; } - gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); } #endif else @@ -2046,7 +2075,8 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) xg_event->crossing.x_root = event->xcrossing.x_root; xg_event->crossing.y_root = event->xcrossing.y_root; xg_event->crossing.focus = event->xcrossing.focus; - gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gdk_event_set_device (xg_event, + find_suitable_pointer (view->frame, false)); } gtk_main_do_event (xg_event); @@ -2072,7 +2102,8 @@ synthesize_focus_in_event (GtkWidget *offscreen_window) if (FRAME_WINDOW_P (SELECTED_FRAME ())) gdk_event_set_device (focus_event, - find_suitable_pointer (SELECTED_FRAME ())); + find_suitable_pointer (SELECTED_FRAME (), + false)); g_object_ref (wnd); commit 4c8e23d5d7fb662dc9eefba67b52ae5df0dffe62 Author: Lars Ingebrigtsen Date: Thu Apr 7 13:37:16 2022 +0200 Clarify read-answer-short/use-short-answers action * lisp/emacs-lisp/map-ynp.el (read-answer-short): Clarify what this variable affects (bug#54754). * src/fns.c (Fyes_or_no_p): Mention `use-short-answers'. diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index b3e7fca478..c47025f884 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -278,11 +278,17 @@ Type \\`SPC' or \\`y' to %s the current %s; ;; For backward compatibility check if short y/n answers are preferred. (defcustom read-answer-short 'auto - "If non-nil, `read-answer' accepts single-character answers. + "If non-nil, the `read-answer' function accepts single-character answers. If t, accept short (single key-press) answers to the question. If nil, require long answers. If `auto', accept short answers if `use-short-answers' is non-nil, or the function cell of `yes-or-no-p' -is set to `y-or-n-p'." +is set to `y-or-n-p'. + +Note that this variable does not affect calls to the more +commonly-used `yes-or-no-p' function; it only affects calls to +the `read-answer' function. To control whether `yes-or-no-p' +requires a long or a short answer, see the `use-short-answers' +variable." :type '(choice (const :tag "Accept short answers" t) (const :tag "Require long answer" nil) (const :tag "Guess preference" auto)) diff --git a/src/fns.c b/src/fns.c index ee4e80b506..4673fde28c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2915,6 +2915,9 @@ it does up to one space will be removed. The user must confirm the answer with RET, and can edit it until it has been confirmed. +If the `use-short-answers' variable is non-nil, instead of asking for +\"yes\" or \"no\", this function will ask for \"y\" or \"n\". + If dialog boxes are supported, a dialog box will be used if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) (Lisp_Object prompt) commit d859cdd62157b3489ca893a54a4d7a6400cfae2c Author: Andrew G Cohen Date: Tue Mar 22 13:04:58 2022 +0800 Encrypt some parameters in auth-source plstore backend The auth-source plstore backend allows a list of extra parameters but currently stores them all unencrypted. This allows a plist with :unencrypted and :encrypted keys to specify which extra parameters to encrypt in the plstore file. * lisp/auth-source.el (auth-source-plstore-create): Allow specifying both unencrypted and encrypted extra parameters. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index cb528cebdc..cd135bd2e2 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -573,19 +573,24 @@ which says: or P. The resulting token will only have keys user, host, and port.\" -:create \\='(A B C) also means to create a token if possible. +:create \\='(A B C) or +:create \\='(:unencrypted A B :encrypted C) +also means to create a token if possible. The behavior is like :create t but if the list contains any parameter, that parameter will be required in the resulting -token. The value for that parameter will be obtained from the -search parameters or from user input. If any queries are needed, -the alist `auth-source-creation-defaults' will be checked for the -default value. If the user, host, or port are missing, the alist -`auth-source-creation-prompts' will be used to look up the -prompts IN THAT ORDER (so the `user' prompt will be queried first, -then `host', then `port', and finally `secret'). Each prompt string -can use %u, %h, and %p to show the user, host, and port. The prompt -is formatted with `format-prompt', a trailing \": \" is removed. +token (the second form is used only with the plstore backend and +specifies if any of the extra parameters should be stored in +encrypted format.) The value for that parameter will be obtained +from the search parameters or from user input. If any queries +are needed, the alist `auth-source-creation-defaults' will be +checked for the default value. If the user, host, or port are +missing, the alist `auth-source-creation-prompts' will be used to +look up the prompts IN THAT ORDER (so the `user' prompt will be +queried first, then `host', then `port', and finally `secret'). +Each prompt string can use %u, %h, and %p to show the user, host, +and port. The prompt is formatted with `format-prompt', a +trailing \": \" is removed. Here's an example: @@ -2131,12 +2136,17 @@ entries for git.gnus.org: (let* ((base-required '(host user port secret)) (base-secret '(secret)) ;; we know (because of an assertion in auth-source-search) that the - ;; :create parameter is either t or a list (which includes nil) - (create-extra (if (eq t create) nil create)) + ;; :create parameter is either t, or a list (which includes nil + ;; or a plist) + (create-extra-secret (plist-get create :encrypted)) + (create-extra (if (eq t create) nil + (or (append (plist-get create :unencrypted) + create-extra-secret) create))) (current-data (car (auth-source-search :max 1 :host host :port port))) (required (append base-required create-extra)) + (required-secret (append base-secret create-extra-secret)) ;; `valist' is an alist valist ;; `artificial' will be returned if no creation is needed @@ -2158,10 +2168,11 @@ entries for git.gnus.org: (auth-source--aput valist br br-choice)))))) ;; for extra required elements, see if the spec includes a value for them - (dolist (er create-extra) - (let ((k (auth-source--symbol-keyword er)) - (keys (cl-loop for i below (length spec) by 2 - collect (nth i spec)))) + (let ((keys (cl-loop for i below (length spec) by 2 + collect (nth i spec))) + k) + (dolist (er create-extra) + (setq k (auth-source--symbol-keyword er)) (when (memq k keys) (auth-source--aput valist er (plist-get spec k))))) @@ -2225,7 +2236,7 @@ entries for git.gnus.org: (eval default))))) (when data - (if (member r base-secret) + (if (member r required-secret) (setq secret-artificial (plist-put secret-artificial (auth-source--symbol-keyword r) commit 77f3bc37e1966c15691421585af4d4b9f8114594 Author: Jai Flack Date: Thu Apr 7 13:14:01 2022 +0200 Add a mu backend for gnus-search * lisp/gnus-search.el (gnus-search-mu-program): New defcustom (gnus-search-mu-switches): New defcustom (gnus-search-mu-remove-prefix): New defcustom (gnus-search-mu-config-directory): New defcustom (gnus-search-mu-raw-queries-p): New defcustom (gnus-search-mu): New subclass of gnus-search-indexed (gnus-search-transform-expression): New method (gnus-search-mu-handle-date): New function (gnus-search-mu-handle-flag): New function (gnus-search-indexed-extract): New method (gnus-search-indexed-search-command): New method (bug#54662). diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index eb93269721..9faace1a75 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -21651,6 +21651,9 @@ are: @item @code{gnus-search-namazu} + +@item +@code{gnus-search-mu} @end itemize If you need more granularity, you can specify a search engine in the @@ -21665,7 +21668,7 @@ buffer. That might look like: (config-file "/home/user/.mail/.notmuch_config"))) @end example -Search engines like notmuch, namazu and mairix are similar in +Search engines like notmuch, namazu, mairix and mu are similar in behavior: they use a local executable to create an index of a message store, and run command line search queries against those messages, and return a list of absolute file names of matching messages. @@ -21704,8 +21707,8 @@ The customization options are formed on the pattern non-standard notmuch program, you might set @code{gnus-search-notmuch-program} to @file{/usr/local/bin/notmuch}. This would apply to all notmuch engines. The engines that use these -options are: ``notmuch'', ``namazu'', ``mairix'', ``swish-e'' and -``swish++''. +options are: ``notmuch'', ``namazu'', ``mairix'', ``mu'', ``swish-e'' +and ``swish++''. Alternately, the options can be set directly on your Gnus server definitions, for instance, in the @code{nnmaildir} example above. diff --git a/etc/NEWS b/etc/NEWS index 6b7bb7a18e..564bd16022 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -818,6 +818,11 @@ displayed as emojis. Default nil. This is bound to 'W D e' and will display symbols that have emoji representation as emojis. ++++ +*** New mu backend for gnus-search. +Configuration is very similar to the notmuch and namazu backends. It +supports the unified search syntax. + ** EIEIO +++ diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 4ca873eeec..6c70257f42 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -349,6 +349,41 @@ This variable can also be set per-server." :version "28.1" :type 'boolean) +(defcustom gnus-search-mu-program "mu" + "Name of the mu search executable. +This can also be set per-server." + :version "29.1" + :type 'string) + +(defcustom gnus-search-mu-switches nil + "A list of strings, to be given as additional arguments to mu. +Note that this should be a list. I.e., do NOT use the following: + (setq gnus-search-mu-switches \"-u -r\") +Instead, use this: + (setq gnus-search-mu-switches \\='(\"-u\" \"-r\")) +This can also be set per-server." + :version "29.1" + :type '(repeat string)) + +(defcustom gnus-search-mu-remove-prefix (expand-file-name "~/Mail/") + "A prefix to remove from the mu results to get a group name. +Usually this will be set to the path to your mail directory. This +can also be set per-server." + :version "29.1" + :type 'directory) + +(defcustom gnus-search-mu-config-directory (expand-file-name "~/.cache/mu") + "Configuration directory for mu. +This can also be set per-server." + :version "29.1" + :type 'file) + +(defcustom gnus-search-mu-raw-queries-p nil + "If t, all mu engines will only accept raw search query strings. +This can also be set per-server." + :version "29.1" + :type 'boolean) + ;; Options for search language parsing. (defcustom gnus-search-expandable-keys @@ -903,6 +938,18 @@ quirks.") (raw-queries-p :initform (symbol-value 'gnus-search-notmuch-raw-queries-p)))) +(defclass gnus-search-mu (gnus-search-indexed) + ((program + :initform (symbol-value 'gnus-search-mu-program)) + (remove-prefix + :initform (symbol-value 'gnus-search-mu-remove-prefix)) + (switches + :initform (symbol-value 'gnus-search-mu-switches)) + (config-directory + :initform (symbol-value 'gnus-search-mu-config-directory)) + (raw-queries-p + :initform (symbol-value 'gnus-search-mu-raw-queries-p)))) + (define-obsolete-variable-alias 'nnir-method-default-engines 'gnus-search-default-engines "28.1") @@ -1849,6 +1896,101 @@ Assume \"size\" key is equal to \"larger\"." (when (alist-get 'thread query) (list "-t")) (list qstring)))) +;;; Mu interface + +(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mu) + (expr list)) + (cl-case (car expr) + (recipient (setf (car expr) 'recip)) + (address (setf (car expr) 'contact)) + (id (setf (car expr) 'msgid)) + (attachment (setf (car expr) 'file))) + (cl-flet () + (cond + ((consp (car expr)) + (format "(%s)" (gnus-search-transform engine expr))) + ;; Explicitly leave out 'date as gnus-search will encode it + ;; first; it is handled later + ((memq (car expr) '(cc c bcc h from f to t subject s body b + maildir m msgid i prio p flag g d + size z embed e file j mime y tag x + list v)) + (format "%s:%s" (car expr) + (if (string-match "\\`\\*" (cdr expr)) + (replace-match "" nil nil (cdr expr)) + (cdr expr)))) + ((eq (car expr) 'mark) + (format "flag:%s" (gnus-search-mu-handle-flag (cdr expr)))) + ((eq (car expr) 'date) + (format "date:%s" (gnus-search-mu-handle-date (cdr expr)))) + ((eq (car expr) 'before) + (format "date:..%s" (gnus-search-mu-handle-date (cdr expr)))) + ((eq (car expr) 'since) + (format "date:%s.." (gnus-search-mu-handle-date (cdr expr)))) + (t (ignore-errors (cl-call-next-method)))))) + +(defun gnus-search-mu-handle-date (date) + (if (stringp date) + date + (pcase date + (`(nil ,m nil) + (nth (1- m) gnus-english-month-names)) + (`(nil nil ,y) + (number-to-string y)) + ;; mu prefers ISO date YYYY-MM-DD HH:MM:SS + (`(,d ,m nil) + (let* ((ct (decode-time)) + (cm (decoded-time-month ct)) + (cy (decoded-time-year ct)) + (y (if (> cm m) + cy + (1- cy)))) + (format "%d-%02d-%02d" y m d))) + (`(nil ,m ,y) + (format "%d-%02d" y m)) + (`(,d ,m ,y) + (format "%d-%02d-%02d" y m d))))) + +(defun gnus-search-mu-handle-flag (flag) + ;; Only change what doesn't match + (cond ((string= flag "flag") + "flagged") + ((string= flag "read") + "seen") + (t + flag))) + +(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-mu)) + (prog1 + (let ((bol (line-beginning-position)) + (eol (line-end-position))) + (list (buffer-substring-no-properties bol eol) + 100)) + (move-beginning-of-line 2))) + +(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mu) + (qstring string) + query &optional groups) + (let ((limit (alist-get 'limit query)) + (thread (alist-get 'thread query))) + (with-slots (switches config-directory) engine + `("find" ; command must come first + "--nocolor" ; mu will always give coloured output otherwise + ,(format "--muhome=%s" config-directory) + ,@switches + ,(if thread "-r" "") + ,(if limit (format "--maxnum=%d" limit) "") + ,qstring + ,@(if groups + `("and" "(" + ,@(nbutlast (mapcan (lambda (x) + (list (concat "maildir:/" x) "or")) + groups)) + ")") + "") + "--format=plain" + "--fields=l")))) + ;;; Find-grep interface (cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep) commit 7e9807d41bdc03a6709a6f87d55a84a1a7fb1a3e Author: Michael Albinus Date: Thu Apr 7 12:11:11 2022 +0200 * lisp/net/tramp-integration.el: Don't require files-x. diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 6be06d0e73..81990c6a33 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -28,7 +28,6 @@ ;;; Code: (require 'tramp-compat) -(require 'files-x) ;; Pacify byte-compiler. (require 'cl-lib)