From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Paul Eggert Newsgroups: gmane.emacs.bugs Subject: bug#37477: 26.3; capitalize-region doesn't work with rectangles Date: Sun, 22 Sep 2019 10:49:36 -0700 Organization: UCLA Computer Science Department Message-ID: References: <84eed07c-b107-f7f5-0df5-d018431cbd6a@psu.edu> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------7C4FD2DF9150698D1310853A" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="22568"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:60.0) Gecko/20100101 Thunderbird/60.8.0 Cc: "Hyatt, Earl J" , 37477@debbugs.gnu.org To: Juri Linkov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Sep 22 19:50:23 2019 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1iC607-0005i0-Ei for geb-bug-gnu-emacs@m.gmane.org; Sun, 22 Sep 2019 19:50:23 +0200 Original-Received: from localhost ([::1]:48102 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iC606-0000BF-CC for geb-bug-gnu-emacs@m.gmane.org; Sun, 22 Sep 2019 13:50:22 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:34429) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iC5zo-00009x-MX for bug-gnu-emacs@gnu.org; Sun, 22 Sep 2019 13:50:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iC5zm-0006Dw-Hh for bug-gnu-emacs@gnu.org; Sun, 22 Sep 2019 13:50:04 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:53901) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iC5zm-0006Dh-BN for bug-gnu-emacs@gnu.org; Sun, 22 Sep 2019 13:50:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iC5zm-00011j-6s for bug-gnu-emacs@gnu.org; Sun, 22 Sep 2019 13:50:02 -0400 X-Loop: help-debbugs@gnu.org In-Reply-To: <84eed07c-b107-f7f5-0df5-d018431cbd6a@psu.edu> Resent-From: Paul Eggert Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 22 Sep 2019 17:50:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 37477 X-GNU-PR-Package: emacs Original-Received: via spool by 37477-submit@debbugs.gnu.org id=B37477.15691745913922 (code B ref 37477); Sun, 22 Sep 2019 17:50:02 +0000 Original-Received: (at 37477) by debbugs.gnu.org; 22 Sep 2019 17:49:51 +0000 Original-Received: from localhost ([127.0.0.1]:34489 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iC5za-00011B-PO for submit@debbugs.gnu.org; Sun, 22 Sep 2019 13:49:51 -0400 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:32840) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iC5zY-00010r-Fc for 37477@debbugs.gnu.org; Sun, 22 Sep 2019 13:49:49 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 412A4160158; Sun, 22 Sep 2019 10:49:42 -0700 (PDT) Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10032) with ESMTP id VTU3bjes-msQ; Sun, 22 Sep 2019 10:49:40 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id DFE64160227; Sun, 22 Sep 2019 10:49:40 -0700 (PDT) X-Virus-Scanned: amavisd-new at zimbra.cs.ucla.edu Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id Vd4u5hjJwpa3; Sun, 22 Sep 2019 10:49:40 -0700 (PDT) Original-Received: from [192.168.1.9] (cpe-23-242-74-103.socal.res.rr.com [23.242.74.103]) by zimbra.cs.ucla.edu (Postfix) with ESMTPSA id AD3F41600FC; Sun, 22 Sep 2019 10:49:40 -0700 (PDT) Content-Language: en-US X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:166932 Archived-At: This is a multi-part message in MIME format. --------------7C4FD2DF9150698D1310853A Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Thanks for implementing that. While checking the surrounding code I noticed that upcase-initials-region could use the same improvement; also, there were some longstanding potential infloops and crashes in the noncontiguous region code. So I installed the attached further patch. --------------7C4FD2DF9150698D1310853A Content-Type: text/x-patch; name="0001-Avoid-crashes-when-casifying-noncontiguous-regions.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Avoid-crashes-when-casifying-noncontiguous-regions.patc"; filename*1="h" >From 2f600e97e7ca43965f55f019759582d93d8bca73 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 22 Sep 2019 10:43:21 -0700 Subject: [PATCH] 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. --- etc/NEWS | 3 +- lisp/simple.el | 16 +----- src/casefiddle.c | 104 +++++++++++++++++------------------ src/insdel.c | 4 +- src/keyboard.c | 2 +- src/search.c | 2 +- test/src/casefiddle-tests.el | 17 ++++++ 7 files changed, 73 insertions(+), 75 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 8a880e5b63..73f0ca2497 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -488,7 +488,8 @@ interface that's more like functions like 'search-forward'. --- ** More commands support noncontiguous rectangular regions, namely '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. diff --git a/lisp/simple.el b/lisp/simple.el index 31e3b2bbab..ecd7eb797e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1087,7 +1087,7 @@ delete-active-region :group 'killing :version "24.1") -(defvar region-extract-function +(setq region-extract-function (lambda (method) (when (region-beginning) (cond @@ -1096,19 +1096,7 @@ region-extract-function ((eq method 'delete-only) (delete-region (region-beginning) (region-end))) (t - (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.") + (filter-buffer-substring (region-beginning) (region-end) method)))))) (defvar region-insert-function (lambda (lines) diff --git a/src/casefiddle.c b/src/casefiddle.c index 3a1724b306..774906df04 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -516,34 +516,43 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) return orig_end + added; } -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) -{ - Lisp_Object bounds = Qnil; +/* Casify a possibly noncontiguous region according to FLAG. BEG and + END specify the bounds, except that if REGION_NONCONTIGUOUS_P is + non-nil, the region's bounds are specified by (funcall + region-extract-function 'bounds) instead. */ +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)) { - bounds = call1 (Fsymbol_value (Qregion_extract_function), - intern ("bounds")); - - while (CONSP (bounds)) + Lisp_Object bounds = call1 (Vregion_extract_function, Qbounds); + FOR_EACH_TAIL (bounds) { - casify_region (CASE_UP, XCAR (XCAR (bounds)), XCDR (XCAR (bounds))); - bounds = XCDR (bounds); + CHECK_CONS (XCAR (bounds)); + casify_region (flag, XCAR (XCAR (bounds)), XCDR (XCAR (bounds))); } + CHECK_LIST_END (bounds, bounds); } else - casify_region (CASE_UP, beg, end); + casify_region (flag, beg, end); 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, "(list (region-beginning) (region-end) (region-noncontiguous-p))", 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 point and the mark is operated on. */) (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p) { - Lisp_Object bounds = Qnil; - - 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; + return casify_pnc_region (CASE_DOWN, beg, end, region_noncontiguous_p); } DEFUN ("capitalize-region", Fcapitalize_region, Scapitalize_region, 2, 3, @@ -580,38 +573,23 @@ In programs, give two arguments, the starting and ending character positions to operate on. */) (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p) { - Lisp_Object bounds = Qnil; - - 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; + return casify_pnc_region (CASE_CAPITALIZE, beg, end, region_noncontiguous_p); } /* Like Fcapitalize_region but change only the initials. */ 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. This means that each word's first character is converted to either title case or upper case, and the rest are left unchanged. In programs, give two arguments, the starting and ending 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 Qnil; + return casify_pnc_region (CASE_CAPITALIZE_UP, beg, end, + region_noncontiguous_p); } static Lisp_Object @@ -668,12 +646,28 @@ With negative argument, capitalize previous words but do not move. */) void syms_of_casefiddle (void) { + DEFSYM (Qbounds, "bounds"); DEFSYM (Qidentity, "identity"); DEFSYM (Qtitlecase, "titlecase"); DEFSYM (Qspecial_uppercase, "special-uppercase"); DEFSYM (Qspecial_lowercase, "special-lowercase"); 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 (&Sdowncase); defsubr (&Scapitalize); diff --git a/src/insdel.c b/src/insdel.c index 093b841d6d..ebfd022ac6 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2002,7 +2002,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end, : (!NILP (Vselect_active_regions) && !NILP (Vtransient_mark_mode)))) Vsaved_region_selection - = call1 (Fsymbol_value (Qregion_extract_function), Qnil); + = call1 (Vregion_extract_function, Qnil); signal_before_change (start, end, preserve_ptr); Fset (Qdeactivate_mark, Qt); @@ -2401,7 +2401,5 @@ handling of the active region per `select-active-regions'. */); inhibit_modification_hooks = 0; DEFSYM (Qinhibit_modification_hooks, "inhibit-modification-hooks"); - DEFSYM (Qregion_extract_function, "region-extract-function"); - defsubr (&Scombine_after_change_execute); } diff --git a/src/keyboard.c b/src/keyboard.c index 1b9a603ca1..a16d13cc7b 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1535,7 +1535,7 @@ command_loop_1 (void) Vselection_inhibit_update_commands))) { Lisp_Object txt - = call1 (Fsymbol_value (Qregion_extract_function), Qnil); + = call1 (Vregion_extract_function, Qnil); if (XFIXNUM (Flength (txt)) > 0) /* Don't set empty selections. */ call2 (Qgui_set_selection, QPRIMARY, txt); diff --git a/src/search.c b/src/search.c index 9b674a5810..1e57d2ecbe 100644 --- a/src/search.c +++ b/src/search.c @@ -2739,7 +2739,7 @@ since only regular expressions have distinguished subexpressions. */) Qnil); else if (case_action == cap_initial) 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 (see signal_before_change and signal_after_change). Try to error diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el index ed9a2f9330..54793f2cda 100644 --- a/test/src/casefiddle-tests.el +++ b/test/src/casefiddle-tests.el @@ -259,5 +259,22 @@ casefiddle-tests--test-casing (should (eq tc (capitalize 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 -- 2.17.1 --------------7C4FD2DF9150698D1310853A--