Declarations in macro definitions

[Gerd Moellmann]

Reading some Lisp code today which contained declarations for ZWEI
inspired me to the following simple hack.  It let's one declare
indentation and Edebug specs in a defmacro, like

        (defmacro foo ()
           (declare (indent INDENT) (debug DEBUG))
           ...)

where INDENT is used for `lisp-indent-function', and DEBUG is used for
`edebug-form-spec'.

What do people think?



*** eval.c      2002/03/17 11:10:24     1.182
--- eval.c      2002/03/17 12:17:12
***************
*** 91,96 ****
--- 91,97 ----
  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,194 ****
--- 190,200 ----
  
  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,659 ****
  {
    register Lisp_Object fn_name;
    register Lisp_Object defn;
  
    fn_name = Fcar (args);
!   defn = Fcons (Qmacro, Fcons (Qlambda, Fcdr (args)));
    if (!NILP (Vpurify_flag))
      defn = Fpurecopy (defn);
    Ffset (fn_name, defn);
--- 657,695 ----
  {
    register Lisp_Object fn_name;
    register Lisp_Object defn;
+   Lisp_Object lambda_list, doc, tail;
  
    fn_name = Fcar (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);
***************
*** 3229,3234 ****
--- 3265,3273 ----
    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");
***************
*** 3313,3318 ****
--- 3352,3365 ----
  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);



*** subr.el     2002/03/17 11:58:18     1.291
--- subr.el     2002/03/17 12:14:14
***************
*** 32,37 ****
--- 32,55 ----
  (defun custom-declare-variable-early (&rest arguments)
    (setq custom-declare-variable-list
        (cons arguments custom-declare-variable-list)))
+ 
+ 
+ (defun macro-declaration-function (macro decl)
+   "Process a declaration found in a macro definition.
+ This is set as the value of the variable `macro-declaration-function'.
+ MACRO is the name of the macro being defined.
+ DECL is a list `(declare ...)' containing the declarations.
+ The return value of this function is not used."
+   (dolist (d (cdr decl))
+     (cond ((and (consp d) (eq (car d) 'indent))
+          (put macro 'lisp-indent-function (cadr d)))
+         ((and (consp d) (eq (car d) 'debug))
+          (put macro 'edebug-form-spec (cadr d)))
+         (t
+          (message "Unknown declaration %s" d)))))
+ 
+ (setq macro-declaration-function 'macro-declaration-function)
+ 
  
  ;;;; Lisp language features.