mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-26 23:31:55 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source
This commit is contained in:
Eli Zaretskii 2022-03-19 17:19:19 +02:00
commit 6887bf555f
9 changed files with 100 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

12
lisp/emacs-lisp/comp.el
View file

@ -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)))))

7
lisp/erc/erc.el
View file

@ -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

1
src/alloc.c
View file

@ -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);

16
src/comp.c
View file

@ -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);

6
src/data.c
View file

@ -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;

1
src/lisp.h
View file

@ -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;

4
src/pdumper.c
View file

@ -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

8
src/xterm.c
View file

@ -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

59
test/lisp/erc/erc-tests.el
View file

@ -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 "_`"))