diff options
| author | Stefan Monnier | 2011-02-01 12:09:25 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2011-02-01 12:09:25 -0500 |
| commit | 8f1d2ef658f95549eb33fe5265f8f11c5129bece (patch) | |
| tree | b7cd852a1adb423384532cfe22c31547160b22bc /src/eval.c | |
| parent | 590130fb19e1f433965c421d98fedeb2d7c33310 (diff) | |
| parent | 1dc4075fa8809805aed5092e93e225e889725c94 (diff) | |
| download | emacs-8f1d2ef658f95549eb33fe5265f8f11c5129bece.tar.gz emacs-8f1d2ef658f95549eb33fe5265f8f11c5129bece.zip | |
Merge from trunk
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 384 |
1 files changed, 117 insertions, 267 deletions
diff --git a/src/eval.c b/src/eval.c index 36acca01c8b..e8b4ae1aba9 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -1,7 +1,5 @@ | |||
| 1 | /* Evaluator for GNU Emacs Lisp interpreter. | 1 | /* Evaluator for GNU Emacs Lisp interpreter. |
| 2 | Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001, | 2 | Copyright (C) 1985-1987, 1993-1995, 1999-2011 Free Software Foundation, Inc. |
| 3 | 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 | ||
| 4 | Free Software Foundation, Inc. | ||
| 5 | 3 | ||
| 6 | This file is part of GNU Emacs. | 4 | This file is part of GNU Emacs. |
| 7 | 5 | ||
| @@ -58,7 +56,7 @@ int gcpro_level; | |||
| 58 | #endif | 56 | #endif |
| 59 | 57 | ||
| 60 | Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; | 58 | Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; |
| 61 | Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; | 59 | Lisp_Object Qinhibit_quit; |
| 62 | Lisp_Object Qand_rest, Qand_optional; | 60 | Lisp_Object Qand_rest, Qand_optional; |
| 63 | Lisp_Object Qdebug_on_error; | 61 | Lisp_Object Qdebug_on_error; |
| 64 | Lisp_Object Qdeclare; | 62 | Lisp_Object Qdeclare; |
| @@ -102,56 +100,10 @@ struct specbinding *specpdl; | |||
| 102 | 100 | ||
| 103 | struct specbinding *specpdl_ptr; | 101 | struct specbinding *specpdl_ptr; |
| 104 | 102 | ||
| 105 | /* Maximum size allowed for specpdl allocation */ | ||
| 106 | |||
| 107 | EMACS_INT max_specpdl_size; | ||
| 108 | |||
| 109 | /* Depth in Lisp evaluations and function calls. */ | 103 | /* Depth in Lisp evaluations and function calls. */ |
| 110 | 104 | ||
| 111 | EMACS_INT lisp_eval_depth; | 105 | EMACS_INT lisp_eval_depth; |
| 112 | 106 | ||
| 113 | /* Maximum allowed depth in Lisp evaluations and function calls. */ | ||
| 114 | |||
| 115 | EMACS_INT max_lisp_eval_depth; | ||
| 116 | |||
| 117 | /* Nonzero means enter debugger before next function call */ | ||
| 118 | |||
| 119 | int debug_on_next_call; | ||
| 120 | |||
| 121 | /* Non-zero means debugger may continue. This is zero when the | ||
| 122 | debugger is called during redisplay, where it might not be safe to | ||
| 123 | continue the interrupted redisplay. */ | ||
| 124 | |||
| 125 | int debugger_may_continue; | ||
| 126 | |||
| 127 | /* List of conditions (non-nil atom means all) which cause a backtrace | ||
| 128 | if an error is handled by the command loop's error handler. */ | ||
| 129 | |||
| 130 | Lisp_Object Vstack_trace_on_error; | ||
| 131 | |||
| 132 | /* List of conditions (non-nil atom means all) which enter the debugger | ||
| 133 | if an error is handled by the command loop's error handler. */ | ||
| 134 | |||
| 135 | Lisp_Object Vdebug_on_error; | ||
| 136 | |||
| 137 | /* List of conditions and regexps specifying error messages which | ||
| 138 | do not enter the debugger even if Vdebug_on_error says they should. */ | ||
| 139 | |||
| 140 | Lisp_Object Vdebug_ignored_errors; | ||
| 141 | |||
| 142 | /* Non-nil means call the debugger even if the error will be handled. */ | ||
| 143 | |||
| 144 | Lisp_Object Vdebug_on_signal; | ||
| 145 | |||
| 146 | /* Hook for edebug to use. */ | ||
| 147 | |||
| 148 | Lisp_Object Vsignal_hook_function; | ||
| 149 | |||
| 150 | /* Nonzero means enter debugger if a quit signal | ||
| 151 | is handled by the command loop's error handler. */ | ||
| 152 | |||
| 153 | int debug_on_quit; | ||
| 154 | |||
| 155 | /* The value of num_nonmacro_input_events as of the last time we | 107 | /* The value of num_nonmacro_input_events as of the last time we |
| 156 | started to enter the debugger. If we decide to enter the debugger | 108 | started to enter the debugger. If we decide to enter the debugger |
| 157 | again when this is still equal to num_nonmacro_input_events, then we | 109 | again when this is still equal to num_nonmacro_input_events, then we |
| @@ -161,8 +113,6 @@ int debug_on_quit; | |||
| 161 | 113 | ||
| 162 | int when_entered_debugger; | 114 | int when_entered_debugger; |
| 163 | 115 | ||
| 164 | Lisp_Object Vdebugger; | ||
| 165 | |||
| 166 | /* The function from which the last `signal' was called. Set in | 116 | /* The function from which the last `signal' was called. Set in |
| 167 | Fsignal. */ | 117 | Fsignal. */ |
| 168 | 118 | ||
| @@ -174,13 +124,10 @@ Lisp_Object Vsignaling_function; | |||
| 174 | 124 | ||
| 175 | int handling_signal; | 125 | int handling_signal; |
| 176 | 126 | ||
| 177 | /* Function to process declarations in defmacro forms. */ | ||
| 178 | |||
| 179 | Lisp_Object Vmacro_declaration_function; | ||
| 180 | |||
| 181 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | 127 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); |
| 182 | static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *); | 128 | static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *); |
| 183 | static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; | 129 | static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; |
| 130 | static int interactive_p (int); | ||
| 184 | 131 | ||
| 185 | void | 132 | void |
| 186 | init_eval_once (void) | 133 | init_eval_once (void) |
| @@ -616,7 +563,7 @@ way to do this), or via (not (or executing-kbd-macro noninteractive)). */) | |||
| 616 | EXCLUDE_SUBRS_P non-zero means always return 0 if the function | 563 | EXCLUDE_SUBRS_P non-zero means always return 0 if the function |
| 617 | called is a built-in. */ | 564 | called is a built-in. */ |
| 618 | 565 | ||
| 619 | int | 566 | static int |
| 620 | interactive_p (int exclude_subrs_p) | 567 | interactive_p (int exclude_subrs_p) |
| 621 | { | 568 | { |
| 622 | struct backtrace *btp; | 569 | struct backtrace *btp; |
| @@ -1706,6 +1653,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (int, Lisp_Object*), | |||
| 1706 | 1653 | ||
| 1707 | static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object, | 1654 | static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object, |
| 1708 | Lisp_Object, Lisp_Object); | 1655 | Lisp_Object, Lisp_Object); |
| 1656 | static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, | ||
| 1657 | Lisp_Object data); | ||
| 1709 | 1658 | ||
| 1710 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, | 1659 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, |
| 1711 | doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. | 1660 | doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. |
| @@ -1726,10 +1675,12 @@ See also the function `condition-case'. */) | |||
| 1726 | /* When memory is full, ERROR-SYMBOL is nil, | 1675 | /* When memory is full, ERROR-SYMBOL is nil, |
| 1727 | and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). | 1676 | and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). |
| 1728 | That is a special case--don't do this in other situations. */ | 1677 | That is a special case--don't do this in other situations. */ |
| 1729 | register struct handler *allhandlers = handlerlist; | ||
| 1730 | Lisp_Object conditions; | 1678 | Lisp_Object conditions; |
| 1731 | Lisp_Object string; | 1679 | Lisp_Object string; |
| 1732 | Lisp_Object real_error_symbol; | 1680 | Lisp_Object real_error_symbol |
| 1681 | = (NILP (error_symbol) ? Fcar (data) : error_symbol); | ||
| 1682 | register Lisp_Object clause = Qnil; | ||
| 1683 | struct handler *h; | ||
| 1733 | struct backtrace *bp; | 1684 | struct backtrace *bp; |
| 1734 | 1685 | ||
| 1735 | immediate_quit = handling_signal = 0; | 1686 | immediate_quit = handling_signal = 0; |
| @@ -1737,11 +1688,6 @@ See also the function `condition-case'. */) | |||
| 1737 | if (gc_in_progress || waiting_for_input) | 1688 | if (gc_in_progress || waiting_for_input) |
| 1738 | abort (); | 1689 | abort (); |
| 1739 | 1690 | ||
| 1740 | if (NILP (error_symbol)) | ||
| 1741 | real_error_symbol = Fcar (data); | ||
| 1742 | else | ||
| 1743 | real_error_symbol = error_symbol; | ||
| 1744 | |||
| 1745 | #if 0 /* rms: I don't know why this was here, | 1691 | #if 0 /* rms: I don't know why this was here, |
| 1746 | but it is surely wrong for an error that is handled. */ | 1692 | but it is surely wrong for an error that is handled. */ |
| 1747 | #ifdef HAVE_WINDOW_SYSTEM | 1693 | #ifdef HAVE_WINDOW_SYSTEM |
| @@ -1780,49 +1726,49 @@ See also the function `condition-case'. */) | |||
| 1780 | Vsignaling_function = *bp->function; | 1726 | Vsignaling_function = *bp->function; |
| 1781 | } | 1727 | } |
| 1782 | 1728 | ||
| 1783 | for (; handlerlist; handlerlist = handlerlist->next) | 1729 | for (h = handlerlist; h; h = h->next) |
| 1784 | { | 1730 | { |
| 1785 | register Lisp_Object clause; | 1731 | clause = find_handler_clause (h->handler, conditions, |
| 1786 | |||
| 1787 | clause = find_handler_clause (handlerlist->handler, conditions, | ||
| 1788 | error_symbol, data); | 1732 | error_symbol, data); |
| 1789 | |||
| 1790 | if (EQ (clause, Qlambda)) | ||
| 1791 | { | ||
| 1792 | /* We can't return values to code which signaled an error, but we | ||
| 1793 | can continue code which has signaled a quit. */ | ||
| 1794 | if (EQ (real_error_symbol, Qquit)) | ||
| 1795 | return Qnil; | ||
| 1796 | else | ||
| 1797 | error ("Cannot return from the debugger in an error"); | ||
| 1798 | } | ||
| 1799 | |||
| 1800 | if (!NILP (clause)) | 1733 | if (!NILP (clause)) |
| 1801 | { | 1734 | break; |
| 1802 | Lisp_Object unwind_data; | ||
| 1803 | struct handler *h = handlerlist; | ||
| 1804 | |||
| 1805 | handlerlist = allhandlers; | ||
| 1806 | |||
| 1807 | if (NILP (error_symbol)) | ||
| 1808 | unwind_data = data; | ||
| 1809 | else | ||
| 1810 | unwind_data = Fcons (error_symbol, data); | ||
| 1811 | h->chosen_clause = clause; | ||
| 1812 | unwind_to_catch (h->tag, unwind_data); | ||
| 1813 | } | ||
| 1814 | } | 1735 | } |
| 1736 | |||
| 1737 | if (/* Don't run the debugger for a memory-full error. | ||
| 1738 | (There is no room in memory to do that!) */ | ||
| 1739 | !NILP (error_symbol) | ||
| 1740 | && (!NILP (Vdebug_on_signal) | ||
| 1741 | /* If no handler is present now, try to run the debugger. */ | ||
| 1742 | || NILP (clause) | ||
| 1743 | /* Special handler that means "print a message and run debugger | ||
| 1744 | if requested". */ | ||
| 1745 | || EQ (h->handler, Qerror))) | ||
| 1746 | { | ||
| 1747 | int debugger_called | ||
| 1748 | = maybe_call_debugger (conditions, error_symbol, data); | ||
| 1749 | /* We can't return values to code which signaled an error, but we | ||
| 1750 | can continue code which has signaled a quit. */ | ||
| 1751 | if (debugger_called && EQ (real_error_symbol, Qquit)) | ||
| 1752 | return Qnil; | ||
| 1753 | } | ||
| 1815 | 1754 | ||
| 1816 | handlerlist = allhandlers; | 1755 | if (!NILP (clause)) |
| 1817 | /* If no handler is present now, try to run the debugger, | 1756 | { |
| 1818 | and if that fails, throw to top level. */ | 1757 | Lisp_Object unwind_data |
| 1819 | find_handler_clause (Qerror, conditions, error_symbol, data); | 1758 | = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); |
| 1820 | if (catchlist != 0) | 1759 | |
| 1821 | Fthrow (Qtop_level, Qt); | 1760 | h->chosen_clause = clause; |
| 1761 | unwind_to_catch (h->tag, unwind_data); | ||
| 1762 | } | ||
| 1763 | else | ||
| 1764 | { | ||
| 1765 | if (catchlist != 0) | ||
| 1766 | Fthrow (Qtop_level, Qt); | ||
| 1767 | } | ||
| 1822 | 1768 | ||
| 1823 | if (! NILP (error_symbol)) | 1769 | if (! NILP (error_symbol)) |
| 1824 | data = Fcons (error_symbol, data); | 1770 | data = Fcons (error_symbol, data); |
| 1825 | 1771 | ||
| 1826 | string = Ferror_message_string (data); | 1772 | string = Ferror_message_string (data); |
| 1827 | fatal ("%s", SDATA (string), 0); | 1773 | fatal ("%s", SDATA (string), 0); |
| 1828 | } | 1774 | } |
| @@ -1997,63 +1943,24 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions, | |||
| 1997 | Lisp_Object sig, Lisp_Object data) | 1943 | Lisp_Object sig, Lisp_Object data) |
| 1998 | { | 1944 | { |
| 1999 | register Lisp_Object h; | 1945 | register Lisp_Object h; |
| 2000 | register Lisp_Object tem; | ||
| 2001 | int debugger_called = 0; | ||
| 2002 | int debugger_considered = 0; | ||
| 2003 | 1946 | ||
| 2004 | /* t is used by handlers for all conditions, set up by C code. */ | 1947 | /* t is used by handlers for all conditions, set up by C code. */ |
| 2005 | if (EQ (handlers, Qt)) | 1948 | if (EQ (handlers, Qt)) |
| 2006 | return Qt; | 1949 | return Qt; |
| 2007 | 1950 | ||
| 2008 | /* Don't run the debugger for a memory-full error. | ||
| 2009 | (There is no room in memory to do that!) */ | ||
| 2010 | if (NILP (sig)) | ||
| 2011 | debugger_considered = 1; | ||
| 2012 | |||
| 2013 | /* error is used similarly, but means print an error message | 1951 | /* error is used similarly, but means print an error message |
| 2014 | and run the debugger if that is enabled. */ | 1952 | and run the debugger if that is enabled. */ |
| 2015 | if (EQ (handlers, Qerror) | 1953 | if (EQ (handlers, Qerror)) |
| 2016 | || !NILP (Vdebug_on_signal)) /* This says call debugger even if | 1954 | return Qt; |
| 2017 | there is a handler. */ | ||
| 2018 | { | ||
| 2019 | if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions)) | ||
| 2020 | { | ||
| 2021 | max_lisp_eval_depth += 15; | ||
| 2022 | max_specpdl_size++; | ||
| 2023 | if (noninteractive) | ||
| 2024 | Fbacktrace (); | ||
| 2025 | else | ||
| 2026 | internal_with_output_to_temp_buffer | ||
| 2027 | ("*Backtrace*", | ||
| 2028 | (Lisp_Object (*) (Lisp_Object)) Fbacktrace, | ||
| 2029 | Qnil); | ||
| 2030 | max_specpdl_size--; | ||
| 2031 | max_lisp_eval_depth -= 15; | ||
| 2032 | } | ||
| 2033 | |||
| 2034 | if (!debugger_considered) | ||
| 2035 | { | ||
| 2036 | debugger_considered = 1; | ||
| 2037 | debugger_called = maybe_call_debugger (conditions, sig, data); | ||
| 2038 | } | ||
| 2039 | |||
| 2040 | /* If there is no handler, return saying whether we ran the debugger. */ | ||
| 2041 | if (EQ (handlers, Qerror)) | ||
| 2042 | { | ||
| 2043 | if (debugger_called) | ||
| 2044 | return Qlambda; | ||
| 2045 | return Qt; | ||
| 2046 | } | ||
| 2047 | } | ||
| 2048 | 1955 | ||
| 2049 | for (h = handlers; CONSP (h); h = Fcdr (h)) | 1956 | for (h = handlers; CONSP (h); h = XCDR (h)) |
| 2050 | { | 1957 | { |
| 2051 | Lisp_Object handler, condit; | 1958 | Lisp_Object handler = XCAR (h); |
| 1959 | Lisp_Object condit, tem; | ||
| 2052 | 1960 | ||
| 2053 | handler = Fcar (h); | ||
| 2054 | if (!CONSP (handler)) | 1961 | if (!CONSP (handler)) |
| 2055 | continue; | 1962 | continue; |
| 2056 | condit = Fcar (handler); | 1963 | condit = XCAR (handler); |
| 2057 | /* Handle a single condition name in handler HANDLER. */ | 1964 | /* Handle a single condition name in handler HANDLER. */ |
| 2058 | if (SYMBOLP (condit)) | 1965 | if (SYMBOLP (condit)) |
| 2059 | { | 1966 | { |
| @@ -2067,15 +1974,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions, | |||
| 2067 | Lisp_Object tail; | 1974 | Lisp_Object tail; |
| 2068 | for (tail = condit; CONSP (tail); tail = XCDR (tail)) | 1975 | for (tail = condit; CONSP (tail); tail = XCDR (tail)) |
| 2069 | { | 1976 | { |
| 2070 | tem = Fmemq (Fcar (tail), conditions); | 1977 | tem = Fmemq (XCAR (tail), conditions); |
| 2071 | if (!NILP (tem)) | 1978 | if (!NILP (tem)) |
| 2072 | { | 1979 | return handler; |
| 2073 | /* This handler is going to apply. | ||
| 2074 | Does it allow the debugger to run first? */ | ||
| 2075 | if (! debugger_considered && !NILP (Fmemq (Qdebug, condit))) | ||
| 2076 | maybe_call_debugger (conditions, sig, data); | ||
| 2077 | return handler; | ||
| 2078 | } | ||
| 2079 | } | 1980 | } |
| 2080 | } | 1981 | } |
| 2081 | } | 1982 | } |
| @@ -2092,7 +1993,6 @@ verror (const char *m, va_list ap) | |||
| 2092 | EMACS_INT size = 200; | 1993 | EMACS_INT size = 200; |
| 2093 | int mlen; | 1994 | int mlen; |
| 2094 | char *buffer = buf; | 1995 | char *buffer = buf; |
| 2095 | char *args[3]; | ||
| 2096 | int allocated = 0; | 1996 | int allocated = 0; |
| 2097 | Lisp_Object string; | 1997 | Lisp_Object string; |
| 2098 | 1998 | ||
| @@ -2413,7 +2313,7 @@ eval_sub (Lisp_Object form) | |||
| 2413 | (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) | 2313 | (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) |
| 2414 | xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); | 2314 | xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); |
| 2415 | 2315 | ||
| 2416 | if (XSUBR (fun)->max_args == UNEVALLED) | 2316 | else if (XSUBR (fun)->max_args == UNEVALLED) |
| 2417 | { | 2317 | { |
| 2418 | backtrace.evalargs = 0; | 2318 | backtrace.evalargs = 0; |
| 2419 | val = (XSUBR (fun)->function.aUNEVALLED) (args_left); | 2319 | val = (XSUBR (fun)->function.aUNEVALLED) (args_left); |
| @@ -2450,14 +2350,14 @@ eval_sub (Lisp_Object form) | |||
| 2450 | GCPRO3 (args_left, fun, fun); | 2350 | GCPRO3 (args_left, fun, fun); |
| 2451 | gcpro3.var = argvals; | 2351 | gcpro3.var = argvals; |
| 2452 | gcpro3.nvars = 0; | 2352 | gcpro3.nvars = 0; |
| 2453 | 2353 | ||
| 2454 | maxargs = XSUBR (fun)->max_args; | 2354 | maxargs = XSUBR (fun)->max_args; |
| 2455 | for (i = 0; i < maxargs; args_left = Fcdr (args_left)) | 2355 | for (i = 0; i < maxargs; args_left = Fcdr (args_left)) |
| 2456 | { | 2356 | { |
| 2457 | argvals[i] = eval_sub (Fcar (args_left)); | 2357 | argvals[i] = eval_sub (Fcar (args_left)); |
| 2458 | gcpro3.nvars = ++i; | 2358 | gcpro3.nvars = ++i; |
| 2459 | } | 2359 | } |
| 2460 | 2360 | ||
| 2461 | UNGCPRO; | 2361 | UNGCPRO; |
| 2462 | 2362 | ||
| 2463 | backtrace.args = argvals; | 2363 | backtrace.args = argvals; |
| @@ -2466,42 +2366,44 @@ eval_sub (Lisp_Object form) | |||
| 2466 | switch (i) | 2366 | switch (i) |
| 2467 | { | 2367 | { |
| 2468 | case 0: | 2368 | case 0: |
| 2469 | val = (XSUBR (fun)->function.a0) (); | 2369 | val = (XSUBR (fun)->function.a0 ()); |
| 2470 | break; | 2370 | break; |
| 2471 | case 1: | 2371 | case 1: |
| 2472 | val = (XSUBR (fun)->function.a1) (argvals[0]); | 2372 | val = (XSUBR (fun)->function.a1 (argvals[0])); |
| 2473 | break; | 2373 | break; |
| 2474 | case 2: | 2374 | case 2: |
| 2475 | val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); | 2375 | val = (XSUBR (fun)->function.a2 (argvals[0], argvals[1])); |
| 2476 | break; | 2376 | break; |
| 2477 | case 3: | 2377 | case 3: |
| 2478 | val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], | 2378 | val = (XSUBR (fun)->function.a3 |
| 2479 | argvals[2]); | 2379 | (argvals[0], argvals[1], argvals[2])); |
| 2480 | break; | 2380 | break; |
| 2481 | case 4: | 2381 | case 4: |
| 2482 | val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], | 2382 | val = (XSUBR (fun)->function.a4 |
| 2483 | argvals[2], argvals[3]); | 2383 | (argvals[0], argvals[1], argvals[2], argvals[3])); |
| 2484 | break; | 2384 | break; |
| 2485 | case 5: | 2385 | case 5: |
| 2486 | val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], | 2386 | val = (XSUBR (fun)->function.a5 |
| 2487 | argvals[3], argvals[4]); | 2387 | (argvals[0], argvals[1], argvals[2], argvals[3], |
| 2388 | argvals[4])); | ||
| 2488 | break; | 2389 | break; |
| 2489 | case 6: | 2390 | case 6: |
| 2490 | val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], | 2391 | val = (XSUBR (fun)->function.a6 |
| 2491 | argvals[3], argvals[4], argvals[5]); | 2392 | (argvals[0], argvals[1], argvals[2], argvals[3], |
| 2393 | argvals[4], argvals[5])); | ||
| 2492 | break; | 2394 | break; |
| 2493 | case 7: | 2395 | case 7: |
| 2494 | val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], | 2396 | val = (XSUBR (fun)->function.a7 |
| 2495 | argvals[3], argvals[4], argvals[5], | 2397 | (argvals[0], argvals[1], argvals[2], argvals[3], |
| 2496 | argvals[6]); | 2398 | argvals[4], argvals[5], argvals[6])); |
| 2497 | |||
| 2498 | break; | 2399 | break; |
| 2499 | case 8: | ||
| 2500 | val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], | ||
| 2501 | argvals[3], argvals[4], argvals[5], | ||
| 2502 | argvals[6], argvals[7]); | ||
| 2503 | 2400 | ||
| 2401 | case 8: | ||
| 2402 | val = (XSUBR (fun)->function.a8 | ||
| 2403 | (argvals[0], argvals[1], argvals[2], argvals[3], | ||
| 2404 | argvals[4], argvals[5], argvals[6], argvals[7])); | ||
| 2504 | break; | 2405 | break; |
| 2406 | |||
| 2505 | default: | 2407 | default: |
| 2506 | /* Someone has created a subr that takes more arguments than | 2408 | /* Someone has created a subr that takes more arguments than |
| 2507 | is supported by this code. We need to either rewrite the | 2409 | is supported by this code. We need to either rewrite the |
| @@ -2806,53 +2708,6 @@ run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond) | |||
| 2806 | } | 2708 | } |
| 2807 | } | 2709 | } |
| 2808 | 2710 | ||
| 2809 | /* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual | ||
| 2810 | present value of that symbol. | ||
| 2811 | Call each element of FUNLIST, | ||
| 2812 | passing each of them the rest of ARGS. | ||
| 2813 | The caller (or its caller, etc) must gcpro all of ARGS, | ||
| 2814 | except that it isn't necessary to gcpro ARGS[0]. */ | ||
| 2815 | |||
| 2816 | Lisp_Object | ||
| 2817 | run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args) | ||
| 2818 | { | ||
| 2819 | Lisp_Object sym; | ||
| 2820 | Lisp_Object val; | ||
| 2821 | Lisp_Object globals; | ||
| 2822 | struct gcpro gcpro1, gcpro2, gcpro3; | ||
| 2823 | |||
| 2824 | sym = args[0]; | ||
| 2825 | globals = Qnil; | ||
| 2826 | GCPRO3 (sym, val, globals); | ||
| 2827 | |||
| 2828 | for (val = funlist; CONSP (val); val = XCDR (val)) | ||
| 2829 | { | ||
| 2830 | if (EQ (XCAR (val), Qt)) | ||
| 2831 | { | ||
| 2832 | /* t indicates this hook has a local binding; | ||
| 2833 | it means to run the global binding too. */ | ||
| 2834 | |||
| 2835 | for (globals = Fdefault_value (sym); | ||
| 2836 | CONSP (globals); | ||
| 2837 | globals = XCDR (globals)) | ||
| 2838 | { | ||
| 2839 | args[0] = XCAR (globals); | ||
| 2840 | /* In a global value, t should not occur. If it does, we | ||
| 2841 | must ignore it to avoid an endless loop. */ | ||
| 2842 | if (!EQ (args[0], Qt)) | ||
| 2843 | Ffuncall (nargs, args); | ||
| 2844 | } | ||
| 2845 | } | ||
| 2846 | else | ||
| 2847 | { | ||
| 2848 | args[0] = XCAR (val); | ||
| 2849 | Ffuncall (nargs, args); | ||
| 2850 | } | ||
| 2851 | } | ||
| 2852 | UNGCPRO; | ||
| 2853 | return Qnil; | ||
| 2854 | } | ||
| 2855 | |||
| 2856 | /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */ | 2711 | /* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */ |
| 2857 | 2712 | ||
| 2858 | void | 2713 | void |
| @@ -3117,7 +2972,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 3117 | xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs); | 2972 | xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs); |
| 3118 | } | 2973 | } |
| 3119 | 2974 | ||
| 3120 | if (XSUBR (fun)->max_args == UNEVALLED) | 2975 | else if (XSUBR (fun)->max_args == UNEVALLED) |
| 3121 | xsignal1 (Qinvalid_function, original_fun); | 2976 | xsignal1 (Qinvalid_function, original_fun); |
| 3122 | 2977 | ||
| 3123 | else if (XSUBR (fun)->max_args == MANY) | 2978 | else if (XSUBR (fun)->max_args == MANY) |
| @@ -3136,44 +2991,46 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 3136 | switch (XSUBR (fun)->max_args) | 2991 | switch (XSUBR (fun)->max_args) |
| 3137 | { | 2992 | { |
| 3138 | case 0: | 2993 | case 0: |
| 3139 | val = (XSUBR (fun)->function.a0) (); | 2994 | val = (XSUBR (fun)->function.a0 ()); |
| 3140 | break; | 2995 | break; |
| 3141 | case 1: | 2996 | case 1: |
| 3142 | val = (XSUBR (fun)->function.a1) (internal_args[0]); | 2997 | val = (XSUBR (fun)->function.a1 (internal_args[0])); |
| 3143 | break; | 2998 | break; |
| 3144 | case 2: | 2999 | case 2: |
| 3145 | val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); | 3000 | val = (XSUBR (fun)->function.a2 |
| 3001 | (internal_args[0], internal_args[1])); | ||
| 3146 | break; | 3002 | break; |
| 3147 | case 3: | 3003 | case 3: |
| 3148 | val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], | 3004 | val = (XSUBR (fun)->function.a3 |
| 3149 | internal_args[2]); | 3005 | (internal_args[0], internal_args[1], internal_args[2])); |
| 3150 | break; | 3006 | break; |
| 3151 | case 4: | 3007 | case 4: |
| 3152 | val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], | 3008 | val = (XSUBR (fun)->function.a4 |
| 3153 | internal_args[2], internal_args[3]); | 3009 | (internal_args[0], internal_args[1], internal_args[2], |
| 3010 | internal_args[3])); | ||
| 3154 | break; | 3011 | break; |
| 3155 | case 5: | 3012 | case 5: |
| 3156 | val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], | 3013 | val = (XSUBR (fun)->function.a5 |
| 3157 | internal_args[2], internal_args[3], | 3014 | (internal_args[0], internal_args[1], internal_args[2], |
| 3158 | internal_args[4]); | 3015 | internal_args[3], internal_args[4])); |
| 3159 | break; | 3016 | break; |
| 3160 | case 6: | 3017 | case 6: |
| 3161 | val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], | 3018 | val = (XSUBR (fun)->function.a6 |
| 3162 | internal_args[2], internal_args[3], | 3019 | (internal_args[0], internal_args[1], internal_args[2], |
| 3163 | internal_args[4], internal_args[5]); | 3020 | internal_args[3], internal_args[4], internal_args[5])); |
| 3164 | break; | 3021 | break; |
| 3165 | case 7: | 3022 | case 7: |
| 3166 | val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], | 3023 | val = (XSUBR (fun)->function.a7 |
| 3167 | internal_args[2], internal_args[3], | 3024 | (internal_args[0], internal_args[1], internal_args[2], |
| 3168 | internal_args[4], internal_args[5], | 3025 | internal_args[3], internal_args[4], internal_args[5], |
| 3169 | internal_args[6]); | 3026 | internal_args[6])); |
| 3170 | break; | 3027 | break; |
| 3171 | 3028 | ||
| 3172 | case 8: | 3029 | case 8: |
| 3173 | val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], | 3030 | val = (XSUBR (fun)->function.a8 |
| 3174 | internal_args[2], internal_args[3], | 3031 | (internal_args[0], internal_args[1], internal_args[2], |
| 3175 | internal_args[4], internal_args[5], | 3032 | internal_args[3], internal_args[4], internal_args[5], |
| 3176 | internal_args[6], internal_args[7]); | 3033 | internal_args[6], internal_args[7])); |
| 3177 | break; | 3034 | break; |
| 3178 | 3035 | ||
| 3179 | default: | 3036 | default: |
| @@ -3841,7 +3698,7 @@ mark_backtrace (void) | |||
| 3841 | void | 3698 | void |
| 3842 | syms_of_eval (void) | 3699 | syms_of_eval (void) |
| 3843 | { | 3700 | { |
| 3844 | DEFVAR_INT ("max-specpdl-size", &max_specpdl_size, | 3701 | DEFVAR_INT ("max-specpdl-size", max_specpdl_size, |
| 3845 | doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's. | 3702 | doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's. |
| 3846 | If Lisp code tries to increase the total number past this amount, | 3703 | If Lisp code tries to increase the total number past this amount, |
| 3847 | an error is signaled. | 3704 | an error is signaled. |
| @@ -3849,7 +3706,7 @@ You can safely use a value considerably larger than the default value, | |||
| 3849 | if that proves inconveniently small. However, if you increase it too far, | 3706 | if that proves inconveniently small. However, if you increase it too far, |
| 3850 | Emacs could run out of memory trying to make the stack bigger. */); | 3707 | Emacs could run out of memory trying to make the stack bigger. */); |
| 3851 | 3708 | ||
| 3852 | DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth, | 3709 | DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth, |
| 3853 | doc: /* *Limit on depth in `eval', `apply' and `funcall' before error. | 3710 | doc: /* *Limit on depth in `eval', `apply' and `funcall' before error. |
| 3854 | 3711 | ||
| 3855 | This limit serves to catch infinite recursions for you before they cause | 3712 | This limit serves to catch infinite recursions for you before they cause |
| @@ -3858,7 +3715,7 @@ You can safely make it considerably larger than its default value, | |||
| 3858 | if that proves inconveniently small. However, if you increase it too far, | 3715 | if that proves inconveniently small. However, if you increase it too far, |
| 3859 | Emacs could overflow the real C stack, and crash. */); | 3716 | Emacs could overflow the real C stack, and crash. */); |
| 3860 | 3717 | ||
| 3861 | DEFVAR_LISP ("quit-flag", &Vquit_flag, | 3718 | DEFVAR_LISP ("quit-flag", Vquit_flag, |
| 3862 | doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil. | 3719 | doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil. |
| 3863 | If the value is t, that means do an ordinary quit. | 3720 | If the value is t, that means do an ordinary quit. |
| 3864 | If the value equals `throw-on-input', that means quit by throwing | 3721 | If the value equals `throw-on-input', that means quit by throwing |
| @@ -3867,7 +3724,7 @@ Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit', | |||
| 3867 | but `inhibit-quit' non-nil prevents anything from taking notice of that. */); | 3724 | but `inhibit-quit' non-nil prevents anything from taking notice of that. */); |
| 3868 | Vquit_flag = Qnil; | 3725 | Vquit_flag = Qnil; |
| 3869 | 3726 | ||
| 3870 | DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit, | 3727 | DEFVAR_LISP ("inhibit-quit", Vinhibit_quit, |
| 3871 | doc: /* Non-nil inhibits C-g quitting from happening immediately. | 3728 | doc: /* Non-nil inhibits C-g quitting from happening immediately. |
| 3872 | Note that `quit-flag' will still be set by typing C-g, | 3729 | Note that `quit-flag' will still be set by typing C-g, |
| 3873 | so a quit will be signaled as soon as `inhibit-quit' is nil. | 3730 | so a quit will be signaled as soon as `inhibit-quit' is nil. |
| @@ -3919,15 +3776,7 @@ before making `inhibit-quit' nil. */); | |||
| 3919 | Qdebug = intern_c_string ("debug"); | 3776 | Qdebug = intern_c_string ("debug"); |
| 3920 | staticpro (&Qdebug); | 3777 | staticpro (&Qdebug); |
| 3921 | 3778 | ||
| 3922 | DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, | 3779 | DEFVAR_LISP ("debug-on-error", Vdebug_on_error, |
| 3923 | doc: /* *Non-nil means errors display a backtrace buffer. | ||
| 3924 | More precisely, this happens for any error that is handled | ||
| 3925 | by the editor command loop. | ||
| 3926 | If the value is a list, an error only means to display a backtrace | ||
| 3927 | if one of its condition symbols appears in the list. */); | ||
| 3928 | Vstack_trace_on_error = Qnil; | ||
| 3929 | |||
| 3930 | DEFVAR_LISP ("debug-on-error", &Vdebug_on_error, | ||
| 3931 | doc: /* *Non-nil means enter debugger if an error is signaled. | 3780 | doc: /* *Non-nil means enter debugger if an error is signaled. |
| 3932 | Does not apply to errors handled by `condition-case' or those | 3781 | Does not apply to errors handled by `condition-case' or those |
| 3933 | matched by `debug-ignored-errors'. | 3782 | matched by `debug-ignored-errors'. |
| @@ -3939,7 +3788,7 @@ The command `toggle-debug-on-error' toggles this. | |||
| 3939 | See also the variable `debug-on-quit'. */); | 3788 | See also the variable `debug-on-quit'. */); |
| 3940 | Vdebug_on_error = Qnil; | 3789 | Vdebug_on_error = Qnil; |
| 3941 | 3790 | ||
| 3942 | DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors, | 3791 | DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors, |
| 3943 | doc: /* *List of errors for which the debugger should not be called. | 3792 | doc: /* *List of errors for which the debugger should not be called. |
| 3944 | Each element may be a condition-name or a regexp that matches error messages. | 3793 | Each element may be a condition-name or a regexp that matches error messages. |
| 3945 | If any element applies to a given error, that error skips the debugger | 3794 | If any element applies to a given error, that error skips the debugger |
| @@ -3948,21 +3797,21 @@ This overrides the variable `debug-on-error'. | |||
| 3948 | It does not apply to errors handled by `condition-case'. */); | 3797 | It does not apply to errors handled by `condition-case'. */); |
| 3949 | Vdebug_ignored_errors = Qnil; | 3798 | Vdebug_ignored_errors = Qnil; |
| 3950 | 3799 | ||
| 3951 | DEFVAR_BOOL ("debug-on-quit", &debug_on_quit, | 3800 | DEFVAR_BOOL ("debug-on-quit", debug_on_quit, |
| 3952 | doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example). | 3801 | doc: /* *Non-nil means enter debugger if quit is signaled (C-g, for example). |
| 3953 | Does not apply if quit is handled by a `condition-case'. */); | 3802 | Does not apply if quit is handled by a `condition-case'. */); |
| 3954 | debug_on_quit = 0; | 3803 | debug_on_quit = 0; |
| 3955 | 3804 | ||
| 3956 | DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call, | 3805 | DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call, |
| 3957 | doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */); | 3806 | doc: /* Non-nil means enter debugger before next `eval', `apply' or `funcall'. */); |
| 3958 | 3807 | ||
| 3959 | DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue, | 3808 | DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue, |
| 3960 | doc: /* Non-nil means debugger may continue execution. | 3809 | doc: /* Non-nil means debugger may continue execution. |
| 3961 | This is nil when the debugger is called under circumstances where it | 3810 | This is nil when the debugger is called under circumstances where it |
| 3962 | might not be safe to continue. */); | 3811 | might not be safe to continue. */); |
| 3963 | debugger_may_continue = 1; | 3812 | debugger_may_continue = 1; |
| 3964 | 3813 | ||
| 3965 | DEFVAR_LISP ("debugger", &Vdebugger, | 3814 | DEFVAR_LISP ("debugger", Vdebugger, |
| 3966 | doc: /* Function to call to invoke debugger. | 3815 | doc: /* Function to call to invoke debugger. |
| 3967 | If due to frame exit, args are `exit' and the value being returned; | 3816 | If due to frame exit, args are `exit' and the value being returned; |
| 3968 | this function's value will be returned instead of that. | 3817 | this function's value will be returned instead of that. |
| @@ -3971,19 +3820,19 @@ If due to `apply' or `funcall' entry, one arg, `lambda'. | |||
| 3971 | If due to `eval' entry, one arg, t. */); | 3820 | If due to `eval' entry, one arg, t. */); |
| 3972 | Vdebugger = Qnil; | 3821 | Vdebugger = Qnil; |
| 3973 | 3822 | ||
| 3974 | DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function, | 3823 | DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function, |
| 3975 | doc: /* If non-nil, this is a function for `signal' to call. | 3824 | doc: /* If non-nil, this is a function for `signal' to call. |
| 3976 | It receives the same arguments that `signal' was given. | 3825 | It receives the same arguments that `signal' was given. |
| 3977 | The Edebug package uses this to regain control. */); | 3826 | The Edebug package uses this to regain control. */); |
| 3978 | Vsignal_hook_function = Qnil; | 3827 | Vsignal_hook_function = Qnil; |
| 3979 | 3828 | ||
| 3980 | DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal, | 3829 | DEFVAR_LISP ("debug-on-signal", Vdebug_on_signal, |
| 3981 | doc: /* *Non-nil means call the debugger regardless of condition handlers. | 3830 | doc: /* *Non-nil means call the debugger regardless of condition handlers. |
| 3982 | Note that `debug-on-error', `debug-on-quit' and friends | 3831 | Note that `debug-on-error', `debug-on-quit' and friends |
| 3983 | still determine whether to handle the particular condition. */); | 3832 | still determine whether to handle the particular condition. */); |
| 3984 | Vdebug_on_signal = Qnil; | 3833 | Vdebug_on_signal = Qnil; |
| 3985 | 3834 | ||
| 3986 | DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function, | 3835 | DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function, |
| 3987 | doc: /* Function to process declarations in a macro definition. | 3836 | doc: /* Function to process declarations in a macro definition. |
| 3988 | The function will be called with two args MACRO and DECL. | 3837 | The function will be called with two args MACRO and DECL. |
| 3989 | MACRO is the name of the macro being defined. | 3838 | MACRO is the name of the macro being defined. |
| @@ -3994,12 +3843,15 @@ The value the function returns is not used. */); | |||
| 3994 | Qinternal_interpreter_environment | 3843 | Qinternal_interpreter_environment |
| 3995 | = intern_c_string ("internal-interpreter-environment"); | 3844 | = intern_c_string ("internal-interpreter-environment"); |
| 3996 | staticpro (&Qinternal_interpreter_environment); | 3845 | staticpro (&Qinternal_interpreter_environment); |
| 3846 | #if 0 /* Don't export this variable to Elisp, so noone can mess with it | ||
| 3847 | (Just imagine if someone makes it buffer-local). */ | ||
| 3997 | DEFVAR_LISP ("internal-interpreter-environment", | 3848 | DEFVAR_LISP ("internal-interpreter-environment", |
| 3998 | &Vinternal_interpreter_environment, | 3849 | &Vinternal_interpreter_environment, |
| 3999 | doc: /* If non-nil, the current lexical environment of the lisp interpreter. | 3850 | doc: /* If non-nil, the current lexical environment of the lisp interpreter. |
| 4000 | When lexical binding is not being used, this variable is nil. | 3851 | When lexical binding is not being used, this variable is nil. |
| 4001 | A value of `(t)' indicates an empty environment, otherwise it is an | 3852 | A value of `(t)' indicates an empty environment, otherwise it is an |
| 4002 | alist of active lexical bindings. */); | 3853 | alist of active lexical bindings. */); |
| 3854 | #endif | ||
| 4003 | Vinternal_interpreter_environment = Qnil; | 3855 | Vinternal_interpreter_environment = Qnil; |
| 4004 | 3856 | ||
| 4005 | Vrun_hooks = intern_c_string ("run-hooks"); | 3857 | Vrun_hooks = intern_c_string ("run-hooks"); |
| @@ -4056,5 +3908,3 @@ alist of active lexical bindings. */); | |||
| 4056 | defsubr (&Sfunctionp); | 3908 | defsubr (&Sfunctionp); |
| 4057 | } | 3909 | } |
| 4058 | 3910 | ||
| 4059 | /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb | ||
| 4060 | (do not change this comment) */ | ||