Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs

9 files changed, 100 insertions, 14 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/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
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
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
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 5603e764547..520f10dd4e6 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,63 @@
     (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))
+      (set-process-query-on-exit-flag erc-server-process nil)
+      (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"))
+      (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")
+        (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 "_`"))