summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2020-01-11 20:05:07 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2020-01-11 20:13:39 +0100
commitb1822760f4ab5fa9bd99db4140a46ac6840b0c77 (patch)
treeb1e58ca4c86b52cbe77f0b67d5ff4366176eb9fb
parentb8f4773bfe19ba1db269bf6d647d59be461ce2c6 (diff)
downloadorg-mode-b1822760f4ab5fa9bd99db4140a46ac6840b0c77.tar.gz
Fix exporting visible parts of a buffer
* lisp/org-element.el (org-element--parse-elements): Only ignore parts due to folding, not because of fontification. * lisp/org-macs.el (org-invisible-p): Add an optional argument. * testing/lisp/test-org-element.el (test-org-element/parse-buffer-visible): Add tests.
-rw-r--r--lisp/org-element.el84
-rw-r--r--lisp/org-macs.el12
-rw-r--r--testing/lisp/test-org-element.el24
3 files changed, 69 insertions, 51 deletions
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 4b5f9a1..5dfe67e 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -4361,54 +4361,52 @@ elements.
Elements are accumulated into ACC."
(save-excursion
(goto-char beg)
- ;; Visible only: skip invisible parts at the beginning of the
- ;; element.
- (when (and visible-only (org-invisible-p2))
- (goto-char (min (1+ (org-find-visible)) end)))
;; When parsing only headlines, skip any text before first one.
(when (and (eq granularity 'headline) (not (org-at-heading-p)))
(org-with-limited-levels (outline-next-heading)))
(let (elements)
(while (< (point) end)
- ;; Find current element's type and parse it accordingly to
- ;; its category.
- (let* ((element (org-element--current-element
- end granularity mode structure))
- (type (org-element-type element))
- (cbeg (org-element-property :contents-begin element)))
- (goto-char (org-element-property :end element))
- ;; Visible only: skip invisible parts between siblings.
- (when (and visible-only (org-invisible-p2))
- (goto-char (min (1+ (org-find-visible)) end)))
- ;; Fill ELEMENT contents by side-effect.
- (cond
- ;; If element has no contents, don't modify it.
- ((not cbeg))
- ;; Greater element: parse it between `contents-begin' and
- ;; `contents-end'. Make sure GRANULARITY allows the
- ;; recursion, or ELEMENT is a headline, in which case going
- ;; inside is mandatory, in order to get sub-level headings.
- ((and (memq type org-element-greater-elements)
- (or (memq granularity '(element object nil))
- (and (eq granularity 'greater-element)
- (eq type 'section))
- (eq type 'headline)))
- (org-element--parse-elements
- cbeg (org-element-property :contents-end element)
- ;; Possibly switch to a special mode.
- (org-element--next-mode type t)
- (and (memq type '(item plain-list))
- (org-element-property :structure element))
- granularity visible-only element))
- ;; ELEMENT has contents. Parse objects inside, if
- ;; GRANULARITY allows it.
- ((memq granularity '(object nil))
- (org-element--parse-objects
- cbeg (org-element-property :contents-end element) element
- (org-element-restriction type))))
- (push (org-element-put-property element :parent acc) elements)
- ;; Update mode.
- (setq mode (org-element--next-mode type nil))))
+ ;; Visible only: skip invisible parts due to folding.
+ (if (and visible-only (org-invisible-p nil t))
+ (progn
+ (goto-char (org-find-visible))
+ (when (and (eolp) (not (eobp))) (forward-char)))
+ ;; Find current element's type and parse it accordingly to
+ ;; its category.
+ (let* ((element (org-element--current-element
+ end granularity mode structure))
+ (type (org-element-type element))
+ (cbeg (org-element-property :contents-begin element)))
+ (goto-char (org-element-property :end element))
+ ;; Fill ELEMENT contents by side-effect.
+ (cond
+ ;; If element has no contents, don't modify it.
+ ((not cbeg))
+ ;; Greater element: parse it between `contents-begin' and
+ ;; `contents-end'. Ensure GRANULARITY allows recursion,
+ ;; or ELEMENT is a headline, in which case going inside
+ ;; is mandatory, in order to get sub-level headings.
+ ((and (memq type org-element-greater-elements)
+ (or (memq granularity '(element object nil))
+ (and (eq granularity 'greater-element)
+ (eq type 'section))
+ (eq type 'headline)))
+ (org-element--parse-elements
+ cbeg (org-element-property :contents-end element)
+ ;; Possibly switch to a special mode.
+ (org-element--next-mode type t)
+ (and (memq type '(item plain-list))
+ (org-element-property :structure element))
+ granularity visible-only element))
+ ;; ELEMENT has contents. Parse objects inside, if
+ ;; GRANULARITY allows it.
+ ((memq granularity '(object nil))
+ (org-element--parse-objects
+ cbeg (org-element-property :contents-end element) element
+ (org-element-restriction type))))
+ (push (org-element-put-property element :parent acc) elements)
+ ;; Update mode.
+ (setq mode (org-element--next-mode type nil)))))
;; Return result.
(apply #'org-element-set-contents acc (nreverse elements)))))
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 2a7ab66..46ee7ee 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -1065,10 +1065,16 @@ the value in cdr."
(get-text-property (or (next-single-property-change 0 prop s) 0)
prop s)))
-(defun org-invisible-p (&optional pos)
+(defun org-invisible-p (&optional pos folding-only)
"Non-nil if the character after POS is invisible.
-If POS is nil, use `point' instead."
- (get-char-property (or pos (point)) 'invisible))
+If POS is nil, use `point' instead. When optional argument
+FOLDING-ONLY is non-nil, only consider invisible parts due to
+folding of a headline, a block or a drawer, i.e., not because of
+fontification."
+ (let ((value (get-char-property (or pos (point)) 'invisible)))
+ (cond ((not value) nil)
+ (folding-only (memq value '(org-hide-block org-hide-drawer outline)))
+ (t value))))
(defun org-truely-invisible-p ()
"Check if point is at a character currently not visible.
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index f2ab380..e4e9de6 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -3353,11 +3353,25 @@ Text
"Test `org-element-parse-buffer' with visible only argument."
(should
(equal '("H1" "H3" "H5")
- (org-test-with-temp-text
- "* H1\n** H2\n** H3 :visible:\n** H4\n** H5 :visible:"
- (org-occur ":visible:")
- (org-element-map (org-element-parse-buffer nil t) 'headline
- (lambda (hl) (org-element-property :raw-value hl)))))))
+ (org-test-with-temp-text
+ "* H1\n** H2\n** H3 :visible:\n** H4\n** H5 :visible:"
+ (org-occur ":visible:")
+ (org-element-map (org-element-parse-buffer nil t) 'headline
+ (lambda (hl) (org-element-property :raw-value hl))))))
+ (should
+ (equal "Test"
+ (let ((contents "Test"))
+ (org-test-with-temp-text contents
+ (add-text-properties 0 1 '(invisible t) contents)
+ (org-element-map (org-element-parse-buffer nil t) 'plain-text
+ #'org-no-properties nil t)))))
+ (should
+ (equal "Test"
+ (let ((contents "Test"))
+ (org-test-with-temp-text (concat "- " contents)
+ (add-text-properties 0 1 '(invisible t) contents)
+ (org-element-map (org-element-parse-buffer nil t) 'plain-text
+ #'org-no-properties nil t))))))