diff options
| author | Stefan Monnier | 2012-11-19 23:24:09 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2012-11-19 23:24:09 -0500 |
| commit | 23ba2705e22b89154ef7cbb0595419732080b94c (patch) | |
| tree | b9ca597bccdbbc6467e0fa76ea1fb321fcb0f5c0 /src | |
| parent | b0636be7f9526041aeaa9f4fb6d3636426eec899 (diff) | |
| download | emacs-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/ChangeLog | 18 | ||||
| -rw-r--r-- | src/bytecode.c | 4 | ||||
| -rw-r--r-- | src/eval.c | 107 |
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 @@ | |||
| 1 | 2012-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 | |||
| 1 | 2012-11-19 Daniel Colascione <dancol@dancol.org> | 7 | 2012-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 | ||
| 26 | 2012-11-18 Jan Djärv <jan.h.d@swipnet.se> | 32 | 2012-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 | ||
| 492 | DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0, | ||
| 493 | doc: /* Return t if the containing function was run directly by user input. | ||
| 494 | This means that the function was called with `call-interactively' | ||
| 495 | \(which includes being called as the binding of a key) | ||
| 496 | and input is currently coming from the keyboard (not a keyboard macro), | ||
| 497 | and Emacs is not running in batch mode (`noninteractive' is nil). | ||
| 498 | |||
| 499 | The only known proper use of `interactive-p' is in deciding whether to | ||
| 500 | display a helpful message, or how to display it. If you're thinking | ||
| 501 | of using it for any other purpose, it is quite likely that you're | ||
| 502 | making a mistake. Think: what do you want to do when the command is | ||
| 503 | called from a keyboard macro? | ||
| 504 | |||
| 505 | To test whether your function was called with `call-interactively', | ||
| 506 | either (i) add an extra optional argument and give it an `interactive' | ||
| 507 | spec that specifies non-nil unconditionally (such as \"p\"); or (ii) | ||
| 508 | use `called-interactively-p'. */) | ||
| 509 | (void) | ||
| 510 | { | ||
| 511 | return (INTERACTIVE && interactive_p ()) ? Qt : Qnil; | ||
| 512 | } | ||
| 513 | |||
| 514 | |||
| 515 | DEFUN ("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'. | ||
| 517 | If KIND is `interactive', then only return t if the call was made | ||
| 518 | interactively by the user, i.e. not in `noninteractive' mode nor | ||
| 519 | when `executing-kbd-macro'. | ||
| 520 | If KIND is `any', on the other hand, it will return t for any kind of | ||
| 521 | interactive call, including being called as the binding of a key, or | ||
| 522 | from a keyboard macro, or in `noninteractive' mode. | ||
| 523 | |||
| 524 | The only known proper use of `interactive' for KIND is in deciding | ||
| 525 | whether to display a helpful message, or how to display it. If you're | ||
| 526 | thinking of using it for any other purpose, it is quite likely that | ||
| 527 | you're making a mistake. Think: what do you want to do when the | ||
| 528 | command is called from a keyboard macro? | ||
| 529 | |||
| 530 | Instead of using this function, it is sometimes cleaner to give your | ||
| 531 | function an extra optional argument whose `interactive' spec specifies | ||
| 532 | non-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 | |||
| 545 | static bool | ||
| 546 | interactive_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 | |||
| 588 | DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, | 492 | DEFUN ("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. |
| 590 | Aliased variables always have the same value; setting one sets the other. | 494 | Aliased 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); |