From b1822760f4ab5fa9bd99db4140a46ac6840b0c77 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 11 Jan 2020 20:05:07 +0100 Subject: [PATCH] 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. --- lisp/org-element.el | 84 ++++++++++++++++---------------- lisp/org-macs.el | 12 +++-- testing/lisp/test-org-element.el | 24 +++++++-- 3 files changed, 69 insertions(+), 51 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 4b5f9a19e..5dfe67e33 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 2a7ab66a3..46ee7eee9 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 f2ab38031..e4e9de618 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))))))