* bug#65734: 29.1.50; kill-whole-line and visibility of Org subtrees @ 2023-09-04 14:44 Sebastian Miele 2023-09-04 15:20 ` Eli Zaretskii 0 siblings, 1 reply; 3+ messages in thread From: Sebastian Miele @ 2023-09-04 14:44 UTC (permalink / raw) To: 65734 In an emacs -Q, create an Org buffer with the following contents: <-----cut-here-----> * AB ** C <-----cut-here-----> Fold the subtree under the heading AB, so that only a single line is diplayed (ending in "..."). With point between A and B, hit C-S-<backspace> (kill-whole-line). Expected: The whole _visible_ line, i.e., the entire contents of the buffer is erased. Actual behavior: The line with heading C remains. Contrast this with the same experiment, except that the point is at the beginning of the line containing AB when hitting C-S-<backspace>. Then the expected behavior happens. And according to the source of kill-whole-line, the intended effect indeed is to kill a whole _visible_ line. The following patch fixes the issue: diff --git a/lisp/simple.el b/lisp/simple.el index abd587245fe..44221f3fc24 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6649,9 +6649,7 @@ kill-whole-line (unless (bobp) (backward-char)) (point)))) (t - (save-excursion - (kill-region (point) (progn (forward-visible-line 0) (point)))) - (kill-region (point) + (kill-region (save-excursion (forward-visible-line 0) (point)) (progn (forward-visible-line arg) (point)))))) (defun forward-visible-line (arg) The reason for the issue probably is: Without the patch, the killing happens in two stages. The first kill-region kills from the beginning of the line until after the A. That kills the leading *. That probably somehow triggers Org visibility changes. With the patch applied the whole killing happens in one stage, probably without causing an intermediate change of visibility. In GNU Emacs 29.1.50 (build 3, x86_64-pc-linux-gnu, GTK+ Version 3.24.38, cairo version 1.17.8) of 2023-09-04 built on huette Repository revision: 5cbe96d17f67e58091de1653f409d87bcc2b3e99 Repository branch: emacs-29 Windowing system distributor 'The X.Org Foundation', version 11.0.12101008 System Description: Arch Linux Configured using: 'configure --with-x-toolkit=gtk --with-native-compilation --with-tree-sitter --with-json --with-mailutils --with-imagemagick' Configured features: ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSYSTEMD LIBXML2 M17N_FLT MODULES NATIVE_COMP NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS TREE_SITTER WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB Important settings: value of $LANG: C.UTF-8 locale-coding-system: utf-8-unix Major mode: Lisp Interaction Minor modes in effect: tooltip-mode: t global-eldoc-mode: t eldoc-mode: t show-paren-mode: t electric-indent-mode: t mouse-wheel-mode: t tool-bar-mode: t menu-bar-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t line-number-mode: t indent-tabs-mode: t transient-mark-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t Load-path shadows: None found. Features: (shadow sort mail-extr emacsbug message mailcap yank-media puny dired dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg rfc6068 epg-config gnus-util text-property-search time-date mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils comp comp-cstr warnings icons subr-x rx cl-seq cl-macs gv cl-extra help-mode cl-loaddefs cl-lib bytecomp byte-compile rmc iso-transl tooltip cconv eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic indonesian philippine cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite emoji-zwj charscript charprop case-table epa-hook jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs theme-loaddefs faces cus-face macroexp files window text-properties overlay sha1 md5 base64 format env code-pages mule custom widget keymap hashtable-print-readable backquote threads dbusbind inotify lcms2 dynamic-setting system-font-setting font-render-setting cairo move-toolbar gtk x-toolkit xinput2 x multi-tty make-network-process native-compile emacs) Memory information: ((conses 16 66653 8786) (symbols 48 7137 0) (strings 32 20076 3360) (string-bytes 1 606691) (vectors 16 16454) (vector-slots 8 296368 15462) (floats 8 29 22) (intervals 56 240 0) (buffers 984 12)) ^ permalink raw reply related [flat|nested] 3+ messages in thread
* bug#65734: 29.1.50; kill-whole-line and visibility of Org subtrees 2023-09-04 14:44 bug#65734: 29.1.50; kill-whole-line and visibility of Org subtrees Sebastian Miele @ 2023-09-04 15:20 ` Eli Zaretskii 0 siblings, 0 replies; 3+ messages in thread From: Eli Zaretskii @ 2023-09-04 15:20 UTC (permalink / raw) To: Sebastian Miele; +Cc: 65734 > From: Sebastian Miele <iota@whxvd.name> > Date: Mon, 04 Sep 2023 16:44:19 +0200 > > In an emacs -Q, create an Org buffer with the following contents: > > <-----cut-here-----> > * AB > ** C > <-----cut-here-----> > > Fold the subtree under the heading AB, so that only a single line is > diplayed (ending in "..."). With point between A and B, hit > C-S-<backspace> (kill-whole-line). > > Expected: The whole _visible_ line, i.e., the entire contents of the > buffer is erased. Actual behavior: The line with heading C remains. > > Contrast this with the same experiment, except that the point is at the > beginning of the line containing AB when hitting C-S-<backspace>. Then > the expected behavior happens. And according to the source of > kill-whole-line, the intended effect indeed is to kill a whole _visible_ > line. > > The following patch fixes the issue: > > diff --git a/lisp/simple.el b/lisp/simple.el > index abd587245fe..44221f3fc24 100644 > --- a/lisp/simple.el > +++ b/lisp/simple.el > @@ -6649,9 +6649,7 @@ kill-whole-line > (unless (bobp) (backward-char)) > (point)))) > (t > - (save-excursion > - (kill-region (point) (progn (forward-visible-line 0) (point)))) > - (kill-region (point) > + (kill-region (save-excursion (forward-visible-line 0) (point)) > (progn (forward-visible-line arg) (point)))))) > > (defun forward-visible-line (arg) > > The reason for the issue probably is: Without the patch, the killing > happens in two stages. The first kill-region kills from the beginning > of the line until after the A. That kills the leading *. That probably > somehow triggers Org visibility changes. With the patch applied the > whole killing happens in one stage, probably without causing an > intermediate change of visibility. I'm not sure I understand why this is deemed a problem in Emacs. Shouldn't Org redefine C-S-<backspace> if the default binding doesn't suit what happens in Org buffers? Did you discuss this with Org developers? Thanks. ^ permalink raw reply [flat|nested] 3+ messages in thread
[parent not found: <87il8pao4l.fsf@whxvd.name>]
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] [not found] <87il8pao4l.fsf@whxvd.name> @ 2023-09-05 10:29 ` Ihor Radchenko 2023-09-05 11:54 ` Eli Zaretskii 0 siblings, 1 reply; 3+ messages in thread From: Ihor Radchenko @ 2023-09-05 10:29 UTC (permalink / raw) To: Sebastian Miele; +Cc: 65734, emacs-orgmode Sebastian Miele <iota@whxvd.name> writes: > I first reported this to bug-gnu-emacs@gnu.org (see > https://debbugs.gnu.org/65734). However, Eli asks: > >> I'm not sure I understand why this is deemed a problem in Emacs. >> Shouldn't Org redefine C-S-<backspace> if the default binding doesn't >> suit what happens in Org buffers? Did you discuss this with Org >> developers? Confirmed. I am CCing debbugs as I'd like to clarify things to be in sync with Emacs. > In an emacs -Q, create an Org buffer with the following contents: > > --8<---------------cut here---------------start------------->8--- > * AB > ** C > --8<---------------cut here---------------end--------------->8--- This will produce * AB... > Fold the subtree under the heading AB, so that only a single line is > displayed (ending in "..."). With point between A and B, hit > C-S-<backspace> (kill-whole-line). > > Expected: The whole _visible_ line, i.e., the entire contents of the > buffer is erased. Actual behavior: The line with heading C remains. This indeed happens because `kill-whole-line' deletes the line in two steps: "* A" and then the rest. The first deletion leaves B<begin invisible> ** C<end invisible> which drastically alters the outline structure and triggers or to automatically unfold the subtree, leaving B ** C visible. Then, `kill-whole-line' proceeds with the second part of the deletion and deletes the now visible line, leading to the observed behaviour. The first deletion would be an equivalent of deleting "(defun" (defun foo ()... in outline-mode and would make it hard to unfold the body, if such single deletion where performed. In Org mode, because of frequent user requests about accidental deletions of hidden text, we try our best to protect deletions of invisible folded outlines. Automatic unfolding is one of the ways to attract user's attention to potential accidental edit. > Contrast this with the same experiment, except that the point is at the > beginning of the line containing AB when hitting C-S-<backspace>. Then > the expected behavior happens. According to the source of > kill-whole-line, the intended effect indeed is to kill a whole _visible_ > line. Currently, Org mode, similar to Eli's suggestion re-binds `kill-line' to Org's own version - `org-kill-line'. But not `kill-whole-line'. We can certainly do the same for `kill-whole-line', but in our previous discussion https://yhetil.org/emacs-devel/87tu8rq2l6.fsf@localhost/, you asked to consider extending the built-in Emacs commands instead of overriding them. As I described in the above, Org needs more control over the behaviour of `kill-line'/`kill-whole-line' when the visible line contains multiple lines of hidden text - to protect accidental deletions. A hook, where Org can intervene with a yes/no prompt, would be useful. It would also make sense to group the two edits together via `combine-after-change-calls', although a more universal way to know that certain edits are a part of the same known command (even when called non-interactively) would be useful. In addition, `org-kill-line' acts specially in certain scenarios: For * Heading <point> text :tag1:tag2: `org-kill-line' will keep and re-align ":tag1:tag2:": * Heading <point> :tag1:tag2: It would be nice if we could express such behavior without overriding the `kill-line' command. -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] 2023-09-05 10:29 ` bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] Ihor Radchenko @ 2023-09-05 11:54 ` Eli Zaretskii [not found] ` <875y4oaban.fsf@whxvd.name> 0 siblings, 1 reply; 3+ messages in thread From: Eli Zaretskii @ 2023-09-05 11:54 UTC (permalink / raw) To: Ihor Radchenko; +Cc: 65734, emacs-orgmode, iota > Cc: 65734@debbugs.gnu.org, emacs-orgmode@gnu.org > From: Ihor Radchenko <yantar92@posteo.net> > Date: Tue, 05 Sep 2023 10:29:20 +0000 > > As I described in the above, Org needs more control over the behaviour of > `kill-line'/`kill-whole-line' when the visible line contains multiple > lines of hidden text - to protect accidental deletions. > A hook, where Org can intervene with a yes/no prompt, would be useful. > It would also make sense to group the two edits together via > `combine-after-change-calls', although a more universal way to know that > certain edits are a part of the same known command (even when called > non-interactively) would be useful. The command kills in two parts for a good reason, which is explained in the comments to the code. So making a single group will not work, I think, at least not in all situations. And relying on after-change hooks to fix this use case sounds too obscure and fragile to me. Moreover, I don't think this is specific to Org: any mode that folds or hides portions of text might hit the same problem. So we could decide that this command needs to become smarter when the visual line includes invisible text. That is, improve the command without making any Org-specific changes anywhere. Patches to that effect are welcome. > In addition, `org-kill-line' acts specially in certain scenarios: > > For > * Heading <point> text :tag1:tag2: > > `org-kill-line' will keep and re-align ":tag1:tag2:": > > * Heading <point> :tag1:tag2: > > It would be nice if we could express such behavior without overriding > the `kill-line' command. This could be handled by a suitable extension to end-of-visible-line. For example, introduce a new text property which end-of-visible-line would then handle the same as it currently handles invisible text. ^ permalink raw reply [flat|nested] 3+ messages in thread
[parent not found: <875y4oaban.fsf@whxvd.name>]
[parent not found: <83bkeg4o1u.fsf@gnu.org>]
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] [not found] ` <83bkeg4o1u.fsf@gnu.org> @ 2023-09-06 8:23 ` Ihor Radchenko [not found] ` <838r9j339x.fsf@gnu.org> 0 siblings, 1 reply; 3+ messages in thread From: Ihor Radchenko @ 2023-09-06 8:23 UTC (permalink / raw) To: Eli Zaretskii; +Cc: 65734, emacs-orgmode, Sebastian Miele Eli Zaretskii <eliz@gnu.org> writes: >> The following would do it. I think I tested it rather thoroughly. >> During testing I found another bug that is addressed by the let-binding >> of kill-read-only-ok during the first kill-region below. > > Thanks. Sadly, we don't have any tests for this function in our test > suite, so verifying this non-trivial change will not be easy... Then, what should we do to move things forward? I guess the first step will be writing these missing tests. Anything else? -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply [flat|nested] 3+ messages in thread
[parent not found: <838r9j339x.fsf@gnu.org>]
[parent not found: <87tts78lve.fsf@whxvd.name>]
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] [not found] ` <87tts78lve.fsf@whxvd.name> @ 2023-09-10 16:31 ` Sebastian Miele 2023-09-10 16:57 ` Eli Zaretskii 0 siblings, 1 reply; 3+ messages in thread From: Sebastian Miele @ 2023-09-10 16:31 UTC (permalink / raw) To: 65734; +Cc: Eli Zaretskii, Ihor Radchenko I removed emacs-orgmode@gnu.org from CC. > From: Sebastian Miele <iota@whxvd.name> > Date: Wed, 2023-09-06 15:30 +0200 > > I will write the tests. And I will probably come up with an updated > version of the original patch. There is at least one cosmetic change. > And something else that I want to have tried. May take some time. Please have a look at the following patch. For now it contains three tests, two of them with :expected-result :failed. (They do not fail on the bug-fixed version of `kill-whole-line'.) There probably will be more tests and further questions. But for now, I would like to basically have a statement of whether the style of writing the tests goes in an acceptable direction. diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 28d8120f143..c15b0059536 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (eval-when-compile (require 'cl-lib)) (defun simple-test--buffer-substrings () @@ -40,6 +41,112 @@ simple-test--dummy-buffer ,@body (with-no-warnings (simple-test--buffer-substrings)))) +(defconst simple-tests-point-tag "<POINT>") +(defconst simple-tests-mark-tag "<MARK>") + +(defun simple-tests--set-buffer-text-point-mark (description) + "Set the current buffers text, point and mark according to DESCRIPTION. + +Erase current buffer and insert DESCRIPTION. Set point to the +first occurrence of `simple-tests-point-tag' (\"<POINT>\") in the +buffer, removing it. If there is no `simple-tests-point-tag', +set point to the beginning of the buffer. Similar for the active +mark (`simple-tests-mark-tag', \"<MARK>\")." + (erase-buffer) + (insert description) + (goto-char (point-min)) + (when (search-forward simple-tests-mark-tag nil t) + (delete-char (- (length simple-tests-mark-tag))) + (push-mark (point) nil 'activate)) + (goto-char (point-min)) + (when (search-forward simple-tests-point-tag nil t) + (delete-char (- (length simple-tests-point-tag))))) + +(defun simple-tests--get-buffer-text-point-mark () + "Inverse of `simple-tests--set-buffer-text-point-mark'." + (if (not mark-active) + (concat (buffer-substring-no-properties (point-min) (point)) + simple-tests-point-tag + (buffer-substring-no-properties (point) (point-max))) + (if (< (mark) (point)) + (concat (buffer-substring-no-properties (point-min) (mark)) + simple-tests-mark-tag + (buffer-substring-no-properties (mark) (point)) + simple-tests-point-tag + (buffer-substring-no-properties (point) (point-max))) + (concat (buffer-substring-no-properties (point-min) (point)) + simple-tests-point-tag + (buffer-substring-no-properties (point) (mark)) + simple-tests-mark-tag + (buffer-substring-no-properties (mark) (point-max)))))) + +(ert-deftest simple-tests--buffer-text-point-mark-helpers () + (ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark "") + (should (equal "" (buffer-substring-no-properties + (point-min) (point-max)))) + (should-not mark-active) + (should (equal 1 (point))) + (should (equal "<POINT>" (simple-tests--get-buffer-text-point-mark)))) + + (ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark "<POINT><MARK>") + (should (equal "" (buffer-substring-no-properties + (point-min) (point-max)))) + (should mark-active) + (should (equal 1 (point))) + (should (equal 1 (mark))) + (should (equal "<POINT><MARK>" (simple-tests--get-buffer-text-point-mark)))) + + (ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark "<MARK><POINT>") + (should (equal "" (buffer-substring-no-properties + (point-min) (point-max)))) + (should mark-active) + (should (equal 1 (point))) + (should (equal 1 (mark))) + (should (equal "<POINT><MARK>" (simple-tests--get-buffer-text-point-mark)))) + + (ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark "A<POINT><MARK>B") + (should (equal "AB" (buffer-substring-no-properties + (point-min) (point-max)))) + (should mark-active) + (should (equal 2 (point))) + (should (equal 2 (mark))) + (should (equal "A<POINT><MARK>B" + (simple-tests--get-buffer-text-point-mark)))) + + (ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark "A<MARK><POINT>B") + (should (equal "AB" (buffer-substring-no-properties + (point-min) (point-max)))) + (should mark-active) + (should (equal 2 (point))) + (should (equal 2 (mark))) + (should (equal "A<POINT><MARK>B" + (simple-tests--get-buffer-text-point-mark)))) + + (ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark "A<POINT>X<MARK>B") + (should (equal "AXB" (buffer-substring-no-properties + (point-min) (point-max)))) + (should mark-active) + (should (equal 2 (point))) + (should (equal 3 (mark))) + (should (equal "A<POINT>X<MARK>B" + (simple-tests--get-buffer-text-point-mark)))) + + (ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark "A<MARK>X<POINT>B") + (should (equal "AXB" (buffer-substring-no-properties + (point-min) (point-max)))) + (should mark-active) + (should (equal 3 (point))) + (should (equal 2 (mark))) + (should (equal "A<MARK>X<POINT>B" + (simple-tests--get-buffer-text-point-mark))))) + \f ;;; `count-words' (ert-deftest simple-test-count-words-bug-41761 () @@ -1046,5 +1153,109 @@ simple-tests-zap-to-char (with-zap-to-char-test "abcdeCXYZ" "XYZ" (zap-to-char 1 ?C 'interactive)))) +\f +;;; Tests for `kill-whole-line' + +(ert-deftest kill-whole-line-invisible () + :expected-result :failed + (cl-macrolet ((test (kill-whole-line-arg &rest expected-lines) + `(ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark + (string-join + '("* -2" "hidden" + "* -1" "hidden" + "* A<POINT>B" "hidden" + "* 1" "hidden" + "* 2" "hidden" + "") + "\n")) + (ert-simulate-command '(org-mode)) + (ert-simulate-command '(org-fold-hide-sublevels 1)) + (ert-simulate-command + '(kill-whole-line ,kill-whole-line-arg)) + (should + (equal (string-join ',expected-lines "\n") + (simple-tests--get-buffer-text-point-mark)))))) + (test 0 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test 1 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>* 1" "hidden" + "* 2" "hidden" + "") + (test 2 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>* 2" "hidden" + "") + (test 3 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>") + (test 9 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>") + (test -1 + "* -2" "hidden" + "* -1" "hidden<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -2 + "* -2" "hidden<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -3 + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -9 + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + ""))) + +(ert-deftest kill-whole-line-read-only () + :expected-result :failed + (cl-macrolet + ((test (kill-whole-line-arg expected-kill-lines expected-buffer-lines) + `(ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark + (string-join '("-2" "-1" "A<POINT>B" "1" "2" "") "\n")) + (ert-simulate-command '(read-only-mode 1)) + (should-error (ert-simulate-command + '(kill-whole-line ,kill-whole-line-arg))) + (should (equal (string-join ,expected-kill-lines "\n") + (car kill-ring))) + (should (equal (string-join ,expected-buffer-lines "\n") + (simple-tests--get-buffer-text-point-mark)))))) + (test 0 '("AB") '("-2" "-1" "AB<POINT>" "1" "2" "")) + (test 1 '("AB" "") '("-2" "-1" "AB" "<POINT>1" "2" "")) + (test 2 '("AB" "1" "") '("-2" "-1" "AB" "1" "<POINT>2" "")) + (test 3 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "<POINT>")) + (test 9 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "<POINT>")) + (test -1 '("" "AB") '("-2" "-1<POINT>" "AB" "1" "2" "")) + (test -2 '("" "-1" "AB") '("-2<POINT>" "-1" "AB" "1" "2" "")) + (test -3 '("-2" "-1" "AB") '("<POINT>-2" "-1" "AB" "1" "2" "")) + (test -9 '("-2" "-1" "AB") '("<POINT>-2" "-1" "AB" "1" "2" "")))) + +(ert-deftest kill-whole-line-after-other-kill () + (ert-with-test-buffer-selected nil + (simple-tests--set-buffer-text-point-mark "A<POINT>X<MARK>B") + (ert-simulate-command '(kill-region (mark) (point) 'region)) + (ert-simulate-command '(kill-whole-line)) + (should (equal "AXB" (car kill-ring))) + (should (equal "<POINT>" + (simple-tests--get-buffer-text-point-mark))))) + (provide 'simple-test) ;;; simple-tests.el ends here ^ permalink raw reply related [flat|nested] 3+ messages in thread
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] 2023-09-10 16:31 ` Sebastian Miele @ 2023-09-10 16:57 ` Eli Zaretskii 2023-12-25 18:53 ` Sebastian Miele 0 siblings, 1 reply; 3+ messages in thread From: Eli Zaretskii @ 2023-09-10 16:57 UTC (permalink / raw) To: Sebastian Miele; +Cc: yantar92, 65734 > From: Sebastian Miele <iota@whxvd.name> > Cc: Eli Zaretskii <eliz@gnu.org>, Ihor Radchenko <yantar92@posteo.net> > Date: Sun, 10 Sep 2023 18:31:20 +0200 > > I removed emacs-orgmode@gnu.org from CC. > > > From: Sebastian Miele <iota@whxvd.name> > > Date: Wed, 2023-09-06 15:30 +0200 > > > > I will write the tests. And I will probably come up with an updated > > version of the original patch. There is at least one cosmetic change. > > And something else that I want to have tried. May take some time. > > Please have a look at the following patch. For now it contains three > tests, two of them with :expected-result :failed. (They do not fail on > the bug-fixed version of `kill-whole-line'.) Yes, there should be more tests, ideally: there are situations where kill-whole-line signals an error, and I don't think I see tests where some of the text is invisible (as the function uses forward-visible-line and end-of-visual-line). > There probably will be more tests and further questions. But for now, I > would like to basically have a statement of whether the style of writing > the tests goes in an acceptable direction. Looks reasonable, but I'm not sure I understand what will the test show if one of the tests fails: will the information shown then tell enough to understand which of the sub-tests failed and why? Thanks. ^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] 2023-09-10 16:57 ` Eli Zaretskii @ 2023-12-25 18:53 ` Sebastian Miele 2024-01-06 8:58 ` Eli Zaretskii 0 siblings, 1 reply; 3+ messages in thread From: Sebastian Miele @ 2023-12-25 18:53 UTC (permalink / raw) To: Eli Zaretskii; +Cc: yantar92, 65734 [-- Attachment #1: Type: text/plain, Size: 2858 bytes --] Attached are two patches. The first patch introduces the tests, including two tests that are expected to be failing for the current `kill-whole-line'. The test `kill-whole-line-read-only' does not fail because of the bug reported in this bug report, but because of another bug that I stumbled upon while investigating and testing: `kill-whole-line' always kills by two calls to `kill-region'. When the buffer is readonly, the first of the two calls to `kill-region' errors out / exits non-locally. That causes `kill-region' to omit to put the remaining stuff (from the second `kill-region') into the kill ring. The second patch fixes both bugs, and removes the corresponding `:expected-result :failed' from the tests. > From: Eli Zaretskii <eliz@gnu.org> > Date: Sun, 2023-09-10 19:57 +0300 > >> From: Sebastian Miele <iota@whxvd.name> >> Cc: Eli Zaretskii <eliz@gnu.org>, Ihor Radchenko <yantar92@posteo.net> >> Date: Sun, 10 Sep 2023 18:31:20 +0200 >> >> I removed emacs-orgmode@gnu.org from CC. >> >> > From: Sebastian Miele <iota@whxvd.name> >> > Date: Wed, 2023-09-06 15:30 +0200 >> > >> > I will write the tests. And I will probably come up with an updated >> > version of the original patch. There is at least one cosmetic change. >> > And something else that I want to have tried. May take some time. >> >> Please have a look at the following patch. For now it contains three >> tests, two of them with :expected-result :failed. (They do not fail on >> the bug-fixed version of `kill-whole-line'.) > > Yes, there should be more tests, ideally: there are situations where > kill-whole-line signals an error, and I don't think I see tests where > some of the text is invisible (as the function uses > forward-visible-line and end-of-visual-line). I added tests for cases when `kill-whole-line' signals errors. The tests for the invisible stuff were already there, in the test `kill-whole-line-invisible'. The calls that introduce invisibility and `after-change-functions' in the test are: (org-mode) (org-fold-hide-sublevels 1) Even though its only five tests, I think they are rather very thorough, now. Except one test, all tests tests have several subtests. All branches of `kill-whole-line' are covered. >> There probably will be more tests and further questions. But for >> now, I would like to basically have a statement of whether the style >> of writing the tests goes in an acceptable direction. > > Looks reasonable, but I'm not sure I understand what will the test > show if one of the tests fails: will the information shown then tell > enough to understand which of the sub-tests failed and why? I found the `ert-info' macro which allows to add arbitrary annotiations to `should's in its body, used it for all subtests. They now are clearly distinguishable in the output of `ert', even when run from a terminal. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: tests.patch --] [-- Type: text/x-patch, Size: 9840 bytes --] diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 28d8120f143..e6d3ffe8d34 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (eval-when-compile (require 'cl-lib)) (defun simple-test--buffer-substrings () @@ -40,6 +41,49 @@ simple-test--dummy-buffer ,@body (with-no-warnings (simple-test--buffer-substrings)))) +(defconst simple-test-point-tag "<POINT>") +(defconst simple-test-mark-tag "<MARK>") + +(defun simple-test--set-buffer-text-point-mark (description) + "Set the current buffer's text, point and mark according to +DESCRIPTION. + +Erase current buffer and insert DESCRIPTION. Set point to the +first occurrence of `simple-test-point-tag' (\"<POINT>\") in the +buffer, removing it. If there is no `simple-test-point-tag', set +point to the beginning of the buffer. If there is a +`simple-test-mark-tag' (\"<MARK>\"), remove it, and set an active +mark there." + (erase-buffer) + (insert description) + (goto-char (point-min)) + (when (search-forward simple-test-mark-tag nil t) + (delete-char (- (length simple-test-mark-tag))) + (push-mark (point) nil 'activate)) + (goto-char (point-min)) + (when (search-forward simple-test-point-tag nil t) + (delete-char (- (length simple-test-point-tag))))) + +(defun simple-test--get-buffer-text-point-mark () + "Inverse of `simple-test--set-buffer-text-point-mark'." + (cond + ((not mark-active) + (concat (buffer-substring-no-properties (point-min) (point)) + simple-test-point-tag + (buffer-substring-no-properties (point) (point-max)))) + ((< (mark) (point)) + (concat (buffer-substring-no-properties (point-min) (mark)) + simple-test-mark-tag + (buffer-substring-no-properties (mark) (point)) + simple-test-point-tag + (buffer-substring-no-properties (point) (point-max)))) + (t + (concat (buffer-substring-no-properties (point-min) (point)) + simple-test-point-tag + (buffer-substring-no-properties (point) (mark)) + simple-test-mark-tag + (buffer-substring-no-properties (mark) (point-max)))))) + \f ;;; `count-words' (ert-deftest simple-test-count-words-bug-41761 () @@ -1046,5 +1090,190 @@ simple-tests-zap-to-char (with-zap-to-char-test "abcdeCXYZ" "XYZ" (zap-to-char 1 ?C 'interactive)))) +\f +;;; Tests for `kill-whole-line' + +(ert-deftest kill-whole-line-invisible () + :expected-result :failed + (cl-flet ((test (kill-whole-line-arg &rest expected-lines) + (ert-info ((format "%s" kill-whole-line-arg) :prefix "Subtest: ") + (ert-with-test-buffer-selected nil + (simple-test--set-buffer-text-point-mark + (string-join + '("* -2" "hidden" + "* -1" "hidden" + "* A<POINT>B" "hidden" + "* 1" "hidden" + "* 2" "hidden" + "") + "\n")) + (org-mode) + (org-fold-hide-sublevels 1) + (kill-whole-line kill-whole-line-arg) + (should + (equal (string-join expected-lines "\n") + (simple-test--get-buffer-text-point-mark))))))) + (test 0 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test 1 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>* 1" "hidden" + "* 2" "hidden" + "") + (test 2 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>* 2" "hidden" + "") + (test 3 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>") + (test 9 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>") + (test -1 + "* -2" "hidden" + "* -1" "hidden<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -2 + "* -2" "hidden<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -3 + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -9 + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + ""))) + +(ert-deftest kill-whole-line-read-only () + :expected-result :failed + (cl-flet + ((test (kill-whole-line-arg expected-kill-lines expected-buffer-lines) + (ert-info ((format "%s" kill-whole-line-arg) :prefix "Subtest: ") + (ert-with-test-buffer-selected nil + (simple-test--set-buffer-text-point-mark + (string-join '("-2" "-1" "A<POINT>B" "1" "2" "") "\n")) + (read-only-mode 1) + (setq last-command #'ignore) + (should-error (kill-whole-line kill-whole-line-arg) + :type 'buffer-read-only) + (should (equal (string-join expected-kill-lines "\n") + (car kill-ring))) + (should (equal (string-join expected-buffer-lines "\n") + (simple-test--get-buffer-text-point-mark))))))) + (test 0 '("AB") '("-2" "-1" "AB<POINT>" "1" "2" "")) + (test 1 '("AB" "") '("-2" "-1" "AB" "<POINT>1" "2" "")) + (test 2 '("AB" "1" "") '("-2" "-1" "AB" "1" "<POINT>2" "")) + (test 3 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "<POINT>")) + (test 9 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "<POINT>")) + (test -1 '("" "AB") '("-2" "-1<POINT>" "AB" "1" "2" "")) + (test -2 '("" "-1" "AB") '("-2<POINT>" "-1" "AB" "1" "2" "")) + (test -3 '("-2" "-1" "AB") '("<POINT>-2" "-1" "AB" "1" "2" "")) + (test -9 '("-2" "-1" "AB") '("<POINT>-2" "-1" "AB" "1" "2" "")))) + +(ert-deftest kill-whole-line-after-other-kill () + (ert-with-test-buffer-selected nil + (simple-test--set-buffer-text-point-mark "A<POINT>X<MARK>B") + (setq last-command #'ignore) + (kill-region (point) (mark)) + (deactivate-mark 'force) + (setq last-command #'kill-region) + (kill-whole-line) + (should (equal "AXB" (car kill-ring))) + (should (equal "<POINT>" + (simple-test--get-buffer-text-point-mark))))) + +(ert-deftest kill-whole-line-buffer-boundaries () + (ert-with-test-buffer-selected nil + (ert-info ("0" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "<POINT>") + (should-error (kill-whole-line -1) + :type 'beginning-of-buffer) + (should-error (kill-whole-line 1) + :type 'end-of-buffer)) + (ert-info ("1a" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>") + (should-error (kill-whole-line 1) + :type 'end-of-buffer)) + (ert-info ("1b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\nA<POINT>") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "-1\n<POINT>" + (simple-test--get-buffer-text-point-mark))) + (should (equal "A" (car kill-ring)))) + (ert-info ("2" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "<POINT>\n1") + (should-error (kill-whole-line -1) + :type 'beginning-of-buffer)) + (ert-info ("2b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "<POINT>A\n1") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "<POINT>1" + (simple-test--get-buffer-text-point-mark))) + (should (equal "A\n" (car kill-ring)))))) + +(ert-deftest kill-whole-line-line-boundaries () + (ert-with-test-buffer-selected nil + (ert-info ("1a" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>\n1\n") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "-1\n<POINT>1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "\n" (car kill-ring)))) + (ert-info ("1b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>\n1\n") + (setq last-command #'ignore) + (kill-whole-line -1) + (should (equal "-1<POINT>\n1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "\n" (car kill-ring)))) + (ert-info ("2a" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\nA<POINT>\n1\n") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "-1\n<POINT>1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "A\n" (car kill-ring)))) + (ert-info ("2b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\nA<POINT>\n1\n") + (setq last-command #'ignore) + (kill-whole-line -1) + (should (equal "-1<POINT>\n1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "\nA" (car kill-ring)))) + (ert-info ("3a" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>A\n1\n") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "-1\n<POINT>1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "A\n" (car kill-ring)))) + (ert-info ("3b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>A\n1\n") + (setq last-command #'ignore) + (kill-whole-line -1) + (should (equal "-1<POINT>\n1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "\nA" (car kill-ring)))))) + (provide 'simple-test) ;;; simple-tests.el ends here [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: fix.patch --] [-- Type: text/x-patch, Size: 4662 bytes --] diff --git a/lisp/simple.el b/lisp/simple.el index 6453dfbcd2b..1fd087538b7 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6640,28 +6640,53 @@ kill-whole-line (unless (eq last-command 'kill-region) (kill-new "") (setq last-command 'kill-region)) - (cond ((zerop arg) - ;; We need to kill in two steps, because the previous command - ;; could have been a kill command, in which case the text - ;; before point needs to be prepended to the current kill - ;; ring entry and the text after point appended. Also, we - ;; need to use save-excursion to avoid copying the same text - ;; twice to the kill ring in read-only buffers. - (save-excursion - (kill-region (point) (progn (forward-visible-line 0) (point)))) - (kill-region (point) (progn (end-of-visible-line) (point)))) - ((< arg 0) - (save-excursion - (kill-region (point) (progn (end-of-visible-line) (point)))) - (kill-region (point) - (progn (forward-visible-line (1+ arg)) - (unless (bobp) (backward-char)) - (point)))) - (t - (save-excursion - (kill-region (point) (progn (forward-visible-line 0) (point)))) - (kill-region (point) - (progn (forward-visible-line arg) (point)))))) + ;; - We need to kill in two steps, because the previous command + ;; could have been a kill command, in which case the text before + ;; point needs to be prepended to the current kill ring entry and + ;; the text after point appended. + ;; - We need to be careful to avoid copying text twice to the kill + ;; ring in read-only buffers. + ;; - We need to determine the boundaries of visible lines before we + ;; do the first kill. Otherwise `after-change-functions' may + ;; change visibility (bug#65734). + (let (;; The beginning of both regions to kill + (regions-begin (point-marker)) + ;; The end of the first region to kill. Moreover, after + ;; evaluation of the value form, (point) will be the end of + ;; the second region to kill. + (region1-end (cond ((zerop arg) + (prog1 (save-excursion + (forward-visible-line 0) + (point-marker)) + (end-of-visible-line))) + ((< arg 0) + (prog1 (save-excursion + (end-of-visible-line) + (point-marker)) + (forward-visible-line (1+ arg)) + (unless (bobp) (backward-char)))) + (t + (prog1 (save-excursion + (forward-visible-line 0) + (point-marker)) + (forward-visible-line arg)))))) + ;; - Pass the marker positions and not the markers themselves. + ;; kill-region determines whether to prepend or append to a + ;; previous kill by checking the direction of the region. But + ;; it deletes the content and hence moves the markers before + ;; that. That effectively makes every region delimited by + ;; markers an (empty) forward region. + ;; - Make the first kill-region emit a non-local exit only if the + ;; second kill-region below would not operate on a non-empty + ;; region. + (let ((kill-read-only-ok (or kill-read-only-ok + (/= regions-begin (point))))) + (kill-region (marker-position regions-begin) + (marker-position region1-end))) + (kill-region (marker-position regions-begin) + (point)) + (set-marker regions-begin nil) + (set-marker region1-end nil))) (defun forward-visible-line (arg) "Move forward by ARG lines, ignoring currently invisible newlines only. diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index e6d3ffe8d34..15f2db7e610 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -1094,7 +1094,6 @@ simple-tests-zap-to-char ;;; Tests for `kill-whole-line' (ert-deftest kill-whole-line-invisible () - :expected-result :failed (cl-flet ((test (kill-whole-line-arg &rest expected-lines) (ert-info ((format "%s" kill-whole-line-arg) :prefix "Subtest: ") (ert-with-test-buffer-selected nil @@ -1162,7 +1161,6 @@ kill-whole-line-invisible ""))) (ert-deftest kill-whole-line-read-only () - :expected-result :failed (cl-flet ((test (kill-whole-line-arg expected-kill-lines expected-buffer-lines) (ert-info ((format "%s" kill-whole-line-arg) :prefix "Subtest: ") ^ permalink raw reply related [flat|nested] 3+ messages in thread
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] 2023-12-25 18:53 ` Sebastian Miele @ 2024-01-06 8:58 ` Eli Zaretskii 2024-06-19 14:01 ` Ihor Radchenko 0 siblings, 1 reply; 3+ messages in thread From: Eli Zaretskii @ 2024-01-06 8:58 UTC (permalink / raw) To: Sebastian Miele, Stefan Monnier, Stefan Kangas; +Cc: yantar92, 65734 > From: Sebastian Miele <iota@whxvd.name> > Cc: 65734@debbugs.gnu.org, yantar92@posteo.net > Date: Mon, 25 Dec 2023 19:53:36 +0100 > > Attached are two patches. The first patch introduces the tests, > including two tests that are expected to be failing for the current > `kill-whole-line'. > > The test `kill-whole-line-read-only' does not fail because of the bug > reported in this bug report, but because of another bug that I stumbled > upon while investigating and testing: `kill-whole-line' always kills by > two calls to `kill-region'. When the buffer is readonly, the first of > the two calls to `kill-region' errors out / exits non-locally. That > causes `kill-region' to omit to put the remaining stuff (from the second > `kill-region') into the kill ring. > > The second patch fixes both bugs, and removes the corresponding > `:expected-result :failed' from the tests. Thanks. The patches lack suitable ChangeLog-style commit log messages (see CONTRIBUTE for details and you can use "git log" to show examples of how we do this). I'd also ask Stefan Monnier and Stefan Kangas to review the patch, since this is an important command and I would like to avoid breaking it. ^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] 2024-01-06 8:58 ` Eli Zaretskii @ 2024-06-19 14:01 ` Ihor Radchenko 2024-06-22 9:00 ` Eli Zaretskii 0 siblings, 1 reply; 3+ messages in thread From: Ihor Radchenko @ 2024-06-19 14:01 UTC (permalink / raw) To: Eli Zaretskii; +Cc: 65734, Sebastian Miele, Stefan Monnier, Stefan Kangas [-- Attachment #1: Type: text/plain, Size: 416 bytes --] Eli Zaretskii <eliz@gnu.org> writes: > The patches lack suitable ChangeLog-style commit log messages (see > CONTRIBUTE for details and you can use "git log" to show examples of > how we do this). > > I'd also ask Stefan Monnier and Stefan Kangas to review the patch, > since this is an important command and I would like to avoid breaking > it. Please see the attached edited patches with proper commit messages. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-kill-whole-line-Honor-visibility-fix-kill-ring-when-.patch --] [-- Type: text/x-patch, Size: 4701 bytes --] From 340e1a6a9d394c89c23ef34cdb37fa9124b4bd84 Mon Sep 17 00:00:00 2001 Message-ID: <340e1a6a9d394c89c23ef34cdb37fa9124b4bd84.1718805590.git.yantar92@posteo.net> From: Sebastian Miele <iota@whxvd.name> Date: Wed, 19 Jun 2024 15:48:59 +0200 Subject: [PATCH 1/2] kill-whole-line: Honor visibility; fix kill-ring when read-only (bug#65734) * lisp/simple.el (kill-whole-line): Use visibility state before performing any edits as reference instead of expecting that visibility cannot change. First of the two calls to `kill-region' may trigger `after-change-functions' that might alter the visibility state. Make sure that we populate the `kill-ring' with the contents of the whole line when buffer is in `read-only-mode'. --- lisp/simple.el | 69 ++++++++++++++++++++++++++++++++++---------------- 1 file changed, 47 insertions(+), 22 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index b48f46fc711..76dffcdd327 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6703,28 +6703,53 @@ kill-whole-line (unless (eq last-command 'kill-region) (kill-new "") (setq last-command 'kill-region)) - (cond ((zerop arg) - ;; We need to kill in two steps, because the previous command - ;; could have been a kill command, in which case the text - ;; before point needs to be prepended to the current kill - ;; ring entry and the text after point appended. Also, we - ;; need to use save-excursion to avoid copying the same text - ;; twice to the kill ring in read-only buffers. - (save-excursion - (kill-region (point) (progn (forward-visible-line 0) (point)))) - (kill-region (point) (progn (end-of-visible-line) (point)))) - ((< arg 0) - (save-excursion - (kill-region (point) (progn (end-of-visible-line) (point)))) - (kill-region (point) - (progn (forward-visible-line (1+ arg)) - (unless (bobp) (backward-char)) - (point)))) - (t - (save-excursion - (kill-region (point) (progn (forward-visible-line 0) (point)))) - (kill-region (point) - (progn (forward-visible-line arg) (point)))))) + ;; - We need to kill in two steps, because the previous command + ;; could have been a kill command, in which case the text before + ;; point needs to be prepended to the current kill ring entry and + ;; the text after point appended. + ;; - We need to be careful to avoid copying text twice to the kill + ;; ring in read-only buffers. + ;; - We need to determine the boundaries of visible lines before we + ;; do the first kill. Otherwise `after-change-functions' may + ;; change visibility (bug#65734). + (let (;; The beginning of both regions to kill + (regions-begin (point-marker)) + ;; The end of the first region to kill. Moreover, after + ;; evaluation of the value form, (point) will be the end of + ;; the second region to kill. + (region1-end (cond ((zerop arg) + (prog1 (save-excursion + (forward-visible-line 0) + (point-marker)) + (end-of-visible-line))) + ((< arg 0) + (prog1 (save-excursion + (end-of-visible-line) + (point-marker)) + (forward-visible-line (1+ arg)) + (unless (bobp) (backward-char)))) + (t + (prog1 (save-excursion + (forward-visible-line 0) + (point-marker)) + (forward-visible-line arg)))))) + ;; - Pass the marker positions and not the markers themselves. + ;; kill-region determines whether to prepend or append to a + ;; previous kill by checking the direction of the region. But + ;; it deletes the content and hence moves the markers before + ;; that. That effectively makes every region delimited by + ;; markers an (empty) forward region. + ;; - Make the first kill-region emit a non-local exit only if the + ;; second kill-region below would not operate on a non-empty + ;; region. + (let ((kill-read-only-ok (or kill-read-only-ok + (/= regions-begin (point))))) + (kill-region (marker-position regions-begin) + (marker-position region1-end))) + (kill-region (marker-position regions-begin) + (point)) + (set-marker regions-begin nil) + (set-marker region1-end nil))) (defun forward-visible-line (arg) "Move forward by ARG lines, ignoring currently invisible newlines only. -- 2.45.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Add-tests-for-kill-whole-line-bug-65734.patch --] [-- Type: text/x-patch, Size: 10796 bytes --] From 40a14348da6680b2213133aa3909e47223459e14 Mon Sep 17 00:00:00 2001 Message-ID: <40a14348da6680b2213133aa3909e47223459e14.1718805590.git.yantar92@posteo.net> In-Reply-To: <340e1a6a9d394c89c23ef34cdb37fa9124b4bd84.1718805590.git.yantar92@posteo.net> References: <340e1a6a9d394c89c23ef34cdb37fa9124b4bd84.1718805590.git.yantar92@posteo.net> From: Sebastian Miele <iota@whxvd.name> Date: Wed, 19 Jun 2024 15:58:24 +0200 Subject: [PATCH 2/2] Add tests for `kill-whole-line' (bug#65734) * test/lisp/simple-tests.el (simple-test-point-tag): (simple-test-mark-tag): (simple-test--set-buffer-text-point-mark): (simple-test--get-buffer-text-point-mark): Add helper functions used by the tests. (kill-whole-line-invisible): (kill-whole-line-read-only): (kill-whole-line-after-other-kill): (kill-whole-line-buffer-boundaries): (kill-whole-line-line-boundaries): Add tests for `kill-whole-line'. --- test/lisp/simple-tests.el | 227 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 227 insertions(+) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index afd75786804..9e3e71bd69b 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (eval-when-compile (require 'cl-lib)) (defun simple-test--buffer-substrings () @@ -40,6 +41,49 @@ simple-test--dummy-buffer ,@body (with-no-warnings (simple-test--buffer-substrings)))) +(defconst simple-test-point-tag "<POINT>") +(defconst simple-test-mark-tag "<MARK>") + +(defun simple-test--set-buffer-text-point-mark (description) + "Set the current buffer's text, point and mark according to +DESCRIPTION. + +Erase current buffer and insert DESCRIPTION. Set point to the +first occurrence of `simple-test-point-tag' (\"<POINT>\") in the +buffer, removing it. If there is no `simple-test-point-tag', set +point to the beginning of the buffer. If there is a +`simple-test-mark-tag' (\"<MARK>\"), remove it, and set an active +mark there." + (erase-buffer) + (insert description) + (goto-char (point-min)) + (when (search-forward simple-test-mark-tag nil t) + (delete-char (- (length simple-test-mark-tag))) + (push-mark (point) nil 'activate)) + (goto-char (point-min)) + (when (search-forward simple-test-point-tag nil t) + (delete-char (- (length simple-test-point-tag))))) + +(defun simple-test--get-buffer-text-point-mark () + "Inverse of `simple-test--set-buffer-text-point-mark'." + (cond + ((not mark-active) + (concat (buffer-substring-no-properties (point-min) (point)) + simple-test-point-tag + (buffer-substring-no-properties (point) (point-max)))) + ((< (mark) (point)) + (concat (buffer-substring-no-properties (point-min) (mark)) + simple-test-mark-tag + (buffer-substring-no-properties (mark) (point)) + simple-test-point-tag + (buffer-substring-no-properties (point) (point-max)))) + (t + (concat (buffer-substring-no-properties (point-min) (point)) + simple-test-point-tag + (buffer-substring-no-properties (point) (mark)) + simple-test-mark-tag + (buffer-substring-no-properties (mark) (point-max)))))) + \f ;;; `count-words' (ert-deftest simple-test-count-words-bug-41761 () @@ -1046,5 +1090,188 @@ simple-tests-zap-to-char (with-zap-to-char-test "abcdeCXYZ" "XYZ" (zap-to-char 1 ?C 'interactive)))) +\f +;;; Tests for `kill-whole-line' + +(ert-deftest kill-whole-line-invisible () + (cl-flet ((test (kill-whole-line-arg &rest expected-lines) + (ert-info ((format "%s" kill-whole-line-arg) :prefix "Subtest: ") + (ert-with-test-buffer-selected nil + (simple-test--set-buffer-text-point-mark + (string-join + '("* -2" "hidden" + "* -1" "hidden" + "* A<POINT>B" "hidden" + "* 1" "hidden" + "* 2" "hidden" + "") + "\n")) + (org-mode) + (org-fold-hide-sublevels 1) + (kill-whole-line kill-whole-line-arg) + (should + (equal (string-join expected-lines "\n") + (simple-test--get-buffer-text-point-mark))))))) + (test 0 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test 1 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>* 1" "hidden" + "* 2" "hidden" + "") + (test 2 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>* 2" "hidden" + "") + (test 3 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>") + (test 9 + "* -2" "hidden" + "* -1" "hidden" + "<POINT>") + (test -1 + "* -2" "hidden" + "* -1" "hidden<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -2 + "* -2" "hidden<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -3 + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + "") + (test -9 + "<POINT>" + "* 1" "hidden" + "* 2" "hidden" + ""))) + +(ert-deftest kill-whole-line-read-only () + (cl-flet + ((test (kill-whole-line-arg expected-kill-lines expected-buffer-lines) + (ert-info ((format "%s" kill-whole-line-arg) :prefix "Subtest: ") + (ert-with-test-buffer-selected nil + (simple-test--set-buffer-text-point-mark + (string-join '("-2" "-1" "A<POINT>B" "1" "2" "") "\n")) + (read-only-mode 1) + (setq last-command #'ignore) + (should-error (kill-whole-line kill-whole-line-arg) + :type 'buffer-read-only) + (should (equal (string-join expected-kill-lines "\n") + (car kill-ring))) + (should (equal (string-join expected-buffer-lines "\n") + (simple-test--get-buffer-text-point-mark))))))) + (test 0 '("AB") '("-2" "-1" "AB<POINT>" "1" "2" "")) + (test 1 '("AB" "") '("-2" "-1" "AB" "<POINT>1" "2" "")) + (test 2 '("AB" "1" "") '("-2" "-1" "AB" "1" "<POINT>2" "")) + (test 3 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "<POINT>")) + (test 9 '("AB" "1" "2" "") '("-2" "-1" "AB" "1" "2" "<POINT>")) + (test -1 '("" "AB") '("-2" "-1<POINT>" "AB" "1" "2" "")) + (test -2 '("" "-1" "AB") '("-2<POINT>" "-1" "AB" "1" "2" "")) + (test -3 '("-2" "-1" "AB") '("<POINT>-2" "-1" "AB" "1" "2" "")) + (test -9 '("-2" "-1" "AB") '("<POINT>-2" "-1" "AB" "1" "2" "")))) + +(ert-deftest kill-whole-line-after-other-kill () + (ert-with-test-buffer-selected nil + (simple-test--set-buffer-text-point-mark "A<POINT>X<MARK>B") + (setq last-command #'ignore) + (kill-region (point) (mark)) + (deactivate-mark 'force) + (setq last-command #'kill-region) + (kill-whole-line) + (should (equal "AXB" (car kill-ring))) + (should (equal "<POINT>" + (simple-test--get-buffer-text-point-mark))))) + +(ert-deftest kill-whole-line-buffer-boundaries () + (ert-with-test-buffer-selected nil + (ert-info ("0" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "<POINT>") + (should-error (kill-whole-line -1) + :type 'beginning-of-buffer) + (should-error (kill-whole-line 1) + :type 'end-of-buffer)) + (ert-info ("1a" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>") + (should-error (kill-whole-line 1) + :type 'end-of-buffer)) + (ert-info ("1b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\nA<POINT>") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "-1\n<POINT>" + (simple-test--get-buffer-text-point-mark))) + (should (equal "A" (car kill-ring)))) + (ert-info ("2" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "<POINT>\n1") + (should-error (kill-whole-line -1) + :type 'beginning-of-buffer)) + (ert-info ("2b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "<POINT>A\n1") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "<POINT>1" + (simple-test--get-buffer-text-point-mark))) + (should (equal "A\n" (car kill-ring)))))) + +(ert-deftest kill-whole-line-line-boundaries () + (ert-with-test-buffer-selected nil + (ert-info ("1a" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>\n1\n") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "-1\n<POINT>1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "\n" (car kill-ring)))) + (ert-info ("1b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>\n1\n") + (setq last-command #'ignore) + (kill-whole-line -1) + (should (equal "-1<POINT>\n1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "\n" (car kill-ring)))) + (ert-info ("2a" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\nA<POINT>\n1\n") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "-1\n<POINT>1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "A\n" (car kill-ring)))) + (ert-info ("2b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\nA<POINT>\n1\n") + (setq last-command #'ignore) + (kill-whole-line -1) + (should (equal "-1<POINT>\n1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "\nA" (car kill-ring)))) + (ert-info ("3a" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>A\n1\n") + (setq last-command #'ignore) + (kill-whole-line 1) + (should (equal "-1\n<POINT>1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "A\n" (car kill-ring)))) + (ert-info ("3b" :prefix "Subtest: ") + (simple-test--set-buffer-text-point-mark "-1\n<POINT>A\n1\n") + (setq last-command #'ignore) + (kill-whole-line -1) + (should (equal "-1<POINT>\n1\n" + (simple-test--get-buffer-text-point-mark))) + (should (equal "\nA" (car kill-ring)))))) + (provide 'simple-test) ;;; simple-tests.el ends here -- 2.45.1 [-- Attachment #4: Type: text/plain, Size: 224 bytes --] -- Ihor Radchenko // yantar92, Org mode contributor, Learn more about Org mode at <https://orgmode.org/>. Support Org development at <https://liberapay.com/org-mode>, or support my work at <https://liberapay.com/yantar92> ^ permalink raw reply related [flat|nested] 3+ messages in thread
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] 2024-06-19 14:01 ` Ihor Radchenko @ 2024-06-22 9:00 ` Eli Zaretskii 2024-06-22 9:51 ` Eli Zaretskii 0 siblings, 1 reply; 3+ messages in thread From: Eli Zaretskii @ 2024-06-22 9:00 UTC (permalink / raw) To: Ihor Radchenko; +Cc: 65734, Andrea Corallo, iota, monnier, stefankangas > From: Ihor Radchenko <yantar92@posteo.net> > Cc: Sebastian Miele <iota@whxvd.name>, Stefan Monnier > <monnier@iro.umontreal.ca>, Stefan Kangas <stefankangas@gmail.com>, > 65734@debbugs.gnu.org > Date: Wed, 19 Jun 2024 14:01:12 +0000 > > Eli Zaretskii <eliz@gnu.org> writes: > > > The patches lack suitable ChangeLog-style commit log messages (see > > CONTRIBUTE for details and you can use "git log" to show examples of > > how we do this). > > > > I'd also ask Stefan Monnier and Stefan Kangas to review the patch, > > since this is an important command and I would like to avoid breaking > > it. > > Please see the attached edited patches with proper commit messages. Stefan, Stefan and Andrea, could you please review this? If you see no problems, let's install this in Emacs 30. ^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] 2024-06-22 9:00 ` Eli Zaretskii @ 2024-06-22 9:51 ` Eli Zaretskii 2024-06-23 19:26 ` bug#65734: 29.1.50; kill-whole-line and visibility of Org subtrees Andrea Corallo 0 siblings, 1 reply; 3+ messages in thread From: Eli Zaretskii @ 2024-06-22 9:51 UTC (permalink / raw) To: acorallo, stefankangas; +Cc: iota, yantar92, 65734, monnier > Cc: 65734@debbugs.gnu.org, Andrea Corallo <acorallo@gnu.org>, iota@whxvd.name, > monnier@iro.umontreal.ca, stefankangas@gmail.com > Date: Sat, 22 Jun 2024 12:00:13 +0300 > From: Eli Zaretskii <eliz@gnu.org> > > > From: Ihor Radchenko <yantar92@posteo.net> > > Cc: Sebastian Miele <iota@whxvd.name>, Stefan Monnier > > <monnier@iro.umontreal.ca>, Stefan Kangas <stefankangas@gmail.com>, > > 65734@debbugs.gnu.org > > Date: Wed, 19 Jun 2024 14:01:12 +0000 > > > > Eli Zaretskii <eliz@gnu.org> writes: > > > > > The patches lack suitable ChangeLog-style commit log messages (see > > > CONTRIBUTE for details and you can use "git log" to show examples of > > > how we do this). > > > > > > I'd also ask Stefan Monnier and Stefan Kangas to review the patch, > > > since this is an important command and I would like to avoid breaking > > > it. > > > > Please see the attached edited patches with proper commit messages. > > Stefan, Stefan and Andrea, could you please review this? If you see > no problems, let's install this in Emacs 30. Oops, I see that Stefan Monnier already chimed in. But I'd like Stefan Kangas and Andrea to do so as well. ^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#65734: 29.1.50; kill-whole-line and visibility of Org subtrees 2024-06-22 9:51 ` Eli Zaretskii @ 2024-06-23 19:26 ` Andrea Corallo 0 siblings, 0 replies; 3+ messages in thread From: Andrea Corallo @ 2024-06-23 19:26 UTC (permalink / raw) To: Eli Zaretskii; +Cc: 65734, yantar92, iota, stefankangas, monnier Eli Zaretskii <eliz@gnu.org> writes: >> Cc: 65734@debbugs.gnu.org, Andrea Corallo <acorallo@gnu.org>, iota@whxvd.name, >> monnier@iro.umontreal.ca, stefankangas@gmail.com >> Date: Sat, 22 Jun 2024 12:00:13 +0300 >> From: Eli Zaretskii <eliz@gnu.org> >> >> > From: Ihor Radchenko <yantar92@posteo.net> >> > Cc: Sebastian Miele <iota@whxvd.name>, Stefan Monnier >> > <monnier@iro.umontreal.ca>, Stefan Kangas <stefankangas@gmail.com>, >> > 65734@debbugs.gnu.org >> > Date: Wed, 19 Jun 2024 14:01:12 +0000 >> > >> > Eli Zaretskii <eliz@gnu.org> writes: >> > >> > > The patches lack suitable ChangeLog-style commit log messages (see >> > > CONTRIBUTE for details and you can use "git log" to show examples of >> > > how we do this). >> > > >> > > I'd also ask Stefan Monnier and Stefan Kangas to review the patch, >> > > since this is an important command and I would like to avoid breaking >> > > it. >> > >> > Please see the attached edited patches with proper commit messages. >> >> Stefan, Stefan and Andrea, could you please review this? If you see >> no problems, let's install this in Emacs 30. > > Oops, I see that Stefan Monnier already chimed in. But I'd like > Stefan Kangas and Andrea to do so as well. Agreed on the behavior and proposed implementation. Andrea ^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2024-06-23 19:26 UTC | newest] Thread overview: 3+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2023-09-04 14:44 bug#65734: 29.1.50; kill-whole-line and visibility of Org subtrees Sebastian Miele 2023-09-04 15:20 ` Eli Zaretskii [not found] <87il8pao4l.fsf@whxvd.name> 2023-09-05 10:29 ` bug#65734: [BUG] kill-whole-line on folded subtrees [9.6.8 (release_9.6.8-3-g21171d @ /home/w/usr/emacs/0/29/0/lisp/org/)] Ihor Radchenko 2023-09-05 11:54 ` Eli Zaretskii [not found] ` <875y4oaban.fsf@whxvd.name> [not found] ` <83bkeg4o1u.fsf@gnu.org> 2023-09-06 8:23 ` Ihor Radchenko [not found] ` <838r9j339x.fsf@gnu.org> [not found] ` <87tts78lve.fsf@whxvd.name> 2023-09-10 16:31 ` Sebastian Miele 2023-09-10 16:57 ` Eli Zaretskii 2023-12-25 18:53 ` Sebastian Miele 2024-01-06 8:58 ` Eli Zaretskii 2024-06-19 14:01 ` Ihor Radchenko 2024-06-22 9:00 ` Eli Zaretskii 2024-06-22 9:51 ` Eli Zaretskii 2024-06-23 19:26 ` bug#65734: 29.1.50; kill-whole-line and visibility of Org subtrees Andrea Corallo
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).