changeset 49932:2f5cdffaaa04

(fix_command): New subroutine, from Fcall_interactively. Detect (when ... (region-beginning)) etc. (Fcall_interactively): Call fix_command. (Qif, Qwhen): New variables. (syms_of_callint): Init and staticpro them.
author Richard M. Stallman <rms@gnu.org>
date Sun, 23 Feb 2003 15:13:41 +0000
parents 7ff13fa2e27a
children 43b8fcc10f4d
files src/callint.c
diffstat 1 files changed, 70 insertions(+), 39 deletions(-) [+]
line wrap: on
line diff
--- a/src/callint.c	Sun Feb 23 15:04:11 2003 +0000
+++ b/src/callint.c	Sun Feb 23 15:13:41 2003 +0000
@@ -51,7 +51,7 @@
 
 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
 
-Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn;
+Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
 static Lisp_Object preserved_fns;
 
 /* Marker used within call-interactively to refer to point.  */
@@ -315,44 +315,7 @@
 	  /* Make a copy of the list of values, for the command history,
 	     and turn them into things we can eval.  */
 	  values = quotify_args (Fcopy_sequence (specs));
-	  /* If the list of args was produced with an explicit call to `list',
-	     look for elements that were computed with (region-beginning)
-	     or (region-end), and put those expressions into VALUES
-	     instead of the present values.  */
-	  if (CONSP (input))
-	    {
-	      car = XCAR (input);
-	      /* Skip through certain special forms.  */
-	      while (EQ (car, Qlet) || EQ (car, Qletx)
-		     || EQ (car, Qsave_excursion)
-		     || EQ (car, Qprogn))
-		{
-		  while (CONSP (XCDR (input)))
-		    input = XCDR (input);
-		  input = XCAR (input);
-		  if (!CONSP (input))
-		    break;
-		  car = XCAR (input);
-		}
-	      if (EQ (car, Qlist))
-		{
-		  Lisp_Object intail, valtail;
-		  for (intail = Fcdr (input), valtail = values;
-		       CONSP (valtail);
-		       intail = Fcdr (intail), valtail = Fcdr (valtail))
-		    {
-		      Lisp_Object elt;
-		      elt = Fcar (intail);
-		      if (CONSP (elt))
-			{
-			  Lisp_Object presflag;
-			  presflag = Fmemq (Fcar (elt), preserved_fns);
-			  if (!NILP (presflag))
-			    Fsetcar (valtail, Fcar (intail));
-			}
-		    }
-		}
-	    }
+	  fix_command (input, values);
 	  Vcommand_history
 	    = Fcons (Fcons (function, values), Vcommand_history);
 
@@ -822,6 +785,70 @@
   }
 }
 
+Lisp_Object
+fix_command (input, values)
+     Lisp_Object input, values;
+{
+  /* If the list of args was produced with an explicit call to `list',
+     look for elements that were computed with (region-beginning)
+     or (region-end), and put those expressions into VALUES
+     instead of the present values.  */
+  if (CONSP (input))
+    {
+      Lisp_Object car;
+
+      car = XCAR (input);
+      /* Skip through certain special forms.  */
+      while (EQ (car, Qlet) || EQ (car, Qletx)
+	     || EQ (car, Qsave_excursion)
+	     || EQ (car, Qprogn))
+	{
+	  while (CONSP (XCDR (input)))
+	    input = XCDR (input);
+	  input = XCAR (input);
+	  if (!CONSP (input))
+	    break;
+	  car = XCAR (input);
+	}
+      if (EQ (car, Qlist))
+	{
+	  Lisp_Object intail, valtail;
+	  for (intail = Fcdr (input), valtail = values;
+	       CONSP (valtail);
+	       intail = Fcdr (intail), valtail = Fcdr (valtail))
+	    {
+	      Lisp_Object elt;
+	      elt = Fcar (intail);
+	      if (CONSP (elt))
+		{
+		  Lisp_Object presflag, carelt;
+		  carelt = Fcar (elt);
+		  /* If it is (if X Y), look at Y.  */
+		  if (EQ (carelt, Qif)
+		      && EQ (Fnthcdr (make_number (3), elt), Qnil))
+		    elt = Fnth (make_number (2), elt);
+		  /* If it is (when ... Y), look at Y.  */
+		  else if (EQ (carelt, Qwhen))
+		    {
+		      while (CONSP (XCDR (elt)))
+			elt = XCDR (elt);
+		      elt = Fcar (elt);
+		    }
+
+		  /* If the function call we're looking at
+		     is a special preserved one, copy the
+		     whole expression for this argument.  */
+		  if (CONSP (elt))
+		    {
+		      presflag = Fmemq (Fcar (elt), preserved_fns);
+		      if (!NILP (presflag))
+			Fsetcar (valtail, Fcar (intail));
+		    }
+		}
+	    }
+	}
+    }
+}
 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
        1, 1, 0,
        doc: /* Return numeric meaning of raw prefix argument RAW.
@@ -862,6 +889,10 @@
   staticpro (&Qlist);
   Qlet = intern ("let");
   staticpro (&Qlet);
+  Qif = intern ("if");
+  staticpro (&Qif);
+  Qwhen = intern ("when");
+  staticpro (&Qwhen);
   Qletx = intern ("let*");
   staticpro (&Qletx);
   Qsave_excursion = intern ("save-excursion");