emacs-elpa-diffs
[Top][All Lists]
Advanced

[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 ()



reply via email to

[Prev in Thread] Current Thread [Next in Thread]