Re: File modes facilities.

[storm@cua.dk (Kim F. Storm)]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>>> Below is a _much_better_ patch which allows ANY function to have its
>>>> interactive specification overridden, and consequently you can make
>>>> any function into a command.
>>>
>>> Indeed, this is much better.
>>> The only problem I still see with it is that it interacts poorly
>>> with aliases.

Here is a new patch which fully supports command aliases, optionally
with different interactive specs:


*** data.c	19 Sep 2005 00:24:45 +0200	1.254
--- data.c	25 Oct 2005 00:49:49 +0200
***************
*** 775,788 ****
    return make_string (name, strlen (name));
  }

! DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
         doc: /* Return the interactive form of CMD or nil if none.
  If CMD is not a command, the return value is nil.
  Value, if non-nil, is a list \(interactive SPEC).  */)
!      (cmd)
!      Lisp_Object cmd;
  {
!   Lisp_Object fun = indirect_function (cmd);

    if (SUBRP (fun))
      {
--- 775,801 ----
    return make_string (name, strlen (name));
  }

! DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 2, 0,
         doc: /* Return the interactive form of CMD or nil if none.
  If CMD is not a command, the return value is nil.
+ If optional second arg NO-OVERRIDE is non-nil, do not look for an
+ overriding `interactive' specification property on CMD.
  Value, if non-nil, is a list \(interactive SPEC).  */)
!   (cmd, no_override)
!      Lisp_Object cmd, no_override;
  {
!   Lisp_Object fun;
!   Lisp_Object specs;
!
!  retry:
!   if (NILP (no_override))
!     {
!       fun = indirect_function_overriding_spec (cmd, &specs);
!       if (!NILP (specs))
! 	return list2 (Qinteractive, specs);
!     }
!   else
!     fun = indirect_function (cmd);

    if (SUBRP (fun))
      {
***************
*** 797,811 ****
    else if (CONSP (fun))
      {
        Lisp_Object funcar = XCAR (fun);
        if (EQ (funcar, Qlambda))
  	return Fassq (Qinteractive, Fcdr (XCDR (fun)));
!       else if (EQ (funcar, Qautoload))
  	{
  	  struct gcpro gcpro1;
  	  GCPRO1 (cmd);
  	  do_autoload (fun, cmd);
  	  UNGCPRO;
! 	  return Finteractive_form (cmd);
  	}
      }
    return Qnil;
--- 810,826 ----
    else if (CONSP (fun))
      {
        Lisp_Object funcar = XCAR (fun);
+
        if (EQ (funcar, Qlambda))
  	return Fassq (Qinteractive, Fcdr (XCDR (fun)));
!
!       if (EQ (funcar, Qautoload))
  	{
  	  struct gcpro gcpro1;
  	  GCPRO1 (cmd);
  	  do_autoload (fun, cmd);
  	  UNGCPRO;
! 	  goto retry;
  	}
      }
    return Qnil;
***************
*** 1912,1917 ****
--- 1927,1975 ----
    return hare;
  }

+ /* If OBJECT is a symbol, find the end of its function chain and
+    return the value found there.  If OBJECT is not a symbol, just
+    return it.  If there is a cycle in the function chain, signal a
+    cyclic-function-indirection error.
+
+    This is like indirect_function, except that it looks for an
+    overriding interactive specification on each symbol alias, and
+    it will return prematurely if found.  */
+ Lisp_Object
+ indirect_function_overriding_spec (object, specs)
+      register Lisp_Object object;
+      Lisp_Object *specs;
+ {
+   Lisp_Object tortoise, hare;
+
+   *specs = Qnil;
+   hare = tortoise = object;
+
+   for (;;)
+     {
+       if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+ 	break;
+       if ((*specs = Fget (hare, Qinteractive), !NILP (*specs)))
+ 	return hare;
+       hare = XSYMBOL (hare)->function;
+
+       if (!SYMBOLP (hare) || EQ (hare, Qunbound))
+ 	break;
+       if ((*specs = Fget (hare, Qinteractive), !NILP (*specs)))
+ 	return hare;
+       hare = XSYMBOL (hare)->function;
+
+       tortoise = XSYMBOL (tortoise)->function;
+
+       if (EQ (hare, tortoise))
+ 	Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil));
+     }
+
+   return hare;
+ }
+
+
+
  DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 1, 0,
         doc: /* Return the function at the end of OBJECT's function chain.
  If OBJECT is a symbol, follow all function indirections and return the final

*** lisp.h	02 Oct 2005 21:08:17 +0200	1.542
--- lisp.h	25 Oct 2005 00:48:23 +0200
***************
*** 2117,2123 ****
  extern Lisp_Object Qinteger;

  extern void circular_list_error P_ ((Lisp_Object));
! EXFUN (Finteractive_form, 1);

  /* Defined in frame.c */
  extern Lisp_Object Qframep;
