commit a95c43976f7cbe571bf404c24574c9a5399f235e (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Fri Feb 25 08:05:11 2022 +0000 Improve tracking of modified regions on Haiku * src/haiku_support.cc (class EmacsView): New field `invalid_region'. (FlipBuffers): Only invalidate that region. (SetUpDoubleBuffering): Clear that region. (BView_draw_lock): New parameters for denoting the region to invalidate. (BView_invalidate_region): New function. * src/haiku_support.h: Update prototypes. * src/haikufns.c (haiku_set_background_color): * src/haikumenu.c (digest_menu_items): * src/haikuterm.c (haiku_clip_to_string): (haiku_flip_buffers): (haiku_clear_frame_area): (haiku_clear_frame): (haiku_draw_glyph_string): (haiku_after_update_window_line): (haiku_draw_window_cursor): (haiku_draw_vertical_window_border): (haiku_draw_window_divider): (haiku_draw_fringe_bitmap): (haiku_scroll_run): (haiku_read_socket): (haiku_flash): (haiku_clear_under_internal_border): Mark appropriate region as invalid before buffer flip. diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 9aeb03c4c9..43b996b795 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -1197,6 +1197,7 @@ class EmacsView : public BView uint32_t previous_buttons = 0; int looper_locked_count = 0; BRegion sb_region; + BRegion invalid_region; BView *offscreen_draw_view = NULL; BBitmap *offscreen_draw_bitmap_1 = NULL; @@ -1403,7 +1404,8 @@ class EmacsView : public BView SetViewBitmap (copy_bitmap, Frame (), Frame (), B_FOLLOW_NONE, 0); - Invalidate (); + Invalidate (&invalid_region); + invalid_region.MakeEmpty (); UnlockLooper (); return; } @@ -1431,6 +1433,7 @@ class EmacsView : public BView gui_abort ("Failed to lock bitmap after double buffering was set up"); } + invalid_region.MakeEmpty (); UnlockLooper (); Invalidate (); } @@ -2147,14 +2150,23 @@ BView_invalidate (void *view) /* Lock VIEW in preparation for drawing operations. This should be called before any attempt to draw onto VIEW or to lock it for Cairo - drawing. `BView_draw_unlock' should be called afterwards. */ + drawing. `BView_draw_unlock' should be called afterwards. + + If any drawing is going to take place, INVALID_REGION should be + true, and X, Y, WIDTH, HEIGHT should specify a rectangle in which + the drawing will take place. */ void -BView_draw_lock (void *view) +BView_draw_lock (void *view, bool invalidate_region, + int x, int y, int width, int height) { EmacsView *vw = (EmacsView *) view; if (vw->looper_locked_count) { vw->looper_locked_count++; + + if (invalidate_region && vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); return; } BView *v = (BView *) find_appropriate_view_for_draw (vw); @@ -2168,9 +2180,23 @@ BView_draw_lock (void *view) if (v != vw && !vw->LockLooper ()) gui_abort ("Failed to lock view while acquiring draw lock"); + + if (invalidate_region && vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); vw->looper_locked_count++; } +void +BView_invalidate_region (void *view, int x, int y, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + + if (vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); +} + void BView_draw_unlock (void *view) { diff --git a/src/haiku_support.h b/src/haiku_support.h index 1deb867c5f..4de71075c0 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -621,7 +621,11 @@ extern "C" BView_invalidate (void *view); extern void - BView_draw_lock (void *view); + BView_draw_lock (void *view, bool invalidate_region, + int x, int y, int width, int height); + + extern void + BView_invalidate_region (void *view, int x, int y, int width, int height); extern void BView_draw_unlock (void *view); diff --git a/src/haikufns.c b/src/haikufns.c index 69f502fb01..ff5082030f 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -1374,7 +1374,7 @@ haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval { struct face *defface; - BView_draw_lock (FRAME_HAIKU_VIEW (f)); + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); BView_SetViewColor (FRAME_HAIKU_VIEW (f), color.pixel); BView_draw_unlock (FRAME_HAIKU_VIEW (f)); diff --git a/src/haikumenu.c b/src/haikumenu.c index 41db0d414d..74328086d6 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -63,7 +63,7 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, } if (view) - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); while (i < menu_items_used) { diff --git a/src/haikuterm.c b/src/haikuterm.c index 83330b5f63..023349327a 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -161,8 +161,12 @@ haiku_clip_to_string (struct glyph_string *s) FRAME_PIXEL_HEIGHT (s->f), 10, 10); else - BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[0].x, - r[0].y, r[0].width, r[0].height); + { + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[0].x, + r[0].y, r[0].width, r[0].height); + BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), r[0].x, + r[0].y, r[0].width, r[0].height); + } } if (n > 1) @@ -175,8 +179,12 @@ haiku_clip_to_string (struct glyph_string *s) FRAME_PIXEL_HEIGHT (s->f), 10, 10); else - BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[1].x, r[1].y, - r[1].width, r[1].height); + { + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[1].x, r[1].y, + r[1].width, r[1].height); + BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), r[1].x, + r[1].y, r[1].width, r[1].height); + } } } @@ -193,7 +201,7 @@ haiku_flip_buffers (struct frame *f) void *view = FRAME_OUTPUT_DATA (f)->view; block_input (); - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); FRAME_DIRTY_P (f) = 0; EmacsView_flip_and_blit (view); BView_draw_unlock (view); @@ -224,7 +232,7 @@ haiku_clear_frame_area (struct frame *f, int x, int y, { void *vw = FRAME_HAIKU_VIEW (f); block_input (); - BView_draw_lock (vw); + BView_draw_lock (vw, true, x, y, width, height); BView_StartClip (vw); BView_ClipToRect (vw, x, y, width, height); BView_SetHighColor (vw, FRAME_BACKGROUND_PIXEL (f)); @@ -242,7 +250,8 @@ haiku_clear_frame (struct frame *f) mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f))); block_input (); - BView_draw_lock (view); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); BView_StartClip (view); BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); @@ -1462,7 +1471,7 @@ haiku_draw_glyph_string (struct glyph_string *s) block_input (); view = FRAME_HAIKU_VIEW (s->f); - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); prepare_face_for_display (s->f, s->face); struct face *face = s->face; @@ -1645,13 +1654,17 @@ haiku_after_update_window_line (struct window *w, if (face) { void *view = FRAME_HAIKU_VIEW (f); - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); BView_StartClip (view); BView_SetHighColor (view, face->background_defaulted_p ? FRAME_BACKGROUND_PIXEL (f) : face->background); BView_FillRectangle (view, 0, y, width, height); BView_FillRectangle (view, FRAME_PIXEL_WIDTH (f) - width, y, width, height); + BView_invalidate_region (FRAME_HAIKU_VIEW (f), + 0, y, width, height); + BView_invalidate_region (view, FRAME_PIXEL_WIDTH (f) - width, + y, width, height); BView_EndClip (view); BView_draw_unlock (view); } @@ -1739,7 +1752,7 @@ haiku_draw_window_cursor (struct window *w, h = cursor_height; } - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); BView_StartClip (view); if (cursor_type == BAR_CURSOR) @@ -1771,13 +1784,20 @@ haiku_draw_window_cursor (struct window *w, break; case HBAR_CURSOR: BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; case BAR_CURSOR: if (cursor_glyph->resolved_level & 1) - BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, - fy, w->phys_cursor_width, h); + { + BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, + fy, w->phys_cursor_width, h); + BView_invalidate_region (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, + fy, w->phys_cursor_width, h); + } else BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); + + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; case HOLLOW_BOX_CURSOR: if (phys_cursor_glyph->type != IMAGE_GLYPH) @@ -1787,6 +1807,8 @@ haiku_draw_window_cursor (struct window *w, } else draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; case FILLED_BOX_CURSOR: draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); @@ -1865,7 +1887,7 @@ haiku_draw_vertical_window_border (struct window *w, face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); void *view = FRAME_HAIKU_VIEW (f); - BView_draw_lock (view); + BView_draw_lock (view, true, x, y_0, 1, y_1); BView_StartClip (view); if (face) BView_SetHighColor (view, face->foreground); @@ -1910,7 +1932,7 @@ haiku_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) : FRAME_FOREGROUND_PIXEL (f)); void *view = FRAME_HAIKU_VIEW (f); - BView_draw_lock (view); + BView_draw_lock (view, true, x0, y0, x1 - x0 + 1, y1 - y0 + 1); BView_StartClip (view); if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) @@ -2240,7 +2262,7 @@ haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct face *face = p->face; block_input (); - BView_draw_lock (view); + BView_draw_lock (view, true, p->x, p->y, p->wd, p->h); BView_StartClip (view); haiku_clip_to_row (w, row, ANY_AREA); @@ -2345,7 +2367,7 @@ haiku_scroll_run (struct window *w, struct run *run) block_input (); gui_clear_cursor (w); - BView_draw_lock (view); + BView_draw_lock (view, true, x, to_y, width, height); BView_StartClip (view); BView_CopyBits (view, x, from_y, width, height, x, to_y, width, height); @@ -2630,7 +2652,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) continue; } - BView_draw_lock (FRAME_HAIKU_VIEW (f)); + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); BView_resize_to (FRAME_HAIKU_VIEW (f), width, height); BView_draw_unlock (FRAME_HAIKU_VIEW (f)); @@ -3222,7 +3244,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) menu bar. */ if (!b->no_lock) { - BView_draw_lock (FRAME_HAIKU_VIEW (f)); + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); /* This shouldn't be here, but nsmenu does it, so it should probably be safe. */ int was_waiting_for_input_p = waiting_for_input; @@ -3440,7 +3462,8 @@ haiku_flash (struct frame *f) delay = make_timespec (0, 150 * 1000 * 1000); wakeup = timespec_add (current_timespec (), delay); - BView_draw_lock (view); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); BView_StartClip (view); /* If window is tall, flash top and bottom line. */ if (height > 3 * FRAME_LINE_HEIGHT (f)) @@ -3484,7 +3507,8 @@ haiku_flash (struct frame *f) pselect (0, NULL, NULL, NULL, &timeout, NULL); } - BView_draw_lock (view); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); BView_StartClip (view); /* If window is tall, flash top and bottom line. */ if (height > 3 * FRAME_LINE_HEIGHT (f)) @@ -3709,7 +3733,8 @@ haiku_clear_under_internal_border (struct frame *f) struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); void *view = FRAME_HAIKU_VIEW (f); block_input (); - BView_draw_lock (view); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); BView_StartClip (view); BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); commit 6fd6bea8c4be3e5025645907a52f56521192fef3 Author: Po Lu Date: Fri Feb 25 14:20:14 2022 +0800 Fix calculation of scroll deltas when coalescing wheel events * src/xterm.c (handle_one_xevent): Use accumulated values instead of raw delta to determine scroll amounts. diff --git a/src/xterm.c b/src/xterm.c index 18d68e52f1..32f76d156a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11471,9 +11471,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, scroll_unit *= XFLOATINT (Vx_scroll_event_delta_factor); if (val->horizontal) - total_x += delta * scroll_unit; + total_x += val->emacs_value * scroll_unit; else - total_y += delta * scroll_unit; + total_y += val->emacs_value * scroll_unit; found_valuator = true; val->emacs_value = 0; commit a2e80d2a419a2092d6a196c42280295c34388ae4 Author: Po Lu Date: Fri Feb 25 14:15:51 2022 +0800 Make interpolated scrolling work above non-selected windows * lisp/pixel-scroll.el (pixel-scroll-precision-interpolate): New parameter `old-window'. (pixel-scroll-precision): Pass originally selected window to the interpolation function. diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 463e106c7a..042c8a419e 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -592,10 +592,11 @@ the height of the current window." (when (< delta 0) (set-window-vscroll nil (- delta) t))))) -(defun pixel-scroll-precision-interpolate (delta) +(defun pixel-scroll-precision-interpolate (delta &optional old-window) "Interpolate a scroll of DELTA pixels. -This results in the window being scrolled by DELTA pixels with an -animation." +OLD-WINDOW is the window which will be selected when redisplay +takes place, or nil for the current window. This results in the +window being scrolled by DELTA pixels with an animation." (let ((percentage 0) (total-time pixel-scroll-precision-interpolation-total-time) (factor pixel-scroll-precision-interpolation-factor) @@ -613,7 +614,9 @@ animation." (while-no-input (unwind-protect (while (< percentage 1) - (redisplay t) + (with-selected-window (or old-window + (selected-window)) + (redisplay t)) (sleep-for between-scroll) (setq time-elapsed (+ time-elapsed (- (float-time) last-time)) @@ -664,7 +667,8 @@ Move the display up or down by the pixel deltas in EVENT to scroll the display according to the user's turning the mouse wheel." (interactive "e") - (let ((window (mwheel-event-window event))) + (let ((window (mwheel-event-window event)) + (current-window (selected-window))) (if (and (nth 4 event)) (let ((delta (round (cdr (nth 4 event))))) (unless (zerop delta) @@ -685,7 +689,7 @@ wheel." (let ((kin-state (pixel-scroll-kinetic-state))) (aset kin-state 0 (make-ring 30)) (aset kin-state 1 nil)) - (pixel-scroll-precision-interpolate delta)) + (pixel-scroll-precision-interpolate delta current-window)) (condition-case nil (progn (if (< delta 0) commit f4ef44a5ebd6a85f1e546ccfea8cc13e71152032 Merge: 73e1be36e5 5c77aed2d6 Author: Stefan Kangas Date: Fri Feb 25 06:30:57 2022 +0100 Merge from origin/emacs-28 5c77aed2d6 Mention flyspell-prog-mode in flyspell-mode doc string commit 73e1be36e513ac7ea56e1435f8242d83ec39e3b3 Author: Jim Porter Date: Fri Feb 25 03:18:27 2022 +0100 Fix Eshell process tests to (hopefully) work on all platforms * test/lisp/eshell/esh-proc-tests.el (esh-proc-test/kill-pipeline): Fix test (bug#54136). diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index e19eaf9779..8cd893ce57 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -57,10 +57,11 @@ prompt. See bug#54136." (let ((output-start (eshell-beginning-of-output))) (eshell-kill-process) (eshell-wait-for-subprocess t) - (should (equal (buffer-substring-no-properties - output-start (eshell-end-of-output)) - ;; "interrupt\n" is for MS-Windows. - (or "interrupt\n" "killed\n")))))) + (should (string-match-p + ;; "interrupt\n" is for MS-Windows. + (rx (or "interrupt\n" "killed\n")) + (buffer-substring-no-properties + output-start (eshell-end-of-output))))))) (ert-deftest esh-proc-test/kill-pipeline-head () "Test that killing the first process in a pipeline doesn't commit fa2b60615b517514c9b83b360a2504048ff0394b Author: Dmitry Gutov Date: Fri Feb 25 03:34:59 2022 +0200 xref--find-file-buffer: Check modified-p and modtime * lisp/progmodes/xref.el (xref--find-file-buffer): Check whether the buffer contents match what's on disk (bug#54025). diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index aa98aa89f1..96fb835d0f 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -2010,10 +2010,16 @@ Such as the current syntax table and the applied syntax properties." (defun xref--find-file-buffer (file) (unless (equal (car xref--last-file-buffer) file) - (setq xref--last-file-buffer - ;; `find-buffer-visiting' is considerably slower, - ;; especially on remote files. - (cons file (get-file-buffer file)))) + ;; `find-buffer-visiting' is considerably slower, + ;; especially on remote files. + (let ((buf (get-file-buffer file))) + (when (and buf + (or + (buffer-modified-p buf) + (not (verify-visited-file-modtime (current-buffer))))) + ;; We can't use buffers whose contents diverge from disk (bug#54025). + (setq buf nil)) + (setq xref--last-file-buffer (cons file buf)))) (cdr xref--last-file-buffer)) (provide 'xref) commit d29cc1e8a06507dc89c5350c59d0eee263c6df0c Author: Po Lu Date: Fri Feb 25 08:40:51 2022 +0800 Set user time when receiving any wheel events * src/xterm.c (handle_one_xevent): Set user time if the mouse wheel moved. diff --git a/src/xterm.c b/src/xterm.c index 54b00455a1..18d68e52f1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -11513,6 +11513,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif if (found_valuator) { + x_display_set_last_user_time (dpyinfo, xev->time); + if (fabs (total_x) > 0 || fabs (total_y) > 0) { inev.ie.kind = (fabs (total_y) >= fabs (total_x) commit 8d2fbd4a146bcd01fd905fb500230c7c662f2a01 Author: Eli Zaretskii Date: Thu Feb 24 22:02:28 2022 +0200 Fix esh-proc-tests on MS-Windows * test/lisp/eshell/esh-proc-tests.el (esh-proc-test/kill-pipeline) (esh-proc-test/kill-background-process): Fix tests on MS-Windows. diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index a8be0f8030..e19eaf9779 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -59,7 +59,8 @@ prompt. See bug#54136." (eshell-wait-for-subprocess t) (should (equal (buffer-substring-no-properties output-start (eshell-end-of-output)) - "killed\n"))))) + ;; "interrupt\n" is for MS-Windows. + (or "interrupt\n" "killed\n")))))) (ert-deftest esh-proc-test/kill-pipeline-head () "Test that killing the first process in a pipeline doesn't @@ -88,4 +89,4 @@ prompt. See bug#54136." (kill-process (caar eshell-process-list)) ;; Give `eshell-sentinel' a chance to run. (sit-for 0.1) - (eshell-match-result "\\[sh\\] [[:digit:]]+\n"))) + (eshell-match-result "\\[sh\\(\\.exe\\)?\\] [[:digit:]]+\n"))) commit 794fbd1c07696a87352ddd9703bb2f8f6a7945ff Author: Eli Zaretskii Date: Thu Feb 24 21:57:34 2022 +0200 Make 't' in Buffer-menu be more defensive * lisp/buff-menu.el (Buffer-menu-visit-tags-table): Verify that the buffer holds a tags-table file before using it as such. (Bug#54133) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 50c2c155ca..179cc5484c 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -527,13 +527,18 @@ If UNMARK is non-nil, unmark them." (multi-occur (Buffer-menu-marked-buffers) regexp nlines)) +(autoload 'etags-verify-tags-table "etags") (defun Buffer-menu-visit-tags-table () "Visit the tags table in the buffer on this line. See `visit-tags-table'." (interactive nil Buffer-menu-mode) - (let ((file (buffer-file-name (Buffer-menu-buffer t)))) - (if file - (visit-tags-table file) - (error "Specified buffer has no file")))) + (let* ((buf (Buffer-menu-buffer t)) + (file (buffer-file-name buf))) + (cond + ((not file) (error "Specified buffer has no file")) + ((and buf (with-current-buffer buf + (etags-verify-tags-table))) + (visit-tags-table file)) + (t (error "Specified buffer is not a tags-table"))))) (defun Buffer-menu-1-window () "Select this line's buffer, alone, in full frame." commit bd17fa2c7565f180cedbfa396c0b159e144178cb Author: Paul Eggert Date: Thu Feb 24 10:12:50 2022 -0800 * admin/merge-gnulib: fix bare checkout (Bug#32452#65) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 4045eabf4e..4aabffa0dc 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -102,6 +102,9 @@ test -x "$gnulib_srcdir"/gnulib-tool || { exit 1 } +# gnulib-tool has problems with a bare checkout (Bug#32452#65). +test -f configure || ./autogen.sh + avoided_flags= for module in $AVOIDED_MODULES; do avoided_flags="$avoided_flags --avoid=$module" commit 6092ee1c3ff503fbe8087e13b7eae2f904c4af3b Author: Alan Mackenzie Date: Thu Feb 24 17:30:39 2022 +0000 Amend byte-run-strip-symbol-positions so that an unexec build builds This fixes bug #54098. * lisp/emacs-lisp/byte-run.el (byte-run--strip-list) (byte-run--strip-vector/record): New functions. These alter a list or vector/record structure only where a symbol with position gets replaced by a bare symbol. (byte-run-strip-symbol-positions): Reformulate to use the two new functions. (function-put): No longer strip positions from the second and third arguments. * lisp/emacs-lisp/bytecomp.el (byte-compile-out): Remove the senseless "stripping" of putative symbol positions from OPERAND, which is nil or a number. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index c542c55016..d7a2d8ceca 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -37,53 +37,69 @@ the corresponding new element of the same type. The purpose of this is to detect circular structures.") -(defalias 'byte-run--strip-s-p-1 +(defalias 'byte-run--strip-list #'(lambda (arg) - "Strip all positions from symbols in ARG, modifying ARG. -Return the modified ARG." + "Strip the positions from symbols with position in the list ARG. +This is done by destructively modifying ARG. Return ARG." + (let ((a arg)) + (while + (and + (not (gethash a byte-run--ssp-seen)) + (progn + (puthash a t byte-run--ssp-seen) + (cond + ((symbol-with-pos-p (car a)) + (setcar a (bare-symbol (car a)))) + ((consp (car a)) + (byte-run--strip-list (car a))) + ((or (vectorp (car a)) (recordp (car a))) + (byte-run--strip-vector/record (car a)))) + (consp (cdr a)))) + (setq a (cdr a))) + (cond + ((symbol-with-pos-p (cdr a)) + (setcdr a (bare-symbol (cdr a)))) + ((or (vectorp (cdr a)) (recordp (cdr a))) + (byte-run--strip-vector/record (cdr a)))) + arg))) + +(defalias 'byte-run--strip-vector/record + #'(lambda (arg) + "Strip the positions from symbols with position in the vector/record ARG. +This is done by destructively modifying ARG. Return ARG." + (unless (gethash arg byte-run--ssp-seen) + (let ((len (length arg)) + (i 0) + elt) + (puthash arg t byte-run--ssp-seen) + (while (< i len) + (setq elt (aref arg i)) + (cond + ((symbol-with-pos-p elt) + (aset arg i elt)) + ((consp elt) + (byte-run--strip-list elt)) + ((or (vectorp elt) (recordp elt)) + (byte-run--strip-vector/record elt)))))) + arg)) + +(defalias 'byte-run-strip-symbol-positions + #'(lambda (arg) + "Strip all positions from symbols in ARG. +This modifies destructively then returns ARG. + +ARG is any Lisp object, but is usually a list or a vector or a +record, containing symbols with position." + (setq byte-run--ssp-seen (make-hash-table :test 'eq)) (cond ((symbol-with-pos-p arg) (bare-symbol arg)) - ((consp arg) - (let* ((hash (gethash arg byte-run--ssp-seen))) - (if hash ; Already processed this node. - arg - (let ((a arg) new) - (while - (progn - (puthash a t byte-run--ssp-seen) - (setq new (byte-run--strip-s-p-1 (car a))) - (setcar a new) - (and (consp (cdr a)) - (not - (setq hash (gethash (cdr a) byte-run--ssp-seen))))) - (setq a (cdr a))) - (setq new (byte-run--strip-s-p-1 (cdr a))) - (setcdr a new) - arg)))) - + (byte-run--strip-list arg)) ((or (vectorp arg) (recordp arg)) - (let ((hash (gethash arg byte-run--ssp-seen))) - (if hash - arg - (let* ((len (length arg)) - (i 0) - new) - (puthash arg t byte-run--ssp-seen) - (while (< i len) - (setq new (byte-run--strip-s-p-1 (aref arg i))) - (aset arg i new) - (setq i (1+ i))) - arg)))) - + (byte-run--strip-vector/record arg)) (t arg)))) -(defalias 'byte-run-strip-symbol-positions - #'(lambda (arg) - (setq byte-run--ssp-seen (make-hash-table :test 'eq)) - (byte-run--strip-s-p-1 arg))) - (defalias 'function-put ;; We don't want people to just use `put' because we can't conveniently ;; hook into `put' to remap old properties to new ones. But for now, there's @@ -92,9 +108,7 @@ Return the modified ARG." "Set FUNCTION's property PROP to VALUE. The namespace for PROP is shared with symbols. So far, FUNCTION can only be a symbol, not a lambda expression." - (put (bare-symbol function) - (byte-run-strip-symbol-positions prop) - (byte-run-strip-symbol-positions value)))) + (put (bare-symbol function) prop value))) (function-put 'defmacro 'doc-string-elt 3) (function-put 'defmacro 'lisp-indent-function 2) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c59bb292f8..6f83429dd4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5099,7 +5099,7 @@ binding slots have been popped." OP and OPERAND are as passed to `byte-compile-out'." (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos)) ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1 - ;; elements, and the push the result, for a total of -OPERAND. + ;; elements, and then push the result, for a total of -OPERAND. ;; For discardN*, of course, we just pop OPERAND elements. (- operand) (or (aref byte-stack+-info (symbol-value op)) @@ -5109,7 +5109,6 @@ OP and OPERAND are as passed to `byte-compile-out'." (- 1 operand)))) (defun byte-compile-out (op &optional operand) - (setq operand (byte-run-strip-symbol-positions operand)) (push (cons op operand) byte-compile-output) (if (eq op 'byte-return) ;; This is actually an unnecessary case, because there should be no commit 2db149539bc7f9720856f1d17f0e7fa9bf735ea1 Author: Michael Albinus Date: Thu Feb 24 16:11:01 2022 +0100 Fix symlinks in tramp-sshfs.el (Bug#54130) * lisp/net/tramp-sshfs.el (tramp-methods) : Add "-o transform_symlinks" to `tramp-mount-args'. (tramp-sshfs-file-name-handler-alist): Use `tramp-sshfs-handle-file-writable-p'. (tramp-sshfs-handle-file-writable-p): New defun. (Bug#54130) * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes) (tramp-test20-file-modes): Adapt tests. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index d30c19436d..90b3c2ba2c 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -51,10 +51,11 @@ (add-to-list 'tramp-methods `(,tramp-sshfs-method (tramp-mount-args (("-C") ("-p" "%p") + ("-o" "transform_symlinks") ("-o" "idmap=user,reconnect"))) ;; These are for remote processes. (tramp-login-program "ssh") - (tramp-login-args (("-q")("-l" "%u") ("-p" "%p") + (tramp-login-args (("-q") ("-l" "%u") ("-p" "%p") ("-e" "none") ("-t" "-t") ("%h") ("%l"))) (tramp-direct-async t) @@ -119,7 +120,7 @@ (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-sshfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) - (file-writable-p . tramp-handle-file-writable-p) + (file-writable-p . tramp-sshfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) @@ -220,6 +221,10 @@ arguments to pass to the OPERATION." ;;`file-system-info' exists since Emacs 27.1. (tramp-compat-funcall 'file-system-info (tramp-fuse-local-file-name filename))) +(defun tramp-sshfs-handle-file-writable-p (filename) + "Like `file-writable-p' for Tramp files." + (file-writable-p (tramp-fuse-local-file-name filename))) + (defun tramp-sshfs-handle-insert-file-contents (filename &optional visit beg end replace) "Like `insert-file-contents' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4e74f2aa73..c468c3501b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3437,8 +3437,10 @@ This tests also `access-file', `file-readable-p', (should (string-equal (file-attribute-type attr) - (tramp-file-name-localname - (tramp-dissect-file-name tmp-name3)))) + (funcall + (if (tramp--test-sshfs-p) #'file-name-nondirectory #'identity) + (tramp-file-name-localname + (tramp-dissect-file-name tmp-name3))))) (delete-file tmp-name2)) (when test-file-ownership-preserved-p @@ -3598,7 +3600,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (should (= (file-modes tmp-name1) #o444)) (should-not (file-executable-p tmp-name1)) ;; A file is always writable for user "root". - (unless (zerop (file-attribute-user-id (file-attributes tmp-name1))) + (unless + (or (zerop (file-attribute-user-id (file-attributes tmp-name1))) + (tramp--test-sshfs-p)) (should-not (file-writable-p tmp-name1))) ;; Check the NOFOLLOW arg. It exists since Emacs 28. For ;; regular files, there shouldn't be a difference. commit 94e59f80b758ed3e3ff083d44a843273342ec054 Author: Po Lu Date: Thu Feb 24 20:01:39 2022 +0800 Check if WM support for NET_WM_USER_TIME_WINDOW changed during updates * src/xterm.c (x_display_set_last_user_time): Update the user time window if window manager support changed. * src/xterm.h (struct x_display_info): New field `last_user_check_time'. diff --git a/src/xterm.c b/src/xterm.c index 66b5dce73c..54b00455a1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -2588,6 +2588,7 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time) { #ifndef USE_GTK struct frame *focus_frame = dpyinfo->x_focus_frame; + struct x_output *output; #endif #ifdef ENABLE_CHECKING @@ -2596,6 +2597,56 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time) dpyinfo->last_user_time = time; #ifndef USE_GTK + if (focus_frame + && (dpyinfo->last_user_time + > (dpyinfo->last_user_check_time + 2000))) + { + output = FRAME_X_OUTPUT (focus_frame); + + if (!x_wm_supports (focus_frame, + dpyinfo->Xatom_net_wm_user_time_window)) + { + if (output->user_time_window == None) + output->user_time_window = FRAME_OUTER_WINDOW (focus_frame); + else if (output->user_time_window != FRAME_OUTER_WINDOW (focus_frame)) + { + XDestroyWindow (dpyinfo->display, + output->user_time_window); + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time_window); + output->user_time_window = FRAME_OUTER_WINDOW (focus_frame); + } + } + else + { + if (output->user_time_window == FRAME_OUTER_WINDOW (focus_frame) + || output->user_time_window == None) + { + XSetWindowAttributes attrs; + memset (&attrs, 0, sizeof attrs); + + output->user_time_window + = XCreateWindow (dpyinfo->display, + FRAME_X_WINDOW (focus_frame), + -1, -1, 1, 1, 0, 0, InputOnly, + CopyFromParent, 0, &attrs); + + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time); + XChangeProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time_window, + XA_WINDOW, 32, PropModeReplace, + (unsigned char *) &output->user_time_window, + 1); + } + } + + dpyinfo->last_user_check_time = time; + } + if (focus_frame) { while (FRAME_PARENT_FRAME (focus_frame)) diff --git a/src/xterm.h b/src/xterm.h index ae9300f783..a41eb43d64 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -459,8 +459,10 @@ struct x_display_info /* The scroll bar in which the last X motion event occurred. */ struct scroll_bar *last_mouse_scroll_bar; - /* Time of last user interaction as returned in X events on this display. */ - Time last_user_time; + /* Time of last user interaction as returned in X events on this + display, and time where WM support for `_NET_WM_USER_TIME_WINDOW' + was last checked. */ + Time last_user_time, last_user_check_time; /* Position where the mouse was last time we reported a motion. This is a position on last_mouse_motion_frame. */ commit dfe78ccb87dced59fd97584dac2f3bed8929799e Author: Eli Zaretskii Date: Thu Feb 24 13:07:16 2022 +0200 ; * etc/NEWS: Fix wording of a recently added NEWS entry. diff --git a/etc/NEWS b/etc/NEWS index 76a9ecdbc0..902d89e62d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -234,8 +234,8 @@ composited display. +++ ** New frame parameter 'shaded'. -On supported window managers, this controls whether or not a frame's -contents will be hidden, leaving only the title bar. +With window managers which support this, it controls whether or not a +frame's contents will be hidden, leaving only the title bar on display. --- ** New user option 'x-gtk-use-native-input'. commit be496f942cb1a6b9a4b31ae6098cb09166793fec Author: Jim Porter Date: Wed Feb 23 20:43:38 2022 -0800 Don't superfluously emit prompts when terminating processes in Eshell * lisp/eshell/esh-proc.el (eshell-kill-process-function): Only reset the prompt if PROC is writing to the terminal. (eshell-sentinel): Only write the exit message if PROC is writing to the terminal (bug#54136). * test/lisp/eshell/esh-proc-tests.el (esh-proc-test/kill-pipeline) (esh-proc-test/kill-pipeline-head) (esh-proc-test/kill-background-process): New tests. diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index d7d22d2a9e..70426ccaf2 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -102,6 +102,7 @@ information, for example." "A list of the current status of subprocesses.") (declare-function eshell-send-eof-to-process "esh-mode") +(declare-function eshell-tail-process "esh-cmd") (defvar-keymap eshell-proc-mode-map "C-c M-i" #'eshell-insert-process @@ -119,7 +120,9 @@ Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments PROC and STATUS to functions on the latter." ;; Was there till 24.1, but it is not optional. (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc) - (eshell-reset-after-proc status) + ;; Only reset the prompt if this process is running interactively. + (when (eq proc (eshell-tail-process)) + (eshell-reset-after-proc status)) (run-hook-with-args 'eshell-kill-hook proc status)) (define-minor-mode eshell-proc-mode @@ -414,7 +417,7 @@ PROC is the process that's exiting. STRING is the exit message." (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) (unwind-protect - (let* ((entry (assq proc eshell-process-list))) + (let ((entry (assq proc eshell-process-list))) ; (if (not entry) ; (error "Sentinel called for unowned process `%s'" ; (process-name proc)) @@ -422,8 +425,13 @@ PROC is the process that's exiting. STRING is the exit message." (unwind-protect (progn (unless (string= string "run") - (unless (string-match "^\\(finished\\|exited\\)" string) - (eshell-insertion-filter proc string)) + ;; Write the exit message if the status is + ;; abnormal and the process is already writing + ;; to the terminal. + (when (and (eq proc (eshell-tail-process)) + (not (string-match "^\\(finished\\|exited\\)" + string))) + (funcall (process-filter proc) proc string)) (let ((handles (nth 1 entry)) (str (prog1 (nth 3 entry) (setf (nth 3 entry) nil))) diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index e7ea6c00d6..a8be0f8030 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -43,3 +43,49 @@ "y\n") (eshell-wait-for-subprocess t) (should (eq (process-list) nil)))) + +(ert-deftest esh-proc-test/kill-pipeline () + "Test that killing a pipeline of processes only emits a single +prompt. See bug#54136." + (skip-unless (and (executable-find "sh") + (executable-find "echo") + (executable-find "sleep"))) + (with-temp-eshell + (eshell-insert-command + (concat "sh -c 'while true; do echo y; sleep 1; done' | " + "sh -c 'while true; do read NAME; done'")) + (let ((output-start (eshell-beginning-of-output))) + (eshell-kill-process) + (eshell-wait-for-subprocess t) + (should (equal (buffer-substring-no-properties + output-start (eshell-end-of-output)) + "killed\n"))))) + +(ert-deftest esh-proc-test/kill-pipeline-head () + "Test that killing the first process in a pipeline doesn't +write the exit status to the pipe. See bug#54136." + (skip-unless (and (executable-find "sh") + (executable-find "echo") + (executable-find "sleep"))) + (with-temp-eshell + (eshell-insert-command + (concat "sh -c 'while true; sleep 1; done' | " + "sh -c 'while read NAME; do echo =${NAME}=; done'")) + (let ((output-start (eshell-beginning-of-output))) + (kill-process (eshell-head-process)) + (eshell-wait-for-subprocess t) + (should (equal (buffer-substring-no-properties + output-start (eshell-end-of-output)) + ""))))) + +(ert-deftest esh-proc-test/kill-background-process () + "Test that killing a background process doesn't emit a new +prompt. See bug#54136." + (skip-unless (and (executable-find "sh") + (executable-find "sleep"))) + (with-temp-eshell + (eshell-insert-command "sh -c 'while true; do sleep 1; done' &") + (kill-process (caar eshell-process-list)) + ;; Give `eshell-sentinel' a chance to run. + (sit-for 0.1) + (eshell-match-result "\\[sh\\] [[:digit:]]+\n"))) commit 5c77aed2d627eba140729824cc41c91905aac52d (refs/remotes/origin/emacs-28) Author: Lars Ingebrigtsen Date: Thu Feb 24 10:10:40 2022 +0100 Mention flyspell-prog-mode in flyspell-mode doc string * lisp/textmodes/flyspell.el (flyspell-mode): Mention flyspell-prog-mode (bug#54131). diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 6d9b93a887..21612cd5e3 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -489,6 +489,9 @@ Flyspell mode is a buffer-local minor mode. When enabled, it spawns a single Ispell process and checks each word. The default flyspell behavior is to highlight incorrect words. +This mode is geared toward text modes. In buffers that contain +code, `flyspell-prog-mode' is usually a better choice. + Bindings: \\[ispell-word]: correct words (using Ispell). \\[flyspell-auto-correct-word]: automatically correct word.