aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2003-02-23 15:14:08 +0000
committerRichard M. Stallman2003-02-23 15:14:08 +0000
commit120d0a23ea5a2a4b9cea75ead02c73ea85ed7b1b (patch)
tree2573463a2a7c2403b23832be379315dd68774658
parente3bfcda9ac9b5b9a279c25539a1a4e9d94826ef3 (diff)
downloademacs-120d0a23ea5a2a4b9cea75ead02c73ea85ed7b1b.tar.gz
emacs-120d0a23ea5a2a4b9cea75ead02c73ea85ed7b1b.zip
(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.
-rw-r--r--src/ChangeLog10
-rw-r--r--src/callint.c109
2 files changed, 80 insertions, 39 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 7d27e0b53d8..afdc53e33c3 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
12003-02-23 Richard M. Stallman <rms@gnu.org>
2
3 * callint.c (fix_command): New subroutine, from Fcall_interactively.
4 Detect (when ... (region-beginning)) etc.
5 (Fcall_interactively): Call fix_command.
6 (Qif, Qwhen): New variables.
7 (syms_of_callint): Init and staticpro them.
8
9 * regex.c (print_partial_compiled_pattern): Output to stderr.
10
12003-02-23 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de> 112003-02-23 Kai Gro,A_(Bjohann <kai.grossjohann@uni-duisburg.de>
2 12
3 * dired.c (directory_files_internal): Don't expand directory. 13 * dired.c (directory_files_internal): Don't expand directory.
diff --git a/src/callint.c b/src/callint.c
index 6ce9fb12387..6decd691b55 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -51,7 +51,7 @@ Lisp_Object Vmark_even_if_inactive;
51 51
52Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; 52Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
53 53
54Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn; 54Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
55static Lisp_Object preserved_fns; 55static Lisp_Object preserved_fns;
56 56
57/* Marker used within call-interactively to refer to point. */ 57/* Marker used within call-interactively to refer to point. */
@@ -315,44 +315,7 @@ supply if the command inquires which events were used to invoke it. */)
315 /* Make a copy of the list of values, for the command history, 315 /* Make a copy of the list of values, for the command history,
316 and turn them into things we can eval. */ 316 and turn them into things we can eval. */
317 values = quotify_args (Fcopy_sequence (specs)); 317 values = quotify_args (Fcopy_sequence (specs));
318 /* If the list of args was produced with an explicit call to `list', 318 fix_command (input, values);
319 look for elements that were computed with (region-beginning)
320 or (region-end), and put those expressions into VALUES
321 instead of the present values. */
322 if (CONSP (input))
323 {
324 car = XCAR (input);
325 /* Skip through certain special forms. */
326 while (EQ (car, Qlet) || EQ (car, Qletx)
327 || EQ (car, Qsave_excursion)
328 || EQ (car, Qprogn))
329 {
330 while (CONSP (XCDR (input)))
331 input = XCDR (input);
332 input = XCAR (input);
333 if (!CONSP (input))
334 break;
335 car = XCAR (input);
336 }
337 if (EQ (car, Qlist))
338 {
339 Lisp_Object intail, valtail;
340 for (intail = Fcdr (input), valtail = values;
341 CONSP (valtail);
342 intail = Fcdr (intail), valtail = Fcdr (valtail))
343 {
344 Lisp_Object elt;
345 elt = Fcar (intail);
346 if (CONSP (elt))
347 {
348 Lisp_Object presflag;
349 presflag = Fmemq (Fcar (elt), preserved_fns);
350 if (!NILP (presflag))
351 Fsetcar (valtail, Fcar (intail));
352 }
353 }
354 }
355 }
356 Vcommand_history 319 Vcommand_history
357 = Fcons (Fcons (function, values), Vcommand_history); 320 = Fcons (Fcons (function, values), Vcommand_history);
358 321
@@ -822,6 +785,70 @@ supply if the command inquires which events were used to invoke it. */)
822 } 785 }
823} 786}
824 787
788Lisp_Object
789fix_command (input, values)
790 Lisp_Object input, values;
791{
792 /* If the list of args was produced with an explicit call to `list',
793 look for elements that were computed with (region-beginning)
794 or (region-end), and put those expressions into VALUES
795 instead of the present values. */
796 if (CONSP (input))
797 {
798 Lisp_Object car;
799
800 car = XCAR (input);
801 /* Skip through certain special forms. */
802 while (EQ (car, Qlet) || EQ (car, Qletx)
803 || EQ (car, Qsave_excursion)
804 || EQ (car, Qprogn))
805 {
806 while (CONSP (XCDR (input)))
807 input = XCDR (input);
808 input = XCAR (input);
809 if (!CONSP (input))
810 break;
811 car = XCAR (input);
812 }
813 if (EQ (car, Qlist))
814 {
815 Lisp_Object intail, valtail;
816 for (intail = Fcdr (input), valtail = values;
817 CONSP (valtail);
818 intail = Fcdr (intail), valtail = Fcdr (valtail))
819 {
820 Lisp_Object elt;
821 elt = Fcar (intail);
822 if (CONSP (elt))
823 {
824 Lisp_Object presflag, carelt;
825 carelt = Fcar (elt);
826 /* If it is (if X Y), look at Y. */
827 if (EQ (carelt, Qif)
828 && EQ (Fnthcdr (make_number (3), elt), Qnil))
829 elt = Fnth (make_number (2), elt);
830 /* If it is (when ... Y), look at Y. */
831 else if (EQ (carelt, Qwhen))
832 {
833 while (CONSP (XCDR (elt)))
834 elt = XCDR (elt);
835 elt = Fcar (elt);
836 }
837
838 /* If the function call we're looking at
839 is a special preserved one, copy the
840 whole expression for this argument. */
841 if (CONSP (elt))
842 {
843 presflag = Fmemq (Fcar (elt), preserved_fns);
844 if (!NILP (presflag))
845 Fsetcar (valtail, Fcar (intail));
846 }
847 }
848 }
849 }
850 }
851}
825DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, 852DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
826 1, 1, 0, 853 1, 1, 0,
827 doc: /* Return numeric meaning of raw prefix argument RAW. 854 doc: /* Return numeric meaning of raw prefix argument RAW.
@@ -862,6 +889,10 @@ syms_of_callint ()
862 staticpro (&Qlist); 889 staticpro (&Qlist);
863 Qlet = intern ("let"); 890 Qlet = intern ("let");
864 staticpro (&Qlet); 891 staticpro (&Qlet);
892 Qif = intern ("if");
893 staticpro (&Qif);
894 Qwhen = intern ("when");
895 staticpro (&Qwhen);
865 Qletx = intern ("let*"); 896 Qletx = intern ("let*");
866 staticpro (&Qletx); 897 staticpro (&Qletx);
867 Qsave_excursion = intern ("save-excursion"); 898 Qsave_excursion = intern ("save-excursion");