;;; test-org.el --- tests for org.el -*- lexical-binding: t; -*- ;; 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 . ;; 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: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" (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: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" (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#+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: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 #("Foo" 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 "Foo" (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 #("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" 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: ** b" (org-set-visibility-according-to-property) (invisible-p (point)))) (org-test-with-temp-text " #+STARTUP: overview * A ** AA ** AB *** ABA :PROPERTIES: :VISIBILITY: folded :END: **** ABAA **** ABAB **** ABAC ** AC * B " (org-set-regexps-and-options) (org-cycle-set-startup-visibility) (search-forward "A") (should-not (invisible-p (point))) (search-forward "AB") (should (invisible-p (point))) (search-forward "ABA") (should (invisible-p (point))) (search-forward "ABAB") (should (invisible-p (point))) (search-forward "AC") (should (invisible-p (point))) (search-forward "B") (should-not (invisible-p (point)))) ;; "children" state. (should (org-test-with-temp-text " * a :PROPERTIES: :VISIBILITY: children :END: ** b Contents ** c" (org-set-visibility-according-to-property) (invisible-p (point)))) (should (org-test-with-temp-text " * a :PROPERTIES: :VISIBILITY: children :END: ** b Contents *** c" (org-set-visibility-according-to-property) (invisible-p (point)))) ;; "content" state. (should (org-test-with-temp-text " * a :PROPERTIES: :VISIBILITY: content :END: ** b Contents *** c" (org-set-visibility-according-to-property) (invisible-p (point)))) (should (org-test-with-temp-text " * a :PROPERTIES: :VISIBILITY: content :END: ** b Contents *** 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 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 *** 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: ** 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 ** 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 ** 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 "* Heading 1 Text here" (org-overview) (re-search-forward "Text") (should (org-invisible-p)) (goto-char 1) (org-delete-char 1) (re-search-forward "Text") (should-not (org-invisible-p))) (org-test-with-temp-text "* Heading 1 :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 :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 #+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 "* 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 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 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 * 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