commit 5fb262597f9eba4d90667e5c24581e93b5516edc (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Mon Feb 14 07:12:17 2022 +0000 Handle allocation failures of fringe bitmaps on Haiku * src/haikuterm.c (haiku_define_fringe_bitmap): Handle allocation failures. diff --git a/src/haikuterm.c b/src/haikuterm.c index 9d128f6a6a..4547380783 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2292,8 +2292,12 @@ haiku_define_fringe_bitmap (int which, unsigned short *bits, fringe_bmps[i++] = NULL; } + block_input (); fringe_bmps[which] = BBitmap_new (wd, h, 1); + if (!fringe_bmps[which]) + memory_full (SIZE_MAX); BBitmap_import_fringe_bitmap (fringe_bmps[which], bits, wd, h); + unblock_input (); } static void commit 0ba1ecc816fc2235ec57bc01ffa799a94aed4a39 Author: Po Lu Date: Mon Feb 14 14:05:46 2022 +0800 * etc/TODO: Update some entires related to macOS and NS. Xwidgets have worked on NS for a long time, "smooth scrolling" is now available as `pixel-scroll-precision-mode' for all GUI platforms, and some mouse gestures have been implemented on NS and X. diff --git a/etc/TODO b/etc/TODO index 80e77bba60..2f23d410a7 100644 --- a/etc/TODO +++ b/etc/TODO @@ -907,17 +907,17 @@ It would make it easy to add (and remove) mappings like *** Missing features This sections contains features found in other official Emacs ports. -**** Support for xwidgets -Emacs 25 has support for xwidgets, a system to include operating -system components into an Emacs buffer. The components range from -simple buttons to webkit (effectively, a web browser). +**** Improved xwidgets support +Emacs 25 has support for xwidgets, a system to include WebKit widgets +into an Emacs buffer. -Currently, xwidgets work only for the gtk+ framework but they are -designed to be compatible with multiple Emacs ports. +They work on NS, but not very well. For example, trying to display a +xwidget in the "killed" state will make Emacs crash. This is because +the NS code has not been updated to keep with recent changes to the +X11 and GTK code. -(See the scratch/nsxwidget branch, and the discussion around -Objective-C code and GCC at -https://lists.gnu.org/r/emacs-devel/2019-08/msg00072.html ) +Many features such as xwidget-webkit-edit-mode do not work correctly +on NS either. **** Respect 'frame-inhibit-implied-resize' When the variable 'frame-inhibit-implied-resize' is non-nil, frames @@ -990,29 +990,16 @@ It has been maintained in parallel to the official Cocoa-based NS interface. The Carbon interface has been enhanced, and a number of the features of that interface could be implemented NS. -**** Smooth scrolling -- maybe not a good idea -Today, by default, scrolling with a trackpad makes the text move in -steps of one line. (Scrolling with SHIFT scrolls horizontally.) - -The "mac" port provides smooth, pixel-based, scrolling. This is a very -popular feature. However, there are drawbacks to this method: what -happens if only a fraction of a line is visible at the top of a -window, is the partially visible text considered part of the window or -not? (Technically, what should 'window-start' return.) - -Note: This feature might not be allowed to be implemented until also -implemented in Emacs for a free system. - **** Mouse gestures The "mac" port defines the gestures 'swipe-left/right/up/down', 'magnify-up/down', and 'rotate-left/right'. -It also binds the magnification commands to change the font -size. (This should be not be done in a specific interface, instead -Emacs should do this binding globally.) +The magnify gestures have now been implemented on X11 and NS. The +event is named differently: it is named `pinch', but it does the same +thing. -Note: This feature might not be allowed to be implemented until also -implemented in Emacs for a free system. +Someone needs to figure out what the other gestures do in the Mac +port, implement them on X, and then following that, on NS. **** Synthesize bold fonts commit 32fbda5c37d7c11201df8232c1cc6e2b5d88791e Author: Po Lu Date: Mon Feb 14 13:13:13 2022 +0800 Ensure bad values don't leak into scroll valuators after DeviceChange * src/xterm.c (xi_reset_scroll_valuators_for_device_id): New argument `pending_only'. (handle_one_xevent): Reset pending scroll valuators on XI_Enter and mark valuators updated via DeviceChanged events as pending. * src/xterm.h (struct xi_scroll_valuator_t): New field `pending_enter_reset'. diff --git a/src/xterm.c b/src/xterm.c index 98c8a22408..9cde6c9a68 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -791,7 +791,8 @@ xi_find_touch_point (struct xi_device_t *device, int detail) #endif /* XI_TouchBegin */ static void -xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id) +xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id, + bool pending_only) { struct xi_device_t *device = xi_device_from_id (dpyinfo, id); struct xi_scroll_valuator_t *valuator; @@ -805,6 +806,11 @@ xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id) for (int i = 0; i < device->scroll_valuator_count; ++i) { valuator = &device->valuators[i]; + + if (pending_only && !valuator->pending_enter_reset) + continue; + + valuator->pending_enter_reset = false; valuator->invalid_p = true; valuator->emacs_value = 0.0; } @@ -10853,6 +10859,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!any) any = x_any_window_to_frame (dpyinfo, enter->event); + xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid, + true); + { #ifdef HAVE_XWIDGETS struct xwidget_view *xwidget_view = xwidget_view_from_window (enter->event); @@ -10916,7 +10925,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, moves out of a frame (and not into one of its children, which we know about). */ if (leave->detail != XINotifyInferior && any) - xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid); + xi_reset_scroll_valuators_for_device_id (dpyinfo, + enter->deviceid, false); #ifdef HAVE_XWIDGETS { @@ -11937,6 +11947,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, { device->valuators[i].invalid_p = false; device->valuators[i].current_value = info->value; + + /* Make sure that this is reset if the + pointer moves into a window of ours. + + Otherwise the valuator state could be + left invalid if the DeviceChange + event happened with the pointer + outside any Emacs frame. */ + device->valuators[i].pending_enter_reset = true; } } } diff --git a/src/xterm.h b/src/xterm.h index 99c86ced56..f58fa0fe54 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -184,6 +184,7 @@ struct color_name_cache_entry struct xi_scroll_valuator_t { bool invalid_p; + bool pending_enter_reset; double current_value; double emacs_value; double increment; commit 80f8dd654014aff065df76095aedfd09c21faf92 Author: Po Lu Date: Mon Feb 14 11:51:22 2022 +0800 Restore valuator values after receiving a DeviceChanged event * src/xterm.c (x_init_master_valuators): Generate valuators for both master and slave devices. (handle_one_xevent): Find current valuator info and use that to populate scroll valuators after a device changed. diff --git a/src/xterm.c b/src/xterm.c index 198aaa69e5..98c8a22408 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -631,16 +631,13 @@ x_init_master_valuators (struct x_display_info *dpyinfo) (XIScrollClassInfo *) device->classes[c]; struct xi_scroll_valuator_t *valuator; - if (xi_device->master_p) - { - valuator = &xi_device->valuators[actual_valuator_count++]; - valuator->horizontal - = (info->scroll_type == XIScrollTypeHorizontal); - valuator->invalid_p = true; - valuator->emacs_value = DBL_MIN; - valuator->increment = info->increment; - valuator->number = info->number; - } + valuator = &xi_device->valuators[actual_valuator_count++]; + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; break; } @@ -11872,9 +11869,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, { struct xi_device_t *device; struct xi_touch_point_t *tem, *last; - int c; + int c, i; - device = xi_device_from_id (dpyinfo, device_changed->sourceid); + device = xi_device_from_id (dpyinfo, device_changed->deviceid); if (!device) emacs_abort (); @@ -11894,20 +11891,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef XIScrollClass case XIScrollClass: { - XIScrollClassInfo *info = - (XIScrollClassInfo *) device_changed->classes[c]; + XIScrollClassInfo *info; + + info = (XIScrollClassInfo *) device_changed->classes[c]; struct xi_scroll_valuator_t *valuator; - if (device->master_p) - { - valuator = &device->valuators[device->scroll_valuator_count++]; - valuator->horizontal - = (info->scroll_type == XIScrollTypeHorizontal); - valuator->invalid_p = true; - valuator->emacs_value = DBL_MIN; - valuator->increment = info->increment; - valuator->number = info->number; - } + valuator = &device->valuators[device->scroll_valuator_count++]; + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; break; } @@ -11927,6 +11922,27 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } +#ifdef XIScrollClass + for (c = 0; c < device_changed->num_classes; ++c) + { + if (device_changed->classes[c]->type == XIValuatorClass) + { + XIValuatorClassInfo *info; + + info = (XIValuatorClassInfo *) device_changed->classes[c]; + + for (i = 0; i < device->scroll_valuator_count; ++i) + { + if (device->valuators[i].number == info->number) + { + device->valuators[i].invalid_p = false; + device->valuators[i].current_value = info->value; + } + } + } + } +#endif + /* The device is no longer a DirectTouch device, so remove any touchpoints that we might have recorded. */ commit 1bf30718dd1e4284af285e4a92c336f512564f01 Author: Po Lu Date: Mon Feb 14 11:16:38 2022 +0800 Improve efficency of handling DeviceChanged events * src/xterm.c (handle_one_xevent): Just update the device that was changed on DeviceChanged and only do hierarchy recalculation upon HierarchyChanged events. diff --git a/src/xterm.c b/src/xterm.c index a17b445701..198aaa69e5 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10783,6 +10783,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XIEnterEvent *enter = (XIEnterEvent *) xi_event; XIFocusInEvent *focusin = (XIFocusInEvent *) xi_event; XIFocusOutEvent *focusout = (XIFocusOutEvent *) xi_event; + XIDeviceChangedEvent *device_changed = (XIDeviceChangedEvent *) xi_event; XIValuatorState *states; double *values; bool found_valuator = false; @@ -11861,17 +11862,91 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; case XI_PropertyEvent: + goto XI_OTHER; + case XI_HierarchyChanged: - case XI_DeviceChanged: -#ifdef XISlaveSwitch - if (xi_event->evtype == XI_DeviceChanged - && (((XIDeviceChangedEvent *) xi_event)->reason - == XISlaveSwitch)) - goto XI_OTHER; -#endif x_init_master_valuators (dpyinfo); goto XI_OTHER; + case XI_DeviceChanged: + { + struct xi_device_t *device; + struct xi_touch_point_t *tem, *last; + int c; + + device = xi_device_from_id (dpyinfo, device_changed->sourceid); + + if (!device) + emacs_abort (); + + /* Free data that we will regenerate from new + information. */ + device->valuators = xrealloc (device->valuators, + (device_changed->num_classes + * sizeof *device->valuators)); + device->scroll_valuator_count = 0; + device->direct_p = false; + + for (c = 0; c < device_changed->num_classes; ++c) + { + switch (device_changed->classes[c]->type) + { +#ifdef XIScrollClass + case XIScrollClass: + { + XIScrollClassInfo *info = + (XIScrollClassInfo *) device_changed->classes[c]; + struct xi_scroll_valuator_t *valuator; + + if (device->master_p) + { + valuator = &device->valuators[device->scroll_valuator_count++]; + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; + } + + break; + } +#endif + +#ifdef XITouchClass + case XITouchClass: + { + XITouchClassInfo *info; + + info = (XITouchClassInfo *) device_changed->classes[c]; + device->direct_p = info->mode == XIDirectTouch; + } +#endif + default: + break; + } + } + + /* The device is no longer a DirectTouch device, so + remove any touchpoints that we might have + recorded. */ + if (!device->direct_p) + { + tem = device->touchpoints; + + while (tem) + { + last = tem; + tem = tem->next; + xfree (last); + } + + device->touchpoints = NULL; + } + + goto XI_OTHER; + } + #ifdef XI_TouchBegin case XI_TouchBegin: { commit 27658a0a3b311ad38b87b9981c6e7b9aaae40728 Author: Po Lu Date: Mon Feb 14 09:52:05 2022 +0800 Try to reduce empty areas on GTK when a frame is being resized * src/xterm.c (x_fill_rectangle): (x_clear_rectangle, x_draw_image_glyph_string): (x_clear_area): Don't use picture if frame background is opaque. diff --git a/src/xterm.c b/src/xterm.c index b8d0a2b58b..a17b445701 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1390,6 +1390,7 @@ x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height, #else #if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) if (respect_alpha_background + && f->alpha_background != 1.0 && FRAME_DISPLAY_INFO (f)->alpha_bits && FRAME_CHECK_XR_VERSION (f, 0, 2)) { @@ -1432,6 +1433,7 @@ x_clear_rectangle (struct frame *f, GC gc, int x, int y, int width, int height, #else #if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) if (respect_alpha_background + && f->alpha_background != 1.0 && FRAME_DISPLAY_INFO (f)->alpha_bits && FRAME_CHECK_XR_VERSION (f, 0, 2)) { @@ -4255,6 +4257,7 @@ x_draw_image_glyph_string (struct glyph_string *s) XGCValues xgcv; #if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) if (FRAME_DISPLAY_INFO (s->f)->alpha_bits + && s->f->alpha_background != 1.0 && FRAME_CHECK_XR_VERSION (s->f, 0, 2) && FRAME_X_PICTURE_FORMAT (s->f)) { @@ -4939,6 +4942,7 @@ x_clear_area (struct frame *f, int x, int y, int width, int height) x_xr_ensure_picture (f); if (FRAME_DISPLAY_INFO (f)->alpha_bits && FRAME_X_PICTURE (f) != None + && f->alpha_background != 1.0 && FRAME_CHECK_XR_VERSION (f, 0, 2)) { XRenderColor xc; commit 2fe4d93624e3b1084a12bba27e6ff9a212fc8117 Author: Po Lu Date: Mon Feb 14 01:34:09 2022 +0000 Fix wide fringe bitmap processing on Haiku * src/haiku_support.cc (BBitmap_import_mono_bits): Rewrite to use ImportBits. (BBitmap_import_fringe_bitmap): New function. * src/haiku_support.h: Update prototypes. * src/haikuterm.c (haiku_define_fringe_bitmap): Pass entire short array to BBitmap_import_fringe_bitmap instead. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 5feb56b9f9..ced680d2e5 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -2187,21 +2187,40 @@ BView_mouse_moved (void *view, int x, int y, uint32_t transit) } } -/* Import BITS into BITMAP using the B_GRAY1 colorspace. */ +/* Import fringe bitmap (short array, low bit rightmost) BITS into + BITMAP using the B_GRAY1 colorspace. */ void -BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h) +BBitmap_import_fringe_bitmap (void *bitmap, unsigned short *bits, int wd, int h) { BBitmap *bmp = (BBitmap *) bitmap; unsigned char *data = (unsigned char *) bmp->Bits (); - unsigned short *bts = (unsigned short *) bits; + int i; - for (int i = 0; i < (h * (wd / 8)); i++) + for (i = 0; i < h; i++) { - *((unsigned short *) data) = bts[i]; + if (wd <= 8) + data[0] = bits[i] & 0xff; + else + { + data[1] = bits[i] & 0xff; + data[0] = bits[i] >> 8; + } + data += bmp->BytesPerRow (); } } +void +BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h) +{ + BBitmap *bmp = (BBitmap *) bitmap; + + if (wd % 8) + wd += 8 - (wd % 8); + + bmp->ImportBits (bits, wd / 8 * h, wd / 8, 0, B_GRAY1); +} + /* Make a scrollbar at X, Y known to the view VIEW. */ void BView_publish_scroll_bar (void *view, int x, int y, int width, int height) diff --git a/src/haiku_support.h b/src/haiku_support.h index e6560f401a..c9035d3dc0 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -631,6 +631,10 @@ extern "C" extern void BView_mouse_up (void *view, int x, int y); + extern void + BBitmap_import_fringe_bitmap (void *bitmap, unsigned short *bits, + int wd, int h); + extern void BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h); diff --git a/src/haikuterm.c b/src/haikuterm.c index f129eba0cc..9d128f6a6a 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2293,7 +2293,7 @@ haiku_define_fringe_bitmap (int which, unsigned short *bits, } fringe_bmps[which] = BBitmap_new (wd, h, 1); - BBitmap_import_mono_bits (fringe_bmps[which], bits, wd, h); + BBitmap_import_fringe_bitmap (fringe_bmps[which], bits, wd, h); } static void commit bd07d4fac9da40cecf6a5936fd4b4c8ebb751586 Author: Michael Albinus Date: Sun Feb 13 20:50:51 2022 +0100 Improve Tramp's process-file implementations * lisp/net/tramp-adb.el (tramp-adb-handle-process-file) * lisp/net/tramp-sh.el (tramp-sh-handle-process-file): * lisp/net/tramp-smb.el (tramp-smb-handle-process-file): * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file): Improve implementation. (Bug#53854) * test/lisp/net/tramp-tests.el (tramp-test28-process-file) (tramp--test-check-files, tramp-test47-unload): Extend tests. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 85cd2d9bc1..c683f4c6e8 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -818,7 +818,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (tramp-file-local-name infile)) + (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) @@ -849,7 +849,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar (cdr destination) (expand-file-name (cadr destination))) (if (tramp-equal-remote default-directory (cadr destination)) ;; stderr is on the same remote host. - (setq stderr (tramp-file-local-name (cadr destination))) + (setq stderr (tramp-unquote-file-local-name (cadr destination))) ;; stderr must be copied to remote host. The temporary ;; file must be deleted after execution. (setq stderr (tramp-make-tramp-temp-file v) @@ -1264,7 +1264,7 @@ connection if a previous connection has died for some reason." (if (zerop (length device)) (tramp-error vec 'file-error "Device %s not connected" host)) (with-tramp-progress-reporter vec 3 "Opening adb shell connection" - (let* ((coding-system-for-read 'utf-8-dos) ;is this correct? + (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? (process-connection-type tramp-process-connection-type) (args (if (> (length host) 0) (list "-s" device "shell") diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ea089224ae..40ddf106c9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3118,7 +3118,7 @@ implementation will be used." (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (tramp-file-local-name infile)) + (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) @@ -3149,7 +3149,7 @@ implementation will be used." (setcar (cdr destination) (expand-file-name (cadr destination))) (if (tramp-equal-remote default-directory (cadr destination)) ;; stderr is on the same remote host. - (setq stderr (tramp-file-local-name (cadr destination))) + (setq stderr (tramp-unquote-file-local-name (cadr destination))) ;; stderr must be copied to remote host. The temporary ;; file must be deleted after execution. (setq stderr (tramp-make-tramp-temp-file v) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 6515519680..f52fa0a93b 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1284,7 +1284,7 @@ component is used as the target of the symlink." (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (tramp-file-local-name infile)) + (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 664dbc31b1..3f23b1a878 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -240,12 +240,13 @@ arguments to pass to the OPERATION." (error "Implementation does not handle immediate return")) (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((command + (let ((coding-system-for-read 'utf-8-dos) ; Is this correct? + (command (format "cd %s && exec %s" (tramp-unquote-shell-quote-argument localname) (mapconcat #'tramp-shell-quote-argument (cons program args) " "))) - input tmpinput) + input tmpinput stderr tmpstderr outbuf) ;; Determine input. (if (null infile) @@ -253,18 +254,55 @@ arguments to pass to the OPERATION." (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (tramp-file-local-name infile)) + (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) (copy-file infile tmpinput t))) (when input (setq command (format "%s <%s" command input))) + ;; Determine output. + (cond + ;; Just a buffer. + ((bufferp destination) + (setq outbuf destination)) + ;; A buffer name. + ((stringp destination) + (setq outbuf (get-buffer-create destination))) + ;; (REAL-DESTINATION ERROR-DESTINATION) + ((consp destination) + ;; output. + (cond + ((bufferp (car destination)) + (setq outbuf (car destination))) + ((stringp (car destination)) + (setq outbuf (get-buffer-create (car destination)))) + ((car destination) + (setq outbuf (current-buffer)))) + ;; stderr. + (cond + ((stringp (cadr destination)) + (setcar (cdr destination) (expand-file-name (cadr destination))) + (if (tramp-equal-remote default-directory (cadr destination)) + ;; stderr is on the same remote host. + (setq stderr (tramp-unquote-file-local-name (cadr destination))) + ;; stderr must be copied to remote host. The temporary + ;; file must be deleted after execution. + (setq stderr (tramp-make-tramp-temp-file v) + tmpstderr (tramp-make-tramp-file-name v stderr)))) + ;; stderr to be discarded. + ((null (cadr destination)) + (setq stderr (tramp-get-remote-null-device v))))) + ;; 't + (destination + (setq outbuf (current-buffer)))) + (when stderr (setq command (format "%s 2>%s" command stderr))) + (unwind-protect (apply #'tramp-call-process v (tramp-get-method-parameter v 'tramp-login-program) - nil destination display + nil outbuf display (tramp-expand-args v 'tramp-login-args ?h (or (tramp-file-name-host v) "") @@ -272,6 +310,15 @@ arguments to pass to the OPERATION." ?p (or (tramp-file-name-port v) "") ?l command)) + ;; Synchronize stderr. + (when tmpstderr + (tramp-cleanup-connection v 'keep-debug 'keep-password) + (tramp-fuse-unmount v)) + + ;; Provide error file. + (when tmpstderr + (rename-file tmpstderr (cadr destination) t)) + ;; Cleanup. We remove all file cache values for the ;; connection, because the remote process could have changed ;; them. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d78e8815b2..baddcd2d7a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4398,6 +4398,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) (fnnd (file-name-nondirectory tmp-name)) (default-directory tramp-test-temporary-file-directory) + (buffer (get-buffer-create "*tramp-tests*")) kill-buffer-query-functions) (unwind-protect (progn @@ -4430,31 +4431,47 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp--test-shell-file-name) nil nil nil "-c" "kill -2 $$"))))) - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (should (zerop (process-file "ls" nil t nil fnnd))) - ;; "ls" could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should (string-equal (format "%s\n" fnnd) (buffer-string))) - (should-not (get-buffer-window (current-buffer) t)) + ;; Check DESTINATION. + (dolist (destination `(nil t ,buffer)) + (when (bufferp destination) + (with-current-buffer destination + (delete-region (point-min) (point-max)))) + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (should (zerop (process-file "ls" nil destination nil fnnd))) + (with-current-buffer + (if (bufferp destination) destination (current-buffer)) + ;; "ls" could produce colorized output. + (goto-char (point-min)) + (while (re-search-forward + tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should + (string-equal (if destination (format "%s\n" fnnd) "") + (buffer-string))) + (should-not (get-buffer-window (current-buffer) t)) + (goto-char (point-max))) + + ;; Second run. The output must be appended. + (should (zerop (process-file "ls" nil destination t fnnd))) + (with-current-buffer + (if (bufferp destination) destination (current-buffer)) + ;; "ls" could produce colorized output. + (goto-char (point-min)) + (while (re-search-forward + tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should + (string-equal + (if destination (format "%s\n%s\n" fnnd fnnd) "") + (buffer-string)))) - ;; Second run. The output must be appended. - (goto-char (point-max)) - (should (zerop (process-file "ls" nil t t fnnd))) - ;; "ls" could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) - ;; A non-nil DISPLAY must not raise the buffer. - (should-not (get-buffer-window (current-buffer) t)) - (delete-file tmp-name)) + (unless (eq destination t) + (should (string-empty-p (buffer-string)))) + ;; A non-nil DISPLAY must not raise the buffer. + (should-not (get-buffer-window (current-buffer) t)) + (delete-file tmp-name))) ;; Check remote and local INFILE. (dolist (local '(nil t)) @@ -4464,10 +4481,37 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-exists-p tmp-name)) (should (zerop (process-file "cat" tmp-name t))) (should (string-equal "foo" (buffer-string))) - (should-not (get-buffer-window (current-buffer) t))) - (delete-file tmp-name))) + (should-not (get-buffer-window (current-buffer) t)) + (delete-file tmp-name))) + + ;; Check remote and local DESTNATION file. This isn't + ;; implemented yet ina all file name handler backends. + ;; (dolist (local '(nil t)) + ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) + ;; (should + ;; (zerop (process-file "echo" nil `(:file ,tmp-name) nil "foo"))) + ;; (with-temp-buffer + ;; (insert-file-contents tmp-name) + ;; (should (string-equal "foo" (buffer-string))) + ;; (should-not (get-buffer-window (current-buffer) t)) + ;; (delete-file tmp-name))) + + ;; Check remote and local STDERR. + (dolist (local '(nil t)) + (setq tmp-name (tramp--test-make-temp-name local quoted)) + (should-not + (zerop + (process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist"))) + (with-temp-buffer + (insert-file-contents tmp-name) + (should + (string-match-p + "cat:.* No such file or directory" (buffer-string))) + (should-not (get-buffer-window (current-buffer) t)) + (delete-file tmp-name)))) ;; Cleanup. + (ignore-errors (kill-buffer buffer)) (ignore-errors (delete-file tmp-name)))))) ;; Must be a command, because used as `sigusr1' handler. @@ -6479,7 +6523,13 @@ This requires restrictions of file name syntax." ;; `default-directory' with special characters. See ;; Bug#53846. (when (and (tramp--test-expensive-test-p) - (tramp--test-supports-processes-p)) + (tramp--test-supports-processes-p) + ;; Prior Emacs 27, `shell-file-name' was + ;; hard coded as "/bin/sh" for remote + ;; processes in Emacs. That doesn't work + ;; for tramp-adb.el. + (or (not (tramp--test-adb-p)) + (tramp--test-emacs27-p))) (let ((default-directory file1)) (dolist (this-shell-command (append @@ -7207,17 +7257,20 @@ Since it unloads Tramp, it shall be the last test to run." (should (featurep 'tramp-archive)) ;; This unloads also tramp-archive.el and tramp-theme.el if needed. (unload-feature 'tramp 'force) - ;; No Tramp feature must be left. + + ;; No Tramp feature must be left except the test packages. (should-not (featurep 'tramp)) (should-not (featurep 'tramp-archive)) (should-not (featurep 'tramp-theme)) (should-not (all-completions "tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features)))) + ;; `file-name-handler-alist' must be clean. (should-not (all-completions "tramp" (mapcar #'cdr file-name-handler-alist))) + ;; There shouldn't be left a bound symbol, except buffer-local - ;; variables, and autoload functions. We do not regard our test + ;; variables, and autoloaded functions. We do not regard our test ;; symbols, and the Tramp unload hooks. (mapatoms (lambda (x) @@ -7231,6 +7284,7 @@ Since it unloads Tramp, it shall be the last test to run." (not (string-match-p "unload-hook$" (symbol-name x))) (not (get x 'tramp-autoload)) (ert-fail (format "`%s' still bound" x))))) + ;; The defstruct `tramp-file-name' and all its internal functions ;; shall be purged. (should-not (cl--find-class 'tramp-file-name)) @@ -7239,6 +7293,7 @@ Since it unloads Tramp, it shall be the last test to run." (and (functionp x) (string-match-p "tramp-file-name" (symbol-name x)) (ert-fail (format "Structure function `%s' still exists" x))))) + ;; There shouldn't be left a hook function containing a Tramp ;; function. We do not regard the Tramp unload hooks. (mapatoms @@ -7248,7 +7303,18 @@ Since it unloads Tramp, it shall be the last test to run." (not (string-match-p "unload-hook$" (symbol-name x))) (consp (symbol-value x)) (ignore-errors (all-completions "tramp" (symbol-value x))) - (ert-fail (format "Hook `%s' still contains Tramp function" x)))))) + (ert-fail (format "Hook `%s' still contains Tramp function" x))))) + + ;; There shouldn't be left an advice function from Tramp. + (mapatoms + (lambda (x) + (and (functionp x) + (advice-mapc + (lambda (fun _symbol) + (and (string-match-p "^tramp" (symbol-name fun)) + (ert-fail + (format "Function `%s' still contains Tramp advice" x)))) + x))))) (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]. commit fc44bc6255733fa99e00932ca515f400b9c67aec Author: Juri Linkov Date: Sun Feb 13 20:44:14 2022 +0200 * lisp/faces.el (read-face-name-sample-text): Add defconst (bug#53960). (read-face-name): Use it instead of hard-coded string. diff --git a/lisp/faces.el b/lisp/faces.el index b765522914..3a434b3251 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1065,6 +1065,9 @@ of the default face. Value is FACE." (defvar crm-separator) ; from crm.el +(defconst read-face-name-sample-text "SAMPLE" + "Text string to display as the sample text for `read-face-name'.") + (defun read-face-name (prompt &optional default multiple) "Read one or more face names, prompting with PROMPT. PROMPT should not end in a space or a colon. @@ -1115,7 +1118,9 @@ returned. Otherwise, DEFAULT is returned verbatim." (mapcar (lambda (face) (list face - (concat (propertize "SAMPLE" 'face face) "\t") + (concat (propertize read-face-name-sample-text + 'face face) + "\t") "")) faces)))) aliasfaces nonaliasfaces faces) commit 997dd86a9f6a253e4542d65b17dfec6af2f4e8fd Author: Lars Ingebrigtsen Date: Sun Feb 13 16:29:26 2022 +0100 Add a new macro `setopt' * doc/emacs/custom.texi (Examining): Mention it. (Init Syntax): Ditto. * doc/emacs/windows.texi (Window Choice): Adjust example. * doc/lispref/windows.texi (Choosing Window Options): Adjust examples. * doc/lispref/variables.texi (Setting Variables): Document setopt. * doc/misc/eudc.texi (Emacs-only Configuration): Adjust examples. * lisp/cus-edit.el (setopt): New macro. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index b2dd5eb698..c4f112d668 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -844,6 +844,21 @@ otherwise stated, affects only the current Emacs session. The only way to alter the variable in future sessions is to put something in your initialization file (@pxref{Init File}). + If you're setting a customizable variable in your initialization +file, and you don't want to use the Customize interface, you can use +the @code{setopt} macro. For instance: + +@findex setopt +@example +(setopt fill-column 75) +@end example + +This works the same as @code{setq}, but if the variable has any +special setter functions, they will be run automatically when using +@code{setopt}. You can also use @code{setopt} on other, +non-customizable variables, but this is less efficient than using +@code{setq}. + @node Hooks @subsection Hooks @cindex hook @@ -2338,8 +2353,8 @@ mode when you set them with Customize, but ordinary @code{setq} won't do that; to enable the mode in your init file, call the minor mode command. Finally, a few customizable user options are initialized in complex ways, and these have to be set either via the customize -interface (@pxref{Customization}) or by using -@code{customize-set-variable} (@pxref{Examining}). +interface (@pxref{Customization}), or by using +@code{customize-set-variable}/@code{setopt} (@pxref{Examining}). The second argument to @code{setq} is an expression for the new value of the variable. This can be a constant, a variable, or a @@ -2492,7 +2507,7 @@ Change the coding system used when using the clipboard (@pxref{Communication Coding}). @example -(customize-set-variable 'selection-coding-system 'utf-8) +(setopt selection-coding-system 'utf-8) @end example @item diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index 4a3862562c..4537f8157e 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -442,8 +442,8 @@ selected window write: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*scratch\\*" (display-buffer-same-window)))) @end group @end example @@ -468,8 +468,8 @@ Lisp Reference Manual}) as follows: @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '((display-buffer-reuse-window display-buffer-pop-up-frame) (reusable-frames . 0))) @end group @@ -535,8 +535,8 @@ the following form in your initialization file (@pxref{Init File}): @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*Completions\\*" display-buffer-below-selected))) @end group @end example diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index b9de92a29e..8b5f50562e 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -861,6 +861,33 @@ error is signaled. @end example @end defun +@defmac setopt [symbol form]@dots{} +This is like @code{setq} (see above), but meant for user options. +This macro uses the Customize machinery to set the variable(s). In +particular, @code{setopt} will run the setter function associated with +the variable. For instance, if you have: + +@example +(defcustom my-var 1 + "My var." + :type 'number + :set (lambda (var val) + (set-default var val) + (message "We set %s to %s" var val))) +@end example + +Then the following, in addition to setting @code{my-var} to @samp{2}, +will also issue a message: + +@example +(setop my-var 2) +@end example + +@code{setopt} can be used on regular, non-user option variables, but +is much less efficient than @code{setq}. The main use case for this +macro is setting user options in the user's init file. +@end defmac + @node Watching Variables @section Running a function when a variable is changed. @cindex variable watchpoints diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index bbf8988e5c..43f222d57f 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3377,8 +3377,8 @@ functions it should try instead as, for example: @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '((display-buffer-reuse-window display-buffer-same-window display-buffer-in-previous-window display-buffer-use-some-window))) @@ -3392,8 +3392,8 @@ Instead of customizing this variable to @code{t}, customize @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '((display-buffer-reuse-window display-buffer-pop-up-frame) (reusable-frames . 0))) @end group @@ -3409,8 +3409,8 @@ specifying the action function @code{display-buffer-same-window}. @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist (cons '("\\*foo\\*" (display-buffer-same-window)) display-buffer-alist)) @end group @@ -3483,8 +3483,8 @@ another frame. Such a user might provide the following customization: @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '((display-buffer-reuse-window display-buffer-pop-up-frame) (reusable-frames . 0))) @end group @@ -3529,8 +3529,8 @@ In fact, this: @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '(display-buffer-pop-up-frame (reusable-frames . 0))) @end group @end example @@ -3586,8 +3586,8 @@ by customizing the option @code{display-buffer-alist} as follows: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-reuse-window display-buffer-pop-up-frame)))) @end group @@ -3609,8 +3609,8 @@ we would have to specify that separately, however: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-reuse-window display-buffer-pop-up-frame) (reusable-frames . visible)))) @@ -3716,8 +3716,8 @@ written that as @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-reuse-window display-buffer-pop-up-frame) (inhibit-same-window . t) @@ -3860,8 +3860,8 @@ follows: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-below-selected display-buffer-at-bottom) (inhibit-same-window . t) @@ -3874,8 +3874,8 @@ To add a customization for a second buffer one would then write: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-below-selected display-buffer-at-bottom) (inhibit-same-window . t) diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index e9cf4cfade..7c37ae5505 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -286,14 +286,14 @@ LDAP: @lisp (with-eval-after-load "message" (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) -(customize-set-variable 'eudc-server-hotlist - '(("" . bbdb) - ("ldaps://ldap.gnu.org" . ldap))) -(customize-set-variable 'ldap-host-parameters-alist - '(("ldaps://ldap.gnu.org" - base "ou=people,dc=gnu,dc=org" - binddn "gnu\\emacsuser" - passwd ldap-password-read))) +(setopt eudc-server-hotlist + '(("" . bbdb) + ("ldaps://ldap.gnu.org" . ldap))) +(setopt 'ldap-host-parameters-alist + '(("ldaps://ldap.gnu.org" + base "ou=people,dc=gnu,dc=org" + binddn "gnu\\emacsuser" + passwd ldap-password-read))) @end lisp @findex ldap-password-read @@ -342,12 +342,12 @@ configure EUDC for LDAP: @lisp (with-eval-after-load "message" (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) -(customize-set-variable 'eudc-server-hotlist - '(("" . bbdb) - ("ldaps://ldap.gnu.org" . ldap))) -(customize-set-variable 'ldap-host-parameters-alist - '(("ldaps://ldap.gnu.org" - auth-source t))) +(setopt 'eudc-server-hotlist + '(("" . bbdb) + ("ldaps://ldap.gnu.org" . ldap))) +(setopt 'ldap-host-parameters-alist + '(("ldaps://ldap.gnu.org" + auth-source t))) @end lisp For this example where we only care about one server, the server name @@ -371,10 +371,10 @@ and the @file{.emacs} expressions become: @lisp (with-eval-after-load "message" (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) -(customize-set-variable 'eudc-server-hotlist - '(("" . bbdb) ("" . ldap))) -(customize-set-variable 'ldap-host-parameters-alist - '(("" auth-source t))) +(setopt 'eudc-server-hotlist + '(("" . bbdb) ("" . ldap))) +(setopt 'ldap-host-parameters-alist + '(("" auth-source t))) @end lisp @node Troubleshooting diff --git a/etc/NEWS b/etc/NEWS index 6f5edfafc5..0f956f18a2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1092,6 +1092,11 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** New macro 'setopt'. +This is like 'setq', but uses 'customize-set-variable' to set the +variable(s). + +++ ** New utility predicate 'mode-line-window-selected-p'. This is meant to be used from ':eval' mode line constructs to create diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index ff70f6724a..bb7ffc1eae 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1044,6 +1044,29 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (put variable 'customized-variable-comment comment))) value) +;;;###autoload +(defmacro setopt (&rest pairs) + "Set VARIABLE/VALUE pairs, and return the final VALUE. +This is like `setq', but is meant for user options instead of +plain variables. This means that `setopt' will execute any +Customize form associated with VARIABLE. + +If VARIABLE has a `custom-set' property, that is used for setting +VARIABLE, otherwise `set-default' is used. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + (let ((expr nil)) + (while pairs + (unless (symbolp (car pairs)) + (error "Attempting to set a non-symbol: %s" (car pairs))) + (push `(customize-set-variable ',(car pairs) ,(cadr pairs)) + expr) + (setq pairs (cddr pairs))) + (macroexp-progn (nreverse expr)))) + ;;;###autoload (defun customize-save-variable (variable value &optional comment) "Set the default for VARIABLE to VALUE, and save it for future sessions. commit 68b32732140606a1eddce82f50733c549a40900a Author: Eli Zaretskii Date: Sun Feb 13 15:05:13 2022 +0200 ; * lisp/simple.el (count-words): Doc fix. diff --git a/lisp/simple.el b/lisp/simple.el index bd1138ac85..695871db50 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1486,11 +1486,11 @@ START and END." If called interactively, START and END are normally the start and end of the buffer; but if the region is active, START and END are the start and end of the region. Print a message reporting the -number of lines, words, and chars. If given a prefix, also -include the data for the total (un-narrowed) buffer. +number of lines, words, and chars. With prefix argument, also +include the data for the entire (un-narrowed) buffer. If called from Lisp, return the number of words between START and -END, without printing any message. TOTAL is ignored when called +END, without printing any message. TOTALS is ignored when called from Lisp." (interactive (list nil nil current-prefix-arg)) ;; When called from Lisp, return the data. commit 7a702cfd42da6231435f25578866f050e47d043b Author: Po Lu Date: Sun Feb 13 12:15:21 2022 +0000 * src/haikuterm.c (haiku_read_socket): Implement auto-lower. diff --git a/src/haikuterm.c b/src/haikuterm.c index 3de215bc88..f129eba0cc 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2771,6 +2771,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) need_flush = 1; } + if (f->auto_lower) + haiku_frame_raise_lower (f, 0); + haiku_new_focus_frame (x_display_list->focused_frame); if (any_help_event_p) commit 7e612a26a8697a984980f15a8ffefd90e8c34d36 Author: Po Lu Date: Sun Feb 13 19:50:20 2022 +0800 Only get rid of IC focus if focus is really gone * src/xterm.c (x_focus_changed): Only unset IC focus if the focus state is empty. diff --git a/src/xterm.c b/src/xterm.c index fe213b0fab..b8d0a2b58b 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5559,17 +5559,21 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra XSETFRAME (bufp->frame_or_window, frame); } + if (!frame->output_data.x->focus_state) + { #ifdef HAVE_X_I18N - if (FRAME_XIC (frame)) - XUnsetICFocus (FRAME_XIC (frame)); + if (FRAME_XIC (frame)) + XUnsetICFocus (FRAME_XIC (frame)); #ifdef USE_GTK - if (x_gtk_use_native_input) - { - gtk_im_context_focus_out (FRAME_X_OUTPUT (frame)->im_context); - gtk_im_context_set_client_window (FRAME_X_OUTPUT (frame)->im_context, NULL); - } + if (x_gtk_use_native_input) + { + gtk_im_context_focus_out (FRAME_X_OUTPUT (frame)->im_context); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (frame)->im_context, NULL); + } #endif #endif + } + if (frame->pointer_invisible) XTtoggle_invisible_pointer (frame, false); } commit c189ce5a33d93dd74529a6ad091f55b5ef60ac19 Author: Lars Ingebrigtsen Date: Sun Feb 13 11:23:43 2022 +0100 Remove the 'C-k' binding in ido-mode * lisp/ido.el (ido-file-completion-map): Remove the `C-k' binding, because it's too dangerous and probably not very useful (bug#44556). diff --git a/etc/NEWS b/etc/NEWS index 169208d94f..6f5edfafc5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -103,6 +103,14 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 +--- +** 'C-k' no longer deletes files in 'ido-mode'. +To get the previous action back, put something like the following in +your init file: + + (require 'ido) + (keymap-set ido-file-completion-map "C-k" #'ido-delete-file-at-head) + --- ** New user option 'term-clear-full-screen-programs'. By default, term will now work like most terminals when displaying diff --git a/lisp/ido.el b/lisp/ido.el index 58cec3deb0..e068028d91 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -978,7 +978,6 @@ The fallback command is passed as an argument to the functions." (defvar-keymap ido-file-completion-map :doc "Keymap for Ido file commands." :parent ido-file-dir-completion-map - "C-k" #'ido-delete-file-at-head "C-o" #'ido-copy-current-word "C-w" #'ido-copy-current-file-name "M-l" #'ido-toggle-literal) commit 6ed1994d277541035a507481aede6892bb55018c Author: Po Lu Date: Sun Feb 13 18:19:51 2022 +0800 Prevent crashes from illegal locale coding systems * src/xfns.c (xic_preedit_draw_callback): * src/xterm.c (handle_one_xevent): Don't pass invalid coding systems to `setup_coding_system'. diff --git a/src/xfns.c b/src/xfns.c index 02994e1b94..c490dc1802 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -3198,6 +3198,14 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data, if (!output->preedit_active) return; + /* If we don't bail out here then GTK can crash + from the resulting signal in `setup_coding_system'. */ + if (NILP (Fcoding_system_p (Vlocale_coding_system))) + { + text = NULL; + goto im_abort; + } + if (call_data->text) text = x_xim_text_to_utf8_unix (call_data->text, &text_length); else diff --git a/src/xterm.c b/src/xterm.c index 50b7c9a606..fe213b0fab 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10024,6 +10024,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (nchars < nbytes) { + /* If we don't bail out here then GTK can crash + from the resulting signal in `setup_coding_system'. */ + if (NILP (Fcoding_system_p (coding_system))) + goto done_keysym; + /* Decode the input data. */ /* The input should be decoded with `coding_system' @@ -11763,6 +11768,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (nchars < nbytes) { + /* If we don't bail out here then GTK can crash + from the resulting signal in `setup_coding_system'. */ + if (NILP (Fcoding_system_p (Vlocale_coding_system))) + goto xi_done_keysym; + /* Decode the input data. */ setup_coding_system (Vlocale_coding_system, &coding); commit 242a2765d3970641887be7a6dedcc14b07fade7e Author: Lars Ingebrigtsen Date: Sun Feb 13 10:56:20 2022 +0100 Make `C-u M-x count-words' also give totals * lisp/simple.el (count-words-region): Adjust callers. (count-words): If given a prefix, give totals (bug#9959). (count-words--buffer-format, count-words--format): Rename and don't message, but return the string. diff --git a/etc/NEWS b/etc/NEWS index 1b0e26da9b..169208d94f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -144,6 +144,9 @@ An autoload definition appears just as a '(defun . NAME)' and the * Changes in Emacs 29.1 +--- +** 'count-lines' will now report buffer totals if given a prefix. + --- ** New user option 'find-library-include-other-files'. If set to nil, commands like 'find-library' will only include library diff --git a/lisp/simple.el b/lisp/simple.el index af51c99b28..bd1138ac85 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1477,46 +1477,59 @@ START and END." (cond ((not (called-interactively-p 'any)) (count-words start end)) (arg - (count-words--buffer-message)) + (message "%s" (count-words--buffer-format))) (t - (count-words--message "Region" start end)))) + (message "%s" (count-words--format "Region" start end))))) -(defun count-words (start end) +(defun count-words (start end &optional totals) "Count words between START and END. If called interactively, START and END are normally the start and end of the buffer; but if the region is active, START and END are the start and end of the region. Print a message reporting the -number of lines, words, and chars. +number of lines, words, and chars. If given a prefix, also +include the data for the total (un-narrowed) buffer. If called from Lisp, return the number of words between START and -END, without printing any message." - (interactive (list nil nil)) - (cond ((not (called-interactively-p 'any)) - (let ((words 0) - ;; Count across field boundaries. (Bug#41761) - (inhibit-field-text-motion t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (forward-word-strictly 1) - (setq words (1+ words))))) - words)) - ((use-region-p) - (call-interactively 'count-words-region)) - (t - (count-words--buffer-message)))) - -(defun count-words--buffer-message () - (count-words--message +END, without printing any message. TOTAL is ignored when called +from Lisp." + (interactive (list nil nil current-prefix-arg)) + ;; When called from Lisp, return the data. + (if (not (called-interactively-p 'any)) + (let ((words 0) + ;; Count across field boundaries. (Bug#41761) + (inhibit-field-text-motion t)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (forward-word-strictly 1) + (setq words (1+ words))))) + words) + ;; When called interactively, message the data. + (let ((totals (if (and totals + (or (use-region-p) + (buffer-narrowed-p))) + (save-restriction + (widen) + (count-words--format "; buffer in total" + (point-min) (point-max))) + ""))) + (if (use-region-p) + (message "%s%s" (count-words--format + "Region" (region-beginning) (region-end)) + totals) + (message "%s%s" (count-words--buffer-format) totals))))) + +(defun count-words--buffer-format () + (count-words--format (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer") (point-min) (point-max))) -(defun count-words--message (str start end) +(defun count-words--format (str start end) (let ((lines (count-lines start end)) (words (count-words start end)) (chars (- end start))) - (message "%s has %d line%s, %d word%s, and %d character%s." + (format "%s has %d line%s, %d word%s, and %d character%s" str lines (if (= lines 1) "" "s") words (if (= words 1) "" "s") commit eba9e30f9af68a657eeddedb33e30d9967ad9dbe Author: Lars Ingebrigtsen Date: Sun Feb 13 10:12:27 2022 +0100 Note meaning on nil HIST in Fread_from_minibuffer * src/minibuf.c (Fread_from_minibuffer): Note the meaning of a nil HIST parameter (bug#20063). diff --git a/src/minibuf.c b/src/minibuf.c index bab8830646..49a474dd49 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1292,8 +1292,9 @@ Fifth arg HIST, if non-nil, specifies a history list and optionally HISTPOS is the initial position for use by the minibuffer history commands. For consistency, you should also specify that element of the history as the value of INITIAL-CONTENTS. Positions are counted - starting from 1 at the beginning of the list. If HIST is t, history - is not recorded. + starting from 1 at the beginning of the list. If HIST is nil, the + default history list `minibuffer-history' is used. If HIST is t, + history is not recorded. If `history-add-new-input' is non-nil (the default), the result will be added to the history list using `add-to-history'. commit 9a4cc857aa0f04b353990be6fc968c6dc765399c Author: Lars Ingebrigtsen Date: Sun Feb 13 09:35:55 2022 +0100 Fix mouse clicking in read-face-name * lisp/faces.el (read-face-name): Put the data in the right position so that clicking on completions work (bug#53960). diff --git a/lisp/faces.el b/lisp/faces.el index 5e0be11828..b765522914 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1114,10 +1114,9 @@ returned. Otherwise, DEFAULT is returned verbatim." (lambda (faces) (mapcar (lambda (face) - (list (concat (propertize "SAMPLE" 'face face) - "\t") - "" - face)) + (list face + (concat (propertize "SAMPLE" 'face face) "\t") + "")) faces)))) aliasfaces nonaliasfaces faces) ;; Build up the completion tables. commit 51d44fd705a2779beeb3fe1d59af88caadbc247a Author: Bob Rogers Date: Sun Feb 13 09:32:13 2022 +0100 Fix ietf-drums-remove-whitespace unmatched " and ( * lisp/mail/ietf-drums.el: + (ietf-drums-skip-comment): New helper function. + (ietf-drums-remove-comments): Use ietf-drums-skip-comment. + (ietf-drums-remove-whitespace): Handle unterminated quotes and comments, as ietf-drums-remove-comments already does. * test/lisp/mail/ietf-drums-tests.el: + Test unterminated quote and comment for ietf-drums-remove-whitespace and ietf-drums-remove-comments (bug#53965). diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index db77aba172..85aa27235f 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -65,6 +65,21 @@ backslash and doublequote.") (modify-syntax-entry ?\' "_" table) table)) +(defvar ietf-drums-comment-syntax-table + (let ((table (copy-syntax-table ietf-drums-syntax-table))) + (modify-syntax-entry ?\" "w" table) + table) + "In comments, DQUOTE is normal and does not start a string.") + +(defun ietf-drums--skip-comment () + ;; From just before the start of a comment, go to the end. Returns + ;; point. If the comment is unterminated, go to point-max. + (condition-case () + (with-syntax-table ietf-drums-comment-syntax-table + (forward-sexp 1)) + (scan-error (goto-char (point-max)))) + (point)) + (defun ietf-drums-token-to-list (token) "Translate TOKEN into a list of characters." (let ((i 0) @@ -109,14 +124,7 @@ backslash and doublequote.") (forward-sexp 1) (error (goto-char (point-max))))) ((eq c ?\() - (delete-region - (point) - (condition-case nil - (with-syntax-table (copy-syntax-table ietf-drums-syntax-table) - (modify-syntax-entry ?\" "w") - (forward-sexp 1) - (point)) - (error (point-max))))) + (delete-region (point) (ietf-drums--skip-comment))) (t (forward-char 1)))) (buffer-string)))) @@ -130,9 +138,11 @@ backslash and doublequote.") (setq c (char-after)) (cond ((eq c ?\") - (forward-sexp 1)) + (condition-case () + (forward-sexp 1) + (scan-error (goto-char (point-max))))) ((eq c ?\() - (forward-sexp 1)) + (ietf-drums--skip-comment)) ((memq c '(?\ ?\t ?\n ?\r)) (delete-char 1)) (t diff --git a/test/lisp/mail/ietf-drums-tests.el b/test/lisp/mail/ietf-drums-tests.el index 4cc38b8763..b13937bf73 100644 --- a/test/lisp/mail/ietf-drums-tests.el +++ b/test/lisp/mail/ietf-drums-tests.el @@ -40,6 +40,16 @@ (should (equal (ietf-drums-remove-comments "random (first) (second (and)) (third) not fourth") "random not fourth")) + ;; Test some unterminated comments. + (should (equal (ietf-drums-remove-comments "test an (unterminated comment") + "test an ")) + (should (equal (ietf-drums-remove-comments "test an \"unterminated quote") + ;; returns the string unchanged (and doesn't barf). + "test an \"unterminated quote")) + (should (equal (ietf-drums-remove-comments + ;; note that double-quote is not special. + "test (unterminated comments with \"quoted (\" )stuff") + "test ")) ;; ietf-drums-remove-whitespace (should (equal (ietf-drums-remove-whitespace "random string") @@ -53,6 +63,12 @@ (should (equal (ietf-drums-remove-whitespace "random (first) (second (and)) (third) not fourth") "random(first)(second (and))(third)notfourth")) + ;; Test some unterminated comments and quotes. + (should (equal (ietf-drums-remove-whitespace + "random (first) (second (and)) (third unterminated") + "random(first)(second (and))(third unterminated")) + (should (equal (ietf-drums-remove-whitespace "random \"non terminated string") + "random\"non terminated string")) ;; ietf-drums-strip (should (equal (ietf-drums-strip "random string") "randomstring")) commit ae13948ff52c91b4a8188be6a2cc8d65b440731c Author: Andreas Schwab Date: Sun Feb 13 09:10:25 2022 +0100 * src/eval.c (specpdl_unrewind): Remove empty statement. diff --git a/src/eval.c b/src/eval.c index 3e384fc28b..7472e649af 100644 --- a/src/eval.c +++ b/src/eval.c @@ -4106,7 +4106,7 @@ specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only) non-local, this is fine, but if it ever reverts to being local we may end up using this entry "in the wrong direction". */ - {}; + {} } break; }