/[emacs]/emacs/src/eval.c
ViewVC logotype

Diff of /emacs/src/eval.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.201 by rost, Tue Jan 7 19:33:57 2003 UTC revision 1.202 by lektu, Tue Feb 4 14:03:12 2003 UTC
# Line 234  call_debugger (arg) Line 234  call_debugger (arg)
234    int debug_while_redisplaying;    int debug_while_redisplaying;
235    int count = SPECPDL_INDEX ();    int count = SPECPDL_INDEX ();
236    Lisp_Object val;    Lisp_Object val;
237      
238    if (lisp_eval_depth + 20 > max_lisp_eval_depth)    if (lisp_eval_depth + 20 > max_lisp_eval_depth)
239      max_lisp_eval_depth = lisp_eval_depth + 20;      max_lisp_eval_depth = lisp_eval_depth + 20;
240      
241    if (specpdl_size + 40 > max_specpdl_size)    if (specpdl_size + 40 > max_specpdl_size)
242      max_specpdl_size = specpdl_size + 40;      max_specpdl_size = specpdl_size + 40;
243      
244  #ifdef HAVE_X_WINDOWS  #ifdef HAVE_X_WINDOWS
245    if (display_hourglass_p)    if (display_hourglass_p)
246      cancel_hourglass ();      cancel_hourglass ();
# Line 261  call_debugger (arg) Line 261  call_debugger (arg)
261           redisplay, which necessarily leads to display problems.  */           redisplay, which necessarily leads to display problems.  */
262    specbind (Qinhibit_eval_during_redisplay, Qt);    specbind (Qinhibit_eval_during_redisplay, Qt);
263  #endif  #endif
264      
265    val = apply1 (Vdebugger, arg);    val = apply1 (Vdebugger, arg);
266    
267    /* Interrupting redisplay and resuming it later is not safe under    /* Interrupting redisplay and resuming it later is not safe under
# Line 535  usage: (setq SYM VAL SYM VAL ...)  */) Line 535  usage: (setq SYM VAL SYM VAL ...)  */)
535    UNGCPRO;    UNGCPRO;
536    return val;    return val;
537  }  }
538        
539  DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,  DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
540         doc: /* Return the argument, without evaluating it.  `(quote x)' yields `x'.         doc: /* Return the argument, without evaluating it.  `(quote x)' yields `x'.
541  usage: (quote ARG)  */)  usage: (quote ARG)  */)
# Line 544  usage: (quote ARG)  */) Line 544  usage: (quote ARG)  */)
544  {  {
545    return Fcar (args);    return Fcar (args);
546  }  }
547        
548  DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,  DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
549         doc: /* Like `quote', but preferred for objects which are functions.         doc: /* Like `quote', but preferred for objects which are functions.
550  In byte compilation, `function' causes its argument to be compiled.  In byte compilation, `function' causes its argument to be compiled.
# Line 614  interactive_p (exclude_subrs_p) Line 614  interactive_p (exclude_subrs_p)
614    fun = Findirect_function (*btp->function);    fun = Findirect_function (*btp->function);
615    if (exclude_subrs_p && SUBRP (fun))    if (exclude_subrs_p && SUBRP (fun))
616      return 0;      return 0;
617      
618    /* btp points to the frame of a Lisp function that called interactive-p.    /* btp points to the frame of a Lisp function that called interactive-p.
619       Return t if that function was called interactively.  */       Return t if that function was called interactively.  */
620    if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))    if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
# Line 694  usage: (defmacro NAME ARGLIST [DOCSTRING Line 694  usage: (defmacro NAME ARGLIST [DOCSTRING
694            call2 (Vmacro_declaration_function, fn_name, Fcar (tail));            call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
695            UNGCPRO;            UNGCPRO;
696          }          }
697          
698        tail = Fcdr (tail);        tail = Fcdr (tail);
699      }      }
700    
# Line 703  usage: (defmacro NAME ARGLIST [DOCSTRING Line 703  usage: (defmacro NAME ARGLIST [DOCSTRING
703    else    else
704      tail = Fcons (lambda_list, Fcons (doc, tail));      tail = Fcons (lambda_list, Fcons (doc, tail));
705    defn = Fcons (Qmacro, Fcons (Qlambda, tail));    defn = Fcons (Qmacro, Fcons (Qlambda, tail));
706      
707    if (!NILP (Vpurify_flag))    if (!NILP (Vpurify_flag))
708      defn = Fpurecopy (defn);      defn = Fpurecopy (defn);
709    if (CONSP (XSYMBOL (fn_name)->function)    if (CONSP (XSYMBOL (fn_name)->function)
# Line 835  value of `standard-value' or of `custom- Line 835  value of `standard-value' or of `custom-
835       Lisp_Object variable;       Lisp_Object variable;
836  {  {
837    Lisp_Object documentation;    Lisp_Object documentation;
838      
839    if (!SYMBOLP (variable))    if (!SYMBOLP (variable))
840        return Qnil;        return Qnil;
841    
# Line 856  value of `standard-value' or of `custom- Line 856  value of `standard-value' or of `custom-
856        || (!NILP (Fget (variable, intern ("custom-autoload")))))        || (!NILP (Fget (variable, intern ("custom-autoload")))))
857      return Qt;      return Qt;
858    return Qnil;    return Qnil;
859  }    }
860    
861  DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,  DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
862         doc: /* Bind variables according to VARLIST then eval BODY.         doc: /* Bind variables according to VARLIST then eval BODY.
# Line 1168  unwind_to_catch (catch, value) Line 1168  unwind_to_catch (catch, value)
1168  #endif  #endif
1169    backtrace_list = catch->backlist;    backtrace_list = catch->backlist;
1170    lisp_eval_depth = catch->lisp_eval_depth;    lisp_eval_depth = catch->lisp_eval_depth;
1171      
1172    _longjmp (catch->jmp, 1);    _longjmp (catch->jmp, 1);
1173  }  }
1174    
# Line 1207  usage: (unwind-protect BODYFORM UNWINDFO Line 1207  usage: (unwind-protect BODYFORM UNWINDFO
1207    
1208    record_unwind_protect (0, Fcdr (args));    record_unwind_protect (0, Fcdr (args));
1209    val = Feval (Fcar (args));    val = Feval (Fcar (args));
1210    return unbind_to (count, val);      return unbind_to (count, val);
1211  }  }
1212    
1213  /* Chain of condition handlers currently in effect.  /* Chain of condition handlers currently in effect.
# Line 1288  usage: (condition-case VAR BODYFORM HAND Line 1288  usage: (condition-case VAR BODYFORM HAND
1288      }      }
1289    c.next = catchlist;    c.next = catchlist;
1290    catchlist = &c;    catchlist = &c;
1291      
1292    h.var = var;    h.var = var;
1293    h.handler = handlers;    h.handler = handlers;
1294    h.next = handlerlist;    h.next = handlerlist;
# Line 1486  See also the function `condition-case'. Line 1486  See also the function `condition-case'.
1486    if (display_hourglass_p)    if (display_hourglass_p)
1487      cancel_hourglass ();      cancel_hourglass ();
1488  #endif  #endif
1489  #endif  #endif
1490    
1491    /* This hook is used by edebug.  */    /* This hook is used by edebug.  */
1492    if (! NILP (Vsignal_hook_function)    if (! NILP (Vsignal_hook_function)
# Line 1512  See also the function `condition-case'. Line 1512  See also the function `condition-case'.
1512    for (; handlerlist; handlerlist = handlerlist->next)    for (; handlerlist; handlerlist = handlerlist->next)
1513      {      {
1514        register Lisp_Object clause;        register Lisp_Object clause;
1515          
1516        if (lisp_eval_depth + 20 > max_lisp_eval_depth)        if (lisp_eval_depth + 20 > max_lisp_eval_depth)
1517          max_lisp_eval_depth = lisp_eval_depth + 20;          max_lisp_eval_depth = lisp_eval_depth + 20;
1518      
1519        if (specpdl_size + 40 > max_specpdl_size)        if (specpdl_size + 40 > max_specpdl_size)
1520          max_specpdl_size = specpdl_size + 40;          max_specpdl_size = specpdl_size + 40;
1521      
1522        clause = find_handler_clause (handlerlist->handler, conditions,        clause = find_handler_clause (handlerlist->handler, conditions,
1523                                      error_symbol, data, &debugger_value);                                      error_symbol, data, &debugger_value);
1524    
# Line 1608  skip_debugger (conditions, data) Line 1608  skip_debugger (conditions, data)
1608                error_message = Ferror_message_string (data);                error_message = Ferror_message_string (data);
1609                first_string = 0;                first_string = 0;
1610              }              }
1611              
1612            if (fast_string_match (XCAR (tail), error_message) >= 0)            if (fast_string_match (XCAR (tail), error_message) >= 0)
1613              return 1;              return 1;
1614          }          }
# Line 1933  do_autoload (fundef, funname) Line 1933  do_autoload (fundef, funname)
1933    
1934    /* Preserve the match data.  */    /* Preserve the match data.  */
1935    record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));    record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1936      
1937    /* Value saved here is to be restored into Vautoload_queue.  */    /* Value saved here is to be restored into Vautoload_queue.  */
1938    record_unwind_protect (un_autoload, Vautoload_queue);    record_unwind_protect (un_autoload, Vautoload_queue);
1939    Vautoload_queue = Qt;    Vautoload_queue = Qt;
# Line 1981  DEFUN ("eval", Feval, Seval, 1, 1, 0, Line 1981  DEFUN ("eval", Feval, Seval, 1, 1, 0,
1981    
1982    if (handling_signal)    if (handling_signal)
1983      abort ();      abort ();
1984      
1985    if (SYMBOLP (form))    if (SYMBOLP (form))
1986      return Fsymbol_value (form);      return Fsymbol_value (form);
1987    if (!CONSP (form))    if (!CONSP (form))
# Line 2162  DEFUN ("eval", Feval, Seval, 1, 1, 0, Line 2162  DEFUN ("eval", Feval, Seval, 1, 1, 0,
2162    
2163  #ifdef HAVE_CARBON  #ifdef HAVE_CARBON
2164    mac_check_for_quit_char();    mac_check_for_quit_char();
2165  #endif    #endif
2166    return val;    return val;
2167  }  }
2168    
# Line 2185  usage: (apply FUNCTION &rest ARGUMENTS) Line 2185  usage: (apply FUNCTION &rest ARGUMENTS)
2185    funcall_args = 0;    funcall_args = 0;
2186    spread_arg = args [nargs - 1];    spread_arg = args [nargs - 1];
2187    CHECK_LIST (spread_arg);    CHECK_LIST (spread_arg);
2188      
2189    numargs = XINT (Flength (spread_arg));    numargs = XINT (Flength (spread_arg));
2190    
2191    if (numargs == 0)    if (numargs == 0)
# Line 2280  usage: (run-hooks &rest HOOKS)  */) Line 2280  usage: (run-hooks &rest HOOKS)  */)
2280    
2281    return Qnil;    return Qnil;
2282  }  }
2283          
2284  DEFUN ("run-hook-with-args", Frun_hook_with_args,  DEFUN ("run-hook-with-args", Frun_hook_with_args,
2285         Srun_hook_with_args, 1, MANY, 0,         Srun_hook_with_args, 1, MANY, 0,
2286         doc: /* Run HOOK with the specified arguments ARGS.         doc: /* Run HOOK with the specified arguments ARGS.
# Line 2523  call1 (fn, arg1) Line 2523  call1 (fn, arg1)
2523  {  {
2524    struct gcpro gcpro1;    struct gcpro gcpro1;
2525  #ifdef NO_ARG_ARRAY  #ifdef NO_ARG_ARRAY
2526    Lisp_Object args[2];      Lisp_Object args[2];
2527    
2528    args[0] = fn;    args[0] = fn;
2529    args[1] = arg1;    args[1] = arg1;
# Line 2779  usage: (funcall FUNCTION &rest ARGUMENTS Line 2779  usage: (funcall FUNCTION &rest ARGUMENTS
2779          default:          default:
2780    
2781            /* If a subr takes more than 8 arguments without using MANY            /* If a subr takes more than 8 arguments without using MANY
2782               or UNEVALLED, we need to extend this function to support it.               or UNEVALLED, we need to extend this function to support it.
2783               Until this is done, there is no way to call the function.  */               Until this is done, there is no way to call the function.  */
2784            abort ();            abort ();
2785          }          }
# Line 2887  funcall_lambda (fun, nargs, arg_vector) Line 2887  funcall_lambda (fun, nargs, arg_vector)
2887    for (; CONSP (syms_left); syms_left = XCDR (syms_left))    for (; CONSP (syms_left); syms_left = XCDR (syms_left))
2888      {      {
2889        QUIT;        QUIT;
2890          
2891        next = XCAR (syms_left);        next = XCAR (syms_left);
2892        while (!SYMBOLP (next))        while (!SYMBOLP (next))
2893          next = Fsignal (Qinvalid_function, Fcons (fun, Qnil));          next = Fsignal (Qinvalid_function, Fcons (fun, Qnil));
2894          
2895        if (EQ (next, Qand_rest))        if (EQ (next, Qand_rest))
2896          rest = 1;          rest = 1;
2897        else if (EQ (next, Qand_optional))        else if (EQ (next, Qand_optional))
# Line 2928  funcall_lambda (fun, nargs, arg_vector) Line 2928  funcall_lambda (fun, nargs, arg_vector)
2928                          AREF (fun, COMPILED_CONSTANTS),                          AREF (fun, COMPILED_CONSTANTS),
2929                          AREF (fun, COMPILED_STACK_DEPTH));                          AREF (fun, COMPILED_STACK_DEPTH));
2930      }      }
2931      
2932    return unbind_to (count, val);    return unbind_to (count, val);
2933  }  }
2934    
# Line 3006  specbind (symbol, value) Line 3006  specbind (symbol, value)
3006    else    else
3007      {      {
3008        Lisp_Object valcontents;        Lisp_Object valcontents;
3009          
3010        ovalue = find_symbol_value (symbol);        ovalue = find_symbol_value (symbol);
3011        specpdl_ptr->func = 0;        specpdl_ptr->func = 0;
3012        specpdl_ptr->old_value = ovalue;        specpdl_ptr->old_value = ovalue;
# Line 3020  specbind (symbol, value) Line 3020  specbind (symbol, value)
3020            Lisp_Object where, current_buffer;            Lisp_Object where, current_buffer;
3021    
3022            current_buffer = Fcurrent_buffer ();            current_buffer = Fcurrent_buffer ();
3023              
3024            /* For a local variable, record both the symbol and which            /* For a local variable, record both the symbol and which
3025               buffer's or frame's value we are saving.  */               buffer's or frame's value we are saving.  */
3026            if (!NILP (Flocal_variable_p (symbol, Qnil)))            if (!NILP (Flocal_variable_p (symbol, Qnil)))
# Line 3112  unbind_to (count, value) Line 3112  unbind_to (count, value)
3112              Fset_default (symbol, specpdl_ptr->old_value);              Fset_default (symbol, specpdl_ptr->old_value);
3113            else if (BUFFERP (where))            else if (BUFFERP (where))
3114              set_internal (symbol, specpdl_ptr->old_value, XBUFFER (where), 1);              set_internal (symbol, specpdl_ptr->old_value, XBUFFER (where), 1);
3115            else            else
3116              set_internal (symbol, specpdl_ptr->old_value, NULL, 1);              set_internal (symbol, specpdl_ptr->old_value, NULL, 1);
3117          }          }
3118        else        else
# Line 3126  unbind_to (count, value) Line 3126  unbind_to (count, value)
3126              set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1);              set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1);
3127          }          }
3128      }      }
3129      
3130    if (NILP (Vquit_flag) && quitf)    if (NILP (Vquit_flag) && quitf)
3131      Vquit_flag = Qt;      Vquit_flag = Qt;
3132    
# Line 3300  before making `inhibit-quit' nil.  */); Line 3300  before making `inhibit-quit' nil.  */);
3300    
3301    Qdeclare = intern ("declare");    Qdeclare = intern ("declare");
3302    staticpro (&Qdeclare);    staticpro (&Qdeclare);
3303      
3304    /* Note that the process handling also uses Qexit, but we don't want    /* Note that the process handling also uses Qexit, but we don't want
3305       to staticpro it twice, so we just do it here.  */       to staticpro it twice, so we just do it here.  */
3306    Qexit = intern ("exit");    Qexit = intern ("exit");

Legend:
Removed from v.1.201  
changed lines
  Added in v.1.202

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26