Commit 2f600e97 authored by Paul Eggert's avatar Paul Eggert

Avoid crashes when casifying noncontiguous regions

This is a followon fix for Bug#37477.
* lisp/simple.el (region-extract-function):
Use setq here, since the var is now defined in C code.
* src/casefiddle.c (casify_pnc_region): New function.
(Fupcase_region, Fdowncase_region, Fcapitalize_region)
(Fupcase_initials_region): Use it.
(Fupcase_initials_region): Add region-noncontiguous-p flag
for consistency with the others.  All uses changed.
(syms_of_casefiddle): Define Qbounds, Vregion_extract_function.
* src/insdel.c (prepare_to_modify_buffer_1):
* src/keyboard.c (command_loop_1):
Use Vregion_extraction_function.
* src/insdel.c (syms_of_insdel): No need to define
Qregion_extract_function.
* test/src/casefiddle-tests.el (casefiddle-oldfunc): New var.
(casefiddle-loopfunc, casefiddle-badfunc): New functions.
(casefiddle-invalid-region-extract-function): New test.
parent dddff96a
Pipeline #3257 failed with stage
in 54 minutes and 14 seconds
...@@ -488,7 +488,8 @@ interface that's more like functions like 'search-forward'. ...@@ -488,7 +488,8 @@ interface that's more like functions like 'search-forward'.
--- ---
** More commands support noncontiguous rectangular regions, namely ** More commands support noncontiguous rectangular regions, namely
'upcase-dwim', 'downcase-dwim', 'capitalize-dwim', 'capitalize-region', 'upcase-dwim', 'downcase-dwim', 'capitalize-dwim', 'capitalize-region',
'replace-string', 'replace-regexp', and 'delimit-columns-region'. 'upcase-initials-region', 'replace-string', 'replace-regexp', and
'delimit-columns-region'.
+++ +++
** When asked to visit a large file, Emacs now offers visiting it literally. ** When asked to visit a large file, Emacs now offers visiting it literally.
......
...@@ -1087,7 +1087,7 @@ instead of deleted." ...@@ -1087,7 +1087,7 @@ instead of deleted."
:group 'killing :group 'killing
:version "24.1") :version "24.1")
(defvar region-extract-function (setq region-extract-function
(lambda (method) (lambda (method)
(when (region-beginning) (when (region-beginning)
(cond (cond
...@@ -1096,19 +1096,7 @@ instead of deleted." ...@@ -1096,19 +1096,7 @@ instead of deleted."
((eq method 'delete-only) ((eq method 'delete-only)
(delete-region (region-beginning) (region-end))) (delete-region (region-beginning) (region-end)))
(t (t
(filter-buffer-substring (region-beginning) (region-end) method))))) (filter-buffer-substring (region-beginning) (region-end) method))))))
"Function to get the region's content.
Called with one argument METHOD which can be:
- nil: return the content as a string (list of strings for
non-contiguous regions).
- `delete-only': delete the region; the return value is undefined.
- `bounds': return the boundaries of the region as a list of one
or more cons cells of the form (START . END).
- anything else: delete the region and return its content
as a string (or list of strings for non-contiguous regions),
after filtering it with `filter-buffer-substring', which
is called, for each contiguous sub-region, with METHOD as its
3rd argument.")
(defvar region-insert-function (defvar region-insert-function
(lambda (lines) (lambda (lines)
......
...@@ -516,34 +516,43 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) ...@@ -516,34 +516,43 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
return orig_end + added; return orig_end + added;
} }
DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3, /* Casify a possibly noncontiguous region according to FLAG. BEG and
"(list (region-beginning) (region-end) (region-noncontiguous-p))", END specify the bounds, except that if REGION_NONCONTIGUOUS_P is
doc: /* Convert the region to upper case. In programs, wants two arguments. non-nil, the region's bounds are specified by (funcall
These arguments specify the starting and ending character numbers of region-extract-function 'bounds) instead. */
the region to operate on. When used as a command, the text between
point and the mark is operated on.
See also `capitalize-region'. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{
Lisp_Object bounds = Qnil;
static Lisp_Object
casify_pnc_region (enum case_action flag, Lisp_Object beg, Lisp_Object end,
Lisp_Object region_noncontiguous_p)
{
if (!NILP (region_noncontiguous_p)) if (!NILP (region_noncontiguous_p))
{ {
bounds = call1 (Fsymbol_value (Qregion_extract_function), Lisp_Object bounds = call1 (Vregion_extract_function, Qbounds);
intern ("bounds")); FOR_EACH_TAIL (bounds)
while (CONSP (bounds))
{ {
casify_region (CASE_UP, XCAR (XCAR (bounds)), XCDR (XCAR (bounds))); CHECK_CONS (XCAR (bounds));
bounds = XCDR (bounds); casify_region (flag, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
} }
CHECK_LIST_END (bounds, bounds);
} }
else else
casify_region (CASE_UP, beg, end); casify_region (flag, beg, end);
return Qnil; return Qnil;
} }
DEFUN ("upcase-region", Fupcase_region, Supcase_region, 2, 3,
"(list (region-beginning) (region-end) (region-noncontiguous-p))",
doc: /* Convert the region to upper case. In programs, wants two arguments.
These arguments specify the starting and ending character numbers of
the region to operate on. When used as a command, the text between
point and the mark is operated on.
See also `capitalize-region'. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{
return casify_pnc_region (CASE_UP, beg, end, region_noncontiguous_p);
}
DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3, DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3,
"(list (region-beginning) (region-end) (region-noncontiguous-p))", "(list (region-beginning) (region-end) (region-noncontiguous-p))",
doc: /* Convert the region to lower case. In programs, wants two arguments. doc: /* Convert the region to lower case. In programs, wants two arguments.
...@@ -552,23 +561,7 @@ the region to operate on. When used as a command, the text between ...@@ -552,23 +561,7 @@ the region to operate on. When used as a command, the text between
point and the mark is operated on. */) point and the mark is operated on. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p) (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{ {
Lisp_Object bounds = Qnil; return casify_pnc_region (CASE_DOWN, beg, end, region_noncontiguous_p);
if (!NILP (region_noncontiguous_p))
{
bounds = call1 (Fsymbol_value (Qregion_extract_function),
intern ("bounds"));
while (CONSP (bounds))
{
casify_region (CASE_DOWN, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
bounds = XCDR (bounds);
}
}
else
casify_region (CASE_DOWN, beg, end);
return Qnil;
} }
DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 3, DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 3,
...@@ -580,38 +573,23 @@ In programs, give two arguments, the starting and ending ...@@ -580,38 +573,23 @@ In programs, give two arguments, the starting and ending
character positions to operate on. */) character positions to operate on. */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p) (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{ {
Lisp_Object bounds = Qnil; return casify_pnc_region (CASE_CAPITALIZE, beg, end, region_noncontiguous_p);
if (!NILP (region_noncontiguous_p))
{
bounds = call1 (Fsymbol_value (Qregion_extract_function),
intern ("bounds"));
while (CONSP (bounds))
{
casify_region (CASE_CAPITALIZE, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
bounds = XCDR (bounds);
}
}
else
casify_region (CASE_CAPITALIZE, beg, end);
return Qnil;
} }
/* Like Fcapitalize_region but change only the initials. */ /* Like Fcapitalize_region but change only the initials. */
DEFUN ("upcase-initials-region", Fupcase_initials_region, DEFUN ("upcase-initials-region", Fupcase_initials_region,
Supcase_initials_region, 2, 2, "r", Supcase_initials_region, 2, 3,
"(list (region-beginning) (region-end) (region-noncontiguous-p))",
doc: /* Upcase the initial of each word in the region. doc: /* Upcase the initial of each word in the region.
This means that each word's first character is converted to either This means that each word's first character is converted to either
title case or upper case, and the rest are left unchanged. title case or upper case, and the rest are left unchanged.
In programs, give two arguments, the starting and ending In programs, give two arguments, the starting and ending
character positions to operate on. */) character positions to operate on. */)
(Lisp_Object beg, Lisp_Object end) (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
{ {
casify_region (CASE_CAPITALIZE_UP, beg, end); return casify_pnc_region (CASE_CAPITALIZE_UP, beg, end,
return Qnil; region_noncontiguous_p);
} }
static Lisp_Object static Lisp_Object
...@@ -668,12 +646,28 @@ With negative argument, capitalize previous words but do not move. */) ...@@ -668,12 +646,28 @@ With negative argument, capitalize previous words but do not move. */)
void void
syms_of_casefiddle (void) syms_of_casefiddle (void)
{ {
DEFSYM (Qbounds, "bounds");
DEFSYM (Qidentity, "identity"); DEFSYM (Qidentity, "identity");
DEFSYM (Qtitlecase, "titlecase"); DEFSYM (Qtitlecase, "titlecase");
DEFSYM (Qspecial_uppercase, "special-uppercase"); DEFSYM (Qspecial_uppercase, "special-uppercase");
DEFSYM (Qspecial_lowercase, "special-lowercase"); DEFSYM (Qspecial_lowercase, "special-lowercase");
DEFSYM (Qspecial_titlecase, "special-titlecase"); DEFSYM (Qspecial_titlecase, "special-titlecase");
DEFVAR_LISP ("region-extract-function", Vregion_extract_function,
doc: /* Function to get the region's content.
Called with one argument METHOD which can be:
- nil: return the content as a string (list of strings for
non-contiguous regions).
- `delete-only': delete the region; the return value is undefined.
- `bounds': return the boundaries of the region as a list of one
or more cons cells of the form (START . END).
- anything else: delete the region and return its content
as a string (or list of strings for non-contiguous regions),
after filtering it with `filter-buffer-substring', which
is called, for each contiguous sub-region, with METHOD as its
3rd argument. */);
Vregion_extract_function = Qnil; /* simple.el sets this. */
defsubr (&Supcase); defsubr (&Supcase);
defsubr (&Sdowncase); defsubr (&Sdowncase);
defsubr (&Scapitalize); defsubr (&Scapitalize);
......
...@@ -2002,7 +2002,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end, ...@@ -2002,7 +2002,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end,
: (!NILP (Vselect_active_regions) : (!NILP (Vselect_active_regions)
&& !NILP (Vtransient_mark_mode)))) && !NILP (Vtransient_mark_mode))))
Vsaved_region_selection Vsaved_region_selection
= call1 (Fsymbol_value (Qregion_extract_function), Qnil); = call1 (Vregion_extract_function, Qnil);
signal_before_change (start, end, preserve_ptr); signal_before_change (start, end, preserve_ptr);
Fset (Qdeactivate_mark, Qt); Fset (Qdeactivate_mark, Qt);
...@@ -2401,7 +2401,5 @@ handling of the active region per `select-active-regions'. */); ...@@ -2401,7 +2401,5 @@ handling of the active region per `select-active-regions'. */);
inhibit_modification_hooks = 0; inhibit_modification_hooks = 0;
DEFSYM (Qinhibit_modification_hooks, "inhibit-modification-hooks"); DEFSYM (Qinhibit_modification_hooks, "inhibit-modification-hooks");
DEFSYM (Qregion_extract_function, "region-extract-function");
defsubr (&Scombine_after_change_execute); defsubr (&Scombine_after_change_execute);
} }
...@@ -1535,7 +1535,7 @@ command_loop_1 (void) ...@@ -1535,7 +1535,7 @@ command_loop_1 (void)
Vselection_inhibit_update_commands))) Vselection_inhibit_update_commands)))
{ {
Lisp_Object txt Lisp_Object txt
= call1 (Fsymbol_value (Qregion_extract_function), Qnil); = call1 (Vregion_extract_function, Qnil);
if (XFIXNUM (Flength (txt)) > 0) if (XFIXNUM (Flength (txt)) > 0)
/* Don't set empty selections. */ /* Don't set empty selections. */
call2 (Qgui_set_selection, QPRIMARY, txt); call2 (Qgui_set_selection, QPRIMARY, txt);
......
...@@ -2739,7 +2739,7 @@ since only regular expressions have distinguished subexpressions. */) ...@@ -2739,7 +2739,7 @@ since only regular expressions have distinguished subexpressions. */)
Qnil); Qnil);
else if (case_action == cap_initial) else if (case_action == cap_initial)
Fupcase_initials_region (make_fixnum (search_regs.start[sub]), Fupcase_initials_region (make_fixnum (search_regs.start[sub]),
make_fixnum (newpoint)); make_fixnum (newpoint), Qnil);
/* The replace_range etc. functions can trigger modification hooks /* The replace_range etc. functions can trigger modification hooks
(see signal_before_change and signal_after_change). Try to error (see signal_before_change and signal_after_change). Try to error
......
...@@ -259,5 +259,22 @@ ...@@ -259,5 +259,22 @@
(should (eq tc (capitalize ch))) (should (eq tc (capitalize ch)))
(should (eq tc (upcase-initials ch)))))) (should (eq tc (upcase-initials ch))))))
(defvar casefiddle-oldfunc region-extract-function)
(defun casefiddle-loopfunc (method)
(if (eq method 'bounds)
(let ((looping (list '(1 . 1))))
(setcdr looping looping))
(funcall casefiddle-oldfunc method)))
(defun casefiddle-badfunc (method)
(if (eq method 'bounds)
'(())
(funcall casefiddle-oldfunc method)))
(ert-deftest casefiddle-invalid-region-extract-function ()
(dolist (region-extract-function '(casefiddle-badfunc casefiddle-loopfunc))
(with-temp-buffer
(should-error (upcase-region nil nil t)))))
;;; casefiddle-tests.el ends here ;;; casefiddle-tests.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment