]> code.delx.au - gnu-emacs/blobdiff - src/eval.c
(Fmake_network_process): Only support server sockets
[gnu-emacs] / src / eval.c
index a625d679e0f9fbba3f079fda24629429709e9e62..147e8bef2dd56d300783fc98bbd2aa19b42ebb9a 100644 (file)
@@ -91,6 +91,7 @@ Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
 Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
 Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qdebug_on_error;
+Lisp_Object Qdeclare;
 
 /* This holds either the symbol `run-hooks' or nil.
    It is nil at an early stage of startup, and when Emacs
@@ -189,6 +190,11 @@ Lisp_Object Vsignaling_function;
 
 int handling_signal;
 
+/* Function to process declarations in defmacro forms.  */
+
+Lisp_Object Vmacro_declaration_function;
+
+
 static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
 
 void
@@ -651,9 +657,39 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] BODY...)  */)
 {
   register Lisp_Object fn_name;
   register Lisp_Object defn;
+  Lisp_Object lambda_list, doc, tail;
 
   fn_name = Fcar (args);
-  defn = Fcons (Qmacro, Fcons (Qlambda, Fcdr (args)));
+  lambda_list = Fcar (Fcdr (args));
+  tail = Fcdr (Fcdr (args));
+
+  doc = Qnil;
+  if (STRINGP (Fcar (tail)))
+    {
+      doc = Fcar (tail);
+      tail = Fcdr (tail);
+    }
+
+  while (CONSP (Fcar (tail))
+        && EQ (Fcar (Fcar (tail)), Qdeclare))
+    {
+      if (!NILP (Vmacro_declaration_function))
+       {
+         struct gcpro gcpro1;
+         GCPRO1 (args);
+         call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
+         UNGCPRO;
+       }
+      
+      tail = Fcdr (tail);
+    }
+
+  if (NILP (doc))
+    tail = Fcons (lambda_list, tail);
+  else
+    tail = Fcons (lambda_list, Fcons (doc, tail));
+  defn = Fcons (Qmacro, Fcons (Qlambda, tail));
+  
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
   Ffset (fn_name, defn);
@@ -1413,7 +1449,6 @@ See also the function `condition-case'.  */)
   Lisp_Object debugger_value;
   Lisp_Object string;
   Lisp_Object real_error_symbol;
-  extern int display_hourglass_p;
   struct backtrace *bp;
 
   immediate_quit = handling_signal = 0;
@@ -1726,7 +1761,7 @@ error (m, a1, a2, a3)
   abort ();
 }
 \f
-DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0,
+DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
        doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
 This means it contains a description for how to read arguments to give it.
 The value is nil for an invalid function or a symbol with no function
@@ -1737,9 +1772,12 @@ as keyboard macros), lambda-expressions that contain a top-level call
 to `interactive', autoload definitions made by `autoload' with non-nil
 fourth argument, and some of the built-in functions of Lisp.
 
-Also, a symbol satisfies `commandp' if its function definition does so.  */)
-     (function)
-     Lisp_Object function;
+Also, a symbol satisfies `commandp' if its function definition does so.
+
+If the optional argument FOR-CALL-INTERACTIVELY is non-nil,
+then strins and vectors are not accepted.  */)
+     (function, for_call_interactively)
+     Lisp_Object function, for_call_interactively;
 {
   register Lisp_Object fun;
   register Lisp_Object funcar;
@@ -1768,7 +1806,7 @@ Also, a symbol satisfies `commandp' if its function definition does so.  */)
            ? Qt : Qnil);
 
   /* Strings and vectors are keyboard macros.  */
-  if (STRINGP (fun) || VECTORP (fun))
+  if (NILP (for_call_interactively) && (STRINGP (fun) || VECTORP (fun)))
     return Qt;
 
   /* Lists may represent commands.  */
@@ -1868,6 +1906,12 @@ do_autoload (fundef, funname)
   Lisp_Object fun, queue, first, second;
   struct gcpro gcpro1, gcpro2, gcpro3;
 
+  /* This is to make sure that loadup.el gives a clear picture
+     of what files are preloaded and when.  */
+  if (! NILP (Vpurify_flag))
+    error ("Attempt to autoload %s while preparing to dump",
+          XSYMBOL (funname)->name->data);
+
   fun = funname;
   CHECK_SYMBOL (funname);
   GCPRO3 (fun, funname, fundef);
@@ -3230,6 +3274,9 @@ before making `inhibit-quit' nil.  */);
   Qmacro = intern ("macro");
   staticpro (&Qmacro);
 
+  Qdeclare = intern ("declare");
+  staticpro (&Qdeclare);
+  
   /* Note that the process handling also uses Qexit, but we don't want
      to staticpro it twice, so we just do it here.  */
   Qexit = intern ("exit");
@@ -3315,6 +3362,14 @@ Note that `debug-on-error', `debug-on-quit' and friends
 still determine whether to handle the particular condition.  */);
   Vdebug_on_signal = Qnil;
 
+  DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function,
+              doc: /* Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.  */);
+  Vmacro_declaration_function = Qnil;
+
   Vrun_hooks = intern ("run-hooks");
   staticpro (&Vrun_hooks);