--- 2117,2123 ----
  extern Lisp_Object Qinteger;

  extern void circular_list_error P_ ((Lisp_Object));
! EXFUN (Finteractive_form, 2);

  /* Defined in frame.c */
  extern Lisp_Object Qframep;
***************
*** 2159,2164 ****
--- 2159,2166 ----
  EXFUN (Fsymbol_plist, 1);
  EXFUN (Fsymbol_name, 1);
  extern Lisp_Object indirect_function P_ ((Lisp_Object));
+ extern Lisp_Object indirect_function_overriding_spec P_ ((Lisp_Object,
+ 							  Lisp_Object *));
  EXFUN (Findirect_function, 1);
  EXFUN (Ffset, 2);
  EXFUN (Fsetplist, 2);

*** callint.c	14 Aug 2005 14:47:25 +0200	1.140
--- callint.c	25 Oct 2005 10:47:36 +0200
***************
*** 321,328 ****
    else
      enable = Qnil;

-   fun = indirect_function (function);
-
    specs = Qnil;
    string = 0;
    /* The idea of FILTER_SPECS is to provide away to
--- 321,326 ----
***************
*** 333,343 ****
    /* If k or K discard an up-event, save it here so it can be retrieved with U */
    up_event = Qnil;

    /* Decode the kind of function.  Either handle it and return,
       or go to `lose' if not interactive, or go to `retry'
       to specify a different function, or set either STRING or SPECS.  */

!   if (SUBRP (fun))
      {
        string = (unsigned char *) XSUBR (fun)->prompt;
        if (!string)
--- 331,347 ----
    /* If k or K discard an up-event, save it here so it can be retrieved with U */
    up_event = Qnil;

+   fun = indirect_function_overriding_spec (function, &specs);
+
    /* Decode the kind of function.  Either handle it and return,
       or go to `lose' if not interactive, or go to `retry'
       to specify a different function, or set either STRING or SPECS.  */

!   if (!NILP (specs))
!     {
!       filter_specs = specs;
!     }
!   else if (SUBRP (fun))
      {
        string = (unsigned char *) XSUBR (fun)->prompt;
        if (!string)
***************
*** 357,363 ****
      {
        Lisp_Object form;
        GCPRO2 (function, prefix_arg);
!       form = Finteractive_form (function);
        UNGCPRO;
        if (CONSP (form))
  	specs = filter_specs = Fcar (XCDR (form));
--- 361,367 ----
      {
        Lisp_Object form;
        GCPRO2 (function, prefix_arg);
!       form = Finteractive_form (function, Qt);
        UNGCPRO;
        if (CONSP (form))
  	specs = filter_specs = Fcar (XCDR (form));

*** eval.c	14 Aug 2005 14:47:28 +0200	1.256
--- eval.c	25 Oct 2005 00:52:49 +0200
***************
*** 1907,1916 ****
  {
    register Lisp_Object fun;
    register Lisp_Object funcar;

!   fun = function;
!
!   fun = indirect_function (fun);
    if (EQ (fun, Qunbound))
      return Qnil;

--- 1907,1917 ----
  {
    register Lisp_Object fun;
    register Lisp_Object funcar;
+   Lisp_Object specs;

!   fun = indirect_function_overriding_spec (function, &specs);
!   if (!NILP (specs))
!     return Qt;
    if (EQ (fun, Qunbound))
      return Qnil;


--
Kim F. Storm <storm@cua.dk> http://www.cua.dk