From 17bd063a67404a13ff719830336693d7cd7f6d79 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 13 Mar 2022 22:39:36 -0700 Subject: [PATCH 1/5] Add unit test for erc--switch-to-buffer * test/lisp/erc/erc-tests.el (erc--switch-to-buffer): Add new test. (Bug#53617) --- test/lisp/erc/erc-tests.el | 57 +++++++++++++++++++++++++++++++++++++- 1 file changed, 56 insertions(+), 1 deletion(-) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 5603e764547..5a2b90a9402 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -21,7 +21,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'erc) (require 'erc-ring) (require 'erc-networks) @@ -114,6 +114,61 @@ (should (get-buffer "#spam")) (kill-buffer "#spam"))) +(ert-deftest erc--switch-to-buffer () + (defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el + + (let ((proc (start-process "aNet" (current-buffer) "true")) + (erc-modified-channels-alist `(("fake") (,(messages-buffer)))) + (inhibit-message noninteractive) + (completion-fail-discreetly t) ; otherwise ^G^G printed to .log file + ;; + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + + (with-current-buffer (get-buffer-create "server") + (erc-mode) + (set-process-buffer (setq erc-server-process proc) (current-buffer)) + (with-current-buffer (get-buffer-create "#chan") + (erc-mode) + (setq erc-server-process proc)) + (with-current-buffer (get-buffer-create "#foo") + (erc-mode) + (setq erc-server-process proc)) + + (ert-info ("Channel #chan selectable from server buffer") + (ert-simulate-keys (list ?# ?c ?h ?a ?n ?\C-m) + (should (string= "#chan" (erc--switch-to-buffer)))))) + + (ert-info ("Channel #foo selectable from non-ERC buffer") + (ert-simulate-keys (list ?# ?f ?o ?o ?\C-m) + (should (string= "#foo" (erc--switch-to-buffer))))) + + (ert-info ("Default selectable") + (ert-simulate-keys (list ?\C-m) + (should (string= "*Messages*" (erc--switch-to-buffer))))) + + (ert-info ("Extant but non-ERC buffer not selectable") + (get-buffer-create "#fake") ; not ours + (ert-simulate-keys (kbd "#fake C-m C-a C-k C-m") + ;; Initial query fails ~~~~~~^; clearing input accepts default + (should (string= "*Messages*" (erc--switch-to-buffer))))) + + (with-current-buffer (get-buffer-create "other") + (erc-mode) + (setq erc-server-process (start-process "bNet" (current-buffer) "true"))) + + (ert-info ("Foreign ERC buffer not selectable") + (ert-simulate-keys (kbd "other C-m C-a C-k C-m") + (with-current-buffer "server" + (should (string= "*Messages*" (erc--switch-to-buffer)))))) + + (ert-info ("Any ERC-buffer selectable from non-ERC buffer") + (should-not (eq major-mode 'erc-mode)) + (ert-simulate-keys (list ?o ?t ?h ?e ?r ?\C-m) + (should (string= "other" (erc--switch-to-buffer))))) + + (dolist (b '("server" "other" "#chan" "#foo" "#fake")) + (kill-buffer b)))) + (ert-deftest erc-lurker-maybe-trim () (let (erc-lurker-trim-nicks (erc-lurker-ignore-chars "_`")) From f755daafb92cc61596708a580040784fc269edd4 Mon Sep 17 00:00:00 2001 From: Guy Gastineau Date: Fri, 28 Jan 2022 23:12:42 -0500 Subject: [PATCH 2/5] Remove redundant checks in erc--switch-to-buffer * lisp/erc/erc.el (erc--switch-to-buffer): Commit f925fc93bac41d7622d1af927e33b0e738ff55b0 "Add `predicate' arg to `read-buffer' and use it for erc-iswitchb" meant to remove this, but it was left behind. (Bug#53617) Copyright-paperwork-exempt: yes --- lisp/erc/erc.el | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 9ee8d38b026..52fe106f2d1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1761,12 +1761,7 @@ nil." (lambda (bufname) (let ((buf (if (consp bufname) (cdr bufname) (get-buffer bufname)))) - (when buf - (erc--buffer-p buf (lambda () t) proc) - (with-current-buffer buf - (and (derived-mode-p 'erc-mode) - (or (null proc) - (eq proc erc-server-process)))))))))) + (and buf (erc--buffer-p buf (lambda () t) proc))))))) (defun erc-switch-to-buffer (&optional arg) "Prompt for an ERC buffer to switch to. When invoked with prefix argument, use all ERC buffers. Without From 2f1fbf20ad957331b34bb3914e06185b3b34a1a1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 19 Mar 2022 02:33:24 -0700 Subject: [PATCH 3/5] ; * test/lisp/erc/erc-tests.el (erc--switch-to-buffer): Fix test failure. --- test/lisp/erc/erc-tests.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 5a2b90a9402..520f10dd4e6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -127,6 +127,7 @@ (with-current-buffer (get-buffer-create "server") (erc-mode) (set-process-buffer (setq erc-server-process proc) (current-buffer)) + (set-process-query-on-exit-flag erc-server-process nil) (with-current-buffer (get-buffer-create "#chan") (erc-mode) (setq erc-server-process proc)) @@ -154,7 +155,8 @@ (with-current-buffer (get-buffer-create "other") (erc-mode) - (setq erc-server-process (start-process "bNet" (current-buffer) "true"))) + (setq erc-server-process (start-process "bNet" (current-buffer) "true")) + (set-process-query-on-exit-flag erc-server-process nil)) (ert-info ("Foreign ERC buffer not selectable") (ert-simulate-keys (kbd "other C-m C-a C-k C-m") From c79e0188e849715a7c4dc306c93ad8d0b3517d32 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sat, 19 Mar 2022 18:46:50 +0800 Subject: [PATCH 4/5] Improve protection against faulty clients during DND * src/xterm.c (x_dnd_send_enter, x_dnd_send_position) (xdnd_send_leave, x_dnd_send_drop): Catch errors around call to XSendEvent. The target window could be gone. --- src/xterm.c | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/xterm.c b/src/xterm.c index b820c102f1b..fb0fc66ae59 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1035,7 +1035,9 @@ x_dnd_send_enter (struct frame *f, Window target, int supported) PropModeReplace, (unsigned char *) x_dnd_targets, x_dnd_n_targets); + x_catch_errors (dpyinfo->display); XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); + x_uncatch_errors (); } static void @@ -1075,7 +1077,9 @@ x_dnd_send_position (struct frame *f, Window target, int supported, if (supported >= 4) msg.xclient.data.l[4] = action; + x_catch_errors (dpyinfo->display); XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); + x_uncatch_errors (); } static void @@ -1094,7 +1098,9 @@ x_dnd_send_leave (struct frame *f, Window target) msg.xclient.data.l[3] = 0; msg.xclient.data.l[4] = 0; + x_catch_errors (dpyinfo->display); XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); + x_uncatch_errors (); } static void @@ -1117,7 +1123,9 @@ x_dnd_send_drop (struct frame *f, Window target, Time timestamp, if (supported >= 1) msg.xclient.data.l[2] = timestamp; + x_catch_errors (dpyinfo->display); XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); + x_uncatch_errors (); } void From 71b8f1fc635d9bbe00ca89457065e0c83456ac43 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 19 Mar 2022 15:11:15 +0100 Subject: [PATCH 5/5] Make `command-modes' work for (native-compiled) subrs, too * lisp/emacs-lisp/comp.el (comp-func): Add a command-modes slot. (comp-spill-lap-function, comp-intern-func-in-ctxt): Fill it. (comp-emit-for-top-level, comp-emit-lambda-for-top-level): Use it. * src/alloc.c (mark_object): Mark the command_modes slot. * src/comp.c (make_subr): Add a command_modes parameter. (Fcomp__register_lambda): Use it. (Fcomp__register_subr): Ditto. * src/data.c (Fcommand_modes): Output the command_modes data for subrs (bug#54437). * src/lisp.h (GCALIGNED_STRUCT): Add a command_modes slot. * src/pdumper.c (dump_subr): Update hash. (dump_subr): Dump the command_modes slot. --- lisp/emacs-lisp/comp.el | 12 ++++++++++-- src/alloc.c | 1 + src/comp.c | 16 +++++++++++++--- src/data.c | 6 +++++- src/lisp.h | 1 + src/pdumper.c | 4 +++- 6 files changed, 33 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 122638077ce..00efedd71f3 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -898,6 +898,8 @@ non local exit (ends with an `unreachable' insn).")) :documentation "Doc string.") (int-spec nil :type list :documentation "Interactive form.") + (command-modes nil :type list + :documentation "Command modes.") (lap () :type list :documentation "LAP assembly representation.") (ssa-status nil :type symbol @@ -1243,6 +1245,7 @@ clashes." :c-name c-name :doc (documentation f t) :int-spec (interactive-form f) + :command-modes (command-modes f) :speed (comp-spill-speed function-name) :pure (comp-spill-decl-spec function-name 'pure)))) @@ -1282,10 +1285,12 @@ clashes." (make-comp-func-l :c-name c-name :doc (documentation form t) :int-spec (interactive-form form) + :command-modes (command-modes form) :speed (comp-ctxt-speed comp-ctxt)) (make-comp-func-d :c-name c-name :doc (documentation form t) :int-spec (interactive-form form) + :command-modes (command-modes form) :speed (comp-ctxt-speed comp-ctxt))))) (let ((lap (byte-to-native-lambda-lap (gethash (aref byte-code 1) @@ -1327,6 +1332,7 @@ clashes." (comp-func-byte-func func) byte-func (comp-func-doc func) (documentation byte-func t) (comp-func-int-spec func) (interactive-form byte-func) + (comp-func-command-modes func) (command-modes byte-func) (comp-func-c-name func) c-name (comp-func-lap func) lap (comp-func-frame-size func) (comp-byte-frame-size byte-func) @@ -2079,7 +2085,8 @@ and the annotation emission." (i (hash-table-count h))) (puthash i (comp-func-doc f) h) i) - (comp-func-int-spec f))) + (comp-func-int-spec f) + (comp-func-command-modes f))) ;; This is the compilation unit it-self passed as ;; parameter. (make-comp-mvar :slot 0)))))) @@ -2122,7 +2129,8 @@ These are stored in the reloc data array." (i (hash-table-count h))) (puthash i (comp-func-doc func) h) i) - (comp-func-int-spec func))) + (comp-func-int-spec func) + (comp-func-command-modes func))) ;; This is the compilation unit it-self passed as ;; parameter. (make-comp-mvar :slot 0))))) diff --git a/src/alloc.c b/src/alloc.c index c19e3dabb6e..b0fbc91fe50 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6844,6 +6844,7 @@ mark_object (Lisp_Object arg) set_vector_marked (ptr); struct Lisp_Subr *subr = XSUBR (obj); mark_object (subr->native_intspec); + mark_object (subr->command_modes); mark_object (subr->native_comp_u); mark_object (subr->lambda_list); mark_object (subr->type); diff --git a/src/comp.c b/src/comp.c index 6449eedb278..499eee7e709 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5411,7 +5411,7 @@ native_function_doc (Lisp_Object function) static Lisp_Object make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, Lisp_Object c_name, Lisp_Object type, Lisp_Object doc_idx, - Lisp_Object intspec, Lisp_Object comp_u) + Lisp_Object intspec, Lisp_Object command_modes, Lisp_Object comp_u) { struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u); dynlib_handle_ptr handle = cu->handle; @@ -5445,6 +5445,7 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; x->s.symbol_name = xstrdup (SSDATA (symbol_name)); x->s.native_intspec = intspec; + x->s.command_modes = command_modes; x->s.doc = XFIXNUM (doc_idx); #ifdef HAVE_NATIVE_COMP x->s.native_comp_u = comp_u; @@ -5467,12 +5468,17 @@ This gets called by top_level_run during the load phase. */) { Lisp_Object doc_idx = FIRST (rest); Lisp_Object intspec = SECOND (rest); + Lisp_Object command_modes = Qnil; + if (!NILP (XCDR (XCDR (rest)))) + command_modes = THIRD (rest); + struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u); if (cu->loaded_once) return Qnil; Lisp_Object tem = - make_subr (c_name, minarg, maxarg, c_name, type, doc_idx, intspec, comp_u); + make_subr (c_name, minarg, maxarg, c_name, type, doc_idx, intspec, + command_modes, comp_u); /* We must protect it against GC because the function is not reachable through symbols. */ @@ -5497,9 +5503,13 @@ This gets called by top_level_run during the load phase. */) { Lisp_Object doc_idx = FIRST (rest); Lisp_Object intspec = SECOND (rest); + Lisp_Object command_modes = Qnil; + if (!NILP (XCDR (XCDR (rest)))) + command_modes = THIRD (rest); + Lisp_Object tem = make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx, - intspec, comp_u); + intspec, command_modes, comp_u); defalias (name, tem); diff --git a/src/data.c b/src/data.c index 23b0e7c29d9..5894340aba3 100644 --- a/src/data.c +++ b/src/data.c @@ -1167,7 +1167,11 @@ The value, if non-nil, is a list of mode name symbols. */) fun = Fsymbol_function (fun); } - if (COMPILEDP (fun)) + if (SUBRP (fun)) + { + return XSUBR (fun)->command_modes; + } + else if (COMPILEDP (fun)) { if (PVSIZE (fun) <= COMPILED_INTERACTIVE) return Qnil; diff --git a/src/lisp.h b/src/lisp.h index e4d156c0f45..b558d311a80 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2154,6 +2154,7 @@ struct Lisp_Subr const char *intspec; Lisp_Object native_intspec; }; + Lisp_Object command_modes; EMACS_INT doc; #ifdef HAVE_NATIVE_COMP Lisp_Object native_comp_u; diff --git a/src/pdumper.c b/src/pdumper.c index f14239f863a..11831023622 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2854,7 +2854,7 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_F09D8E8E19) +#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_A212A8F82A) # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h." #endif struct Lisp_Subr out; @@ -2878,11 +2878,13 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) COLD_OP_NATIVE_SUBR, make_lisp_ptr ((void *) subr, Lisp_Vectorlike)); dump_field_lv (ctx, &out, subr, &subr->native_intspec, WEIGHT_NORMAL); + dump_field_lv (ctx, &out, subr, &subr->command_modes, WEIGHT_NORMAL); } else { dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name); dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); + dump_field_emacs_ptr (ctx, &out, subr, &subr->command_modes); } DUMP_FIELD_COPY (&out, subr, doc); #ifdef HAVE_NATIVE_COMP