aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorStefan Monnier2012-11-19 23:24:09 -0500
committerStefan Monnier2012-11-19 23:24:09 -0500
commit23ba2705e22b89154ef7cbb0595419732080b94c (patch)
treeb9ca597bccdbbc6467e0fa76ea1fb321fcb0f5c0 /src
parentb0636be7f9526041aeaa9f4fb6d3636426eec899 (diff)
downloademacs-23ba2705e22b89154ef7cbb0595419732080b94c.tar.gz
emacs-23ba2705e22b89154ef7cbb0595419732080b94c.zip
Make called-interactively-p work for edebug or advised code.
* lisp/subr.el (called-interactively-p-functions): New var. (internal--called-interactively-p--get-frame): New macro. (called-interactively-p, interactive-p): Rewrite in Lisp. * lisp/emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun. (called-interactively-p-functions): Use it. * lisp/emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun. (called-interactively-p-functions): Use it. * lisp/allout.el (allout-called-interactively-p): Don't assume called-interactively-p is a subr. * src/eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove. (syms_of_eval): Remove corresponding defsubr. * src/bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function. * test/automated/advice-tests.el (advice-tests--data): Remove. (advice-tests): Move the tests directly here instead. Add called-interactively-p tests.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog18
-rw-r--r--src/bytecode.c4
-rw-r--r--src/eval.c107
3 files changed, 20 insertions, 109 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 89c4e273715..9e83129e585 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
12012-11-20 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove.
4 (syms_of_eval): Remove corresponding defsubr.
5 * bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function.
6
12012-11-19 Daniel Colascione <dancol@dancol.org> 72012-11-19 Daniel Colascione <dancol@dancol.org>
2 8
3 * w32fns.c (Fx_file_dialog): 9 * w32fns.c (Fx_file_dialog):
@@ -17,10 +23,10 @@
17 windows.h gets included before w32term.h uses some of its 23 windows.h gets included before w32term.h uses some of its
18 features, see below. 24 features, see below.
19 25
20 * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]: New 26 * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]:
21 typedefs. 27 New typedefs.
22 (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]: New 28 (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]:
23 prototypes. 29 New prototypes.
24 (EnumSystemLocales) [_MSC_VER]: Define if undefined. (Bug#12878) 30 (EnumSystemLocales) [_MSC_VER]: Define if undefined. (Bug#12878)
25 31
262012-11-18 Jan Djärv <jan.h.d@swipnet.se> 322012-11-18 Jan Djärv <jan.h.d@swipnet.se>
@@ -312,8 +318,8 @@
312 * xdisp.c (try_scrolling): Fix correction of aggressive-scroll 318 * xdisp.c (try_scrolling): Fix correction of aggressive-scroll
313 amount when the scroll margins are too large. When scrolling 319 amount when the scroll margins are too large. When scrolling
314 backwards in the buffer, give up if cannot reach point or the 320 backwards in the buffer, give up if cannot reach point or the
315 scroll margin within a reasonable number of screen lines. Fixes 321 scroll margin within a reasonable number of screen lines.
316 point position in window under scroll-up/down-aggressively when 322 Fixes point position in window under scroll-up/down-aggressively when
317 point is positioned many lines beyond the window top/bottom. 323 point is positioned many lines beyond the window top/bottom.
318 (Bug#12811) 324 (Bug#12811)
319 325
diff --git a/src/bytecode.c b/src/bytecode.c
index 648813aed86..3267c7c8c76 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1579,7 +1579,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1579 NEXT; 1579 NEXT;
1580 1580
1581 CASE (Binteractive_p): /* Obsolete since 24.1. */ 1581 CASE (Binteractive_p): /* Obsolete since 24.1. */
1582 PUSH (Finteractive_p ()); 1582 BEFORE_POTENTIAL_GC ();
1583 PUSH (call0 (intern ("interactive-p")));
1584 AFTER_POTENTIAL_GC ();
1583 NEXT; 1585 NEXT;
1584 1586
1585 CASE (Bforward_char): 1587 CASE (Bforward_char):
diff --git a/src/eval.c b/src/eval.c
index f8a76646352..459fb762c6e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -489,102 +489,6 @@ usage: (function ARG) */)
489} 489}
490 490
491 491
492DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
493 doc: /* Return t if the containing function was run directly by user input.
494This means that the function was called with `call-interactively'
495\(which includes being called as the binding of a key)
496and input is currently coming from the keyboard (not a keyboard macro),
497and Emacs is not running in batch mode (`noninteractive' is nil).
498
499The only known proper use of `interactive-p' is in deciding whether to
500display a helpful message, or how to display it. If you're thinking
501of using it for any other purpose, it is quite likely that you're
502making a mistake. Think: what do you want to do when the command is
503called from a keyboard macro?
504
505To test whether your function was called with `call-interactively',
506either (i) add an extra optional argument and give it an `interactive'
507spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
508use `called-interactively-p'. */)
509 (void)
510{
511 return (INTERACTIVE && interactive_p ()) ? Qt : Qnil;
512}
513
514
515DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0,
516 doc: /* Return t if the containing function was called by `call-interactively'.
517If KIND is `interactive', then only return t if the call was made
518interactively by the user, i.e. not in `noninteractive' mode nor
519when `executing-kbd-macro'.
520If KIND is `any', on the other hand, it will return t for any kind of
521interactive call, including being called as the binding of a key, or
522from a keyboard macro, or in `noninteractive' mode.
523
524The only known proper use of `interactive' for KIND is in deciding
525whether to display a helpful message, or how to display it. If you're
526thinking of using it for any other purpose, it is quite likely that
527you're making a mistake. Think: what do you want to do when the
528command is called from a keyboard macro?
529
530Instead of using this function, it is sometimes cleaner to give your
531function an extra optional argument whose `interactive' spec specifies
532non-nil unconditionally (\"p\" is a good way to do this), or via
533\(not (or executing-kbd-macro noninteractive)). */)
534 (Lisp_Object kind)
535{
536 return (((INTERACTIVE || !EQ (kind, intern ("interactive")))
537 && interactive_p ())
538 ? Qt : Qnil);
539}
540
541
542/* Return true if function in which this appears was called using
543 call-interactively and is not a built-in. */
544
545static bool
546interactive_p (void)
547{
548 struct backtrace *btp;
549 Lisp_Object fun;
550
551 btp = backtrace_list;
552
553 /* If this isn't a byte-compiled function, there may be a frame at
554 the top for Finteractive_p. If so, skip it. */
555 fun = Findirect_function (btp->function, Qnil);
556 if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
557 || XSUBR (fun) == &Scalled_interactively_p))
558 btp = btp->next;
559
560 /* If we're running an Emacs 18-style byte-compiled function, there
561 may be a frame for Fbytecode at the top level. In any version of
562 Emacs there can be Fbytecode frames for subexpressions evaluated
563 inside catch and condition-case. Skip past them.
564
565 If this isn't a byte-compiled function, then we may now be
566 looking at several frames for special forms. Skip past them. */
567 while (btp
568 && (EQ (btp->function, Qbytecode)
569 || btp->nargs == UNEVALLED))
570 btp = btp->next;
571
572 /* `btp' now points at the frame of the innermost function that isn't
573 a special form, ignoring frames for Finteractive_p and/or
574 Fbytecode at the top. If this frame is for a built-in function
575 (such as load or eval-region) return false. */
576 fun = Findirect_function (btp->function, Qnil);
577 if (SUBRP (fun))
578 return 0;
579
580 /* `btp' points to the frame of a Lisp function that called interactive-p.
581 Return t if that function was called interactively. */
582 if (btp && btp->next && EQ (btp->next->function, Qcall_interactively))
583 return 1;
584 return 0;
585}
586
587
588DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, 492DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
589 doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. 493 doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
590Aliased variables always have the same value; setting one sets the other. 494Aliased variables always have the same value; setting one sets the other.
@@ -696,8 +600,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
696 if (EQ ((--pdl)->symbol, sym) && !pdl->func 600 if (EQ ((--pdl)->symbol, sym) && !pdl->func
697 && EQ (pdl->old_value, Qunbound)) 601 && EQ (pdl->old_value, Qunbound))
698 { 602 {
699 message_with_string ("Warning: defvar ignored because %s is let-bound", 603 message_with_string
700 SYMBOL_NAME (sym), 1); 604 ("Warning: defvar ignored because %s is let-bound",
605 SYMBOL_NAME (sym), 1);
701 break; 606 break;
702 } 607 }
703 } 608 }
@@ -717,8 +622,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
717 /* A simple (defvar foo) with lexical scoping does "nothing" except 622 /* A simple (defvar foo) with lexical scoping does "nothing" except
718 declare that var to be dynamically scoped *locally* (i.e. within 623 declare that var to be dynamically scoped *locally* (i.e. within
719 the current file or let-block). */ 624 the current file or let-block). */
720 Vinternal_interpreter_environment = 625 Vinternal_interpreter_environment
721 Fcons (sym, Vinternal_interpreter_environment); 626 = Fcons (sym, Vinternal_interpreter_environment);
722 else 627 else
723 { 628 {
724 /* Simple (defvar <var>) should not count as a definition at all. 629 /* Simple (defvar <var>) should not count as a definition at all.
@@ -3551,8 +3456,6 @@ alist of active lexical bindings. */);
3551 defsubr (&Sunwind_protect); 3456 defsubr (&Sunwind_protect);
3552 defsubr (&Scondition_case); 3457 defsubr (&Scondition_case);
3553 defsubr (&Ssignal); 3458 defsubr (&Ssignal);
3554 defsubr (&Sinteractive_p);
3555 defsubr (&Scalled_interactively_p);
3556 defsubr (&Scommandp); 3459 defsubr (&Scommandp);
3557 defsubr (&Sautoload); 3460 defsubr (&Sautoload);
3558 defsubr (&Sautoload_do_load); 3461 defsubr (&Sautoload_do_load);