[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/org 2e4ed52b19: org-fold: Revert old behaviour when han
From: |
ELPA Syncer |
Subject: |
[elpa] externals/org 2e4ed52b19: org-fold: Revert old behaviour when handling invisible edits |
Date: |
Sun, 8 May 2022 05:57:55 -0400 (EDT) |
branch: externals/org
commit 2e4ed52b1969f43b9e043267d4a256eeafed4416
Author: Ihor Radchenko <yantar92@gmail.com>
Commit: Ihor Radchenko <yantar92@gmail.com>
org-fold: Revert old behaviour when handling invisible edits
* lisp/org-fold-core.el (org-fold-core-folded-p): Allow list of fold
types to be passed as argument.
* lisp/org-fold.el (org-fold-check-before-invisible-edit--overlays):
(org-fold-check-before-invisible-edit--text-properties): Make
overlay/text-property behaviour consistent. Do not handle edits
inside folded links. Fix inconsistencies.
* testing/lisp/test-org-fold.el:
* testing/lisp/test-org.el: Move folding-related tests to new test
file.
* testing/lisp/test-org-fold.el:
(test-org-fold/org-catch-invisible-edits): New test.
See https://orgmode.org/list/m2o809q170.fsf@gmail.com
---
lisp/org-fold-core.el | 10 +-
lisp/org-fold.el | 41 ++-
testing/lisp/test-org-fold.el | 609 ++++++++++++++++++++++++++++++++++++++++++
testing/lisp/test-org.el | 457 -------------------------------
4 files changed, 636 insertions(+), 481 deletions(-)
diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el
index 6786009ec4..dae3426173 100644
--- a/lisp/org-fold-core.el
+++ b/lisp/org-fold-core.el
@@ -762,8 +762,14 @@ future org buffers."
(defsubst org-fold-core-folded-p (&optional pos spec-or-alias)
"Non-nil if the character after POS is folded.
If POS is nil, use `point' instead.
-If SPEC-OR-ALIAS is a folding spec, only check the given folding spec."
- (org-fold-core-get-folding-spec spec-or-alias pos))
+If SPEC-OR-ALIAS is a folding spec or a list, only check the given
+folding spec or the listed specs."
+ (if (and spec-or-alias (listp spec-or-alias))
+ (catch :found
+ (dolist (spec spec-or-alias)
+ (let ((val (org-fold-core-get-folding-spec spec pos)))
+ (when val (throw :found val)))))
+ (org-fold-core-get-folding-spec spec-or-alias pos)))
(defun org-fold-core-region-folded-p (beg end &optional spec-or-alias)
"Non-nil if the region between BEG and END is folded.
diff --git a/lisp/org-fold.el b/lisp/org-fold.el
index 5085778dcd..7d4bb56203 100644
--- a/lisp/org-fold.el
+++ b/lisp/org-fold.el
@@ -1050,19 +1050,16 @@ The detailed reaction depends on the user option
(let* ((invisible-at-point
(pcase (get-char-property-and-overlay (point) 'invisible)
(`(,_ . ,(and (pred overlayp) o)) o)))
- ;; Assume that point cannot land in the middle of an
- ;; overlay, or between two overlays.
(invisible-before-point
- (and (not invisible-at-point)
- (not (bobp))
+ (and (not (bobp))
(pcase (get-char-property-and-overlay (1- (point)) 'invisible)
(`(,_ . ,(and (pred overlayp) o)) o))))
(border-and-ok-direction
(or
;; Check if we are acting predictably before invisible
;; text.
- (and invisible-at-point
- (memq kind '(insert delete-backward)))
+ (and invisible-at-point (not invisible-before-point)
+ (memq kind '(insert delete-backward)))
;; Check if we are acting predictably after invisible text
;; This works not well, and I have turned it off. It seems
;; better to always show and stop after invisible text.
@@ -1077,7 +1074,7 @@ The detailed reaction depends on the user option
(org-toggle-custom-properties-visibility)
;; Make the area visible
(save-excursion
- (when invisible-before-point
+ (when (and (not invisible-at-point) invisible-before-point)
(goto-char
(previous-single-char-property-change (point) 'invisible)))
;; Remove whatever overlay is currently making yet-to-be
@@ -1111,32 +1108,35 @@ The detailed reaction depends on the user option
(or (org-invisible-p)
(org-invisible-p (max (point-min) (1- (point))))))
;; OK, we need to take a closer look. Only consider invisibility
- ;; caused by folding.
- (let* ((invisible-at-point (org-invisible-p))
+ ;; caused by folding of headlines, drawers, and blocks. Edits
+ ;; inside links will be handled by font-lock.
+ (let* ((invisible-at-point (org-fold-folded-p (point) '(headline drawer
block)))
(invisible-before-point
(and (not (bobp))
- (org-invisible-p (1- (point)))))
+ (org-fold-folded-p (1- (point)) '(headline drawer block))))
(border-and-ok-direction
(or
;; Check if we are acting predictably before invisible
;; text.
(and invisible-at-point (not invisible-before-point)
(memq kind '(insert delete-backward)))
- (and (not invisible-at-point) invisible-before-point
- (memq kind '(insert delete))))))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
(when (or invisible-at-point invisible-before-point)
- (when (and (eq org-fold-catch-invisible-edits 'error)
- (not border-and-ok-direction))
+ (when (eq org-fold-catch-invisible-edits 'error)
(user-error "Editing in invisible areas is prohibited, make them
visible first"))
(if (and org-custom-properties-overlays
(y-or-n-p "Display invisible properties in this buffer? "))
(org-toggle-custom-properties-visibility)
;; Make the area visible
- (unless (eq org-fold-catch-invisible-edits 'error)
- (save-excursion
- (org-fold-show-set-visibility 'local))
- (when invisible-before-point
- (org-with-point-at (1- (point)) (org-fold-show-set-visibility
'local))))
+ (save-excursion
+ (org-fold-show-set-visibility 'local))
+ (when invisible-before-point
+ (org-with-point-at (1- (point)) (org-fold-show-set-visibility
'local)))
(cond
((eq org-fold-catch-invisible-edits 'show)
;; That's it, we do the edit after showing
@@ -1146,9 +1146,6 @@ The detailed reaction depends on the user option
((and (eq org-fold-catch-invisible-edits 'smart)
border-and-ok-direction)
(message "Unfolding invisible region around point before editing"))
- (border-and-ok-direction
- ;; Just continue editing.
- nil)
(t
;; Don't do the edit, make the user repeat it in full visibility
(user-error "Edit in invisible region aborted, repeat to confirm
with text visible"))))))))
diff --git a/testing/lisp/test-org-fold.el b/testing/lisp/test-org-fold.el
new file mode 100644
index 0000000000..40afe55aeb
--- /dev/null
+++ b/testing/lisp/test-org-fold.el
@@ -0,0 +1,609 @@
+;;; test-org.el --- tests for org.el
+
+;; Authors: Ihor Radchenko
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;; Org folding tests.
+
+;;; Code:
+
+(eval-and-compile (require 'cl-lib))
+
+
+
+(ert-deftest test-org-fold/hide-drawer-toggle ()
+ "Test `org-fold-hide-drawer-toggle' specifications."
+ ;; Error when not at a drawer.
+ (should-error
+ (org-test-with-temp-text ":fake-drawer:\ncontents"
+ (org-fold-hide-drawer-toggle 'off)
+ (get-char-property (line-end-position) 'invisible)))
+ (should-error
+ (org-test-with-temp-text
+ "#+begin_example\n<point>:D:\nc\n:END:\n#+end_example"
+ (org-fold-hide-drawer-toggle t)))
+ ;; Hide drawer.
+ (should
+ (org-test-with-temp-text ":drawer:\ncontents\n:end:"
+ (org-fold-show-all)
+ (org-fold-hide-drawer-toggle)
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Show drawer unconditionally when optional argument is `off'.
+ (should-not
+ (org-test-with-temp-text ":drawer:\ncontents\n:end:"
+ (org-fold-hide-drawer-toggle)
+ (org-fold-hide-drawer-toggle 'off)
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Hide drawer unconditionally when optional argument is non-nil.
+ (should
+ (org-test-with-temp-text ":drawer:\ncontents\n:end:"
+ (org-fold-hide-drawer-toggle t)
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Do not hide drawer when called from final blank lines.
+ (should-not
+ (org-test-with-temp-text ":drawer:\ncontents\n:end:\n\n<point>"
+ (org-fold-show-all)
+ (org-fold-hide-drawer-toggle)
+ (goto-char (point-min))
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Don't leave point in an invisible part of the buffer when hiding
+ ;; a drawer away.
+ (should-not
+ (org-test-with-temp-text ":drawer:\ncontents\n<point>:end:"
+ (org-fold-hide-drawer-toggle)
+ (get-char-property (point) 'invisible))))
+
+(ert-deftest test-org/hide-block-toggle ()
+ "Test `org-fold-hide-block-toggle' specifications."
+ ;; Error when not at a block.
+ (should-error
+ (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents"
+ (org-fold-hide-block-toggle 'off)
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Hide block.
+ (should
+ (org-test-with-temp-text "#+BEGIN_CENTER\ncontents\n#+END_CENTER"
+ (org-fold-hide-block-toggle)
+ (get-char-property (line-end-position) 'invisible)))
+ (should
+ (org-test-with-temp-text "#+BEGIN_EXAMPLE\ncontents\n#+END_EXAMPLE"
+ (org-fold-hide-block-toggle)
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Show block unconditionally when optional argument is `off'.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
+ (org-fold-hide-block-toggle)
+ (org-fold-hide-block-toggle 'off)
+ (get-char-property (line-end-position) 'invisible)))
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
+ (org-fold-hide-block-toggle 'off)
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Hide block unconditionally when optional argument is non-nil.
+ (should
+ (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
+ (org-fold-hide-block-toggle t)
+ (get-char-property (line-end-position) 'invisible)))
+ (should
+ (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
+ (org-fold-hide-block-toggle)
+ (org-fold-hide-block-toggle t)
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Do not hide block when called from final blank lines.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE\n\n<point>"
+ (org-fold-hide-block-toggle)
+ (goto-char (point-min))
+ (get-char-property (line-end-position) 'invisible)))
+ ;; Don't leave point in an invisible part of the buffer when hiding
+ ;; a block away.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n<point>#+END_QUOTE"
+ (org-fold-hide-block-toggle)
+ (get-char-property (point) 'invisible))))
+
+(ert-deftest test-org-fold/hide-block-toggle-maybe ()
+ "Test `org-fold-hide-block-toggle' specifications."
+ (should
+ (org-test-with-temp-text "#+BEGIN: dynamic\nContents\n#+END:"
+ (org-hide-block-toggle)))
+ (should-error
+ (org-test-with-temp-text "Paragraph" (org-hide-block-toggle))))
+
+(ert-deftest test-org-fold/show-set-visibility ()
+ "Test `org-fold-show-set-visibility' specifications."
+ ;; Do not throw an error before first heading.
+ (should
+ (org-test-with-temp-text "Preamble\n* Headline"
+ (org-fold-show-set-visibility 'tree)
+ t))
+ ;; Test all visibility spans, both on headline and in entry.
+ (let ((list-visible-lines
+ (lambda (state headerp)
+ (org-test-with-temp-text "* Grandmother (0)
+** Uncle (1)
+*** Heir (2)
+** Father (3)
+ Ancestor text (4)
+*** Sister (5)
+ Sibling text (6)
+*** Self (7)
+ Match (8)
+**** First born (9)
+ Child text (10)
+**** The other child (11)
+*** Brother (12)
+** Aunt (13)
+"
+ (org-cycle t)
+ (search-forward (if headerp "Self" "Match"))
+ (org-fold-show-set-visibility state)
+ (goto-char (point-min))
+ (let (result (line 0))
+ (while (not (eobp))
+ (unless (org-invisible-p2) (push line result))
+ (cl-incf line)
+ (forward-line))
+ (nreverse result))))))
+ (should (equal '(0 7) (funcall list-visible-lines 'minimal t)))
+ (should (equal '(0 7 8) (funcall list-visible-lines 'minimal nil)))
+ (should (equal '(0 7 8 9) (funcall list-visible-lines 'local t)))
+ (should (equal '(0 7 8 9) (funcall list-visible-lines 'local nil)))
+ (should (equal '(0 3 7) (funcall list-visible-lines 'ancestors t)))
+ (should (equal '(0 3 7 8) (funcall list-visible-lines 'ancestors nil)))
+ (should (equal '(0 3 7 8 9 10 11)
+ (funcall list-visible-lines 'ancestors-full t)))
+ (should (equal '(0 3 7 8 9 10 11)
+ (funcall list-visible-lines 'ancestors-full nil)))
+ (should (equal '(0 3 5 7 12) (funcall list-visible-lines 'lineage t)))
+ (should (equal '(0 3 5 7 8 9 12) (funcall list-visible-lines 'lineage
nil)))
+ (should (equal '(0 1 3 5 7 12 13) (funcall list-visible-lines 'tree t)))
+ (should (equal '(0 1 3 5 7 8 9 11 12 13)
+ (funcall list-visible-lines 'tree nil)))
+ (should (equal '(0 1 3 4 5 7 12 13)
+ (funcall list-visible-lines 'canonical t)))
+ (should (equal '(0 1 3 4 5 7 8 9 11 12 13)
+ (funcall list-visible-lines 'canonical nil))))
+ ;; When point is hidden in a drawer or a block, make sure to make it
+ ;; visible.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
+ (org-fold-hide-block-toggle)
+ (search-forward "Text")
+ (org-fold-show-set-visibility 'minimal)
+ (org-invisible-p2)))
+ (should-not
+ (org-test-with-temp-text ":DRAWER:\nText\n:END:"
+ (org-fold-hide-drawer-toggle)
+ (search-forward "Text")
+ (org-fold-show-set-visibility 'minimal)
+ (org-invisible-p2)))
+ (should-not
+ (org-test-with-temp-text
+ "#+BEGIN_QUOTE\n<point>:DRAWER:\nText\n:END:\n#+END_QUOTE"
+ (org-fold-hide-drawer-toggle)
+ (forward-line -1)
+ (org-fold-hide-block-toggle)
+ (search-forward "Text")
+ (org-fold-show-set-visibility 'minimal)
+ (org-invisible-p2))))
+
+(ert-deftest test-org-fold/copy-visible ()
+ "Test `org-copy-visible' specifications."
+ ;;`org-unfontify-region', which is wired up to
+ ;; `font-lock-unfontify-region-function', removes the invisible text
+ ;; property, among other things.
+ (cl-letf (((symbol-function 'org-unfontify-region) #'ignore))
+ (should
+ (equal "Foo"
+ (org-test-with-temp-text "Foo"
+ (let ((kill-ring nil))
+ (org-copy-visible (point-min) (point-max))
+ (current-kill 0 t)))))
+ ;; Skip invisible characters by text property.
+ (should
+ (equal "Foo"
+ (org-test-with-temp-text #("F<hidden>oo" 1 9 (invisible t))
+ (let ((kill-ring nil))
+ (org-copy-visible (point-min) (point-max))
+ (current-kill 0 t)))))
+ ;; Skip invisible characters by overlay.
+ (should
+ (equal "Foo"
+ (org-test-with-temp-text "F<hidden>oo"
+ (let ((o (make-overlay 2 10)))
+ (overlay-put o 'invisible t))
+ (let ((kill-ring nil))
+ (org-copy-visible (point-min) (point-max))
+ (current-kill 0 t)))))
+ ;; Handle invisible characters at the beginning and the end of the
+ ;; buffer.
+ (should
+ (equal "Foo"
+ (org-test-with-temp-text #("<hidden>Foo" 0 8 (invisible t))
+ (let ((kill-ring nil))
+ (org-copy-visible (point-min) (point-max))
+ (current-kill 0 t)))))
+ (should
+ (equal "Foo"
+ (org-test-with-temp-text #("Foo<hidden>" 3 11 (invisible t))
+ (let ((kill-ring nil))
+ (org-copy-visible (point-min) (point-max))
+ (current-kill 0 t)))))
+ ;; Handle multiple visible parts.
+ (should
+ (equal "abc"
+ (org-test-with-temp-text
+ #("aXbXc" 1 2 (invisible t) 3 4 (invisible t))
+ (let ((kill-ring nil))
+ (org-copy-visible (point-min) (point-max))
+ (current-kill 0 t)))))
+ ;; Handle adjacent invisible parts.
+ (should
+ (equal "ab"
+ (org-test-with-temp-text
+ #("aXXb" 1 2 (invisible t) 2 3 (invisible org-link))
+ (let ((kill-ring nil))
+ (org-copy-visible (point-min) (point-max))
+ (current-kill 0 t)))))
+ ;; Copies text based on what's actually visible, as defined by
+ ;; `buffer-invisibility-spec'.
+ (should
+ (equal "aYb"
+ (org-test-with-temp-text
+ #("aXYb"
+ 1 2 (invisible t)
+ 2 3 (invisible org-test-copy-visible))
+ (let ((kill-ring nil))
+ (org-copy-visible (point-min) (point-max))
+ (current-kill 0 t)))))))
+
+(ert-deftest test-org-fold/set-visibility-according-to-property ()
+ "Test `org-set-visibility-according-to-property' specifications."
+ ;; "folded" state.
+ (should
+ (org-test-with-temp-text
+ "
+* a
+:PROPERTIES:
+:VISIBILITY: folded
+:END:
+** <point>b"
+ (org-set-visibility-according-to-property)
+ (invisible-p (point))))
+ ;; "children" state.
+ (should
+ (org-test-with-temp-text
+ "
+* a
+:PROPERTIES:
+:VISIBILITY: children
+:END:
+** b
+<point>Contents
+** c"
+ (org-set-visibility-according-to-property)
+ (invisible-p (point))))
+ (should
+ (org-test-with-temp-text
+ "
+* a
+:PROPERTIES:
+:VISIBILITY: children
+:END:
+** b
+Contents
+*** <point>c"
+ (org-set-visibility-according-to-property)
+ (invisible-p (point))))
+ ;; "content" state.
+ (should
+ (org-test-with-temp-text
+ "
+* a
+:PROPERTIES:
+:VISIBILITY: content
+:END:
+** b
+<point>Contents
+*** c"
+ (org-set-visibility-according-to-property)
+ (invisible-p (point))))
+ (should
+ (org-test-with-temp-text
+ "
+* a
+:PROPERTIES:
+:VISIBILITY: content
+:END:
+** b
+Contents
+*** <point>c"
+ (org-set-visibility-according-to-property)
+ (not (invisible-p (point)))))
+ ;; "showall" state.
+ (should
+ (org-test-with-temp-text
+ "
+* a
+:PROPERTIES:
+:VISIBILITY: showall
+:END:
+** b
+<point>Contents
+*** c"
+ (org-set-visibility-according-to-property)
+ (not (invisible-p (point)))))
+ (should
+ (org-test-with-temp-text
+ "
+* a
+:PROPERTIES:
+:VISIBILITY: showall
+:END:
+** b
+Contents
+*** <point>c"
+ (org-set-visibility-according-to-property)
+ (not (invisible-p (point)))))
+ ;; When VISIBILITY properties are nested, ignore inner ones.
+ (should
+ (org-test-with-temp-text
+ "
+* A
+:PROPERTIES:
+:VISIBILITY: folded
+:END:
+** <point>B
+:PROPERTIES:
+:VISIBILITY: folded
+:END:"
+ (org-set-visibility-according-to-property)
+ (invisible-p (point)))))
+
+(ert-deftest test-org-fold/visibility-show-branches ()
+ "Test visibility of inline archived subtrees."
+ (org-test-with-temp-text
+ "* Foo<point>
+** Bar :ARCHIVE:
+*** Baz
+"
+ (org-kill-note-or-show-branches)
+ (should (org-invisible-p (- (point-max) 2)))))
+
+(ert-deftest test-org-fold/org-cycle-narrowed-subtree ()
+ "Test cycling in narrowed buffer."
+ (org-test-with-temp-text
+ "* Heading 1<point>
+** Child 1.1
+** Child 1.2
+some text
+*** Sub-child 1.2.1
+* Heading 2"
+ (org-overview)
+ (org-narrow-to-subtree)
+ (org-cycle)
+ (re-search-forward "Sub-child")
+ (should (org-invisible-p))))
+
+(ert-deftest test-org-fold/org-fold-reveal-broken-structure ()
+ "Test unfolding broken elements."
+ (let ((org-fold-core-style 'text-properties))
+ (org-test-with-temp-text
+ "<point>* Heading 1
+Text here"
+ (org-overview)
+ (re-search-forward "Text")
+ (should (org-invisible-p))
+ (goto-char 1)
+ (delete-char 1)
+ (re-search-forward "Text")
+ (should-not (org-invisible-p)))
+ (org-test-with-temp-text
+ "* Heading 1
+<point>:PROPERTIES:
+:ID: something
+:END:
+Text here"
+ (org-cycle)
+ (org-fold-hide-drawer-all)
+ (re-search-forward "ID")
+ (should (org-invisible-p))
+ (re-search-backward ":PROPERTIES:")
+ (delete-char 1)
+ (re-search-forward "ID")
+ (should-not (org-invisible-p)))
+ (org-test-with-temp-text
+ "* Heading 1
+<point>:PROPERTIES:
+:ID: something
+:END:
+Text here"
+ (org-cycle)
+ (org-fold-hide-drawer-all)
+ (re-search-forward "ID")
+ (should (org-invisible-p))
+ (re-search-forward ":END:")
+ (delete-char -1)
+ (re-search-backward "ID")
+ (should-not (org-invisible-p)))
+ (org-test-with-temp-text
+ "* Heading 1
+<point>#+begin_src emacs-lisp
+(+ 1 2)
+#+end_src
+Text here"
+ (org-cycle)
+ (org-fold-hide-drawer-all)
+ (re-search-forward "end")
+ (should (org-invisible-p))
+ (delete-char -1)
+ (re-search-backward "2")
+ (should-not (org-invisible-p)))))
+
+(ert-deftest test-org-fold/re-hide-edits-inside-fold ()
+ "Test edits inside folded regions."
+ (org-test-with-temp-text
+ "<point>* Heading 1
+Text here"
+ (org-overview)
+ (org-set-property "TEST" "1")
+ (re-search-forward "TEST")
+ (should (org-invisible-p)))
+ (org-test-with-temp-text
+ "* Heading 1<point>
+Text here"
+ (org-overview)
+ (insert " and extra heading text")
+ (re-search-backward "heading")
+ (should-not (org-invisible-p)))
+ (org-test-with-temp-text
+ "* Heading 1
+Text<point> here"
+ (org-overview)
+ (insert " and extra text")
+ (re-search-backward "extra")
+ (should (org-invisible-p))))
+
+
+(defmacro test-org-fold-with-default-template (&rest body)
+ "Run `org-test-with-temp-text' using default folded template."
+ (declare (indent 0))
+ `(let ((org-link-descriptive t))
+ (org-test-with-temp-text
+ "#+STARTUP: showeverything
+* <point>Folded heading
+Folded Paragraph inside heading.
+* Unfolded heading
+:FOLDED-DRAWER:
+Folded Paragraph inside drawer.
+:END:
+Unfolded Paragraph.
+#+begin_src emacs-lisp
+(message \"Folded block\")
+#+end_src
+[[hiddenlink][link]]
+"
+ (org-cycle)
+ (search-forward "FOLDED-DRAWER")
+ (org-hide-drawer-toggle t)
+ (search-forward "begin_src")
+ (org-hide-block-toggle t)
+ (goto-char 1)
+ ,@body)))
+
+(ert-deftest test-org-fold/org-catch-invisible-edits ()
+ "Test invisible edits handling."
+ ;; Disable delay in `org-fold-check-before-invisible-edit'.
+ (cl-letf (((symbol-function 'sit-for) #'ignore))
+ (dolist (org-fold-core-style '(text-properties overlays))
+ (dolist (org-fold-catch-invisible-edits
+ '(nil error smart show show-and-error))
+ (dolist (kind '(insert delete-backward delete nil))
+ (message "Testing invisible edits: %S:%S:%S"
+ org-fold-core-style
+ org-fold-catch-invisible-edits
+ kind)
+ ;; Edits outside invisible.
+ (test-org-fold-with-default-template
+ (search-forward "Unfolded Paragraph")
+ (message "Outside invisible")
+ (org-fold-check-before-invisible-edit kind)
+ (should-not (org-invisible-p)))
+ ;; Edits inside invisible region.
+ (test-org-fold-with-default-template
+ (dolist (txt '("Folded Paragraph inside heading"
+ "Folded Paragraph inside drawer"
+ "Folded block"))
+ (search-forward txt)
+ (message "Inside invisible %S" txt)
+ (pcase org-fold-catch-invisible-edits
+ (`nil
+ (org-fold-check-before-invisible-edit kind)
+ (should (org-invisible-p)))
+ (`show
+ (org-fold-check-before-invisible-edit kind)
+ (should-not (org-invisible-p)))
+ ((or `smart `show-and-error)
+ (should-error (org-fold-check-before-invisible-edit kind))
+ (should-not (org-invisible-p)))
+ (`error
+ (should-error (org-fold-check-before-invisible-edit kind))
+ (should (org-invisible-p)))))
+ (search-forward "hiddenlink")
+ (message "Inside hidden link")
+ (org-fold-check-before-invisible-edit kind)
+ (should (org-invisible-p)))
+ ;; Edits at the left border.
+ (test-org-fold-with-default-template
+ (dolist (txt '("Folded heading"
+ ":FOLDED-DRAWER:"
+ "#+begin_src emacs-lisp"))
+ (search-forward txt)
+ (message "Left of folded %S" txt)
+ (pcase org-fold-catch-invisible-edits
+ (`nil
+ (org-fold-check-before-invisible-edit kind)
+ (should (org-invisible-p (1+ (point)))))
+ (`show
+ (org-fold-check-before-invisible-edit kind)
+ (should-not (org-invisible-p (1+ (point)))))
+ (`smart
+ (if (memq kind '(insert delete-backward))
+ (org-fold-check-before-invisible-edit kind)
+ (should-error (org-fold-check-before-invisible-edit kind)))
+ (should-not (org-invisible-p (1+ (point)))))
+ (`show-and-error
+ (should-error (org-fold-check-before-invisible-edit kind))
+ (should-not (org-invisible-p (1+ (point)))))
+ (`error
+ (should-error (org-fold-check-before-invisible-edit kind))
+ (should (org-invisible-p (1+ (point)))))))
+ (search-forward "hiddenlink")
+ (search-forward "lin")
+ (message "Left border of ]] in link")
+ (org-fold-check-before-invisible-edit kind)
+ (should (org-invisible-p (1+ (point)))))
+ ;; Edits at the right border.
+ (test-org-fold-with-default-template
+ (dolist (txt '("Folded Paragraph inside heading."
+ ":END:"
+ "#+end_src"))
+ (search-forward txt)
+ (message "After %S" txt)
+ (pcase org-fold-catch-invisible-edits
+ (`nil
+ (org-fold-check-before-invisible-edit kind)
+ (should (org-invisible-p (1- (point)))))
+ (`show
+ (org-fold-check-before-invisible-edit kind)
+ (should-not (org-invisible-p (1- (point)))))
+ ((or `smart `show-and-error)
+ (should-error (org-fold-check-before-invisible-edit kind))
+ (should-not (org-invisible-p (1- (point)))))
+ (`error
+ (should-error (org-fold-check-before-invisible-edit kind))
+ (should (org-invisible-p (1- (point)))))))
+ (search-forward "hiddenlink")
+ (search-forward "link]]")
+ (message "Right border of ]] in link")
+ (org-fold-check-before-invisible-edit kind)
+ (should (org-invisible-p (1- (point))))))))))
+
+(provide 'test-org-fold)
+
+;;; test-org-fold.el ends here
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index ca0dc676b0..d79d7de519 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -8110,463 +8110,6 @@ CLOSED: %s
t)))))
-;;; Visibility
-
-(ert-deftest test-org/hide-drawer-toggle ()
- "Test `org-fold-hide-drawer-toggle' specifications."
- ;; Error when not at a drawer.
- (should-error
- (org-test-with-temp-text ":fake-drawer:\ncontents"
- (org-fold-hide-drawer-toggle 'off)
- (get-char-property (line-end-position) 'invisible)))
- (should-error
- (org-test-with-temp-text
- "#+begin_example\n<point>:D:\nc\n:END:\n#+end_example"
- (org-fold-hide-drawer-toggle t)))
- ;; Hide drawer.
- (should
- (org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-fold-show-all)
- (org-fold-hide-drawer-toggle)
- (get-char-property (line-end-position) 'invisible)))
- ;; Show drawer unconditionally when optional argument is `off'.
- (should-not
- (org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-fold-hide-drawer-toggle)
- (org-fold-hide-drawer-toggle 'off)
- (get-char-property (line-end-position) 'invisible)))
- ;; Hide drawer unconditionally when optional argument is non-nil.
- (should
- (org-test-with-temp-text ":drawer:\ncontents\n:end:"
- (org-fold-hide-drawer-toggle t)
- (get-char-property (line-end-position) 'invisible)))
- ;; Do not hide drawer when called from final blank lines.
- (should-not
- (org-test-with-temp-text ":drawer:\ncontents\n:end:\n\n<point>"
- (org-fold-show-all)
- (org-fold-hide-drawer-toggle)
- (goto-char (point-min))
- (get-char-property (line-end-position) 'invisible)))
- ;; Don't leave point in an invisible part of the buffer when hiding
- ;; a drawer away.
- (should-not
- (org-test-with-temp-text ":drawer:\ncontents\n<point>:end:"
- (org-fold-hide-drawer-toggle)
- (get-char-property (point) 'invisible))))
-
-(ert-deftest test-org/hide-block-toggle ()
- "Test `org-fold-hide-block-toggle' specifications."
- ;; Error when not at a block.
- (should-error
- (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents"
- (org-fold-hide-block-toggle 'off)
- (get-char-property (line-end-position) 'invisible)))
- ;; Hide block.
- (should
- (org-test-with-temp-text "#+BEGIN_CENTER\ncontents\n#+END_CENTER"
- (org-fold-hide-block-toggle)
- (get-char-property (line-end-position) 'invisible)))
- (should
- (org-test-with-temp-text "#+BEGIN_EXAMPLE\ncontents\n#+END_EXAMPLE"
- (org-fold-hide-block-toggle)
- (get-char-property (line-end-position) 'invisible)))
- ;; Show block unconditionally when optional argument is `off'.
- (should-not
- (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-fold-hide-block-toggle)
- (org-fold-hide-block-toggle 'off)
- (get-char-property (line-end-position) 'invisible)))
- (should-not
- (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-fold-hide-block-toggle 'off)
- (get-char-property (line-end-position) 'invisible)))
- ;; Hide block unconditionally when optional argument is non-nil.
- (should
- (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-fold-hide-block-toggle t)
- (get-char-property (line-end-position) 'invisible)))
- (should
- (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE"
- (org-fold-hide-block-toggle)
- (org-fold-hide-block-toggle t)
- (get-char-property (line-end-position) 'invisible)))
- ;; Do not hide block when called from final blank lines.
- (should-not
- (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n#+END_QUOTE\n\n<point>"
- (org-fold-hide-block-toggle)
- (goto-char (point-min))
- (get-char-property (line-end-position) 'invisible)))
- ;; Don't leave point in an invisible part of the buffer when hiding
- ;; a block away.
- (should-not
- (org-test-with-temp-text "#+BEGIN_QUOTE\ncontents\n<point>#+END_QUOTE"
- (org-fold-hide-block-toggle)
- (get-char-property (point) 'invisible))))
-
-(ert-deftest test-org/hide-block-toggle-maybe ()
- "Test `org-fold-hide-block-toggle' specifications."
- (should
- (org-test-with-temp-text "#+BEGIN: dynamic\nContents\n#+END:"
- (org-hide-block-toggle)))
- (should-error
- (org-test-with-temp-text "Paragraph" (org-hide-block-toggle))))
-
-(ert-deftest test-org/show-set-visibility ()
- "Test `org-fold-show-set-visibility' specifications."
- ;; Do not throw an error before first heading.
- (should
- (org-test-with-temp-text "Preamble\n* Headline"
- (org-fold-show-set-visibility 'tree)
- t))
- ;; Test all visibility spans, both on headline and in entry.
- (let ((list-visible-lines
- (lambda (state headerp)
- (org-test-with-temp-text "* Grandmother (0)
-** Uncle (1)
-*** Heir (2)
-** Father (3)
- Ancestor text (4)
-*** Sister (5)
- Sibling text (6)
-*** Self (7)
- Match (8)
-**** First born (9)
- Child text (10)
-**** The other child (11)
-*** Brother (12)
-** Aunt (13)
-"
- (org-cycle t)
- (search-forward (if headerp "Self" "Match"))
- (org-fold-show-set-visibility state)
- (goto-char (point-min))
- (let (result (line 0))
- (while (not (eobp))
- (unless (org-invisible-p2) (push line result))
- (cl-incf line)
- (forward-line))
- (nreverse result))))))
- (should (equal '(0 7) (funcall list-visible-lines 'minimal t)))
- (should (equal '(0 7 8) (funcall list-visible-lines 'minimal nil)))
- (should (equal '(0 7 8 9) (funcall list-visible-lines 'local t)))
- (should (equal '(0 7 8 9) (funcall list-visible-lines 'local nil)))
- (should (equal '(0 3 7) (funcall list-visible-lines 'ancestors t)))
- (should (equal '(0 3 7 8) (funcall list-visible-lines 'ancestors nil)))
- (should (equal '(0 3 7 8 9 10 11)
- (funcall list-visible-lines 'ancestors-full t)))
- (should (equal '(0 3 7 8 9 10 11)
- (funcall list-visible-lines 'ancestors-full nil)))
- (should (equal '(0 3 5 7 12) (funcall list-visible-lines 'lineage t)))
- (should (equal '(0 3 5 7 8 9 12) (funcall list-visible-lines 'lineage
nil)))
- (should (equal '(0 1 3 5 7 12 13) (funcall list-visible-lines 'tree t)))
- (should (equal '(0 1 3 5 7 8 9 11 12 13)
- (funcall list-visible-lines 'tree nil)))
- (should (equal '(0 1 3 4 5 7 12 13)
- (funcall list-visible-lines 'canonical t)))
- (should (equal '(0 1 3 4 5 7 8 9 11 12 13)
- (funcall list-visible-lines 'canonical nil))))
- ;; When point is hidden in a drawer or a block, make sure to make it
- ;; visible.
- (should-not
- (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
- (org-fold-hide-block-toggle)
- (search-forward "Text")
- (org-fold-show-set-visibility 'minimal)
- (org-invisible-p2)))
- (should-not
- (org-test-with-temp-text ":DRAWER:\nText\n:END:"
- (org-fold-hide-drawer-toggle)
- (search-forward "Text")
- (org-fold-show-set-visibility 'minimal)
- (org-invisible-p2)))
- (should-not
- (org-test-with-temp-text
- "#+BEGIN_QUOTE\n<point>:DRAWER:\nText\n:END:\n#+END_QUOTE"
- (org-fold-hide-drawer-toggle)
- (forward-line -1)
- (org-fold-hide-block-toggle)
- (search-forward "Text")
- (org-fold-show-set-visibility 'minimal)
- (org-invisible-p2))))
-
-(ert-deftest test-org/copy-visible ()
- "Test `org-copy-visible' specifications."
- ;;`org-unfontify-region', which is wired up to
- ;; `font-lock-unfontify-region-function', removes the invisible text
- ;; property, among other things.
- (cl-letf (((symbol-function 'org-unfontify-region) #'ignore))
- (should
- (equal "Foo"
- (org-test-with-temp-text "Foo"
- (let ((kill-ring nil))
- (org-copy-visible (point-min) (point-max))
- (current-kill 0 t)))))
- ;; Skip invisible characters by text property.
- (should
- (equal "Foo"
- (org-test-with-temp-text #("F<hidden>oo" 1 9 (invisible t))
- (let ((kill-ring nil))
- (org-copy-visible (point-min) (point-max))
- (current-kill 0 t)))))
- ;; Skip invisible characters by overlay.
- (should
- (equal "Foo"
- (org-test-with-temp-text "F<hidden>oo"
- (let ((o (make-overlay 2 10)))
- (overlay-put o 'invisible t))
- (let ((kill-ring nil))
- (org-copy-visible (point-min) (point-max))
- (current-kill 0 t)))))
- ;; Handle invisible characters at the beginning and the end of the
- ;; buffer.
- (should
- (equal "Foo"
- (org-test-with-temp-text #("<hidden>Foo" 0 8 (invisible t))
- (let ((kill-ring nil))
- (org-copy-visible (point-min) (point-max))
- (current-kill 0 t)))))
- (should
- (equal "Foo"
- (org-test-with-temp-text #("Foo<hidden>" 3 11 (invisible t))
- (let ((kill-ring nil))
- (org-copy-visible (point-min) (point-max))
- (current-kill 0 t)))))
- ;; Handle multiple visible parts.
- (should
- (equal "abc"
- (org-test-with-temp-text
- #("aXbXc" 1 2 (invisible t) 3 4 (invisible t))
- (let ((kill-ring nil))
- (org-copy-visible (point-min) (point-max))
- (current-kill 0 t)))))
- ;; Handle adjacent invisible parts.
- (should
- (equal "ab"
- (org-test-with-temp-text
- #("aXXb" 1 2 (invisible t) 2 3 (invisible org-link))
- (let ((kill-ring nil))
- (org-copy-visible (point-min) (point-max))
- (current-kill 0 t)))))
- ;; Copies text based on what's actually visible, as defined by
- ;; `buffer-invisibility-spec'.
- (should
- (equal "aYb"
- (org-test-with-temp-text
- #("aXYb"
- 1 2 (invisible t)
- 2 3 (invisible org-test-copy-visible))
- (let ((kill-ring nil))
- (org-copy-visible (point-min) (point-max))
- (current-kill 0 t)))))))
-
-(ert-deftest test-org/set-visibility-according-to-property ()
- "Test `org-set-visibility-according-to-property' specifications."
- ;; "folded" state.
- (should
- (org-test-with-temp-text
- "
-* a
-:PROPERTIES:
-:VISIBILITY: folded
-:END:
-** <point>b"
- (org-set-visibility-according-to-property)
- (invisible-p (point))))
- ;; "children" state.
- (should
- (org-test-with-temp-text
- "
-* a
-:PROPERTIES:
-:VISIBILITY: children
-:END:
-** b
-<point>Contents
-** c"
- (org-set-visibility-according-to-property)
- (invisible-p (point))))
- (should
- (org-test-with-temp-text
- "
-* a
-:PROPERTIES:
-:VISIBILITY: children
-:END:
-** b
-Contents
-*** <point>c"
- (org-set-visibility-according-to-property)
- (invisible-p (point))))
- ;; "content" state.
- (should
- (org-test-with-temp-text
- "
-* a
-:PROPERTIES:
-:VISIBILITY: content
-:END:
-** b
-<point>Contents
-*** c"
- (org-set-visibility-according-to-property)
- (invisible-p (point))))
- (should
- (org-test-with-temp-text
- "
-* a
-:PROPERTIES:
-:VISIBILITY: content
-:END:
-** b
-Contents
-*** <point>c"
- (org-set-visibility-according-to-property)
- (not (invisible-p (point)))))
- ;; "showall" state.
- (should
- (org-test-with-temp-text
- "
-* a
-:PROPERTIES:
-:VISIBILITY: showall
-:END:
-** b
-<point>Contents
-*** c"
- (org-set-visibility-according-to-property)
- (not (invisible-p (point)))))
- (should
- (org-test-with-temp-text
- "
-* a
-:PROPERTIES:
-:VISIBILITY: showall
-:END:
-** b
-Contents
-*** <point>c"
- (org-set-visibility-according-to-property)
- (not (invisible-p (point)))))
- ;; When VISIBILITY properties are nested, ignore inner ones.
- (should
- (org-test-with-temp-text
- "
-* A
-:PROPERTIES:
-:VISIBILITY: folded
-:END:
-** <point>B
-:PROPERTIES:
-:VISIBILITY: folded
-:END:"
- (org-set-visibility-according-to-property)
- (invisible-p (point)))))
-
-(ert-deftest test-org/visibility-show-branches ()
- "Test visibility of inline archived subtrees."
- (org-test-with-temp-text
- "* Foo<point>
-** Bar :ARCHIVE:
-*** Baz
-"
- (org-kill-note-or-show-branches)
- (should (org-invisible-p (- (point-max) 2)))))
-
-(ert-deftest test-org/org-cycle-narrowed-subtree ()
- "Test cycling in narrowed buffer."
- (org-test-with-temp-text
- "* Heading 1<point>
-** Child 1.1
-** Child 1.2
-some text
-*** Sub-child 1.2.1
-* Heading 2"
- (org-overview)
- (org-narrow-to-subtree)
- (org-cycle)
- (re-search-forward "Sub-child")
- (should (org-invisible-p))))
-
-(ert-deftest test-org/org-fold-reveal-broken-structure ()
- "Test unfolding broken elements."
- (let ((org-fold-core-style 'text-properties))
- (org-test-with-temp-text
- "<point>* Heading 1
-Text here"
- (org-overview)
- (re-search-forward "Text")
- (should (org-invisible-p))
- (goto-char 1)
- (delete-char 1)
- (re-search-forward "Text")
- (should-not (org-invisible-p)))
- (org-test-with-temp-text
- "* Heading 1
-<point>:PROPERTIES:
-:ID: something
-:END:
-Text here"
- (org-cycle)
- (org-fold-hide-drawer-all)
- (re-search-forward "ID")
- (should (org-invisible-p))
- (re-search-backward ":PROPERTIES:")
- (delete-char 1)
- (re-search-forward "ID")
- (should-not (org-invisible-p)))
- (org-test-with-temp-text
- "* Heading 1
-<point>:PROPERTIES:
-:ID: something
-:END:
-Text here"
- (org-cycle)
- (org-fold-hide-drawer-all)
- (re-search-forward "ID")
- (should (org-invisible-p))
- (re-search-forward ":END:")
- (delete-char -1)
- (re-search-backward "ID")
- (should-not (org-invisible-p)))
- (org-test-with-temp-text
- "* Heading 1
-<point>#+begin_src emacs-lisp
-(+ 1 2)
-#+end_src
-Text here"
- (org-cycle)
- (org-fold-hide-drawer-all)
- (re-search-forward "end")
- (should (org-invisible-p))
- (delete-char -1)
- (re-search-backward "2")
- (should-not (org-invisible-p)))))
-
-(ert-deftest test-org/re-hide-edits-inside-fold ()
- "Test edits inside folded regions."
- (org-test-with-temp-text
- "<point>* Heading 1
-Text here"
- (org-overview)
- (org-set-property "TEST" "1")
- (re-search-forward "TEST")
- (should (org-invisible-p)))
- (org-test-with-temp-text
- "* Heading 1<point>
-Text here"
- (org-overview)
- (insert " and extra heading text")
- (re-search-backward "heading")
- (should-not (org-invisible-p)))
- (org-test-with-temp-text
- "* Heading 1
-Text<point> here"
- (org-overview)
- (insert " and extra text")
- (re-search-backward "extra")
- (should (org-invisible-p))))
-
-
;;; Yank and Kill
(ert-deftest test-org/paste-subtree ()
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/org 2e4ed52b19: org-fold: Revert old behaviour when handling invisible edits,
ELPA Syncer <=