commit 43ee6f291d88453f0d6dec76fe80f4e7503abc81 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Sat Mar 19 07:00:11 2022 +0000 Ignore drag source frame on Haiku in line with documentation * src/haiku_support.cc (class EmacsWindow): New field `window_id'. (MessageReceived): Ignore dropped messages with same window id. (be_drag_message): Add source frame's window ID to message. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 8c45a7adcb..26b7ebed24 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -117,6 +117,7 @@ static BLocker movement_locker; static BMessage volatile *popup_track_message; static int32 volatile alert_popup_value; +static int current_window_id; static void *grab_view = NULL; static BLocker grab_view_locker; @@ -414,11 +415,12 @@ class EmacsWindow : public BWindow 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; EmacsWindow () : BWindow (BRect (0, 0, 0, 0), "", B_TITLED_WINDOW_LOOK, B_NORMAL_WINDOW_FEEL, B_NO_SERVER_SIDE_WINDOW_MODIFIERS) { - + window_id = current_window_id++; } ~EmacsWindow () @@ -639,8 +641,13 @@ class EmacsWindow : public BWindow if (msg->WasDropped ()) { BPoint whereto; + int32 windowid; struct haiku_drag_and_drop_event rq; + if (msg->FindInt32 ("emacs:window_id", &windowid) == B_OK + && windowid == this->window_id) + return; + if (msg->FindPoint ("_drop_point_", &whereto) == B_OK) { this->ConvertFromScreen (&whereto); @@ -3960,6 +3967,7 @@ be_drag_message (void *view, void *message, void (*process_pending_signals_function) (void)) { EmacsView *vw = (EmacsView *) view; + EmacsWindow *window = (EmacsWindow *) vw->Window (); BMessage *msg = (BMessage *) message; BMessage wait_for_release; BMessenger messenger (vw); @@ -3967,6 +3975,7 @@ be_drag_message (void *view, void *message, ssize_t stat; block_input_function (); + msg->AddInt32 ("emacs:window_id", window->window_id); if (!vw->LockLooper ()) gui_abort ("Failed to lock view looper for drag"); commit 5781f0af7dae91097f797e93a63cb733b2b66f1d Merge: c7f085b53f c4596c8522 Author: Stefan Kangas Date: Sat Mar 19 06:30:38 2022 +0100 Merge from origin/emacs-28 c4596c8522 Fix a regression in 'decipher-digram-list' commit c7f085b53fe4bf0e6bc13e33b38f46f6b35a5608 Author: Po Lu Date: Sat Mar 19 11:35:55 2022 +0800 Document dired-mouse-drag-files * doc/emacs/dired.texi (Misc Dired Features): Explain that dragging files is now supported. * etc/NEWS: Update documentation status. * lisp/dired.el (dired-mouse-drag-files): Fix typo in doc string. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 3112ac332b..e18c8b048b 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1695,9 +1695,15 @@ directory than in this one. It also marks files with no counterpart, in both directories, as always. @cindex drag and drop, Dired - On the X Window System, Emacs supports the drag and drop -protocol. You can drag a file object from another program, and drop -it onto a Dired buffer; this either moves, copies, or creates a link -to the file in that directory. Precisely which action is taken is -determined by the originating program. Dragging files out of a Dired -buffer is currently not supported. +@vindex dired-mouse-drag-files + On the X Window System, Emacs supports the drag and drop protocol. +You can drag a file object from another program, and drop it onto a +Dired buffer; this either moves, copies, or creates a link to the file +in that directory. Precisely which action is taken is determined by +the originating program. Dragging files out of a Dired buffer is also +supported, by enabling the user option @code{dired-mouse-drag-files}, +the mouse can be used to drag files onto other programs. When set to +@code{link}, it will make the other program (typically a file manager) +create a symbolic link to the file, and setting it to any other +non-@code{nil} value will make the other program open or create a copy +of the file. diff --git a/etc/NEWS b/etc/NEWS index c20d683710..87fc323990 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -942,6 +942,7 @@ the thumbnail file. ** Dired ++++ *** New user option 'dired-mouse-drag-files'. If non-nil, dragging file names with the mouse in a Dired buffer will initiate a drag-and-drop session allowing them to be opened in other diff --git a/lisp/dired.el b/lisp/dired.el index 2fe30d2a4e..3790197f66 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -252,7 +252,7 @@ The target is used in the prompt for file copy, rename etc." "If non-nil, allow the mouse to drag files from inside a Dired buffer. Dragging the mouse and then releasing it over the window of another program will result in that program opening the file, or -creating a copy of it . +creating a copy of it. If the value is `link', then a symbolic link will be created to the file instead by the other program (usually a file manager)." commit d2ba793ed97c7e759630109033cf729fee14446b Author: Po Lu Date: Sat Mar 19 10:52:27 2022 +0800 * src/xterm.c (XTread_socket): Don't filter GenericEvents. diff --git a/src/xterm.c b/src/xterm.c index 5c5f24e297..b820c102f1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -14510,8 +14510,17 @@ XTread_socket (struct terminal *terminal, struct input_event *hold_quit) #ifdef HAVE_X_I18N /* Filter events for the current X input method. */ - if (x_filter_event (dpyinfo, &event)) - continue; +#ifdef HAVE_XINPUT2 + if (event.type != GenericEvent) + { + /* Input extension key events are filtered inside + handle_one_xevent. */ +#endif + if (x_filter_event (dpyinfo, &event)) + continue; +#ifdef HAVE_XINPUT2 + } +#endif #endif event_found = true; commit 808a6f8f5f86f5c2356585dcf4b495916ed8bf6d Author: Po Lu Date: Sat Mar 19 10:27:19 2022 +0800 Fix some glitches when dragging files from dired * lisp/dired.el (dired-mouse-drag-files): Fix initial values. (dired-mouse-drag): Clear mark if active and only make button release events unread. diff --git a/lisp/dired.el b/lisp/dired.el index da3c3c80cc..2fe30d2a4e 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -257,7 +257,7 @@ creating a copy of it . If the value is `link', then a symbolic link will be created to the file instead by the other program (usually a file manager)." :type '(choice (const :tag "Don't allow dragging" nil) - (const :tag "Copy file to other window" tx) + (const :tag "Copy file to other window" t) (const :tag "Create symbolic link to file" link))) (defcustom dired-copy-preserve-time t @@ -1689,15 +1689,17 @@ see `dired-use-ls-dired' for more details.") (declare-function x-begin-drag "xfns.cx") (defun dired-mouse-drag (event) - "Begin a drag-and-drop operation for the file at EVENT. -If we get a mouse motion event right " + "Begin a drag-and-drop operation for the file at EVENT." (interactive "e") + (when mark-active + (deactivate-mark)) (save-excursion (goto-char (posn-point (event-end event))) (track-mouse (let ((new-event (read-event))) (if (not (eq (event-basic-type new-event) 'mouse-movement)) - (push new-event unread-command-events) + (when (eq (event-basic-type new-event) 'mouse-1) + (push new-event unread-command-events)) ;; We can get an error if there's by some chance no file ;; name at point. (condition-case nil @@ -1709,7 +1711,8 @@ If we get a mouse motion event right " (if (eq 'dired-mouse-drag-files 'link) 'XdndActionLink 'XdndActionCopy))) - (error (push new-event unread-command-events)))))))) + (error (when (eq (event-basic-type new-event) 'mouse-1) + (push new-event unread-command-events))))))))) (defvar dired-mouse-drag-files-map (let ((keymap (make-sparse-keymap))) (define-key keymap [down-mouse-1] #'dired-mouse-drag) commit 1467b04f5cf586c0f44b7df00591986fa8d40c66 Author: Po Lu Date: Sat Mar 19 09:11:09 2022 +0800 Handle composite overlay window during drag and drop sessions * configure.ac: Test for the composite extension and use it if available. * msdos/sed1v2.inp: Update. * src/Makefile.in (XCOMPOSITE_LIBS, XCOMPOSITE_CFLAGS): New variables. (EMACS_CFLAGS, LIBES): Add new libs and cflags. * src/xterm.c (x_dnd_get_target_window): Look for proxy on composite overlay window if mapped. (x_term_init): Test if the composite extension is available. * src/xterm.h (struct x_display_info): New fields for composite extension presence. diff --git a/configure.ac b/configure.ac index bc17935eb1..6e63747733 100644 --- a/configure.ac +++ b/configure.ac @@ -4538,6 +4538,24 @@ fi AC_SUBST(XDBE_CFLAGS) AC_SUBST(XDBE_LIBS) +### Use Xcomposite (-lXcomposite) if available +HAVE_XCOMPOSITE=no +if test "${HAVE_X11}" = "yes"; then + AC_CHECK_HEADER(X11/extensions/Xcomposite.h, + [AC_CHECK_LIB(Xcomposite, XCompositeRedirectWindow, HAVE_XCOMPOSITE=yes)], + [], + [#include + ]) + if test $HAVE_XCOMPOSITE = yes; then + XCOMPOSITE_LIBS=-lXcomposite + fi + if test $HAVE_XCOMPOSITE = yes; then + AC_DEFINE(HAVE_XCOMPOSITE, 1, [Define to 1 if you have the XCOMPOSITE extension.]) + fi +fi +AC_SUBST(XCOMPOSITE_CFLAGS) +AC_SUBST(XCOMPOSITE_LIBS) + ### Use libxml (-lxml2) if available ### mingw32 doesn't use -lxml2, since it loads the library dynamically. HAVE_LIBXML2=no diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index cc29ad0281..24ae079db1 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -117,6 +117,8 @@ s/ *@WEBP_LIBS@// /^XFIXES_CFLAGS *=/s/@XFIXES_CFLAGS@// /^XDBE_LIBS *=/s/@XDBE_LIBS@// /^XDBE_CFLAGS *=/s/@XDBE_CFLAGS@// +/^XCOMPOSITE_LIBS *=/s/@XCOMPOSITE_LIBS@// +/^XCOMPOSITE_CFLAGS *=/s/@XCOMPOSITE_CFLAGS@// /^XINPUT_LIBS *=/s/@XINPUT_LIBS@// /^XINPUT_CFLAGS *=/s/@XINPUT_CFLAGS@// /^XSYNC_LIBS *=/s/@XSYNC_LIBS@// diff --git a/src/Makefile.in b/src/Makefile.in index 2b7c4bb316..0ec2d34264 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -271,6 +271,9 @@ XSYNC_CFLAGS = @XSYNC_CFLAGS@ XDBE_LIBS = @XDBE_LIBS@ XDBE_CFLAGS = @XDBE_CFLAGS@ +XCOMPOSITE_LIBS = @XCOMPOSITE_LIBS@ +XCOMPOSITE_CFLAGS = @XCOMPOSITE_CFLAGS@ + ## widget.o if USE_X_TOOLKIT, otherwise empty. WIDGET_OBJ=@WIDGET_OBJ@ @@ -402,7 +405,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) $(XSYNC_CFLAGS) \ $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ - $(WERROR_CFLAGS) $(HAIKU_CFLAGS) + $(WERROR_CFLAGS) $(HAIKU_CFLAGS) $(XCOMPOSITE_CFLAGS) ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS) ALL_OBJC_CFLAGS = $(EMACS_CFLAGS) \ $(filter-out $(NON_OBJC_CFLAGS),$(WARN_CFLAGS)) $(CFLAGS) \ @@ -559,7 +562,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE) $(LIBIMAGE $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) \ - $(SQLITE3_LIBS) + $(SQLITE3_LIBS) $(XCOMPOSITE_LIBS) ## FORCE it so that admin/unidata can decide whether this file is ## up-to-date. Although since charprop depends on bootstrap-emacs, diff --git a/src/xterm.c b/src/xterm.c index f7047ff0e8..5c5f24e297 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -542,6 +542,10 @@ along with GNU Emacs. If not, see . */ #include #endif +#ifdef HAVE_XCOMPOSITE +#include +#endif + /* Load sys/types.h if not already loaded. In some systems loading it twice is suicidal. */ #ifndef makedev @@ -817,6 +821,10 @@ x_dnd_get_target_window (struct x_display_info *dpyinfo, { Window child_return, child, dummy, proxy; int dest_x_return, dest_y_return, rc, proto; +#if defined HAVE_XCOMPOSITE && (XCOMPOSITE_MAJOR > 0 || XCOMPOSITE_MINOR > 2) + Window overlay_window; + XWindowAttributes attrs; +#endif child_return = dpyinfo->root_window; dest_x_return = root_x; dest_y_return = root_y; @@ -853,7 +861,7 @@ x_dnd_get_target_window (struct x_display_info *dpyinfo, { *proto_out = proto; - x_uncatch_errors_after_check (); + x_uncatch_errors (); return proxy; } } @@ -865,7 +873,7 @@ x_dnd_get_target_window (struct x_display_info *dpyinfo, if (proto != -1) { *proto_out = proto; - x_uncatch_errors_after_check (); + x_uncatch_errors (); return child_return; } @@ -887,8 +895,49 @@ x_dnd_get_target_window (struct x_display_info *dpyinfo, x_uncatch_errors_after_check (); } +#if defined HAVE_XCOMPOSITE && (XCOMPOSITE_MAJOR > 0 || XCOMPOSITE_MINOR > 2) + if (child != dpyinfo->root_window) + { +#endif + *proto_out = x_dnd_get_window_proto (dpyinfo, child); + return child; +#if defined HAVE_XCOMPOSITE && (XCOMPOSITE_MAJOR > 0 || XCOMPOSITE_MINOR > 2) + } + else if (dpyinfo->composite_supported_p + && (dpyinfo->composite_major > 0 + || dpyinfo->composite_minor > 2)) + { + /* Only do this if a compositing manager is present. */ + if (XGetSelectionOwner (dpyinfo->display, + dpyinfo->Xatom_NET_WM_CM_Sn) != None) + { + overlay_window = XCompositeGetOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + XCompositeReleaseOverlayWindow (dpyinfo->display, + dpyinfo->root_window); + XGetWindowAttributes (dpyinfo->display, overlay_window, &attrs); + + if (attrs.map_state == IsViewable) + { + proxy = x_dnd_get_window_proxy (dpyinfo, overlay_window); + + if (proxy != None) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *proto_out = proto; + return proxy; + } + } + } + } + } + *proto_out = x_dnd_get_window_proto (dpyinfo, child); return child; +#endif } static Window @@ -17936,6 +17985,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #ifdef USE_XCB xcb_connection_t *xcb_conn; #endif + char *cm_atom_sprintf; block_input (); @@ -18217,6 +18267,20 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) &dpyinfo->xrender_minor); #endif + /* This must come after XRenderQueryVersion! */ +#ifdef HAVE_XCOMPOSITE + int composite_event_base, composite_error_base; + dpyinfo->composite_supported_p = XCompositeQueryExtension (dpyinfo->display, + &composite_event_base, + &composite_error_base); + + if (dpyinfo->composite_supported_p) + dpyinfo->composite_supported_p + = XCompositeQueryVersion (dpyinfo->display, + &dpyinfo->composite_major, + &dpyinfo->composite_minor); +#endif + /* Put the rdb where we can find it in a way that works on all versions. */ dpyinfo->rdb = xrdb; @@ -18575,6 +18639,15 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->resx = (mm < 1) ? 100 : pixels * 25.4 / mm; } + { + int n = snprintf (NULL, 0, "_NET_WM_CM_S%d", + XScreenNumberOfScreen (dpyinfo->screen)); + cm_atom_sprintf = alloca (n + 1); + + snprintf (cm_atom_sprintf, n + 1, "_NET_WM_CM_S%d", + XScreenNumberOfScreen (dpyinfo->screen)); + } + { static const struct { @@ -18688,7 +18761,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) int i; enum { atom_count = ARRAYELTS (atom_refs) }; /* 1 for _XSETTINGS_SN. */ - enum { total_atom_count = 1 + atom_count }; + enum { total_atom_count = 2 + atom_count }; Atom atoms_return[total_atom_count]; char *atom_names[total_atom_count]; static char const xsettings_fmt[] = "_XSETTINGS_S%d"; @@ -18702,6 +18775,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) sprintf (xsettings_atom_name, xsettings_fmt, XScreenNumberOfScreen (dpyinfo->screen)); atom_names[i] = xsettings_atom_name; + atom_names[i + 1] = cm_atom_sprintf; XInternAtoms (dpyinfo->display, atom_names, total_atom_count, False, atoms_return); @@ -18709,8 +18783,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) for (i = 0; i < atom_count; i++) *(Atom *) ((char *) dpyinfo + atom_refs[i].offset) = atoms_return[i]; - /* Manually copy last atom. */ + /* Manually copy last two atoms. */ dpyinfo->Xatom_xsettings_sel = atoms_return[i]; + dpyinfo->Xatom_NET_WM_CM_Sn = atoms_return[i + 1]; } #ifdef HAVE_XKB diff --git a/src/xterm.h b/src/xterm.h index 9665e92a9f..05d5e08dc0 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -429,6 +429,9 @@ struct x_display_info /* Atom used in XEmbed client messages. */ Atom Xatom_XEMBED, Xatom_XEMBED_INFO; + /* Atom used to determine whether or not the screen is composited. */ + Atom Xatom_NET_WM_CM_Sn; + /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in xfns.c. Note that a mere EnterNotify event can set this; if you need to know the @@ -635,6 +638,12 @@ struct x_display_info #ifdef HAVE_XINERAMA bool xinerama_supported_p; #endif + +#ifdef HAVE_XCOMPOSITE + bool composite_supported_p; + int composite_major; + int composite_minor; +#endif }; #ifdef HAVE_X_I18N commit ae9a0b78080d8c448e3949b257c55c5288d05529 Author: Po Lu Date: Sat Mar 19 07:45:14 2022 +0800 Fix some XIM servers getting confused during drag-and-drop * src/xterm.c (x_dnd_begin_drag_and_drop): Clear XIC while event loop is in progress. (x_filter_event): Return 0 if DND is in progress. (xim_instantiate_callback): Likewise. diff --git a/src/xterm.c b/src/xterm.c index eb2ecf7d65..f7047ff0e8 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1089,6 +1089,10 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, XEvent next_event; int finish; #endif +#ifdef HAVE_X_I18N + XIC ic = FRAME_XIC (f); +#endif + struct input_event hold_quit; char *atom_name; Lisp_Object action, ltimestamp; @@ -1126,6 +1130,12 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, current_count = 0; #endif + block_input (); +#ifdef HAVE_X_I18N + /* Make sure no events get filtered when XInput 2 is enabled. + Otherwise, the ibus XIM server gets very confused. */ + FRAME_XIC (f) = NULL; +#endif while (x_dnd_in_progress) { hold_quit.kind = NO_EVENT; @@ -1134,7 +1144,6 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, current_hold_quit = &hold_quit; #endif - block_input (); #ifndef USE_GTK XNextEvent (FRAME_X_DISPLAY (f), &next_event); @@ -1143,17 +1152,14 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, #else gtk_main_iteration (); #endif - unblock_input (); if (hold_quit.kind != NO_EVENT) { if (x_dnd_in_progress) { - block_input (); if (x_dnd_last_seen_window != None && x_dnd_last_protocol_version != -1) x_dnd_send_leave (f, x_dnd_last_seen_window); - unblock_input (); x_dnd_in_progress = false; x_dnd_frame = NULL; @@ -1164,16 +1170,24 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, #ifdef USE_GTK current_hold_quit = NULL; #endif +#ifdef HAVE_X_I18N + FRAME_XIC (f) = ic; +#endif + unblock_input (); quit (); } } - +#ifdef HAVE_X_I18N + FRAME_XIC (f) = ic; +#endif x_set_dnd_targets (NULL, 0); #ifdef USE_GTK current_hold_quit = NULL; #endif + unblock_input (); + if (x_dnd_return_frame == 3) { x_dnd_return_frame_object->mouse_moved = true; @@ -10205,6 +10219,9 @@ x_filter_event (struct x_display_info *dpyinfo, XEvent *event) f1 = x_any_window_to_frame (dpyinfo, event->xclient.window); + if (x_dnd_in_progress) + return 0; + #ifdef USE_GTK if (!x_gtk_use_native_input && !dpyinfo->prefer_native_input) @@ -15443,6 +15460,9 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_ struct xim_inst_t *xim_inst = (struct xim_inst_t *) client_data; struct x_display_info *dpyinfo = xim_inst->dpyinfo; + if (x_dnd_in_progress) + return; + /* We don't support multiple XIM connections. */ if (dpyinfo->xim) return; commit ab8a34ce8a54539cc9f66892145153312fa2a7fa Author: Stefan Monnier Date: Fri Mar 18 16:07:42 2022 -0400 * lisp/emacs-lisp/bytecomp.el (byte-compile-make-closure): Minor optimization diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c680437f32..c39d931517 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3924,7 +3924,7 @@ discarding." docstring-exp)) ;Otherwise, we don't need a closure. (cl-assert (byte-code-function-p fun)) (byte-compile-form - (if (or (not docstring-exp) (stringp docstring-exp)) + (if (macroexp-const-p docstring-exp) ;; Use symbols V0, V1 ... as placeholders for closure variables: ;; they should be short (to save space in the .elc file), yet ;; distinct when disassembled. @@ -3940,7 +3940,7 @@ discarding." (vconcat dummy-vars (aref fun 2)) (aref fun 3) (if docstring-exp - (cons docstring-exp (cdr opt-args)) + (cons (eval docstring-exp t) (cdr opt-args)) opt-args)))) `(make-closure ,proto-fun ,@env)) ;; Nontrivial doc string expression: create a bytecode object commit ce28de5d3a1293ceaf4317520ec8c3d2095ab947 Author: Stefan Monnier Date: Fri Mar 18 11:59:32 2022 -0400 Pcomplete: Better obey `completion-at-point-functions` Functions on `completion-at-point-functions` should not modify the buffer. Pcomplete itself mostly abides by this but Eshell's use of it doesn't. Try and catch those cases. Also fix one of those cases. * lisp/pcomplete.el (pcomplete-allow-modifications): New var. (pcomplete-completions-at-point): Enforce it. (pcomplete, pcomplete-expand-and-complete, pcomplete-expand): Rebind it since these commands expect the extra side effects. * lisp/eshell/em-cmpl.el (eshell--pcomplete-insert-tab): New function, extracted from `eshell-complete-parse-arguments`. (eshell-complete-parse-arguments): Use it and obey `pcomplete-allow-modifications`. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index b79475f6e0..f4c1302629 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -311,18 +311,24 @@ to writing a completion function." (describe-prefix-bindings) (call-interactively 'pcomplete-help))) +(defun eshell--pcomplete-insert-tab () + (if (not pcomplete-allow-modifications) + (throw 'pcompleted nil) + (insert-and-inherit "\t") + (throw 'pcompleted t))) + (defun eshell-complete-parse-arguments () "Parse the command line arguments for `pcomplete-argument'." (when (and eshell-no-completion-during-jobs (eshell-interactive-process-p)) - (insert-and-inherit "\t") - (throw 'pcompleted t)) + (eshell--pcomplete-insert-tab)) (let ((end (point-marker)) (begin (save-excursion (eshell-bol) (point))) (posns (list t)) args delim) - (when (memq this-command '(pcomplete-expand - pcomplete-expand-and-complete)) + (when (and pcomplete-allow-modifications + (memq this-command '(pcomplete-expand + pcomplete-expand-and-complete))) (run-hook-with-args 'eshell-expand-input-functions begin end) (if (= begin end) (end-of-line)) @@ -335,14 +341,11 @@ to writing a completion function." (setq begin (1+ (cadr delim)) args (eshell-parse-arguments begin end))) ((eq (car delim) ?\() - (eshell-complete-lisp-symbol) - (throw 'pcompleted t)) + (throw 'pcompleted (elisp-completion-at-point))) (t - (insert-and-inherit "\t") - (throw 'pcompleted t)))) + (eshell--pcomplete-insert-tab)))) (when (get-text-property (1- end) 'comment) - (insert-and-inherit "\t") - (throw 'pcompleted t)) + (eshell--pcomplete-insert-tab)) (let ((pos begin)) (while (< pos end) (if (get-text-property pos 'arg-begin) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 289312e0bb..a1492af89d 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -189,6 +189,16 @@ and how is entirely up to the behavior of the `pcomplete-parse-arguments-function'." :type 'boolean) +(defvar pcomplete-allow-modifications nil + "If non-nil, allow effects in `pcomplete-parse-arguments-function'. +For the `pcomplete' command, it was common for functions in +`pcomplete-parse-arguments-function' to make modifications to the +buffer, like expanding variables are such. +For `completion-at-point-functions', this is not an option any more, so +this variable is used to tell `pcomplete-parse-arguments-function' +whether it can do the modifications like it used to, or whether +it should refrain from doing so.") + (defcustom pcomplete-parse-arguments-function #'pcomplete-parse-buffer-arguments "A function to call to parse the current line's arguments. @@ -392,6 +402,9 @@ Same as `pcomplete' but using the standard completion UI." ;; imposing the pcomplete UI over the standard UI. (catch 'pcompleted (let* ((pcomplete-stub) + (buffer-read-only + ;; Make sure the function obeys `pcomplete-allow-modifications'. + (if pcomplete-allow-modifications buffer-read-only t)) pcomplete-seen pcomplete-norm-func pcomplete-args pcomplete-last pcomplete-index (pcomplete-autolist pcomplete-autolist) @@ -526,6 +539,7 @@ completion functions list (it should occur fairly early in the list)." pcomplete-last-completion-raw nil) (catch 'pcompleted (let* ((pcomplete-stub) + (pcomplete-allow-modifications t) pcomplete-seen pcomplete-norm-func pcomplete-args pcomplete-last pcomplete-index (pcomplete-autolist pcomplete-autolist) @@ -551,7 +565,8 @@ completion functions list (it should occur fairly early in the list)." "Expand the textual value of the current argument. This will modify the current buffer." (interactive) - (let ((pcomplete-expand-before-complete t)) + (let ((pcomplete-expand-before-complete t) + (pcomplete-allow-modifications t)) (with-suppressed-warnings ((obsolete pcomplete)) (pcomplete)))) @@ -569,6 +584,7 @@ This will modify the current buffer." This will modify the current buffer." (interactive) (let ((pcomplete-expand-before-complete t) + (pcomplete-allow-modifications t) (pcomplete-expand-only-p t)) (with-suppressed-warnings ((obsolete pcomplete)) (pcomplete)) commit f51e12feceae18f0b6715142a4e61d6522f79389 Author: Stefan Monnier Date: Fri Mar 18 11:51:46 2022 -0400 * lisp/gnus/mail-source.el (mail-source-set-1): Fix indent and simplify diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 5d0c0e2654..04de70bf0f 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -413,7 +413,7 @@ the `mail-source-keyword-map' variable." (let* ((type (pop source)) (defaults (cdr (assq type mail-source-keyword-map))) (search '(:max 1)) - found default value keyword user-auth pass-auth) ;; auth-info + found default keyword user-auth pass-auth) ;; auth-info ;; append to the search the useful info from the source and the defaults: ;; user, host, and port @@ -440,22 +440,22 @@ the `mail-source-keyword-map' variable." ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL ;; using `mail-source-value' to evaluate the plist value (set (mail-source-strip-keyword (setq keyword (car default))) - ;; note the following reasons for this structure: + ;; Note the following reasons for this structure: ;; 1) the auth-sources user and password override everything ;; 2) it avoids macros, so it's cleaner ;; 3) it falls through to the mail-sources and then default values (cond ((and - (eq keyword :user) - (setq user-auth - (plist-get - ;; cache the search result in `found' - (or found - (setq found (nth 0 (apply #'auth-source-search - search)))) - :user))) + (eq keyword :user) + (setq user-auth + (plist-get + ;; cache the search result in `found' + (or found + (setq found (nth 0 (apply #'auth-source-search + search)))) + :user))) user-auth) - ((and ; cf. 'auth-source-pick-first-password' + ((and ; cf. 'auth-source-pick-first-password' (eq keyword :password) (setq pass-auth (plist-get @@ -468,9 +468,8 @@ the `mail-source-keyword-map' variable." (if (functionp pass-auth) (setq pass-auth (funcall pass-auth)) pass-auth)) - (t (if (setq value (plist-get source keyword)) - (mail-source-value value) - (mail-source-value (cadr default))))))))) + (t (mail-source-value (or (plist-get source keyword) + (cadr default))))))))) (eval-and-compile (defun mail-source-bind-common-1 () commit 4d61badad15e8213c84798b85f10868fc48b94ee Author: Mattias Engdegård Date: Fri Mar 18 13:58:36 2022 +0100 Speed up fixnum printing Use the new number-to-string code to speed up fixnum printing, with similar results (often more than twice as fast as before). * src/data.c (Fnumber_to_string): Move fixnum conversion to... (fixnum_to_string): ... this new function. * src/lisp.h: (fixnum_to_string): External declaration. * src/print.c (print_object): Use fixnum_to_string instead of sprintf. diff --git a/src/data.c b/src/data.c index 6eda008970..23b0e7c29d 100644 --- a/src/data.c +++ b/src/data.c @@ -2968,6 +2968,29 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) return val; } +/* Render NUMBER in decimal into BUFFER which ends right before END. + Return the start of the string; the end is always at END. + The string is not null-terminated. */ +char * +fixnum_to_string (EMACS_INT number, char *buffer, char *end) +{ + EMACS_INT x = number; + bool negative = x < 0; + if (negative) + x = -x; + char *p = end; + do + { + eassume (p > buffer && p - 1 < end); + *--p = '0' + x % 10; + x /= 10; + } + while (x); + if (negative) + *--p = '-'; + return p; +} + DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, doc: /* Return the decimal representation of NUMBER as a string. Uses a minus sign if negative. @@ -2978,21 +3001,8 @@ NUMBER may be an integer or a floating point number. */) if (FIXNUMP (number)) { - EMACS_INT x = XFIXNUM (number); - bool negative = x < 0; - if (negative) - x = -x; char *end = buffer + sizeof buffer; - char *p = end; - do - { - eassume (p > buffer && p - 1 < buffer + sizeof buffer); - *--p = '0' + x % 10; - x /= 10; - } - while (x); - if (negative) - *--p = '-'; + char *p = fixnum_to_string (XFIXNUM (number), buffer, end); return make_unibyte_string (p, end - p); } diff --git a/src/lisp.h b/src/lisp.h index 21709b1259..e4d156c0f4 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -622,6 +622,7 @@ extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object default_value (Lisp_Object symbol); extern void defalias (Lisp_Object symbol, Lisp_Object definition); +extern char *fixnum_to_string (EMACS_INT number, char *buffer, char *end); /* Defined in emacs.c. */ diff --git a/src/print.c b/src/print.c index 704fc278f2..4a68d15fe0 100644 --- a/src/print.c +++ b/src/print.c @@ -2060,8 +2060,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } else { - int len = sprintf (buf, "%"pI"d", i); - strout (buf, len, len, printcharfun); + char *end = buf + sizeof buf; + char *start = fixnum_to_string (i, buf, end); + ptrdiff_t len = end - start; + strout (start, len, len, printcharfun); } } break; commit c4596c8522e221ecff847a4d997c133436b07e1a (refs/remotes/origin/emacs-28) Author: Eli Zaretskii Date: Fri Mar 18 13:54:46 2022 +0200 Fix a regression in 'decipher-digram-list' * lisp/play/decipher.el (decipher-stats-buffer): Don't assume the statistics buffer always exists. (Bug#54443) diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index ae44ecd681..aeb4726bb9 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -983,13 +983,14 @@ if it can't, it signals an error." decipher-stats-buffer) ;; Create a new buffer if requested: (create - (let ((stats-name (concat "*" (buffer-name) "*"))) + (let* ((stats-name (concat "*" (buffer-name) "*")) + (buf (get-buffer stats-name))) (setq decipher-stats-buffer - (if (eq 'decipher-stats-mode - (buffer-local-value 'major-mode - (get-buffer stats-name))) - ;; We just lost track of the statistics buffer: - (get-buffer stats-name) + (if (and (bufferp buf) + (eq 'decipher-stats-mode + (buffer-local-value 'major-mode buf))) + buf + ;; We just lost track of the statistics buffer: (generate-new-buffer stats-name)))) (with-current-buffer decipher-stats-buffer (decipher-stats-mode)) commit 499f2085fa6fce6c7a2868c8d27d465f43d53f0f Author: Michael Albinus Date: Fri Mar 18 12:25:32 2022 +0100 Make application configurable in 'with-connection-local-variables' * doc/lispref/variables.texi (Connection Local Variables): Explain 'connection-local-default-application'. * etc/NEWS: Mention 'connection-local-default-application'. * lisp/files-x.el (connection-local-default-application): New variable. (connection-local-criteria-for-default-directory): Use it. (Bug#54405) * test/lisp/files-x-tests.el (files-x-test-with-connection-local-variables): Extend test. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index d991ae9e27..cd39e6b647 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2418,6 +2418,37 @@ are unwound. Example: @end example @end defmac +@defvar connection-local-default-application +The default application, a symbol, to be applied in +@code{with-connection-local-variables}. It defaults to @code{tramp}, +but in case you want to overwrite Tramp's settings temporarily, you +could let-bind it like + +@example +@group +(connection-local-set-profile-variables + 'my-remote-perl + '((perl-command-name . "/usr/local/bin/perl5") + (perl-command-switch . "-e %s"))) +@end group + +@group +(connection-local-set-profiles + '(:application 'my-app :protocol "ssh" :machine "remotehost") + 'my-remote-perl) +@end group + +@group +(let ((default-directory "/ssh:remotehost:/working/dir/") + (connection-local-default-application 'my-app)) + (with-connection-local-variables + do something useful)) +@end group +@end example + +This variable must not be changed globally. +@end defvar + @defvar enable-connection-local-variables If @code{nil}, connection-local variables are ignored. This variable shall be changed temporarily only in special modes. diff --git a/etc/NEWS b/etc/NEWS index e2546bb3ca..c20d683710 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -269,12 +269,22 @@ defaults to t, which makes Emacs use the toolkit tooltips. The existing GTK-specific option 'x-gtk-use-system-tooltips' is now an alias of this new option. +** Connection-local variables + +++ -** Some connection-local variables are now user options. +*** Some connection-local variables are now user options. The variables 'connection-local-profile-alist' and 'connection-local-criteria-alist' are now user options, in order to make it more convenient to inspect and modify them. ++++ +*** The default connection-local application can be changed temporarily. +Running 'with-connection-local-variables' defaults to application +'tramp'. This can be changed by let-binding +'connection-local-default-application' to another symbol. This is +useful when running code in a buffer, where Tramp has already set some +connection local variables. + --- ** New minor mode 'pixel-scroll-precision-mode'. When enabled, and if your mouse supports it, you can scroll the @@ -647,7 +657,7 @@ It narrows to the current node. +++ *** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'. -Rename 'eudc-expansion-overwrites-query' to +'eudc-expansion-overwrites-query' is renamed to 'eudc-expansion-save-query-as-kill' to reflect the actual behaviour of the customization variable. @@ -933,7 +943,7 @@ the thumbnail file. ** Dired *** New user option 'dired-mouse-drag-files'. -If non-nil, dragging filenames with the mouse in a Dired buffer will +If non-nil, dragging file names with the mouse in a Dired buffer will initiate a drag-and-drop session allowing them to be opened in other programs. @@ -1000,7 +1010,7 @@ and friends. --- *** Tramp supports abbreviating remote home directories now. -When calling 'abbreviate-file-name' on a Tramp filename, the result +When calling 'abbreviate-file-name' on a Tramp file name, the result will abbreviate the user's home directory, for example by abbreviating "/ssh:user@host:/home/user" to "/ssh:user@host:~". diff --git a/lisp/files-x.el b/lisp/files-x.el index 319bfe0565..0ae9fb076e 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -722,14 +722,18 @@ will not be changed." (copy-tree connection-local-variables-alist))) (hack-local-variables-apply))) +(defvar connection-local-default-application 'tramp + "Default application in connection-local functions, a symbol. +This variable must not be changed globally.") + (defsubst connection-local-criteria-for-default-directory (&optional application) "Return a connection-local criteria, which represents `default-directory'. -If APPLICATION is nil, the symbol `tramp' is used." +If APPLICATION is nil, `connection-local-default-application' is used." (when (file-remote-p default-directory) - `(:application ,(or application 'tramp) - :protocol ,(file-remote-p default-directory 'method) - :user ,(file-remote-p default-directory 'user) - :machine ,(file-remote-p default-directory 'host)))) + `(:application ,(or application connection-local-default-application) + :protocol ,(file-remote-p default-directory 'method) + :user ,(file-remote-p default-directory 'user) + :machine ,(file-remote-p default-directory 'host)))) ;;;###autoload (defmacro with-connection-local-variables (&rest body) diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 60787e1cd3..7ee2f0c1a6 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -325,6 +325,9 @@ (should-not (boundp 'remote-shell-file-name)) (should (string-equal (symbol-value 'remote-null-device) "null")) + (connection-local-set-profiles + files-x-test--application 'remote-bash) + (with-connection-local-variables ;; All connection-local variables are set. They apply in ;; reverse order in `connection-local-variables-alist'. @@ -344,6 +347,21 @@ (should (local-variable-p 'remote-shell-file-name)) (should (local-variable-p 'remote-null-device)) ;; The proper variable values are set. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")) + (should + (string-equal (symbol-value 'remote-null-device) "/dev/null")) + + ;; Run another instance of `with-connection-local-variables' + ;; with a different application. + (let ((connection-local-default-application (cadr files-x-test--application))) + (with-connection-local-variables + ;; The proper variable values are set. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash")) + (should + (string-equal (symbol-value 'remote-null-device) "/dev/null")))) + ;; The variable values are reset. (should (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")) (should commit ce26657b5d7e77d851ed9267d554f4f48e43a0b6 Author: Mattias Engdegård Date: Fri Mar 18 11:43:10 2022 +0100 Speed up number-to-string for fixnums Do the binary-to-decimal conversion by hand for fixnums instead of calling sprintf. This results in a noticeable speed increase (on my machine, 2.2× faster excluding GC). * src/data.c (Fnumber_to_string): Don't use sprintf for fixnums. diff --git a/src/data.c b/src/data.c index 1526cc0c73..6eda008970 100644 --- a/src/data.c +++ b/src/data.c @@ -2975,19 +2975,35 @@ NUMBER may be an integer or a floating point number. */) (Lisp_Object number) { char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))]; - int len; - CHECK_NUMBER (number); + if (FIXNUMP (number)) + { + EMACS_INT x = XFIXNUM (number); + bool negative = x < 0; + if (negative) + x = -x; + char *end = buffer + sizeof buffer; + char *p = end; + do + { + eassume (p > buffer && p - 1 < buffer + sizeof buffer); + *--p = '0' + x % 10; + x /= 10; + } + while (x); + if (negative) + *--p = '-'; + return make_unibyte_string (p, end - p); + } if (BIGNUMP (number)) return bignum_to_string (number, 10); if (FLOATP (number)) - len = float_to_string (buffer, XFLOAT_DATA (number)); - else - len = sprintf (buffer, "%"pI"d", XFIXNUM (number)); + return make_unibyte_string (buffer, + float_to_string (buffer, XFLOAT_DATA (number))); - return make_unibyte_string (buffer, len); + wrong_type_argument (Qnumberp, number); } DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0, commit 2b05a06786e7b5adf9d4329959da49d9b40c2bef Author: Po Lu Date: Fri Mar 18 09:21:39 2022 +0000 Implement drag-and-drop of files on Haiku * lisp/term/haiku-win.el (haiku-dnd-selection-converters): Add new selection converter. (haiku-dnd-convert-uri-list): New function. (x-begin-drag): Allow selection converters to change message field type. * src/haikuselect.c (haiku_lisp_to_message): Perform more error checking. diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 83f70edd2c..632177f843 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -48,13 +48,18 @@ (defvar haiku-dnd-selection-value nil "The local value of the special `XdndSelection' selection.") -(defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string)) +(defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string) + (text/uri-list . haiku-dnd-convert-uri-list)) "Alist of X selection types to functions that act as selection converters. The functions should accept a single argument VALUE, describing the value of the drag-and-drop selection, and return a list of two elements TYPE and DATA, where TYPE is a string containing the MIME type of DATA, and DATA is a unibyte string, or nil if the -data could not be converted.") +data could not be converted. + +DATA can optionally have a text property `type', which specifies +the type of DATA inside the system message (see the doc string of +`haiku-drag-message' for more details).") (defun haiku-dnd-convert-string (value) "Convert VALUE to a UTF-8 string and appropriate MIME type. @@ -64,6 +69,12 @@ VALUE as a unibyte string, or nil if VALUE was not a string." (list "text/plain" (string-to-unibyte (encode-coding-string value 'utf-8))))) +(defun haiku-dnd-convert-uri-list (value) + "Convert VALUE to a file system reference if it is a file name." + (when (and (stringp value) + (file-exists-p value)) + (list "refs" (propertize (expand-file-name value) 'type 'ref)))) + (declare-function x-open-connection "haikufns.c") (declare-function x-handle-args "common-win") (declare-function haiku-selection-data "haikuselect.c") @@ -199,9 +210,12 @@ take effect on menu items until the menu bar is updated again." (let ((field (cdr (assoc (car selection-result) message)))) (unless (cadr field) ;; Add B_MIME_TYPE to the message if the type was not - ;; previously defined. - (push 1296649541 (alist-get (car selection-result) message - nil nil #'equal)))) + ;; previously specified, or the type if it was. + (push (or (get-text-property 0 'type + (cadr selection-result)) + 1296649541) + (alist-get (car selection-result) message + nil nil #'equal)))) (push (cadr selection-result) (cdr (alist-get (car selection-result) message nil nil #'equal)))))))) diff --git a/src/haikuselect.c b/src/haikuselect.c index 807cbc2493..8192a1ad5b 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -351,6 +351,7 @@ haiku_lisp_to_message (Lisp_Object obj, void *message) int8 char_data; bool bool_data; intmax_t t4; + int rc; CHECK_LIST (obj); for (tem = obj; CONSP (tem); tem = XCDR (tem)) @@ -390,10 +391,13 @@ haiku_lisp_to_message (Lisp_Object obj, void *message) short_data = XFIXNUM (data); block_input (); - be_add_message_data (message, SSDATA (name), - type_code, &short_data, - sizeof short_data); + rc = be_add_message_data (message, SSDATA (name), + type_code, &short_data, + sizeof short_data); unblock_input (); + + if (rc) + signal_error ("Failed to add short", data); break; case 'LONG': @@ -417,10 +421,13 @@ haiku_lisp_to_message (Lisp_Object obj, void *message) } block_input (); - be_add_message_data (message, SSDATA (name), - type_code, &long_data, - sizeof long_data); + rc = be_add_message_data (message, SSDATA (name), + type_code, &long_data, + sizeof long_data); unblock_input (); + + if (rc) + signal_error ("Failed to add long", data); break; case 'LLNG': @@ -443,10 +450,13 @@ haiku_lisp_to_message (Lisp_Object obj, void *message) } block_input (); - be_add_message_data (message, SSDATA (name), - type_code, &llong_data, - sizeof llong_data); + rc = be_add_message_data (message, SSDATA (name), + type_code, &llong_data, + sizeof llong_data); unblock_input (); + + if (rc) + signal_error ("Failed to add llong", data); break; case 'CHAR': @@ -456,30 +466,39 @@ haiku_lisp_to_message (Lisp_Object obj, void *message) char_data = XFIXNUM (data); block_input (); - be_add_message_data (message, SSDATA (name), - type_code, &char_data, - sizeof char_data); + rc = be_add_message_data (message, SSDATA (name), + type_code, &char_data, + sizeof char_data); unblock_input (); + + if (rc) + signal_error ("Failed to add char", data); break; case 'BOOL': bool_data = !NILP (data); block_input (); - be_add_message_data (message, SSDATA (name), - type_code, &bool_data, - sizeof bool_data); + rc = be_add_message_data (message, SSDATA (name), + type_code, &bool_data, + sizeof bool_data); unblock_input (); + + if (rc) + signal_error ("Failed to add bool", data); break; default: CHECK_STRING (data); block_input (); - be_add_message_data (message, SSDATA (name), - type_code, SDATA (data), - SBYTES (data)); + rc = be_add_message_data (message, SSDATA (name), + type_code, SDATA (data), + SBYTES (data)); unblock_input (); + + if (rc) + signal_error ("Failed to add", data); } } CHECK_LIST_END (t2, t1);