commit 224aeb2877fffc894e9d1b31f7f44db0e55160c3 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Sat Feb 5 08:50:05 2022 +0100 Fix yank-media utf-16 detection * lisp/yank-media.el (yank-media--utf-16-p): Factor out into its own function for easier testing and fix the code. diff --git a/lisp/yank-media.el b/lisp/yank-media.el index 8c75877724..5cd75eb318 100644 --- a/lisp/yank-media.el +++ b/lisp/yank-media.el @@ -155,33 +155,7 @@ non-supported selection data types." (format "%s" data)) ((string-match-p "\\`text/" (symbol-name data-type)) ;; We may have utf-16, which Emacs won't detect automatically. - (let ((coding-system - (and (zerop (mod (length data) 2)) - (let ((stats (vector 0 0))) - (dotimes (i (length data)) - (when (zerop (elt data i)) - (setf (aref stats (mod i 2)) - (1+ (aref stats (mod i 2)))))) - ;; We have some nuls... - (and (not (and (zerop (elt stats 0)) - (zerop (elt stats 1)))) - ;; If we have more than 90% every-other nul, then it's - ;; pretty likely to be utf-16. - (cond - ((> (if (zerop (elt stats 1)) - 1 - (/ (float (elt stats 0)) - (float (elt stats 1)))) - 0.9) - ;; Big endian. - 'utf-16-be) - ((> (if (zerop (elt stats 0)) - 1 - (/ (float (elt stats 1)) - (float (elt stats 0)))) - 0.9) - ;; Little endian. - 'utf-16-le))))))) + (let ((coding-system (yank-media--utf-16-p data))) (if coding-system (decode-coding-string data coding-system) ;; Some programs add a nul character at the end of text/* @@ -192,6 +166,25 @@ non-supported selection data types." (t data))) +(defun yank-media--utf-16-p (data) + (and (zerop (mod (length data) 2)) + (let ((stats (vector 0 0))) + (dotimes (i (length data)) + (when (zerop (elt data i)) + (setf (aref stats (mod i 2)) + (1+ (aref stats (mod i 2)))))) + ;; If we have more than 90% every-other nul, then it's + ;; pretty likely to be utf-16. + (cond + ((> (/ (float (elt stats 0)) (/ (length data) 2)) + 0.9) + ;; Big endian. + 'utf-16-be) + ((> (/ (float (elt stats 1)) (/ (length data) 2)) + 0.9) + ;; Little endian. + 'utf-16-le))))) + (provide 'yank-media) ;;; yank-media.el ends here diff --git a/test/lisp/yank-media-tests.el b/test/lisp/yank-media-tests.el new file mode 100644 index 0000000000..4487ae150d --- /dev/null +++ b/test/lisp/yank-media-tests.el @@ -0,0 +1,38 @@ +;;; yank-media-tests.el --- Tests for yank-media.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'yank-media) +(require 'ert) +(require 'ert-x) + +(ert-deftest test-utf-16 () + (should-not (yank-media--utf-16-p "f")) + (should-not (yank-media--utf-16-p "fo")) + (should-not (yank-media--utf-16-p "\000ofo")) + (should (eq (yank-media--utf-16-p "\000o\000o") 'utf-16-be)) + (should (eq (yank-media--utf-16-p "o\000o\000") 'utf-16-le)) + (should-not (yank-media--utf-16-p "o\000\000o"))) + +;;; yank-media-tests.el ends here commit 89d419255b662e6e4e916ecc2afa733a788e9b1e Author: Lars Ingebrigtsen Date: Sat Feb 5 08:07:18 2022 +0100 Improve the selected-window doc string * src/window.c (Fselected_window): Add some pointers to other functions in this area. diff --git a/src/window.c b/src/window.c index 2a5e4042a4..449f2b0cc5 100644 --- a/src/window.c +++ b/src/window.c @@ -481,7 +481,9 @@ Return WINDOW. */) DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0, doc: /* Return the selected window. The selected window is the window in which the standard cursor for -selected windows appears and to which many commands apply. */) +selected windows appears and to which many commands apply. + +Also see `old-selected-window' and `minibuffer-selected-window'. */) (void) { return selected_window; commit 785a045b868e0aeef08858e86a9efe48311e8f48 Author: Jim Porter Date: Fri Feb 4 22:41:39 2022 -0800 Ensure that the CAR of 'eshell-last-async-procs' always points to a process Previously, if a non-process was piped to a process, this could end up being nil, which isn't correct. 'eshell-last-async-procs' should just ignore non-process commands in a pipeline. * lisp/eshell/esh-cmd.el (eshell-do-pipelines): Set 'headproc' correctly. * test/lisp/eshell/eshell-tests.el (eshell-test/pipe-headproc): New test. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index e702de03a0..5819506cc0 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -800,8 +800,7 @@ This macro calls itself recursively, with NOTFIRST non-nil." ((cdr pipeline) t) (t (quote 'last))))) (let ((proc ,(car pipeline))) - ,(unless notfirst - '(setq headproc proc)) + (setq headproc (or proc headproc)) (setq tailproc (or tailproc proc)) proc)))))) diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index c5ca0a5485..d6ee1bdb17 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -123,6 +123,13 @@ e.g. \"{(+ 1 2)} 3\" => 3" (eshell-command-result-p "echo ${echo hi}-${*echo there}" "hi-there\n"))) +(ert-deftest eshell-test/pipe-headproc () + "Check that piping a non-process to a process command waits for the process" + (skip-unless (executable-find "cat")) + (with-temp-eshell + (eshell-command-result-p "echo hi | *cat" + "hi"))) + (ert-deftest eshell-test/pipe-tailproc () "Check that piping a process to a non-process command waits for the process" (skip-unless (executable-find "echo")) commit a8de2e20e093bb45231327e824ceb8421993634e Author: Brendan O'Dea Date: Sat Feb 5 07:51:03 2022 +0100 Remove kerning escapes in woman mode * lisp/woman.el (woman-decode-region): Remove kerning escapes (bug#53770). Copyright-paperwork-exempt: yes diff --git a/lisp/woman.el b/lisp/woman.el index 2e0d9a9090..e16785329a 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2280,9 +2280,9 @@ Currently set only from \\='\\\" t in the first line of the source file.") (replace-match woman-unpadded-space-string t t)) ;; Discard optional hyphen \%; concealed newlines \; - ;; point-size change function \sN,\s+N, \s-N: + ;; kerning \/, \,; point-size change function \sN,\s+N, \s-N: (goto-char from) - (while (re-search-forward "\\\\\\([%\n]\\|s[-+]?[0-9]+\\)" nil t) + (while (re-search-forward "\\\\\\([%\n/,]\\|s[-+]?[0-9]+\\)" nil t) (woman-delete-match 0)) ;; BEWARE: THIS SHOULD PROBABLY ALL BE DONE MUCH LATER!!!!! commit 72a3bbf27e2ce7d99077486913aa2a132403e59f Author: Lars Ingebrigtsen Date: Sat Feb 5 07:26:24 2022 +0100 Improve the Archive file names tramp documentation * doc/misc/tramp.texi (Archive file names): Explicitly say how to open an archive with Tramp (bug#25076). diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ea544218ec..8ee4ab24cd 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4164,8 +4164,10 @@ methods}. Internally, file archives are mounted via the @acronym{GVFS} @option{archive} method. A file archive is a regular file of kind @file{/path/to/dir/file.EXT}. -The extension @samp{.EXT} identifies the type of the file archive. A -file inside a file archive, called archive file name, has the name +The extension @samp{.EXT} identifies the type of the file archive. To +examine the contents of an archive with Dired, open file name as if it +were a directory (i.e., open @file{/path/to/dir/file.EXT/}). A file +inside a file archive, called archive file name, has the name @file{/path/to/dir/file.EXT/dir/file}. Most of the @ref{Magic File Names, , magic file name operations, commit e51f9046762a4f34ece910802aa7f2007303124d Author: Lars Ingebrigtsen Date: Sat Feb 5 07:00:50 2022 +0100 Fix yank-media-types--format decoding * lisp/yank-media.el (yank-media-types--format): Check that we really have some nuls. diff --git a/lisp/yank-media.el b/lisp/yank-media.el index 9836082fb2..8c75877724 100644 --- a/lisp/yank-media.el +++ b/lisp/yank-media.el @@ -162,23 +162,26 @@ non-supported selection data types." (when (zerop (elt data i)) (setf (aref stats (mod i 2)) (1+ (aref stats (mod i 2)))))) - ;; If we have more than 90% every-other nul, then it's - ;; pretty likely to be utf-16. - (cond - ((> (if (zerop (elt stats 1)) - 1 - (/ (float (elt stats 0)) - (float (elt stats 1)))) - 0.9) - ;; Big endian. - 'utf-16-be) - ((> (if (zerop (elt stats 0)) - 1 - (/ (float (elt stats 1)) - (float (elt stats 0)))) - 0.9) - ;; Little endian. - 'utf-16-le)))))) + ;; We have some nuls... + (and (not (and (zerop (elt stats 0)) + (zerop (elt stats 1)))) + ;; If we have more than 90% every-other nul, then it's + ;; pretty likely to be utf-16. + (cond + ((> (if (zerop (elt stats 1)) + 1 + (/ (float (elt stats 0)) + (float (elt stats 1)))) + 0.9) + ;; Big endian. + 'utf-16-be) + ((> (if (zerop (elt stats 0)) + 1 + (/ (float (elt stats 1)) + (float (elt stats 0)))) + 0.9) + ;; Little endian. + 'utf-16-le))))))) (if coding-system (decode-coding-string data coding-system) ;; Some programs add a nul character at the end of text/* commit adf1ba578d1d5533382270919ddde77413aec906 Author: Po Lu Date: Sat Feb 5 05:08:00 2022 +0000 Finish up cursor color merging on Haiku * src/haikuterm.c (haiku_draw_text_decoration): (haiku_draw_plain_background): (haiku_draw_stretch_glyph_string): (haiku_merge_cursor_foreground): Use merged cursor colors. diff --git a/src/haikuterm.c b/src/haikuterm.c index 6707340ca0..2436558e31 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -606,15 +606,20 @@ static void haiku_draw_text_decoration (struct glyph_string *s, struct face *face, int width, int x) { + unsigned long cursor_color; + if (s->for_overlaps) return; + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, &cursor_color, NULL); + void *view = FRAME_HAIKU_VIEW (s->f); if (face->underline) { if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + BView_SetHighColor (view, cursor_color); else if (!face->underline_defaulted_p) BView_SetHighColor (view, face->underline_color); else @@ -711,7 +716,7 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face, { unsigned long dy = 0, h = 1; if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + BView_SetHighColor (view, cursor_color); else if (!face->overline_color_defaulted_p) BView_SetHighColor (view, face->overline_color); else @@ -735,7 +740,7 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face, unsigned long dy = (glyph_height - h) / 2; if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + BView_SetHighColor (view, cursor_color); else if (!face->strike_through_color_defaulted_p) BView_SetHighColor (view, face->strike_through_color); else @@ -812,8 +817,12 @@ haiku_draw_plain_background (struct glyph_string *s, struct face *face, int box_line_hwidth, int box_line_vwidth) { void *view = FRAME_HAIKU_VIEW (s->f); + unsigned long cursor_color; if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + { + haiku_merge_cursor_foreground (s, NULL, &cursor_color); + BView_SetHighColor (view, cursor_color); + } else BView_SetHighColor (view, face->background_defaulted_p ? FRAME_BACKGROUND_PIXEL (s->f) : @@ -1045,7 +1054,10 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s) x -= width; void *view = FRAME_HAIKU_VIEW (s->f); - BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + unsigned long cursor_color; + + haiku_merge_cursor_foreground (s, NULL, &cursor_color); + BView_SetHighColor (view, cursor_color); BView_FillRectangle (view, x, s->y, width, s->height); if (width < background_width) @@ -1088,9 +1100,9 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s) if (background_width > 0) { void *view = FRAME_HAIKU_VIEW (s->f); - uint32_t bkg; + unsigned long bkg; if (s->hl == DRAW_CURSOR) - bkg = FRAME_CURSOR_COLOR (s->f).pixel; + haiku_merge_cursor_foreground (s, NULL, &bkg); else bkg = s->face->background; @@ -3665,8 +3677,10 @@ haiku_merge_cursor_foreground (struct glyph_string *s, foreground = s->face->background; } - *foreground_out = foreground; - *background_out = background; + if (foreground_out) + *foreground_out = foreground; + if (background_out) + *background_out = background; } void commit 9c66aee17800077a7911972fe402f2ff870b9cec Author: Po Lu Date: Sat Feb 5 03:20:45 2022 +0000 Fix last change to ftcrfont.c * src/ftcrfont.c (ftcrfont_draw): Remove relic `face' variable and use s->face instead. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 87a8692a3b..a0a3490c49 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -571,8 +571,6 @@ ftcrfont_draw (struct glyph_string *s, pgtk_set_cr_source_with_color (f, s->xgcv.background, true); #endif #else - struct face *face = s->face; - uint32_t col = be_background; cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, @@ -580,8 +578,8 @@ ftcrfont_draw (struct glyph_string *s, BLUE_FROM_ULONG (col) / 255.0); #endif s->background_filled_p = 1; - cairo_rectangle (cr, x, y - FONT_BASE (face->font), - s->width, FONT_HEIGHT (face->font)); + cairo_rectangle (cr, x, y - FONT_BASE (s->font), + s->width, FONT_HEIGHT (s->font)); cairo_fill (cr); } commit c274bd5c52fd64c888b1c713060da881bf72caa7 Author: Po Lu Date: Sat Feb 5 03:17:58 2022 +0000 Implement face cursor color merging on Haiku * src/ftcrfont.c (ftcrfont_draw): * src/haikufont.c (haikufont_draw): Use `haiku_merge_cursor_foreground' to calculate cursor HL colors. * src/haikuterm.c (haiku_merge_cursor_foreground): New function. * src/haikuterm.h: Update prototypes. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 7d192697ca..87a8692a3b 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -522,12 +522,23 @@ ftcrfont_draw (struct glyph_string *s, int from, int to, int x, int y, bool with_background) { struct frame *f = s->f; - struct face *face = s->face; struct font_info *ftcrfont_info = (struct font_info *) s->font; cairo_t *cr; cairo_glyph_t *glyphs; int len = to - from; int i; +#ifdef USE_BE_CAIRO + unsigned long be_foreground, be_background; + + if (s->hl != DRAW_CURSOR) + { + be_foreground = s->face->foreground; + be_background = s->face->background; + } + else + haiku_merge_cursor_foreground (s, &be_foreground, + &be_background); +#endif block_input (); @@ -562,8 +573,7 @@ ftcrfont_draw (struct glyph_string *s, #else struct face *face = s->face; - uint32_t col = s->hl == DRAW_CURSOR ? - FRAME_CURSOR_COLOR (s->f).pixel : face->background; + uint32_t col = be_background; cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, GREEN_FROM_ULONG (col) / 255.0, @@ -592,8 +602,7 @@ ftcrfont_draw (struct glyph_string *s, pgtk_set_cr_source_with_color (f, s->xgcv.foreground, false); #endif #else - uint32_t col = s->hl == DRAW_CURSOR ? - FRAME_OUTPUT_DATA (s->f)->cursor_fg : face->foreground; + uint32_t col = be_foreground; cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, GREEN_FROM_ULONG (col) / 255.0, diff --git a/src/haikufont.c b/src/haikufont.c index 1ef5f54c9a..6cc984f316 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -951,10 +951,19 @@ haikufont_draw (struct glyph_string *s, int from, int to, struct font_info *info = (struct font_info *) s->font; unsigned char mb[MAX_MULTIBYTE_LENGTH]; void *view = FRAME_HAIKU_VIEW (f); + unsigned long foreground, background; block_input (); prepare_face_for_display (s->f, face); + if (s->hl != DRAW_CURSOR) + { + foreground = s->face->foreground; + background = s->face->background; + } + else + haiku_merge_cursor_foreground (s, &foreground, &background); + /* Presumably the draw lock is already held by haiku_draw_glyph_string; */ if (with_background) @@ -977,18 +986,12 @@ haikufont_draw (struct glyph_string *s, int from, int to, s->first_glyph->slice.glyphless.lower_yoff - s->first_glyph->slice.glyphless.upper_yoff; - BView_SetHighColor (view, s->hl == DRAW_CURSOR ? - FRAME_CURSOR_COLOR (s->f).pixel : face->background); - + BView_SetHighColor (view, background); BView_FillRectangle (view, x, y - ascent, s->width, height); s->background_filled_p = 1; } - if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); - else - BView_SetHighColor (view, face->foreground); - + BView_SetHighColor (view, foreground); BView_MovePenTo (view, x, y); BView_SetFont (view, ((struct haikufont_info *) info)->be_font); diff --git a/src/haikuterm.c b/src/haikuterm.c index aac9582e6e..6707340ca0 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3643,6 +3643,32 @@ haiku_end_cr_clip (cairo_t *cr) } #endif +void +haiku_merge_cursor_foreground (struct glyph_string *s, + unsigned long *foreground_out, + unsigned long *background_out) +{ + unsigned long background = FRAME_CURSOR_COLOR (s->f).pixel; + unsigned long foreground = s->face->background; + + if (background == foreground) + foreground = s->face->background; + if (background == foreground) + foreground = FRAME_OUTPUT_DATA (s->f)->cursor_fg; + if (background == foreground) + foreground = s->face->foreground; + + if (background == s->face->background + || foreground == s->face->foreground) + { + background = s->face->foreground; + foreground = s->face->background; + } + + *foreground_out = foreground; + *background_out = background; +} + void syms_of_haikuterm (void) { diff --git a/src/haikuterm.h b/src/haikuterm.h index 2dbdb6aafc..a2520858f5 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -294,4 +294,7 @@ haiku_begin_cr_clip (struct frame *f, struct glyph_string *s); extern void haiku_end_cr_clip (cairo_t *cr); #endif + +extern void haiku_merge_cursor_foreground (struct glyph_string *, unsigned long *, + unsigned long *); #endif /* _HAIKU_TERM_H_ */ commit 686f7f8f628c04e9d574186173165b2b5a9f92e2 Author: Po Lu Date: Sat Feb 5 10:51:39 2022 +0800 Set WM_TRANSIENT_FOR on tooltip frames Otherwise the decorations get all messed up on GNOME and some other composited desktops. * src/xfns.c (Fx_show_tip): Set WM_TRANSIENT_FOR to the window underneath the tooltip. diff --git a/src/xfns.c b/src/xfns.c index 9bbefd79a0..4719c5dac7 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7734,6 +7734,8 @@ Text larger than the specified size is clipped. */) ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t count_1; Lisp_Object window, size, tip_buf; + Window child; + int dest_x_return, dest_y_return; AUTO_STRING (tip, " *tip*"); specbind (Qinhibit_redisplay, Qt); @@ -7958,6 +7960,27 @@ Text larger than the specified size is clipped. */) /* Show tooltip frame. */ block_input (); + /* If the display is composited, then WM_TRANSIENT_FOR must be set + as well, or else the compositing manager won't display + decorations correctly, even though the tooltip window is override + redirect. See + https://specifications.freedesktop.org/wm-spec/1.4/ar01s08.html + + Perhaps WM_TRANSIENT_FOR should be used in place of + override-redirect anyway. The ICCCM only recommends + override-redirect if the pointer will be grabbed. */ + + if (XTranslateCoordinates (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + FRAME_DISPLAY_INFO (f)->root_window, + root_x, root_y, &dest_x_return, + &dest_y_return, &child)) + XSetTransientForHint (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), child); + else + XSetTransientForHint (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), None); + #ifndef USE_XCB XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f), root_x, root_y, width, height); commit 9ff88dfc5b148ac616959569165d947c7c388374 Author: Po Lu Date: Sat Feb 5 09:41:01 2022 +0800 Implement _NET_WM_PING protocol * src/xfns.c (append_wm_protocols): New function. (x_window): Call `append_wm_protocols' after window creation. * src/xterm.c (handle_one_xevent): Handle _NET_WM_PING client messages. (x_term_init): Intern _NET_WM_PING atom. * src/xterm.h (struct x_display_info): New field `Xatom_net_wm_ping'. diff --git a/src/xfns.c b/src/xfns.c index 4b10f5035a..9bbefd79a0 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2355,6 +2355,55 @@ hack_wm_protocols (struct frame *f, Widget widget) } #endif +static void +append_wm_protocols (struct x_display_info *dpyinfo, + struct frame *f) +{ + unsigned char *existing = NULL; + int format = 0; + unsigned long nitems = 0; + Atom type; + Atom *existing_protocols; + Atom protos[10]; + int num_protos = 0; + bool found_wm_ping = false; + unsigned long bytes_after; + + block_input (); + if ((XGetWindowProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_wm_protocols, + 0, 100, False, XA_ATOM, &type, &format, &nitems, + &bytes_after, &existing) == Success) + && format == 32 && type == XA_ATOM) + { + existing_protocols = (Atom *) existing; + + while (nitems) + { + nitems--; + + if (existing_protocols[nitems] + == dpyinfo->Xatom_net_wm_ping) + found_wm_ping = true; + } + } + + if (existing) + XFree (existing); + + if (!found_wm_ping) + protos[num_protos++] = dpyinfo->Xatom_net_wm_ping; + + if (num_protos) + XChangeProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_wm_protocols, + XA_ATOM, 32, PropModeAppend, + (unsigned char *) protos, + num_protos); + unblock_input (); +} + /* Support routines for XIC (X Input Context). */ @@ -3630,6 +3679,7 @@ x_window (struct frame *f, long window_prompting) &f->output_data.x->wm_hints); hack_wm_protocols (f, shell_widget); + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); #ifdef X_TOOLKIT_EDITRES XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0); @@ -3750,6 +3800,8 @@ x_window (struct frame *f) } #endif + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); + #ifdef HAVE_XINPUT2 if (FRAME_DISPLAY_INFO (f)->supports_xi2) setup_xi_event_mask (f); @@ -3790,6 +3842,7 @@ x_window (struct frame *f) FRAME_X_VISUAL (f), attribute_mask, &attributes); initial_set_up_x_back_buffer (f); + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); #ifdef HAVE_X_I18N if (use_xim) diff --git a/src/xterm.c b/src/xterm.c index deaa5b5961..34a85aa745 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9071,6 +9071,21 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto done; } + + if (event->xclient.data.l[0] == dpyinfo->Xatom_net_wm_ping + && event->xclient.format == 32) + { + XEvent send_event = *event; + + send_event.xclient.window = dpyinfo->root_window; + XSendEvent (dpyinfo->display, dpyinfo->root_window, False, + SubstructureRedirectMask | SubstructureNotifyMask, + &send_event); + + *finish = X_EVENT_DROP; + goto done; + } + goto done; } @@ -15914,6 +15929,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("_NET_WM_STATE_ABOVE", Xatom_net_wm_state_above) ATOM_REFS_INIT ("_NET_WM_STATE_BELOW", Xatom_net_wm_state_below) ATOM_REFS_INIT ("_NET_WM_OPAQUE_REGION", Xatom_net_wm_opaque_region) + ATOM_REFS_INIT ("_NET_WM_PING", Xatom_net_wm_ping) #ifdef HAVE_XKB ATOM_REFS_INIT ("Meta", Xatom_Meta) ATOM_REFS_INIT ("Super", Xatom_Super) diff --git a/src/xterm.h b/src/xterm.h index 02270d6936..99d339e1f9 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -498,7 +498,7 @@ struct x_display_info Xatom_net_wm_state_sticky, Xatom_net_wm_state_above, Xatom_net_wm_state_below, Xatom_net_wm_state_hidden, Xatom_net_wm_state_skip_taskbar, Xatom_net_frame_extents, Xatom_net_current_desktop, Xatom_net_workarea, - Xatom_net_wm_opaque_region; + Xatom_net_wm_opaque_region, Xatom_net_wm_ping; /* XSettings atoms and windows. */ Atom Xatom_xsettings_sel, Xatom_xsettings_prop, Xatom_xsettings_mgr; commit 5098f2b844b05e4ebbbbf44c5adbc3d7975e43e6 Author: Vladimir Panteleev Date: Fri Feb 4 02:46:50 2022 +0000 Update the MULTIPLE property with conversion outcomes Per the ICCCM spec: > If the owner fails to convert the target named by an atom in the > MULTIPLE property, it should replace that atom in the property with > None. * src/xselect.c (x_handle_selection_request): Do it. diff --git a/src/xselect.c b/src/xselect.c index 537be2ddd5..f2a64dd953 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -795,6 +795,7 @@ x_handle_selection_request (struct selection_input_event *event) Window requestor = SELECTION_EVENT_REQUESTOR (event); Lisp_Object multprop; ptrdiff_t j, nselections; + struct selection_data cs; if (property == None) goto DONE; multprop @@ -811,11 +812,19 @@ x_handle_selection_request (struct selection_input_event *event) Lisp_Object subtarget = AREF (multprop, 2*j); Atom subproperty = symbol_to_x_atom (dpyinfo, AREF (multprop, 2*j+1)); + bool subsuccess = false; if (subproperty != None) - x_convert_selection (selection_symbol, subtarget, - subproperty, true, dpyinfo); + subsuccess = x_convert_selection (selection_symbol, subtarget, + subproperty, true, dpyinfo); + if (!subsuccess) + ASET (multprop, 2*j+1, Qnil); } + /* Save conversion results */ + lisp_data_to_selection_data (dpyinfo, multprop, &cs); + XChangeProperty (dpyinfo->display, requestor, property, + cs.type, cs.format, PropModeReplace, + cs.data, cs.size); success = true; } else commit de687e8983f57c975e902af6eb484d9115ca0733 Author: Vladimir Panteleev Date: Fri Feb 4 01:54:45 2022 +0000 Do not delete the MULTIPLE property after reading it Per the ICCCM spec: > The requestor should delete [...] the property specified in the > MULTIPLE request when it has copied all the data. We are not the requestor, so we should not be deleting this property (which is what x_get_window_property_as_lisp_data does). The property needs to remain available as the requestor will generally want to read it back to see which conversions succeeded or not. * src/xselect.c (x_get_window_property_as_lisp_data): Add flag which skips deleting the read property, or handling INCR (which does not make sense for MULTIPLE). (x_handle_selection_request): Enable the flag. diff --git a/src/xselect.c b/src/xselect.c index cfe028a169..537be2ddd5 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -52,7 +52,7 @@ static void unexpect_property_change (struct prop_location *); static void wait_for_property_change (struct prop_location *); static Lisp_Object x_get_window_property_as_lisp_data (struct x_display_info *, Window, Atom, - Lisp_Object, Atom); + Lisp_Object, Atom, bool); static Lisp_Object selection_data_to_lisp_data (struct x_display_info *, const unsigned char *, ptrdiff_t, Atom, int); @@ -799,7 +799,7 @@ x_handle_selection_request (struct selection_input_event *event) if (property == None) goto DONE; multprop = x_get_window_property_as_lisp_data (dpyinfo, requestor, property, - QMULTIPLE, selection); + QMULTIPLE, selection, true); if (!VECTORP (multprop) || ASIZE (multprop) % 2) goto DONE; @@ -1210,7 +1210,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, return x_get_window_property_as_lisp_data (dpyinfo, requestor_window, target_property, target_type, - selection_atom); + selection_atom, false); } /* Subroutines of x_get_window_property_as_lisp_data */ @@ -1461,7 +1461,8 @@ static Lisp_Object x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, Window window, Atom property, Lisp_Object target_type, - Atom selection_atom) + Atom selection_atom, + bool for_multiple) { Atom actual_type; int actual_format; @@ -1477,6 +1478,8 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, &actual_type, &actual_format, &actual_size); if (! data) { + if (for_multiple) + return Qnil; block_input (); bool there_is_a_selection_owner = XGetSelectionOwner (display, selection_atom) != 0; @@ -1499,7 +1502,7 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, } } - if (actual_type == dpyinfo->Xatom_INCR) + if (!for_multiple && actual_type == dpyinfo->Xatom_INCR) { /* That wasn't really the data, just the beginning. */ @@ -1515,11 +1518,14 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, &actual_size); } - block_input (); - TRACE1 (" Delete property %s", XGetAtomName (display, property)); - XDeleteProperty (display, window, property); - XFlush (display); - unblock_input (); + if (!for_multiple) + { + block_input (); + TRACE1 (" Delete property %s", XGetAtomName (display, property)); + XDeleteProperty (display, window, property); + XFlush (display); + unblock_input (); + } /* It's been read. Now convert it to a lisp object in some semi-rational manner. */ commit d52c929e31f60ff0462371bfe27ebd479e3e82bd Author: Stefan Monnier Date: Fri Feb 4 19:39:53 2022 -0500 (with-demoted-errors): Warn on missing `format` arg The `format` arg has been mandatory for a while, but the backward compatibility code that handled the case of a missing `format` arg made it hard to notice when using the old calling convention. * lisp/subr.el (with-demoted-errors): Warn on missing `format` arg. * lisp/emacs-lisp/smie.el (smie-indent--separator-outdent): Don't abuse `with-demoted-errors`. (smie-indent-line, smie-auto-fill): * test/lisp/emacs-lisp/ert-tests.el (ert-test-with-demoted-errors): * lisp/vc/vc-hooks.el (vc-refresh-state): * lisp/vc/vc-annotate.el (vc-annotate-background-mode): * lisp/vc/diff-mode.el (diff-syntax-fontify-hunk): * lisp/textmodes/reftex-toc.el (reftex-re-enlarge): * lisp/progmodes/sh-script.el (sh-smie-sh-rules): * lisp/progmodes/octave.el (inferior-octave-startup): * lisp/pcmpl-gnu.el (pcmpl-gnu-make-all-targets): * lisp/org/org-refile.el (org-refile): * lisp/org/org-capture.el (org-capture-store-last-position): * lisp/nxml/nxml-mode.el (nxml-mode): * lisp/notifications.el (notifications-notify): * lisp/gnus/mm-view.el (mm-display-inline-fontify): * lisp/finder.el (finder-unload-function): * lisp/files.el (safe-local-variable-p, backup-buffer-copy * lisp/autorevert.el (auto-revert-notify-handler): Pass `format` arg to `with-demoted-errors`. diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 97a122b7bc..918c0c7f19 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -692,7 +692,7 @@ system.") (defun auto-revert-notify-handler (event) "Handle an EVENT returned from file notification." - (with-demoted-errors + (with-demoted-errors "Error while auto-reverting: %S" (let* ((descriptor (car event)) (action (nth 1 event)) (file (nth 2 event)) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index b2283e66e4..2bab131913 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1301,9 +1301,9 @@ Only meaningful when called from within `smie-rules-function'." (let ((afterpos (save-excursion (let ((tok (funcall smie-forward-token-function))) (unless tok - (with-demoted-errors - (error "smie-rule-separator: Can't skip token %s" - smie--token)))) + (funcall (if debug-on-error #'error #'message) + "smie-rule-separator: Can't skip token %s" + smie--token))) (skip-chars-forward " ") (unless (eolp) (point))))) (or (and afterpos @@ -1820,7 +1820,7 @@ to which that point should be aligned, if we were to reindent it.") "Indent current line using the SMIE indentation engine." (interactive) (let* ((savep (point)) - (indent (or (with-demoted-errors + (indent (or (with-demoted-errors "SMIE Error: %S" (save-excursion (forward-line 0) (skip-chars-forward " \t") @@ -1846,7 +1846,7 @@ to which that point should be aligned, if we were to reindent it.") (move-to-column fc) (syntax-ppss)))) (while - (and (with-demoted-errors + (and (with-demoted-errors "SMIE Error: %S" (save-excursion (let ((end (point)) (bsf nil) ;Best-so-far. diff --git a/lisp/files.el b/lisp/files.el index 247579efb4..cfa1a5972c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4061,7 +4061,8 @@ It is safe if any of these conditions are met: (and (functionp safep) ;; If the function signals an error, that means it ;; can't assure us that the value is safe. - (with-demoted-errors (funcall safep val)))))) + (with-demoted-errors "Local variable error: %S" + (funcall safep val)))))) (defun risky-local-variable-p (sym &optional _ignored) "Non-nil if SYM could be dangerous as a file-local variable. @@ -4937,7 +4938,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." nil))) ;; If set-file-extended-attributes fails, fall back on set-file-modes. (unless (and extended-attributes - (with-demoted-errors + (with-demoted-errors "Error setting attributes: %S" (set-file-extended-attributes to-name extended-attributes))) (and modes (set-file-modes to-name (logand modes #o1777) nofollow-flag))))) @@ -5558,7 +5559,8 @@ Before and after saving the buffer, this function runs (goto-char (point-max)) (insert ?\n)))) ;; Don't let errors prevent saving the buffer. - (with-demoted-errors (run-hooks 'before-save-hook)) + (with-demoted-errors "Before-save hook error: %S" + (run-hooks 'before-save-hook)) ;; Give `write-contents-functions' a chance to ;; short-circuit the whole process. (unless (run-hook-with-args-until-success 'write-contents-functions) @@ -5606,7 +5608,7 @@ Before and after saving the buffer, this function runs (condition-case () (progn (unless - (with-demoted-errors + (with-demoted-errors "Error setting file modes: %S" (set-file-modes buffer-file-name (car setmodes))) (set-file-extended-attributes buffer-file-name (nth 1 setmodes)))) @@ -5721,7 +5723,7 @@ Before and after saving the buffer, this function runs ;; If set-file-extended-attributes fails, fall back on ;; set-file-modes. (unless - (with-demoted-errors + (with-demoted-errors "Error setting attributes: %s" (set-file-extended-attributes buffer-file-name (nth 1 setmodes))) (set-file-modes buffer-file-name diff --git a/lisp/finder.el b/lisp/finder.el index 5a6fe45192..a40f8c64f2 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -454,7 +454,8 @@ Quit the window and kill all Finder-related buffers." (defun finder-unload-function () "Unload the Finder library." - (with-demoted-errors (unload-feature 'finder-inf t)) + (with-demoted-errors "Error unloading finder: %S" + (unload-feature 'finder-inf t)) ;; continue standard unloading nil) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index c40c38a95f..57ce36a944 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -519,17 +519,17 @@ If MODE is not set, try to find mode automatically." ;; setting now, but it seems harmless and potentially still useful. (setq-local font-lock-mode-hook nil) (setq buffer-file-name (mm-handle-filename handle)) - (with-demoted-errors - (if mode - (save-window-excursion - ;; According to Katsumi Yamaoka , org-mode - ;; requires the buffer to be temporarily displayed here, but - ;; I could not reproduce this problem. Furthermore, if - ;; there's such a problem, we should fix org-mode rather than - ;; use switch-to-buffer which can have undesirable - ;; side-effects! - ;;(switch-to-buffer (current-buffer)) - (funcall mode)) + (with-demoted-errors "Error setting mode: %S" + (if mode + (save-window-excursion + ;; According to Katsumi Yamaoka , org-mode + ;; requires the buffer to be temporarily displayed here, but + ;; I could not reproduce this problem. Furthermore, if + ;; there's such a problem, we should fix org-mode rather than + ;; use switch-to-buffer which can have undesirable + ;; side-effects! + ;;(switch-to-buffer (current-buffer)) + (funcall mode)) (let ((auto-mode-alist (delq (rassq 'doc-view-mode-maybe auto-mode-alist) (copy-sequence auto-mode-alist)))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 121ede42c4..126badca3e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5023,6 +5023,7 @@ Mostly useful to protect BODY from being interrupted by timers." ,@body) (tramp-flush-connection-property ,proc "locked")))) +;; FIXME: This call is redundant in current Emacsen. (font-lock-add-keywords 'emacs-lisp-mode '("\\")) diff --git a/lisp/notifications.el b/lisp/notifications.el index 5ad64ff73b..b58a1a0211 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -202,7 +202,7 @@ This function returns a notification id, an integer, which can be used to manipulate the notification item with `notifications-close-notification' or the `:replaces-id' argument of another `notifications-notify' call." - (with-demoted-errors + (with-demoted-errors "Notification error: %S" (let ((bus (or (plist-get params :bus) :session)) (title (plist-get params :title)) (body (plist-get params :body)) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index b8f6cb5ad3..171b7088c1 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -566,7 +566,8 @@ Many aspects this mode can be customized using (font-lock-syntactic-face-function . sgml-font-lock-syntactic-face))) - (with-demoted-errors (rng-nxml-mode-init))) + (with-demoted-errors "RNG NXML error: %S" + (rng-nxml-mode-init))) (defun nxml--buffer-substring-filter (string) ;; The `rng-state' property is huge, so don't copy it to the kill ring. diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index d3c5094b46..2fd9a9c74d 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1453,7 +1453,8 @@ Of course, if exact position has been required, just put it there." (org-with-point-at pos (when org-capture-bookmark (let ((bookmark (plist-get org-bookmark-names-plist :last-capture))) - (when bookmark (with-demoted-errors (bookmark-set bookmark))))) + (when bookmark (with-demoted-errors "Bookmark set error: %S" + (bookmark-set bookmark))))) (move-marker org-capture-last-stored-marker (point)))))) (defun org-capture-narrow (beg end) diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 8e1ab7439e..f76ebefe7b 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -566,16 +566,16 @@ prefix argument (`C-u C-u C-u C-c C-w')." (let ((bookmark-name (plist-get org-bookmark-names-plist :last-refile))) (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) + (with-demoted-errors "Bookmark set error: %S" + (bookmark-set bookmark-name)))) ;; If we are refiling for capture, make sure that the ;; last-capture pointers point here (when (bound-and-true-p org-capture-is-refiling) (let ((bookmark-name (plist-get org-bookmark-names-plist :last-capture-marker))) (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) + (with-demoted-errors "Bookmark set error: %S" + (bookmark-set bookmark-name)))) (move-marker org-capture-last-stored-marker (point))) (when (fboundp 'deactivate-mark) (deactivate-mark)) (run-hooks 'org-after-refile-insert-hook))) diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index d0ae9390e3..3c9bf1ec9d 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -134,7 +134,7 @@ Return the new list." "Add to TARGETS the list of target names in MAKEFILE and files it includes. Return the new list." (with-temp-buffer - (with-demoted-errors ;Could be a directory or something. + (with-demoted-errors "Error inserting makefile: %S" (insert-file-contents makefile)) (let ((filenames (when pcmpl-gnu-makefile-includes (pcmpl-gnu-make-includes)))) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index ecc9386cae..7b7c675873 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -879,7 +879,8 @@ startup file, `~/.emacs-octave'." (set-process-filter proc 'comint-output-filter) ;; Just in case, to be sure a cd in the startup file won't have ;; detrimental effects. - (with-demoted-errors (inferior-octave-resync-dirs)) + (with-demoted-errors "Octave resync error: %S" + (inferior-octave-resync-dirs)) ;; Generate a proper prompt, which is critical to ;; `comint-history-isearch-backward-regexp'. Bug#14433. (comint-send-string proc "\n"))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 3ad0f0182f..0a2ec348c1 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1973,7 +1973,7 @@ May return nil if the line should not be treated as continued." (cons 'column (smie-indent-keyword ";")) (smie-rule-separator kind))) (`(:after . ,(or ";;" ";&" ";;&")) - (with-demoted-errors + (with-demoted-errors "SMIE rule error: %S" (smie-backward-sexp token) (cons 'column (if (or (smie-rule-bolp) diff --git a/lisp/subr.el b/lisp/subr.el index a1eb6fe3af..0b546c0e0b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4531,19 +4531,21 @@ It should contain a single %-sequence; e.g., \"Error: %S\". If `debug-on-error' is non-nil, run BODY without catching its errors. This is to be used around code that is not expected to signal an error -but that should be robust in the unexpected case that an error is signaled. - -For backward compatibility, if FORMAT is not a constant string, it -is assumed to be part of BODY, in which case the message format -used is \"Error: %S\"." +but that should be robust in the unexpected case that an error is signaled." (declare (debug t) (indent 1)) - (let ((err (make-symbol "err")) - (format (if (and (stringp format) body) format - (prog1 "Error: %S" - (if format (push format body)))))) - `(condition-case-unless-debug ,err - ,(macroexp-progn body) - (error (message ,format ,err) nil)))) + (let* ((err (make-symbol "err")) + (orig-body body) + (format (if (and (stringp format) body) format + (prog1 "Error: %S" + (if format (push format body))))) + (exp + `(condition-case-unless-debug ,err + ,(macroexp-progn body) + (error (message ,format ,err) nil)))) + (if (eq orig-body body) exp + ;; The use without `format' is obsolete, let's warn when we bump + ;; into any such remaining uses. + (macroexp-warn-and-return format "Missing format argument" exp)))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 4ba3c2193e..f6f72cec4f 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -381,7 +381,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (- (or reftex-last-window-height (window-height)) (window-height))))) (when (> count 0) - (with-demoted-errors ;E.g. the window might be the root window! + (with-demoted-errors "Enlarge window error: %S" (enlarge-window count reftex-toc-split-windows-horizontally))))) (defun reftex-toc-dframe-p (&optional frame error) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 731d1e8256..0bf7899246 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2678,7 +2678,8 @@ When OLD is non-nil, highlight the hunk from the old source." ;; Trim a trailing newline to find hunk in diff-syntax-fontify-props ;; in diffs that have no newline at end of diff file. (text (string-trim-right - (or (with-demoted-errors (diff-hunk-text hunk (not old) nil)) + (or (with-demoted-errors "Error getting hunk text: %S" + (diff-hunk-text hunk (not old) nil)) ""))) (line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?") (if old (match-string 1) diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index bd4ff3e015..4a511f1f68 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -57,7 +57,7 @@ is applied to the background." :set (lambda (symbol value) (set-default symbol value) (when (boundp 'vc-annotate-color-map) - (with-demoted-errors + (with-demoted-errors "VC color map error: %S" ;; Update the value of the dependent variable. (custom-reevaluate-setting 'vc-annotate-color-map)))) :version "25.1" diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 9c49e94781..bd2ea337b1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -799,9 +799,10 @@ In the latter case, VC mode is deactivated for this buffer." (add-hook 'vc-mode-line-hook #'vc-mode-line nil t) (let (backend) (cond - ((setq backend (with-demoted-errors (vc-backend buffer-file-name))) - ;; Let the backend setup any buffer-local things he needs. - (vc-call-backend backend 'find-file-hook) + ((setq backend (with-demoted-errors "VC refresh error: %S" + (vc-backend buffer-file-name))) + ;; Let the backend setup any buffer-local things he needs. + (vc-call-backend backend 'find-file-hook) ;; Compute the state and put it in the mode line. (vc-mode-line buffer-file-name backend) (unless vc-make-backup-files diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 270cca1c2e..dd12e3764c 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -865,7 +865,7 @@ This macro is used to test if macroexpansion in `should' works." (ert-deftest ert-test-with-demoted-errors () "Check that ERT correctly handles `with-demoted-errors'." :expected-result :failed ;; FIXME! Bug#11218 - (should-not (with-demoted-errors (error "Foo")))) + (should-not (with-demoted-errors "FOO: %S" (error "Foo")))) (ert-deftest ert-test-fail-inside-should () "Check that `ert-fail' inside `should' works correctly." commit b4f1ceaf241239b8fc7ad1e91af62f4e425bda8a Author: Stefan Monnier Date: Fri Feb 4 13:39:19 2022 -0500 python.el: Silence left over warning in last commit * lisp/progmodes/python.el (python-shell-calculate-process-environment): Declare tramp-remote-process-environment before using it. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index ba8e3e811d..d83290fe45 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2208,6 +2208,7 @@ virtualenv." (defun python-shell-calculate-process-environment () (declare (obsolete python-shell--calculate-process-environment "29.1")) + (defvar tramp-remote-process-environment) (let* ((remote-p (file-remote-p default-directory))) (append (python-shell--calculate-process-environment) (if remote-p commit d340dc0a256db979c617bd5ee06dafa5a52791f5 Author: Stefan Monnier Date: Fri Feb 4 13:35:21 2022 -0500 python.el: Try and better split the Tramp code Massage the Python-Tramp code so that the Tramp part and the Python part are a bit less intertwined. It's still not quite right, but it's a bit closer to the point where the Tramp part can be moved to `tramp.el`. * lisp/progmodes/python.el: Don't require `tramp-sh`. Do require `subr-x` OTOH. Remove redundant `:group`s. (python-shell--calculate-process-environment): New function, that only return the entries to be added. (python-shell-calculate-process-environment): Rewrite and declare obsolete. (python-shell-tramp-refresh-remote-path) (python-shell-tramp-refresh-process-environment): Silence compiler warnings. (python-shell-with-environment): Move the bulk of its code to a new function `python-shell--with-environment` for easier debugging and to avoid code duplication. (python-shell--with-environment): New function. Split the Tramp case into its own function. (python-shell--tramp-with-environment): New function. (python-eldoc-function-timeout-permanent): Fix doc's first line. * test/lisp/progmodes/python-tests.el: Adjust accordingly. (python-shell-calculate-process-environment-1) (python-shell-calculate-process-environment-2) (python-shell-calculate-process-environment-3) (python-shell-calculate-process-environment-4) (python-shell-calculate-process-environment-5) (python-shell-calculate-process-environment-6) (python-shell-calculate-process-environment-7) (python-shell-calculate-process-environment-8): Use `python-shell--calculate-process-environment`. (python--tests-process-env-canonical, python--tests-process-env-eql): New functions. (python-shell-with-environment-2, python-shell-with-environment-3): Use them. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5889f2ab67..ba8e3e811d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -92,7 +92,7 @@ ;; Operating Systems' pipe buffering (e.g. CPython 3.3.4 in Windows 7. ;; See URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To ;; avoid this, the `python-shell-unbuffered' defaults to non-nil and -;; controls whether `python-shell-calculate-process-environment' +;; controls whether `python-shell--calculate-process-environment' ;; should set the "PYTHONUNBUFFERED" environment variable on startup: ;; See URL `https://docs.python.org/3/using/cmdline.html#cmdoption-u'. @@ -149,7 +149,7 @@ ;; (setq python-shell-process-environment ;; (list ;; (format "PATH=%s" (mapconcat -;; 'identity +;; #'identity ;; (reverse ;; (cons (getenv "PATH") ;; '("/path/to/env/bin/"))) @@ -245,7 +245,7 @@ (require 'ansi-color) (require 'cl-lib) (require 'comint) -(require 'tramp-sh) +(eval-when-compile (require 'subr-x)) ;For `string-empty-p'. ;; Avoid compiler warnings (defvar view-return-to-alist) @@ -273,39 +273,39 @@ (defvar python-mode-map (let ((map (make-sparse-keymap))) ;; Movement - (define-key map [remap backward-sentence] 'python-nav-backward-block) - (define-key map [remap forward-sentence] 'python-nav-forward-block) - (define-key map [remap backward-up-list] 'python-nav-backward-up-list) - (define-key map [remap mark-defun] 'python-mark-defun) - (define-key map "\C-c\C-j" 'imenu) + (define-key map [remap backward-sentence] #'python-nav-backward-block) + (define-key map [remap forward-sentence] #'python-nav-forward-block) + (define-key map [remap backward-up-list] #'python-nav-backward-up-list) + (define-key map [remap mark-defun] #'python-mark-defun) + (define-key map "\C-c\C-j" #'imenu) ;; Indent specific - (define-key map "\177" 'python-indent-dedent-line-backspace) - (define-key map (kbd "") 'python-indent-dedent-line) - (define-key map "\C-c<" 'python-indent-shift-left) - (define-key map "\C-c>" 'python-indent-shift-right) + (define-key map "\177" #'python-indent-dedent-line-backspace) + (define-key map (kbd "") #'python-indent-dedent-line) + (define-key map "\C-c<" #'python-indent-shift-left) + (define-key map "\C-c>" #'python-indent-shift-right) ;; Skeletons - (define-key map "\C-c\C-tc" 'python-skeleton-class) - (define-key map "\C-c\C-td" 'python-skeleton-def) - (define-key map "\C-c\C-tf" 'python-skeleton-for) - (define-key map "\C-c\C-ti" 'python-skeleton-if) - (define-key map "\C-c\C-tm" 'python-skeleton-import) - (define-key map "\C-c\C-tt" 'python-skeleton-try) - (define-key map "\C-c\C-tw" 'python-skeleton-while) + (define-key map "\C-c\C-tc" #'python-skeleton-class) + (define-key map "\C-c\C-td" #'python-skeleton-def) + (define-key map "\C-c\C-tf" #'python-skeleton-for) + (define-key map "\C-c\C-ti" #'python-skeleton-if) + (define-key map "\C-c\C-tm" #'python-skeleton-import) + (define-key map "\C-c\C-tt" #'python-skeleton-try) + (define-key map "\C-c\C-tw" #'python-skeleton-while) ;; Shell interaction - (define-key map "\C-c\C-p" 'run-python) - (define-key map "\C-c\C-s" 'python-shell-send-string) - (define-key map "\C-c\C-e" 'python-shell-send-statement) - (define-key map "\C-c\C-r" 'python-shell-send-region) - (define-key map "\C-\M-x" 'python-shell-send-defun) - (define-key map "\C-c\C-c" 'python-shell-send-buffer) - (define-key map "\C-c\C-l" 'python-shell-send-file) - (define-key map "\C-c\C-z" 'python-shell-switch-to-shell) + (define-key map "\C-c\C-p" #'run-python) + (define-key map "\C-c\C-s" #'python-shell-send-string) + (define-key map "\C-c\C-e" #'python-shell-send-statement) + (define-key map "\C-c\C-r" #'python-shell-send-region) + (define-key map "\C-\M-x" #'python-shell-send-defun) + (define-key map "\C-c\C-c" #'python-shell-send-buffer) + (define-key map "\C-c\C-l" #'python-shell-send-file) + (define-key map "\C-c\C-z" #'python-shell-switch-to-shell) ;; Some util commands - (define-key map "\C-c\C-v" 'python-check) - (define-key map "\C-c\C-f" 'python-eldoc-at-point) - (define-key map "\C-c\C-d" 'python-describe-at-point) + (define-key map "\C-c\C-v" #'python-check) + (define-key map "\C-c\C-f" #'python-eldoc-at-point) + (define-key map "\C-c\C-d" #'python-describe-at-point) ;; Utilities - (substitute-key-definition 'complete-symbol 'completion-at-point + (substitute-key-definition #'complete-symbol #'completion-at-point map global-map) (easy-menu-define python-menu map "Python Mode menu" '("Python" @@ -825,7 +825,6 @@ It makes underscores and dots word constituent chars.") (defcustom python-indent-offset 4 "Default indentation offset for Python." - :group 'python :type 'integer :safe 'integerp) @@ -835,21 +834,18 @@ It makes underscores and dots word constituent chars.") (defcustom python-indent-guess-indent-offset t "Non-nil tells Python mode to guess `python-indent-offset' value." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-indent-guess-indent-offset-verbose t "Non-nil means to emit a warning when indentation guessing fails." :version "25.1" :type 'boolean - :group 'python :safe' booleanp) (defcustom python-indent-trigger-commands '(indent-for-tab-command yas-expand yas/expand) "Commands that might trigger a `python-indent-line' call." - :type '(repeat symbol) - :group 'python) + :type '(repeat symbol)) (defcustom python-indent-def-block-scale 2 "Multiplier applied to indentation inside multi-line def blocks." @@ -2031,7 +2027,6 @@ position, else returns nil." (defcustom python-shell-buffer-name "Python" "Default buffer name for Python interpreter." :type 'string - :group 'python :safe 'stringp) (defcustom python-shell-interpreter @@ -2045,19 +2040,16 @@ Some Python interpreters also require changes to `python-shell-interpreter' to \"ipython3\" requires setting `python-shell-interpreter-args' to \"--simple-prompt\"." :version "28.1" - :type 'string - :group 'python) + :type 'string) (defcustom python-shell-internal-buffer-name "Python Internal" "Default buffer name for the Internal Python interpreter." :type 'string - :group 'python :safe 'stringp) (defcustom python-shell-interpreter-args "-i" "Default arguments for the Python interpreter." - :type 'string - :group 'python) + :type 'string) (defcustom python-shell-interpreter-interactive-arg "-i" "Interpreter argument to force it to run interactively." @@ -2122,7 +2114,6 @@ It should not contain a caret (^) at the beginning." "Should syntax highlighting be enabled in the Python shell buffer? Restart the Python shell after changing this variable for it to take effect." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-shell-unbuffered t @@ -2130,7 +2121,6 @@ Restart the Python shell after changing this variable for it to take effect." When non-nil, this may prevent delayed and missing output in the Python shell. See commentary for details." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-shell-process-environment nil @@ -2140,8 +2130,7 @@ When this variable is non-nil, values are exported into the process environment before starting it. Any variables already present in the current environment are superseded by variables set here." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-extra-pythonpaths nil "List of extra pythonpaths for Python shell. @@ -2150,8 +2139,7 @@ the PYTHONPATH before starting processes. Any values present here that already exists in PYTHONPATH are moved to the beginning of the list so that they are prioritized when looking for modules." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-exec-path nil "List of paths for searching executables. @@ -2159,8 +2147,7 @@ When this variable is non-nil, values added at the beginning of the PATH before starting processes. Any values present here that already exists in PATH are moved to the beginning of the list so that they are prioritized when looking for executables." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-remote-exec-path nil "List of paths to be ensured remotely for searching executables. @@ -2171,8 +2158,7 @@ here. Normally you won't use this variable directly unless you plan to ensure a particular set of paths to all Python shell executed through tramp connections." :version "25.1" - :type '(repeat string) - :group 'python) + :type '(repeat string)) (define-obsolete-variable-alias 'python-shell-virtualenv-path 'python-shell-virtualenv-root "25.1") @@ -2182,13 +2168,11 @@ executed through tramp connections." This variable, when set to a string, makes the environment to be modified such that shells are started within the specified virtualenv." - :type '(choice (const nil) directory) - :group 'python) + :type '(choice (const nil) directory)) (defcustom python-shell-setup-codes nil "List of code run by `python-shell-send-setup-code'." - :type '(repeat symbol) - :group 'python) + :type '(repeat symbol)) (defcustom python-shell-compilation-regexp-alist `((,(rx line-start (1+ (any " \t")) "File \"" @@ -2202,8 +2186,7 @@ virtualenv." "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()") 1 2)) "`compilation-error-regexp-alist' for inferior Python." - :type '(alist regexp) - :group 'python) + :type '(alist regexp)) (defvar python-shell-output-filter-in-progress nil) (defvar python-shell-output-filter-buffer nil) @@ -2221,33 +2204,33 @@ virtualenv." (or (getenv "PYTHONPATH") "") path-separator 'omit))) (python-shell--add-to-path-with-priority pythonpath python-shell-extra-pythonpaths) - (mapconcat 'identity pythonpath path-separator))) + (mapconcat #'identity pythonpath path-separator))) (defun python-shell-calculate-process-environment () - "Calculate `process-environment' or `tramp-remote-process-environment'. + (declare (obsolete python-shell--calculate-process-environment "29.1")) + (let* ((remote-p (file-remote-p default-directory))) + (append (python-shell--calculate-process-environment) + (if remote-p + tramp-remote-process-environment + process-environment)))) + +(defun python-shell--calculate-process-environment () + "Return a list of entries to add to the `process-environment'. Prepends `python-shell-process-environment', sets extra pythonpaths from `python-shell-extra-pythonpaths' and sets a few -virtualenv related vars. If `default-directory' points to a -remote host, the returned value is intended for -`tramp-remote-process-environment'." - (let* ((remote-p (file-remote-p default-directory)) - (process-environment (if remote-p - tramp-remote-process-environment - process-environment)) - (virtualenv (when python-shell-virtualenv-root - (directory-file-name python-shell-virtualenv-root)))) - (dolist (env python-shell-process-environment) - (pcase-let ((`(,key ,value) (split-string env "="))) - (setenv key value))) +virtualenv related vars." + (let* ((virtualenv (when python-shell-virtualenv-root + (directory-file-name python-shell-virtualenv-root))) + (res python-shell-process-environment)) (when python-shell-unbuffered - (setenv "PYTHONUNBUFFERED" "1")) + (push "PYTHONUNBUFFERED=1" res)) (when python-shell-extra-pythonpaths - (setenv "PYTHONPATH" (python-shell-calculate-pythonpath))) + (push (concat "PYTHONPATH=" (python-shell-calculate-pythonpath)) res)) (if (not virtualenv) - process-environment - (setenv "PYTHONHOME" nil) - (setenv "VIRTUAL_ENV" virtualenv)) - process-environment)) + nil + (push "PYTHONHOME" res) + (push (concat "VIRTUAL_ENV=" virtualenv) res)) + res)) (defun python-shell-calculate-exec-path () "Calculate `exec-path'. @@ -2275,14 +2258,26 @@ of `exec-path'." (defun python-shell-tramp-refresh-remote-path (vec paths) "Update VEC's remote-path giving PATHS priority." + (cl-assert (featurep 'tramp)) + (declare-function tramp-set-remote-path "tramp-sh") + (declare-function tramp-set-connection-property "tramp-cache") + (declare-function tramp-get-connection-property "tramp-cache") (let ((remote-path (tramp-get-connection-property vec "remote-path" nil))) (when remote-path + ;; FIXME: This part of the Tramp code still knows about Python! (python-shell--add-to-path-with-priority remote-path paths) (tramp-set-connection-property vec "remote-path" remote-path) (tramp-set-remote-path vec)))) + (defun python-shell-tramp-refresh-process-environment (vec env) "Update VEC's process environment with ENV." + (cl-assert (featurep 'tramp)) + (defvar tramp-end-of-heredoc) + (defvar tramp-end-of-output) + ;; Do we even know that `tramp-sh' is loaded at this point? + ;; What about files accessed via FTP, sudo, ...? + (declare-function tramp-send-command "tramp-sh") ;; Stolen from `tramp-open-connection-setup-interactive-shell'. (let ((env (append (when (fboundp 'tramp-get-remote-locale) ;; Emacs<24.4 compat. @@ -2295,7 +2290,7 @@ of `exec-path'." unset vars item) (while env (setq item (split-string (car env) "=" 'omit)) - (setcdr item (mapconcat 'identity (cdr item) "=")) + (setcdr item (mapconcat #'identity (cdr item) "=")) (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) (push (format "%s %s" (car item) (cdr item)) vars) (push (car item) unset)) @@ -2305,12 +2300,12 @@ of `exec-path'." vec (format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s" tramp-end-of-heredoc - (mapconcat 'identity vars "\n") + (mapconcat #'identity vars "\n") tramp-end-of-heredoc) t)) (when unset (tramp-send-command - vec (format "unset %s" (mapconcat 'identity unset " ")) t)))) + vec (format "unset %s" (mapconcat #'identity unset " ")) t)))) (defmacro python-shell-with-environment (&rest body) "Modify shell environment during execution of BODY. @@ -2319,41 +2314,49 @@ execution of body. If `default-directory' points to a remote machine then modifies `tramp-remote-process-environment' and `python-shell-remote-exec-path' instead." (declare (indent 0) (debug (body))) - (let ((vec (make-symbol "vec"))) - `(progn - (let* ((,vec - (when (file-remote-p default-directory) - (ignore-errors - (tramp-dissect-file-name default-directory 'noexpand)))) - (process-environment - (if ,vec - process-environment - (python-shell-calculate-process-environment))) - (exec-path - (if ,vec - exec-path - (python-shell-calculate-exec-path))) - (tramp-remote-process-environment - (if ,vec - (python-shell-calculate-process-environment) - tramp-remote-process-environment))) - (when (tramp-get-connection-process ,vec) - ;; For already existing connections, the new exec path must - ;; be re-set, otherwise it won't take effect. One example - ;; of such case is when remote dir-locals are read and - ;; *then* subprocesses are triggered within the same - ;; connection. - (python-shell-tramp-refresh-remote-path - ,vec (python-shell-calculate-exec-path)) - ;; The `tramp-remote-process-environment' variable is only - ;; effective when the started process is an interactive - ;; shell, otherwise (like in the case of processes started - ;; with `process-file') the environment is not changed. - ;; This makes environment modifications effective - ;; unconditionally. - (python-shell-tramp-refresh-process-environment - ,vec tramp-remote-process-environment)) - ,(macroexp-progn body))))) + `(python-shell--with-environment + (python-shell--calculate-process-environment) + (lambda () ,@body))) + +(defun python-shell--with-environment (extraenv bodyfun) + ;; FIXME: This is where the generic code delegates to Tramp. + (let* ((vec + (and (file-remote-p default-directory) + (fboundp 'tramp-dissect-file-name) + (ignore-errors + (tramp-dissect-file-name default-directory 'noexpand))))) + (if vec + (python-shell--tramp-with-environment vec extraenv bodyfun) + (let ((process-environment + (append extraenv process-environment)) + (exec-path + ;; FIXME: This is still Python-specific. + (python-shell-calculate-exec-path))) + (funcall bodyfun))))) + +(defun python-shell--tramp-with-environment (vec extraenv bodyfun) + (defvar tramp-remote-process-environment) + (declare-function tramp-get-connection-process "tramp" (vec)) + (let* ((tramp-remote-process-environment + (append extraenv tramp-remote-process-environment))) + (when (tramp-get-connection-process vec) + ;; For already existing connections, the new exec path must + ;; be re-set, otherwise it won't take effect. One example + ;; of such case is when remote dir-locals are read and + ;; *then* subprocesses are triggered within the same + ;; connection. + (python-shell-tramp-refresh-remote-path + ;; FIXME: This is still Python-specific. + vec (python-shell-calculate-exec-path)) + ;; The `tramp-remote-process-environment' variable is only + ;; effective when the started process is an interactive + ;; shell, otherwise (like in the case of processes started + ;; with `process-file') the environment is not changed. + ;; This makes environment modifications effective + ;; unconditionally. + (python-shell-tramp-refresh-process-environment + vec tramp-remote-process-environment)) + (funcall bodyfun))) (defvar python-shell--prompt-calculated-input-regexp nil "Calculated input prompt regexp for inferior python shell. @@ -2636,7 +2639,7 @@ banner and the initial prompt are received separately." (define-obsolete-function-alias 'python-comint-output-filter-function - 'ansi-color-filter-apply + #'ansi-color-filter-apply "25.1") (defun python-comint-postoutput-scroll-to-bottom (output) @@ -2821,8 +2824,7 @@ current process to not hang while waiting. This is useful to safely attach setup code for long-running processes that eventually provide a shell." :version "25.1" - :type 'hook - :group 'python) + :type 'hook) (defconst python-shell-eval-setup-code "\ @@ -2956,7 +2958,7 @@ variable. (add-hook 'completion-at-point-functions #'python-shell-completion-at-point nil 'local) (define-key inferior-python-mode-map "\t" - 'python-shell-completion-complete-or-indent) + #'python-shell-completion-complete-or-indent) (make-local-variable 'python-shell-internal-last-output) (when python-shell-font-lock-enable (python-shell-font-lock-turn-on)) @@ -2982,7 +2984,8 @@ killed." (let* ((cmdlist (split-string-and-unquote cmd)) (interpreter (car cmdlist)) (args (cdr cmdlist)) - (buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name + (buffer (apply #'make-comint-in-buffer proc-name + proc-buffer-name interpreter nil args)) (python-shell--parent-buffer (current-buffer)) (process (get-buffer-process buffer)) @@ -3131,7 +3134,7 @@ there for compatibility with CEDET.") (run-python-internal)))) (define-obsolete-function-alias - 'python-proc 'python-shell-internal-get-or-create-process "24.3") + 'python-proc #'python-shell-internal-get-or-create-process "24.3") (defun python-shell--save-temp-file (string) (let* ((temporary-file-directory @@ -3250,10 +3253,10 @@ Returns the output. See `python-shell-send-string-no-output'." (python-shell-internal-get-or-create-process)))) (define-obsolete-function-alias - 'python-send-receive 'python-shell-internal-send-string "24.3") + 'python-send-receive #'python-shell-internal-send-string "24.3") (define-obsolete-function-alias - 'python-send-string 'python-shell-internal-send-string "24.3") + 'python-send-string #'python-shell-internal-send-string "24.3") (defun python-shell-buffer-substring (start end &optional nomain no-cookie) "Send buffer substring from START to END formatted for shell. @@ -3549,8 +3552,7 @@ def __PYTHON_EL_get_completions(text): completer.print_mode = True return completions" "Code used to setup completion in inferior Python processes." - :type 'string - :group 'python) + :type 'string) (define-obsolete-variable-alias 'python-shell-completion-module-string-code @@ -3823,7 +3825,8 @@ With argument MSG show activation/deactivation message." ;; in use based on its args and uses `apply-partially' ;; to make it up for the 3 args case. (if (= (length - (help-function-arglist 'comint-redirect-filter)) 3) + (help-function-arglist 'comint-redirect-filter)) + 3) (set-process-filter process (apply-partially #'comint-redirect-filter original-filter-fn)) @@ -3932,7 +3935,7 @@ using that one instead of current buffer's process." (define-obsolete-function-alias 'python-shell-completion-complete-at-point - 'python-shell-completion-at-point + #'python-shell-completion-at-point "25.1") (defun python-shell-completion-complete-or-indent () @@ -3961,7 +3964,6 @@ considered over. The overlay arrow will be removed from the currently tracked buffer. Additionally, if `python-pdbtrack-kill-buffers' is non-nil, all files opened by pdbtracking will be killed." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-pdbtrack-stacktrace-info-regexp @@ -4170,7 +4172,7 @@ inferior Python process is updated properly." (define-obsolete-function-alias 'python-completion-complete-at-point - 'python-completion-at-point + #'python-completion-at-point "25.1") @@ -4180,29 +4182,25 @@ inferior Python process is updated properly." "Function to fill comments. This is the function used by `python-fill-paragraph' to fill comments." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-string-function 'python-fill-string "Function to fill strings. This is the function used by `python-fill-paragraph' to fill strings." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-decorator-function 'python-fill-decorator "Function to fill decorators. This is the function used by `python-fill-paragraph' to fill decorators." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-paren-function 'python-fill-paren "Function to fill parens. This is the function used by `python-fill-paragraph' to fill parens." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-docstring-style 'pep-257 "Style used to fill docstrings. @@ -4272,7 +4270,6 @@ value may result in one of the following docstring styles: (const :tag "PEP-257 with 2 newlines at end of string." pep-257) (const :tag "PEP-257 with 1 newline at end of string." pep-257-nn) (const :tag "Symmetric style." symmetric)) - :group 'python :safe (lambda (val) (memq val '(django onetwo pep-257 pep-257-nn symmetric nil)))) @@ -4431,7 +4428,6 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." This happens when pressing \"if\", for example, to prompt for the if condition." :type 'boolean - :group 'python :safe 'booleanp) (defvar python-skeleton-available '() @@ -4556,7 +4552,7 @@ The skeleton will be bound to python-skeleton-NAME." (defun python-skeleton-add-menu-items () "Add menu items to Python->Skeletons menu." - (let ((skeletons (sort python-skeleton-available 'string<))) + (let ((skeletons (sort python-skeleton-available #'string<))) (dolist (skeleton skeletons) (easy-menu-add-item nil '("Python" "Skeletons") @@ -4586,8 +4582,7 @@ def __FFAP_get_module_path(objstr): except: return ''" "Python code to get a module path." - :type 'string - :group 'python) + :type 'string) (defun python-ffap-module-path (module) "Function for `ffap-alist' to return path for MODULE." @@ -4615,14 +4610,12 @@ def __FFAP_get_module_path(objstr): (executable-find "epylint") "install pyflakes, pylint or something else") "Command used to check a Python file." - :type 'string - :group 'python) + :type 'string) (defcustom python-check-buffer-name "*Python check: %s*" "Buffer name used for check commands." - :type 'string - :group 'python) + :type 'string) (defvar python-check-custom-command nil "Internal use.") @@ -4689,8 +4682,7 @@ See `python-check-command' for the default." doc = '' return doc" "Python code to setup documentation retrieval." - :type 'string - :group 'python) + :type 'string) (defun python-eldoc--get-symbol-at-point () "Get the current symbol for eldoc. @@ -4737,14 +4729,13 @@ Set to nil by `python-eldoc-function' if (defcustom python-eldoc-function-timeout 1 "Timeout for `python-eldoc-function' in seconds." - :group 'python :type 'integer :version "25.1") (defcustom python-eldoc-function-timeout-permanent t - "Non-nil means that when `python-eldoc-function' times out -`python-eldoc-get-doc' will be set to nil." - :group 'python + "If non-nil, a timeout in Python-Eldoc will disable it permanently. +Python-Eldoc can be re-enabled manually by setting `python-eldoc-get-doc' +back to t in the affected buffer." :type 'boolean :version "25.1") @@ -4936,7 +4927,7 @@ To this: (\"decorator.wrapped_f\" . 393))" ;; Inspired by imenu--flatten-index-alist removed in revno 21853. (apply - 'nconc + #'nconc (mapcar (lambda (item) (let ((name (if prefix @@ -5019,7 +5010,7 @@ since it returns nil if point is not inside a defun." (and (= (current-indentation) 0) (throw 'exit t)))) (and names (concat (and type (format "%s " type)) - (mapconcat 'identity names "."))))))) + (mapconcat #'identity names "."))))))) (defun python-info-current-symbol (&optional replace-self) "Return current symbol using dotty syntax. @@ -5040,9 +5031,10 @@ parent defun name." (replace-regexp-in-string (python-rx line-start word-start "self" word-end ?.) (concat - (mapconcat 'identity + (mapconcat #'identity (butlast (split-string current-defun "\\.")) - ".") ".") + ".") + ".") name))))))) (defun python-info-statement-starts-block-p () @@ -5084,7 +5076,7 @@ parent defun name." (define-obsolete-function-alias 'python-info-closing-block - 'python-info-dedenter-opening-block-position "24.4") + #'python-info-dedenter-opening-block-position "24.4") (defun python-info-dedenter-opening-block-position () "Return the point of the closest block the current line closes. @@ -5129,7 +5121,8 @@ likely an invalid python file." (let ((indentation (current-indentation))) (when (and (not (memq indentation collected-indentations)) (or (not collected-indentations) - (< indentation (apply #'min collected-indentations))) + (< indentation + (apply #'min collected-indentations))) ;; There must be no line with indentation ;; smaller than `indentation' (except for ;; blank lines) between the found opening @@ -5157,7 +5150,7 @@ likely an invalid python file." (define-obsolete-function-alias 'python-info-closing-block-message - 'python-info-dedenter-opening-block-message "24.4") + #'python-info-dedenter-opening-block-message "24.4") (defun python-info-dedenter-opening-block-message () "Message the first line of the block the current statement closes." @@ -5459,10 +5452,12 @@ allowed files." (let ((dir-name (file-name-as-directory dir))) (apply #'nconc (mapcar (lambda (file-name) - (let ((full-file-name (expand-file-name file-name dir-name))) + (let ((full-file-name + (expand-file-name file-name dir-name))) (when (and (not (member file-name '("." ".."))) - (funcall (or predicate #'identity) full-file-name)) + (funcall (or predicate #'identity) + full-file-name)) (list full-file-name)))) (directory-files dir-name))))) @@ -5530,7 +5525,6 @@ required arguments. Once launched it will receive the Python source to be checked as its standard input. To use `flake8' you would set this to (\"flake8\" \"-\")." :version "26.1" - :group 'python-flymake :type '(repeat string)) ;; The default regexp accommodates for older pyflakes, which did not @@ -5552,7 +5546,6 @@ If COLUMN or TYPE are nil or that index didn't match, that information is not present on the matched line and a default will be used." :version "26.1" - :group 'python-flymake :type '(list regexp (integer :tag "Line's index") (choice @@ -5577,7 +5570,6 @@ configuration could be: By default messages are considered errors." :version "26.1" - :group 'python-flymake :type '(alist :key-type (regexp) :value-type (symbol))) diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 0eb1c087f4..1a6a7dc176 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -2634,58 +2634,59 @@ if x: "Test `python-shell-process-environment' modification." (let* ((python-shell-process-environment '("TESTVAR1=value1" "TESTVAR2=value2")) - (process-environment (python-shell-calculate-process-environment))) - (should (equal (getenv "TESTVAR1") "value1")) - (should (equal (getenv "TESTVAR2") "value2")))) + (env (python-shell--calculate-process-environment))) + (should (equal (getenv-internal "TESTVAR1" env) "value1")) + (should (equal (getenv-internal "TESTVAR2" env) "value2")))) (ert-deftest python-shell-calculate-process-environment-2 () "Test `python-shell-extra-pythonpaths' modification." (let* ((process-environment process-environment) (_original-pythonpath (setenv "PYTHONPATH" "/path0")) (python-shell-extra-pythonpaths '("/path1" "/path2")) - (process-environment (python-shell-calculate-process-environment))) - (should (equal (getenv "PYTHONPATH") + (env (python-shell--calculate-process-environment))) + (should (equal (getenv-internal "PYTHONPATH" env) (concat "/path1" path-separator "/path2" path-separator "/path0"))))) (ert-deftest python-shell-calculate-process-environment-3 () "Test `python-shell-virtualenv-root' modification." (let* ((python-shell-virtualenv-root "/env") - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONHOME" "/home") (setenv "VIRTUAL_ENV") - (python-shell-calculate-process-environment)))) - (should (not (getenv "PYTHONHOME"))) - (should (string= (getenv "VIRTUAL_ENV") "/env")))) + (python-shell--calculate-process-environment)))) + (should (member "PYTHONHOME" env)) + (should (string= (getenv-internal "VIRTUAL_ENV" env) "/env")))) (ert-deftest python-shell-calculate-process-environment-4 () "Test PYTHONUNBUFFERED when `python-shell-unbuffered' is non-nil." (let* ((python-shell-unbuffered t) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED") - (python-shell-calculate-process-environment)))) - (should (string= (getenv "PYTHONUNBUFFERED") "1")))) + (python-shell--calculate-process-environment)))) + (should (string= (getenv-internal "PYTHONUNBUFFERED" env) "1")))) (ert-deftest python-shell-calculate-process-environment-5 () "Test PYTHONUNBUFFERED when `python-shell-unbuffered' is nil." (let* ((python-shell-unbuffered nil) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED") - (python-shell-calculate-process-environment)))) - (should (not (getenv "PYTHONUNBUFFERED"))))) + (python-shell--calculate-process-environment)))) + (should (not (getenv-internal "PYTHONUNBUFFERED" env))))) (ert-deftest python-shell-calculate-process-environment-6 () "Test PYTHONUNBUFFERED=1 when `python-shell-unbuffered' is nil." (let* ((python-shell-unbuffered nil) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED" "1") - (python-shell-calculate-process-environment)))) + (append (python-shell--calculate-process-environment) + process-environment)))) ;; User default settings must remain untouched: - (should (string= (getenv "PYTHONUNBUFFERED") "1")))) + (should (string= (getenv-internal "PYTHONUNBUFFERED" env) "1")))) (ert-deftest python-shell-calculate-process-environment-7 () "Test no side-effects on `process-environment'." @@ -2695,7 +2696,7 @@ if x: (python-shell-unbuffered t) (python-shell-extra-pythonpaths'("/path1" "/path2")) (original-process-environment (copy-sequence process-environment))) - (python-shell-calculate-process-environment) + (python-shell--calculate-process-environment) (should (equal process-environment original-process-environment)))) (ert-deftest python-shell-calculate-process-environment-8 () @@ -2708,7 +2709,7 @@ if x: (python-shell-extra-pythonpaths'("/path1" "/path2")) (original-process-environment (copy-sequence tramp-remote-process-environment))) - (python-shell-calculate-process-environment) + (python-shell--calculate-process-environment) (should (equal tramp-remote-process-environment original-process-environment)))) (ert-deftest python-shell-calculate-exec-path-1 () @@ -2780,23 +2781,43 @@ if x: (should (string= (getenv "VIRTUAL_ENV") "/env"))) (should (equal exec-path original-exec-path)))) +(defun python--tests-process-env-canonical (pe) + ;; `process-environment' can contain various entries for the same + ;; var, and the first in the list hides the others. + (let ((process-environment '())) + (dolist (x (reverse pe)) + (if (string-match "=" x) + (setenv (substring x 0 (match-beginning 0)) + (substring x (match-end 0))) + (setenv x nil))) + process-environment)) + +(defun python--tests-process-env-eql (pe1 pe2) + (equal (python--tests-process-env-canonical pe1) + (python--tests-process-env-canonical pe2))) + (ert-deftest python-shell-with-environment-2 () "Test environment with remote `default-directory'." (let* ((default-directory "/ssh::/example/dir/") (python-shell-remote-exec-path '("/remote1" "/remote2")) (python-shell-exec-path '("/path1" "/path2")) (tramp-remote-process-environment '("EMACS=t")) - (original-process-environment (copy-sequence tramp-remote-process-environment)) + (original-process-environment + (copy-sequence tramp-remote-process-environment)) (python-shell-virtualenv-root "/env")) (python-shell-with-environment (should (equal (python-shell-calculate-exec-path) (list (python-virt-bin) "/path1" "/path2" "/remote1" "/remote2"))) - (let ((process-environment (python-shell-calculate-process-environment))) + (let ((process-environment + (append (python-shell--calculate-process-environment) + tramp-remote-process-environment))) (should (not (getenv "PYTHONHOME"))) (should (string= (getenv "VIRTUAL_ENV") "/env")) - (should (equal tramp-remote-process-environment process-environment)))) - (should (equal tramp-remote-process-environment original-process-environment)))) + (should (python--tests-process-env-eql + tramp-remote-process-environment process-environment)))) + (should (equal tramp-remote-process-environment + original-process-environment)))) (ert-deftest python-shell-with-environment-3 () "Test `python-shell-with-environment' is idempotent." @@ -2805,11 +2826,14 @@ if x: (python-shell-virtualenv-root "/home/user/env") (single-call (python-shell-with-environment - (list exec-path process-environment))) + (list exec-path + (python--tests-process-env-canonical process-environment)))) (nested-call (python-shell-with-environment (python-shell-with-environment - (list exec-path process-environment))))) + (list exec-path + (python--tests-process-env-canonical + process-environment)))))) (should (equal single-call nested-call)))) (ert-deftest python-shell-make-comint-1 () commit f88d4e424877c5709bb49d7d905004dea06ce089 Author: Michael Albinus Date: Fri Feb 4 19:24:43 2022 +0100 Improve Tramp tests backward compatibility * test/lisp/net/tramp-tests.el (tramp-test39-detect-external-change): Improve backward compatibility. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index b41824a6cf..9be1985780 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -6018,13 +6018,13 @@ Use direct async.") (ignore-errors (delete-file tmp-name1)) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) -;; The function was introduced in Emacs 28.1. +;; The functions were introduced in Emacs 28.1. (ert-deftest tramp-test39-detect-external-change () "Check that an external file modification is reported." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-ange-ftp-p))) ;; Since Emacs 28.1. - (skip-unless (fboundp 'file-locked-p)) + (skip-unless (and (fboundp 'lock-file) (fboundp 'file-locked-p))) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (dolist (create-lockfiles '(nil t)) commit dcf30f14f90d13ffe9d1ccca153b17287334060e Author: Andrea Corallo Date: Fri Feb 4 15:45:42 2022 +0100 * Have `null' and `not' explicit in LIMPLE so we inline them * lisp/emacs-lisp/comp.el (comp-limplify-lap-inst): Generate explicit `eq' call in LIMPLE for LAP opcode 'not'. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 9c2fc93821..122638077c 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1832,7 +1832,9 @@ and the annotation emission." (byte-listp auto) (byte-eq auto) (byte-memq auto) - (byte-not null) + (byte-not + (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp)) + (make-comp-mvar :constant nil)))) (byte-car auto) (byte-cdr auto) (byte-cons auto) commit 9a8796f067d1f9d5d0c2c1285dc86b2f577f4f27 Author: Eli Zaretskii Date: Fri Feb 4 15:50:50 2022 +0200 Fix infloop in redisplay_window due to fix of bug#14582 * src/xdisp.c (window_start_acceptable_p): New function. (redisplay_window): Call 'window_start_acceptable_p' to determine whether a given window-start point is acceptable, including when the window's force_start flag is set -- this fixes infloop in redisplay_window in that case. diff --git a/src/xdisp.c b/src/xdisp.c index 20b0d97b97..db9bc512a9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -18739,6 +18739,34 @@ set_horizontal_scroll_bar (struct window *w) (w, portion, whole, start); } +/* Subroutine of redisplay_window, to determine whether a window-start + point STARTP of WINDOW should be rejected. */ +static bool +window_start_acceptable_p (Lisp_Object window, ptrdiff_t startp) +{ + if (!make_window_start_visible) + return true; + + struct window *w = XWINDOW (window); + struct frame *f = XFRAME (w->frame); + Lisp_Object startpos = make_fixnum (startp); + Lisp_Object invprop, disp_spec; + struct text_pos ignored; + + /* Is STARTP in invisible text? */ + if (startp > BEGV + && ((invprop = Fget_char_property (startpos, Qinvisible, window)), + TEXT_PROP_MEANS_INVISIBLE (invprop) != 0)) + return false; + + /* Is STARTP covered by a replacing 'display' property? */ + if (!NILP (disp_spec = Fget_char_property (startpos, Qdisplay, window)) + && handle_display_spec (NULL, disp_spec, Qnil, Qnil, &ignored, startp, + FRAME_WINDOW_P (f)) > 0) + return false; + + return true; +} /* Redisplay leaf window WINDOW. JUST_THIS_ONE_P means only selected_window is redisplayed. @@ -19036,9 +19064,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) force_start: /* Handle case where place to start displaying has been specified, - unless the specified location is outside the accessible range, or - the buffer wants the window-start point to be always visible. */ - if (w->force_start && !make_window_start_visible) + unless the specified location is outside the accessible range. */ + if (w->force_start) { /* We set this later on if we have to adjust point. */ int new_vpos = -1; @@ -19071,6 +19098,11 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) else if (CHARPOS (startp) > ZV) SET_TEXT_POS (startp, ZV, ZV_BYTE); + /* Reject the specified start location if it is invisible, and + the buffer wants it always visible. */ + if (!window_start_acceptable_p (window, CHARPOS (startp))) + goto ignore_start; + /* Redisplay, then check if cursor has been set during the redisplay. Give up if new fonts were loaded. */ /* We used to issue a CHECK_MARGINS argument to try_window here, @@ -19228,8 +19260,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) goto done; } - Lisp_Object iprop, dspec; - struct text_pos ignored; + ignore_start: + /* Handle case where text has not changed, only point, and it has not moved off the frame, and we are not retrying after hscroll. (current_matrix_up_to_date_p is true when retrying.) */ @@ -19253,26 +19285,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) /* If current starting point was originally the beginning of a line but no longer is, or if the starting point is invisible but the buffer wants it always visible, find a new starting point. */ - else if (w->start_at_line_beg - && (!(CHARPOS (startp) <= BEGV - || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n') - || (make_window_start_visible - /* Is window-start in invisible text? */ - && ((CHARPOS (startp) > BEGV - && ((iprop = - Fget_char_property - (make_fixnum (CHARPOS (startp) - 1), Qinvisible, - window)), - TEXT_PROP_MEANS_INVISIBLE (iprop) != 0)) - /* Is window-start covered by a replacing - 'display' property? */ - || (!NILP (dspec = - Fget_char_property - (make_fixnum (CHARPOS (startp)), Qdisplay, - window)) - && handle_display_spec (NULL, dspec, Qnil, Qnil, - &ignored, CHARPOS (startp), - FRAME_WINDOW_P (f)) > 0))))) + else if ((w->start_at_line_beg + && !(CHARPOS (startp) <= BEGV + || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n')) + || !window_start_acceptable_p (window, CHARPOS (startp))) { #ifdef GLYPH_DEBUG debug_method_add (w, "recenter 1"); @@ -19348,14 +19364,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) goto force_start; } - /* Don't use the same window-start if it is covered by a - replacing 'display' property and the buffer requested the - window-start to be always visible. */ - if (make_window_start_visible - && !NILP (dspec = Fget_char_property (make_fixnum (CHARPOS (startp)), - Qdisplay, window)) - && handle_display_spec (NULL, dspec, Qnil, Qnil, &ignored, - CHARPOS (startp), FRAME_WINDOW_P (f)) > 0) + /* Don't use the same window-start if it is invisible or covered + by a replacing 'display' property and the buffer requested + the window-start to be always visible. */ + if (!window_start_acceptable_p (window, CHARPOS (startp))) { #ifdef GLYPH_DEBUG debug_method_add (w, "recenter 2"); commit 38ffb828f26d630cf7e10b7e8554aea98e299f1b Author: Po Lu Date: Fri Feb 4 21:22:03 2022 +0800 Remove misleading "in current buffer" message from auto-raise-mode * lisp/frame.el (auto-raise-mode): Declare as global to prevent a misleading message from being displayed. It's actually frame-local, but declaring it global doesn't hurt since `frame-parameter' is a gv. diff --git a/lisp/frame.el b/lisp/frame.el index d39597d0af..6bf4c6178b 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1590,6 +1590,11 @@ acquires focus to be automatically raised. Note that this minor mode controls Emacs's own auto-raise feature. Window managers that switch focus on mouse movement often have their own auto-raise feature." + ;; This isn't really a global minor mode; rather, it's local to the + ;; selected frame, but declaring it as global prevents a misleading + ;; "Auto-Raise mode enabled in current buffer" message from being + ;; displayed when it is turned on. + :global t :variable (frame-parameter nil 'auto-raise) (if (frame-parameter nil 'auto-raise) (raise-frame))) commit 702a5c6feb7a03cf76ec5a3189c9ae0fbcea6d5e Author: Stefan Kangas Date: Fri Feb 4 14:15:33 2022 +0100 Silence byte-compiler in two tests * test/lisp/electric-tests.el (electric-pair-define-test-form): * test/src/buffer-tests.el (buffer-tests--make-test-name): Silence byte-compiler by defining defuns also at run time. diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index e10ed04f9d..5d7e905cfa 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -79,7 +79,7 @@ (should (equal (point) expected-point)))) -(eval-when-compile +(eval-and-compile (defun electric-pair-define-test-form (name fixture char pos diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 31a4b1ac71..c1e5d0ebed 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -101,7 +101,7 @@ with parameters from the *Messages* buffer modification." ;; | Overlay test setup ;; +==========================================================================+ -(eval-when-compile +(eval-and-compile (defun buffer-tests--make-test-name (fn x y) (intern (format "buffer-tests--%s-%s-%s" fn x y)))) commit 3e20a900195cb72e4c940db9ff123c3049483074 Author: Po Lu Date: Fri Feb 4 12:12:56 2022 +0000 ; * src/haikuterm.c (haiku_end_cr_clip): Fix trivial typo. diff --git a/src/haikuterm.c b/src/haikuterm.c index 5d90acb443..aac9582e6e 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3637,7 +3637,7 @@ void haiku_end_cr_clip (cairo_t *cr) { if (!cr) - return NULL; + return; cairo_restore (cr); } commit 279f3c6d602fe7d43df20db2775b204b2c5bfe3c Author: Po Lu Date: Fri Feb 4 12:10:30 2022 +0000 Implement auto-raise on Haiku * src/haikuterm.c (haiku_read_socket): Implement auto-raising of frames that have that parameter set. diff --git a/src/haikuterm.c b/src/haikuterm.c index e8c734d671..5d90acb443 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -2811,6 +2811,12 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) last_mouse_window = window; } + if (f->auto_raise) + { + if (!BWindow_is_active (FRAME_HAIKU_WINDOW (f))) + haiku_frame_raise_lower (f, 1); + } + if (!NILP (help_echo_string) || !NILP (previous_help_echo_string)) do_help = 1; commit 37c433e4e281077488a72eb7a7cc6a33202317ae Author: Michael Albinus Date: Fri Feb 4 11:59:56 2022 +0100 * lisp/net/tramp-gvfs.el (tramp-gvfs-send-command): Fix problem with locale. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 221ee547a2..763a9e849f 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2246,13 +2246,7 @@ connection if a previous connection has died for some reason." COMMAND is a command from the gvfs-* utilities. It is replaced by the corresponding gio tool call if available. `call-process' is applied, and it returns t if the return code is zero." - (let* ((locale (tramp-get-local-locale vec)) - (process-environment - (append - `(,(format "LANG=%s" locale) - ,(format "LANGUAGE=%s" locale) - ,(format "LC_ALL=%s" locale)) - process-environment))) + (let ((locale (tramp-get-local-locale vec))) (when (tramp-gvfs-gio-tool-p vec) ;; Use gio tool. (setq args (cons (cdr (assoc command tramp-gvfs-gio-mapping)) @@ -2262,7 +2256,14 @@ is applied, and it returns t if the return code is zero." (with-current-buffer (tramp-get-connection-buffer vec) (tramp-gvfs-maybe-open-connection vec) (erase-buffer) - (or (zerop (apply #'tramp-call-process vec command nil t nil args)) + (or (zerop + (apply + #'tramp-call-process vec "env" nil t nil + (append `(,(format "LANG=%s" locale) + ,(format "LANGUAGE=%s" locale) + ,(format "LC_ALL=%s" locale) + ,command) + args))) ;; Remove information about mounted connection. (and (tramp-flush-file-properties vec "/") nil)))))