Browse Source

Implement overlay- and text-property-based versions of some functions

Ihor Radchenko 3 years ago
parent
commit
77aa9be5ac
6 changed files with 585 additions and 97 deletions
  1. 53 1
      lisp/org-element.el
  2. 1 4
      lisp/org-fold.el
  3. 23 3
      lisp/org-inlinetask.el
  4. 73 1
      lisp/org-list.el
  5. 50 4
      lisp/org-macs.el
  6. 385 84
      lisp/org.el

+ 53 - 1
lisp/org-element.el

@@ -7913,7 +7913,7 @@ parse tree."
     (or (and (>= beg-A beg-B) (<= end-A end-B))
     (or (and (>= beg-A beg-B) (<= end-A end-B))
 	(and (>= beg-B beg-A) (<= end-B end-A)))))
 	(and (>= beg-B beg-A) (<= end-B end-A)))))
 
 
-(defun org-element-swap-A-B (elem-A elem-B)
+(defun org-element-swap-A-B--overlays (elem-A elem-B)
   "Swap elements ELEM-A and ELEM-B.
   "Swap elements ELEM-A and ELEM-B.
 Assume ELEM-B is after ELEM-A in the buffer.  Leave point at the
 Assume ELEM-B is after ELEM-A in the buffer.  Leave point at the
 end of ELEM-A."
 end of ELEM-A."
@@ -7981,6 +7981,58 @@ end of ELEM-A."
 	(dolist (o (cdr overlays))
 	(dolist (o (cdr overlays))
 	  (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
 	  (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
       (goto-char (org-element-property :end elem-B)))))
       (goto-char (org-element-property :end elem-B)))))
+(defun org-element-swap-A-B--text-properties (elem-A elem-B)
+  "Swap elements ELEM-A and ELEM-B.
+Assume ELEM-B is after ELEM-A in the buffer.  Leave point at the
+end of ELEM-A."
+  (goto-char (org-element-property :begin elem-A))
+  ;; There are two special cases when an element doesn't start at bol:
+  ;; the first paragraph in an item or in a footnote definition.
+  (let ((specialp (not (bolp))))
+    ;; Only a paragraph without any affiliated keyword can be moved at
+    ;; ELEM-A position in such a situation.  Note that the case of
+    ;; a footnote definition is impossible: it cannot contain two
+    ;; paragraphs in a row because it cannot contain a blank line.
+    (when (and specialp
+	       (or (not (eq (org-element-type elem-B) 'paragraph))
+		   (/= (org-element-property :begin elem-B)
+		       (org-element-property :contents-begin elem-B))))
+      (error "Cannot swap elements"))
+    ;; In a special situation, ELEM-A will have no indentation.  We'll
+    ;; give it ELEM-B's (which will in, in turn, have no indentation).
+    (org-fold-core-ignore-modifications ;; Preserve folding state
+        (let* ((ind-B (when specialp
+		        (goto-char (org-element-property :begin elem-B))
+		        (current-indentation)))
+	       (beg-A (org-element-property :begin elem-A))
+	       (end-A (save-excursion
+		        (goto-char (org-element-property :end elem-A))
+		        (skip-chars-backward " \r\t\n")
+		        (point-at-eol)))
+	       (beg-B (org-element-property :begin elem-B))
+	       (end-B (save-excursion
+		        (goto-char (org-element-property :end elem-B))
+		        (skip-chars-backward " \r\t\n")
+		        (point-at-eol)))
+	       ;; Get contents.
+	       (body-A (buffer-substring beg-A end-A))
+	       (body-B (delete-and-extract-region beg-B end-B)))
+          (goto-char beg-B)
+          (when specialp
+	    (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
+	    (indent-to-column ind-B))
+          (insert body-A)
+	  (goto-char beg-A)
+	  (delete-region beg-A end-A)
+	  (insert body-B)
+          (goto-char (org-element-property :end elem-B))))))
+(defsubst org-element-swap-A-B (elem-A elem-B)
+  "Swap elements ELEM-A and ELEM-B.
+Assume ELEM-B is after ELEM-A in the buffer.  Leave point at the
+end of ELEM-A."
+  (if (eq org-fold-core-style 'text-properties)
+      (org-element-swap-A-B--text-properties elem-A elem-B)
+    (org-element-swap-A-B--overlays elem-A elem-B)))
 
 
 
 
 (provide 'org-element)
 (provide 'org-element)

+ 1 - 4
lisp/org-fold.el

@@ -53,10 +53,7 @@
 (defvar org-property-end-re)
 (defvar org-property-end-re)
 (defvar org-link-descriptive)
 (defvar org-link-descriptive)
 (defvar org-outline-regexp-bol)
 (defvar org-outline-regexp-bol)
-(defvar org-custom-properties-hidden-p)
 (defvar org-archive-tag)
 (defvar org-archive-tag)
-
-;; Needed for overlays only
 (defvar org-custom-properties-overlays)
 (defvar org-custom-properties-overlays)
 
 
 (declare-function isearch-filter-visible "isearch" (beg end))
 (declare-function isearch-filter-visible "isearch" (beg end))
@@ -1101,7 +1098,7 @@ The detailed reaction depends on the user option
       (when (or invisible-at-point invisible-before-point)
       (when (or invisible-at-point invisible-before-point)
 	(when (eq org-fold-catch-invisible-edits 'error)
 	(when (eq org-fold-catch-invisible-edits 'error)
 	  (user-error "Editing in invisible areas is prohibited, make them visible first"))
 	  (user-error "Editing in invisible areas is prohibited, make them visible first"))
-	(if (and org-custom-properties-hidden-p
+	(if (and org-custom-properties-overlays
 		 (y-or-n-p "Display invisible properties in this buffer? "))
 		 (y-or-n-p "Display invisible properties in this buffer? "))
 	    (org-toggle-custom-properties-visibility)
 	    (org-toggle-custom-properties-visibility)
 	  ;; Make the area visible
 	  ;; Make the area visible

+ 23 - 3
lisp/org-inlinetask.el

@@ -305,7 +305,22 @@ If the task has an end part, also demote it."
       (add-text-properties (match-beginning 3) (match-end 3)
       (add-text-properties (match-beginning 3) (match-end 3)
 			   '(face org-inlinetask font-lock-fontified t)))))
 			   '(face org-inlinetask font-lock-fontified t)))))
 
 
-(defun org-inlinetask-toggle-visibility ()
+(defun org-inlinetask-toggle-visibility--text-properties ()
+  "Toggle visibility of inline task at point."
+  (let ((end (save-excursion
+	       (org-inlinetask-goto-end)
+	       (if (bolp) (1- (point)) (point))))
+	(start (save-excursion
+		 (org-inlinetask-goto-beginning)
+		 (point-at-eol))))
+    (cond
+     ;; Nothing to show/hide.
+     ((= end start))
+     ;; Inlinetask was folded: expand it.
+     ((org-fold-get-folding-spec 'headline (1+ start))
+      (org-fold-region start end nil 'headline))
+     (t (org-fold-region start end t 'headline)))))
+(defun org-inlinetask-toggle-visibility--overlays ()
   "Toggle visibility of inline task at point."
   "Toggle visibility of inline task at point."
   (let ((end (save-excursion
   (let ((end (save-excursion
 	       (org-inlinetask-goto-end)
 	       (org-inlinetask-goto-end)
@@ -318,8 +333,13 @@ If the task has an end part, also demote it."
      ((= end start))
      ((= end start))
      ;; Inlinetask was folded: expand it.
      ;; Inlinetask was folded: expand it.
      ((eq (get-char-property (1+ start) 'invisible) 'outline)
      ((eq (get-char-property (1+ start) 'invisible) 'outline)
-      (org-flag-region start end nil 'outline))
-     (t (org-flag-region start end t 'outline)))))
+      (org-fold-region start end nil 'outline))
+     (t (org-fold-region start end t 'outline)))))
+(defsubst org-inlinetask-toggle-visibility ()
+  "Toggle visibility of inline task at point."
+  (if (eq org-fold-core-style 'text-properties)
+      (org-inlinetask-toggle-visibility--text-properties)
+    (org-inlinetask-toggle-visibility--overlays)))
 
 
 (defun org-inlinetask-hide-tasks (state)
 (defun org-inlinetask-hide-tasks (state)
   "Hide inline tasks in buffer when STATE is `contents' or `children'.
   "Hide inline tasks in buffer when STATE is `contents' or `children'.

+ 73 - 1
lisp/org-list.el

@@ -1079,7 +1079,65 @@ It determines the number of whitespaces to append by looking at
 	  (replace-match spaces nil nil bullet 1)
 	  (replace-match spaces nil nil bullet 1)
 	bullet))))
 	bullet))))
 
 
-(defun org-list-swap-items (beg-A beg-B struct)
+(defun org-list-swap-items--text-properties (beg-A beg-B struct)
+  "Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
+
+Blank lines at the end of items are left in place.  Item
+visibility is preserved.  Return the new structure after the
+changes.
+
+Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
+to the same sub-list.
+
+This function modifies STRUCT."
+  (save-excursion
+    (org-fold-core-ignore-modifications
+        (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
+	       (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
+	       (end-A (org-list-get-item-end beg-A struct))
+	       (end-B (org-list-get-item-end beg-B struct))
+	       (size-A (- end-A-no-blank beg-A))
+	       (size-B (- end-B-no-blank beg-B))
+	       (body-A (buffer-substring beg-A end-A-no-blank))
+	       (body-B (buffer-substring beg-B end-B-no-blank))
+	       (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
+	       (sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
+	       (sub-B (cons beg-B (org-list-get-subtree beg-B struct))))
+          ;; 1. Move effectively items in buffer.
+          (goto-char beg-A)
+          (delete-region beg-A end-B-no-blank)
+          (insert (concat body-B between-A-no-blank-and-B body-A))
+          ;; 2. Now modify struct.  No need to re-read the list, the
+          ;;    transformation is just a shift of positions.  Some special
+          ;;    attention is required for items ending at END-A and END-B
+          ;;    as empty spaces are not moved there.  In others words,
+          ;;    item BEG-A will end with whitespaces that were at the end
+          ;;    of BEG-B and the same applies to BEG-B.
+          (dolist (e struct)
+	    (let ((pos (car e)))
+	      (cond
+	       ((< pos beg-A))
+	       ((memq pos sub-A)
+	        (let ((end-e (nth 6 e)))
+	          (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
+	          (setcar (nthcdr 6 e)
+		          (+ end-e (- end-B-no-blank end-A-no-blank)))
+	          (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
+	       ((memq pos sub-B)
+	        (let ((end-e (nth 6 e)))
+	          (setcar e (- (+ pos beg-A) beg-B))
+	          (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
+	          (when (= end-e end-B)
+		    (setcar (nthcdr 6 e)
+			    (+ beg-A size-B (- end-A end-A-no-blank))))))
+	       ((< pos beg-B)
+	        (let ((end-e (nth 6 e)))
+	          (setcar e (+ pos (- size-B size-A)))
+	          (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
+          (setq struct (sort struct #'car-less-than-car))
+          ;; Return structure.
+          struct))))
+(defun org-list-swap-items--overlays (beg-A beg-B struct)
   "Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
   "Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
 
 
 Blank lines at the end of items are left in place.  Item
 Blank lines at the end of items are left in place.  Item
@@ -1164,6 +1222,20 @@ This function modifies STRUCT."
 		      (+ (nth 2 ov) (- beg-A beg-B))))
 		      (+ (nth 2 ov) (- beg-A beg-B))))
       ;; Return structure.
       ;; Return structure.
       struct)))
       struct)))
+(defsubst org-list-swap-items (beg-A beg-B struct)
+  "Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
+
+Blank lines at the end of items are left in place.  Item
+visibility is preserved.  Return the new structure after the
+changes.
+
+Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
+to the same sub-list.
+
+This function modifies STRUCT."
+  (if (eq org-fold-core-style 'text-properties)
+      (org-list-swap-items--text-properties beg-A beg-B struct)
+    (org-list-swap-items--overlays beg-A beg-B struct)))
 
 
 (defun org-list-separating-blank-lines-number (pos struct prevs)
 (defun org-list-separating-blank-lines-number (pos struct prevs)
   "Return number of blank lines that should separate items in list.
   "Return number of blank lines that should separate items in list.

+ 50 - 4
lisp/org-macs.el

@@ -1109,7 +1109,18 @@ the value in cadr."
       (get-text-property (or (next-single-property-change 0 prop s) 0)
       (get-text-property (or (next-single-property-change 0 prop s) 0)
 			 prop s)))
 			 prop s)))
 
 
-(defun org-invisible-p (&optional pos folding-only)
+;; FIXME: move to org-fold?
+(defun org-invisible-p--text-properties (&optional pos folding-only)
+  "Non-nil if the character after POS is 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 (invisible-p (or pos (point)))))
+    (cond ((not value) nil)
+	  (folding-only (org-fold-folded-p (or pos (point))))
+	  (t value))))
+(defun org-invisible-p--overlays (&optional pos folding-only)
   "Non-nil if the character after POS is invisible.
   "Non-nil if the character after POS is invisible.
 If POS is nil, use `point' instead.  When optional argument
 If POS is nil, use `point' instead.  When optional argument
 FOLDING-ONLY is non-nil, only consider invisible parts due to
 FOLDING-ONLY is non-nil, only consider invisible parts due to
@@ -1118,7 +1129,16 @@ fontification."
   (let ((value (get-char-property (or pos (point)) 'invisible)))
   (let ((value (get-char-property (or pos (point)) 'invisible)))
     (cond ((not value) nil)
     (cond ((not value) nil)
 	  (folding-only (memq value '(org-hide-block outline)))
 	  (folding-only (memq value '(org-hide-block outline)))
-	  (t value))))
+	  (t (and (invisible-p (or pos (point))) value)))))
+(defsubst org-invisible-p (&optional pos folding-only)
+  "Non-nil if the character after POS is 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."
+  (if (eq org-fold-core-style 'text-properties)
+      (org-invisible-p--text-properties pos folding-only)
+    (org-invisible-p--overlays pos folding-only)))
 
 
 (defun org-truly-invisible-p ()
 (defun org-truly-invisible-p ()
   "Check if point is at a character currently not visible.
   "Check if point is at a character currently not visible.
@@ -1136,17 +1156,43 @@ move it back by one char before doing this check."
       (backward-char 1))
       (backward-char 1))
     (org-invisible-p)))
     (org-invisible-p)))
 
 
-(defun org-find-visible ()
+(defun org-region-invisible-p (beg end)
+  "Check if region if completely hidden."
+  (org-with-wide-buffer
+   (and (org-invisible-p beg)
+        (org-invisible-p (org-fold-next-visibility-change beg end)))))
+
+(defun org-find-visible--overlays ()
   "Return closest visible buffer position, or `point-max'."
   "Return closest visible buffer position, or `point-max'."
   (if (org-invisible-p)
   (if (org-invisible-p)
       (next-single-char-property-change (point) 'invisible)
       (next-single-char-property-change (point) 'invisible)
     (point)))
     (point)))
+(defun org-find-visible--text-properties ()
+  "Return closest visible buffer position, or `point-max'."
+  (if (org-invisible-p)
+      (org-fold-next-visibility-change (point))
+    (point)))
+(defsubst org-find-visible ()
+  "Return closest visible buffer position, or `point-max'."
+  (if (eq org-fold-core-style 'text-properties)
+      (org-find-visible--text-properties)
+    (org-find-visible--overlays)))
 
 
-(defun org-find-invisible ()
+(defun org-find-invisible--overlays ()
   "Return closest invisible buffer position, or `point-max'."
   "Return closest invisible buffer position, or `point-max'."
   (if (org-invisible-p)
   (if (org-invisible-p)
       (point)
       (point)
     (next-single-char-property-change (point) 'invisible)))
     (next-single-char-property-change (point) 'invisible)))
+(defun org-find-invisible--text-properties ()
+  "Return closest invisible buffer position, or `point-max'."
+  (if (org-invisible-p)
+      (point)
+    (org-fold-next-visibility-change (point))))
+(defsubst org-find-invisible ()
+  "Return closest invisible buffer position, or `point-max'."
+  (if (eq org-fold-core-style 'text-properties)
+      (org-find-invisible--text-properties)
+    (org-find-invisible--overlays)))
 
 
 
 
 ;;; Time
 ;;; Time

+ 385 - 84
lisp/org.el

@@ -4912,7 +4912,7 @@ prompted for."
 (defsubst org-rear-nonsticky-at (pos)
 (defsubst org-rear-nonsticky-at (pos)
   (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
   (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
 
 
-(defun org-activate-links (limit)
+(defun org-activate-links--overlays (limit)
   "Add link properties to links.
   "Add link properties to links.
 This includes angle, plain, and bracket links."
 This includes angle, plain, and bracket links."
   (catch :exit
   (catch :exit
@@ -4927,13 +4927,13 @@ This includes angle, plain, and bracket links."
 	(when (and (memq style org-highlight-links)
 	(when (and (memq style org-highlight-links)
 		   ;; Do not span over paragraph boundaries.
 		   ;; Do not span over paragraph boundaries.
 		   (not (string-match-p org-element-paragraph-separate
 		   (not (string-match-p org-element-paragraph-separate
-					(match-string 0)))
+				      (match-string 0)))
 		   ;; Do not confuse plain links with tags.
 		   ;; Do not confuse plain links with tags.
 		   (not (and (eq style 'plain)
 		   (not (and (eq style 'plain)
-			     (let ((face (get-text-property
-					  (max (1- start) (point-min)) 'face)))
-			       (if (consp face) (memq 'org-tag face)
-				 (eq 'org-tag face))))))
+			   (let ((face (get-text-property
+					(max (1- start) (point-min)) 'face)))
+			     (if (consp face) (memq 'org-tag face)
+			       (eq 'org-tag face))))))
 	  (let* ((link-object (save-excursion
 	  (let* ((link-object (save-excursion
 				(goto-char start)
 				(goto-char start)
 				(save-match-data (org-element-link-parser))))
 				(save-match-data (org-element-link-parser))))
@@ -4983,6 +4983,99 @@ This includes angle, plain, and bracket links."
 		(funcall f start end path (eq style 'bracket))))
 		(funcall f start end path (eq style 'bracket))))
 	    (throw :exit t)))))		;signal success
 	    (throw :exit t)))))		;signal success
     nil))
     nil))
+(defun org-activate-links--text-properties (limit)
+  "Add link properties to links.
+This includes angle, plain, and bracket links."
+  (catch :exit
+    (while (re-search-forward org-link-any-re limit t)
+      (let* ((start (match-beginning 0))
+	     (end (match-end 0))
+	     (visible-start (or (match-beginning 3) (match-beginning 2)))
+	     (visible-end (or (match-end 3) (match-end 2)))
+	     (style (cond ((eq ?< (char-after start)) 'angle)
+			  ((eq ?\[ (char-after (1+ start))) 'bracket)
+			  (t 'plain))))
+	(when (and (memq style org-highlight-links)
+		   ;; Do not span over paragraph boundaries.
+		   (not (string-match-p org-element-paragraph-separate
+					(match-string 0)))
+		   ;; Do not confuse plain links with tags.
+		   (not (and (eq style 'plain)
+			     (let ((face (get-text-property
+					  (max (1- start) (point-min)) 'face)))
+			       (if (consp face) (memq 'org-tag face)
+				 (eq 'org-tag face))))))
+	  (let* ((link-object (save-excursion
+				(goto-char start)
+				(save-match-data (org-element-link-parser))))
+		 (link (org-element-property :raw-link link-object))
+		 (type (org-element-property :type link-object))
+		 (path (org-element-property :path link-object))
+                 (face-property (pcase (org-link-get-parameter type :face)
+				  ((and (pred functionp) face) (funcall face path))
+				  ((and (pred facep) face) face)
+				  ((and (pred consp) face) face) ;anonymous
+				  (_ 'org-link)))
+		 (properties		;for link's visible part
+		  (list 'mouse-face (or (org-link-get-parameter type :mouse-face)
+					'highlight)
+			'keymap (or (org-link-get-parameter type :keymap)
+				    org-mouse-map)
+			'help-echo (pcase (org-link-get-parameter type :help-echo)
+				     ((and (pred stringp) echo) echo)
+				     ((and (pred functionp) echo) echo)
+				     (_ (concat "LINK: " link)))
+			'htmlize-link (pcase (org-link-get-parameter type
+								  :htmlize-link)
+					((and (pred functionp) f) (funcall f))
+					(_ `(:uri ,link)))
+			'font-lock-multiline t)))
+	    (org-remove-flyspell-overlays-in start end)
+	    (org-rear-nonsticky-at end)
+	    (if (not (eq 'bracket style))
+		(progn
+                  (add-face-text-property start end face-property)
+		  (add-text-properties start end properties))
+              ;; Initialise folding when used ouside org-mode.
+              (unless (or (derived-mode-p 'org-mode)
+			  (and (org-fold-folding-spec-p 'org-link-description)
+                               (org-fold-folding-spec-p 'org-link)))
+                (org-fold-initialize (or (and (stringp org-ellipsis) (not (equal "" org-ellipsis)) org-ellipsis)
+                                      "...")))
+	      ;; Handle invisible parts in bracket links.
+	      (let ((spec (or (org-link-get-parameter type :display)
+			      'org-link)))
+                (unless (org-fold-folding-spec-p spec)
+                  (org-fold-add-folding-spec spec
+                                          (cdr org-link--link-folding-spec)
+                                          nil
+                                          'append)
+                  (org-fold-core-set-folding-spec-property spec :visible t))
+                (org-fold-region start end nil 'org-link)
+                (org-fold-region start end nil 'org-link-description)
+                ;; We are folding the whole emphasised text with SPEC
+                ;; first.  It makes everything invisible (or whatever
+                ;; the user wants).
+                (org-fold-region start end t spec)
+                ;; The visible part of the text is folded using
+                ;; 'org-link-description, which is forcing this part of
+                ;; the text to be visible.
+                (org-fold-region visible-start visible-end t 'org-link-description)
+		(add-text-properties start end properties)
+                (add-face-text-property start end face-property)
+		(org-rear-nonsticky-at visible-start)
+		(org-rear-nonsticky-at visible-end)))
+	    (let ((f (org-link-get-parameter type :activate-func)))
+	      (when (functionp f)
+		(funcall f start end path (eq style 'bracket))))
+	    (throw :exit t)))))		;signal success
+    nil))
+(defsubst org-activate-links (limit)
+  "Add link properties to links.
+This includes angle, plain, and bracket links."
+  (if (eq org-fold-core-style 'text-properties)
+      (org-activate-links--text-properties limit)
+    (org-activate-links--overlays limit)))
 
 
 (defun org-activate-code (limit)
 (defun org-activate-code (limit)
   (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
   (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
@@ -6740,81 +6833,82 @@ When REMOVE is non-nil, remove the subtree from the clipboard."
      (substitute-command-keys
      (substitute-command-keys
       "The kill is not a (set of) tree(s).  Use `\\[yank]' to yank anyway")))
       "The kill is not a (set of) tree(s).  Use `\\[yank]' to yank anyway")))
   (org-with-limited-levels
   (org-with-limited-levels
-   (let* ((visp (not (org-invisible-p)))
-	  (txt tree)
-	  (old-level (if (string-match org-outline-regexp-bol txt)
-			 (- (match-end 0) (match-beginning 0) 1)
-		       -1))
-	  (force-level
-	   (cond
-	    (level (prefix-numeric-value level))
-	    ;; When point is after the stars in an otherwise empty
-	    ;; headline, use the number of stars as the forced level.
-	    ((and (org-match-line "^\\*+[ \t]*$")
-		  (not (eq ?* (char-after))))
-	     (org-outline-level))
-	    ((looking-at-p org-outline-regexp-bol) (org-outline-level))))
-	  (previous-level
-	   (save-excursion
-	     (org-previous-visible-heading 1)
-	     (if (org-at-heading-p) (org-outline-level) 1)))
-	  (next-level
-	   (save-excursion
-	     (if (org-at-heading-p) (org-outline-level)
-	       (org-next-visible-heading 1)
-	       (if (org-at-heading-p) (org-outline-level) 1))))
-	  (new-level (or force-level (max previous-level next-level)))
-	  (shift (if (or (= old-level -1)
-			 (= new-level -1)
-			 (= old-level new-level))
-		     0
-		   (- new-level old-level)))
-	  (delta (if (> shift 0) -1 1))
-	  (func (if (> shift 0) #'org-demote #'org-promote))
-	  (org-odd-levels-only nil)
-	  beg end newend)
-     ;; Remove the forced level indicator.
-     (when (and force-level (not level))
-       (delete-region (line-beginning-position) (point)))
-     ;; Paste before the next visible heading or at end of buffer,
-     ;; unless point is at the beginning of a headline.
-     (unless (and (bolp) (org-at-heading-p))
-       (org-next-visible-heading 1)
-       (unless (bolp) (insert "\n")))
-     (setq beg (point))
-     ;; Avoid re-parsing cache elements when i.e. level 1 heading
-     ;; is inserted and then promoted.
-     (combine-change-calls beg beg
-       (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
-       (insert-before-markers txt)
-       (unless (string-suffix-p "\n" txt) (insert "\n"))
-       (setq newend (point))
-       (org-reinstall-markers-in-region beg)
-       (setq end (point))
-       (goto-char beg)
-       (skip-chars-forward " \t\n\r")
-       (setq beg (point))
-       (when (and (org-invisible-p) visp)
-         (save-excursion (outline-show-heading)))
-       ;; Shift if necessary.
-       (unless (= shift 0)
-         (save-restriction
-	   (narrow-to-region beg end)
-	   (while (not (= shift 0))
-	     (org-map-region func (point-min) (point-max))
-	     (setq shift (+ delta shift)))
-	   (goto-char (point-min))
-	   (setq newend (point-max)))))
-     (when (or for-yank (called-interactively-p 'interactive))
-       (message "Clipboard pasted as level %d subtree" new-level))
-     (when (and (not for-yank) ; in this case, org-yank will decide about folding
-		kill-ring
-		(equal org-subtree-clip (current-kill 0))
-		org-subtree-clip-folded)
-       ;; The tree was folded before it was killed/copied
-       (org-flag-subtree t))
-     (when for-yank (goto-char newend))
-     (when remove (pop kill-ring)))))
+   (org-fold-core-ignore-fragility-checks
+       (let* ((visp (not (org-invisible-p)))
+	      (txt tree)
+	      (old-level (if (string-match org-outline-regexp-bol txt)
+			     (- (match-end 0) (match-beginning 0) 1)
+		           -1))
+	      (force-level
+	       (cond
+	        (level (prefix-numeric-value level))
+	        ;; When point is after the stars in an otherwise empty
+	        ;; headline, use the number of stars as the forced level.
+	        ((and (org-match-line "^\\*+[ \t]*$")
+		      (not (eq ?* (char-after))))
+	         (org-outline-level))
+	        ((looking-at-p org-outline-regexp-bol) (org-outline-level))))
+	      (previous-level
+	       (save-excursion
+	         (org-previous-visible-heading 1)
+	         (if (org-at-heading-p) (org-outline-level) 1)))
+	      (next-level
+	       (save-excursion
+	         (if (org-at-heading-p) (org-outline-level)
+	           (org-next-visible-heading 1)
+	           (if (org-at-heading-p) (org-outline-level) 1))))
+	      (new-level (or force-level (max previous-level next-level)))
+	      (shift (if (or (= old-level -1)
+			     (= new-level -1)
+			     (= old-level new-level))
+		         0
+		       (- new-level old-level)))
+	      (delta (if (> shift 0) -1 1))
+	      (func (if (> shift 0) #'org-demote #'org-promote))
+	      (org-odd-levels-only nil)
+	      beg end newend)
+         ;; Remove the forced level indicator.
+         (when (and force-level (not level))
+           (delete-region (line-beginning-position) (point)))
+         ;; Paste before the next visible heading or at end of buffer,
+         ;; unless point is at the beginning of a headline.
+         (unless (and (bolp) (org-at-heading-p))
+           (org-next-visible-heading 1)
+           (unless (bolp) (insert "\n")))
+         (setq beg (point))
+         ;; Avoid re-parsing cache elements when i.e. level 1 heading
+         ;; is inserted and then promoted.
+         (combine-change-calls beg beg
+           (when (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
+           (insert-before-markers txt)
+           (unless (string-suffix-p "\n" txt) (insert "\n"))
+           (setq newend (point))
+           (org-reinstall-markers-in-region beg)
+           (setq end (point))
+           (goto-char beg)
+           (skip-chars-forward " \t\n\r")
+           (setq beg (point))
+           (when (and (org-invisible-p) visp)
+             (save-excursion (org-fold-heading nil)))
+           ;; Shift if necessary.
+           (unless (= shift 0)
+             (save-restriction
+	       (narrow-to-region beg end)
+	       (while (not (= shift 0))
+	         (org-map-region func (point-min) (point-max))
+	         (setq shift (+ delta shift)))
+	       (goto-char (point-min))
+	       (setq newend (point-max)))))
+         (when (or for-yank (called-interactively-p 'interactive))
+           (message "Clipboard pasted as level %d subtree" new-level))
+         (when (and (not for-yank) ; in this case, org-yank will decide about folding
+		    kill-ring
+		    (equal org-subtree-clip (current-kill 0))
+		    org-subtree-clip-folded)
+           ;; The tree was folded before it was killed/copied
+           (org-fold-subtree t))
+         (when for-yank (goto-char newend))
+         (when remove (pop kill-ring))))))
 
 
 (defun org-kill-is-subtree-p (&optional txt)
 (defun org-kill-is-subtree-p (&optional txt)
   "Check if the current kill is an outline subtree, or a set of trees.
   "Check if the current kill is an outline subtree, or a set of trees.
@@ -20014,7 +20108,7 @@ Stop at the first and last subheadings of a superior heading."
   (interactive "p")
   (interactive "p")
   (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
   (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
 
 
-(defun org-next-visible-heading (arg)
+(defun org-next-visible-heading--overlays (arg)
   "Move to the next visible heading line.
   "Move to the next visible heading line.
 With ARG, repeats or can move backward if negative."
 With ARG, repeats or can move backward if negative."
   (interactive "p")
   (interactive "p")
@@ -20040,6 +20134,35 @@ With ARG, repeats or can move backward if negative."
 		nil)))			;leave the loop
 		nil)))			;leave the loop
       (cl-decf arg))
       (cl-decf arg))
     (if (> arg 0) (goto-char (point-max)) (beginning-of-line))))
     (if (> arg 0) (goto-char (point-max)) (beginning-of-line))))
+(defun org-next-visible-heading--text-properties (arg)
+  "Move to the next visible heading line.
+With ARG, repeats or can move backward if negative."
+  (interactive "p")
+  (let ((regexp (concat "^" (org-get-limited-outline-regexp))))
+    (if (< arg 0)
+	(beginning-of-line)
+      (end-of-line))
+    (while (and (< arg 0) (re-search-backward regexp nil :move))
+      (unless (bobp)
+	(when (org-fold-folded-p)
+	  (goto-char (org-fold-previous-visibility-change))
+          (unless (looking-at-p regexp)
+            (re-search-backward regexp nil :mode))))
+      (cl-incf arg))
+    (while (and (> arg 0) (re-search-forward regexp nil :move))
+      (when (org-fold-folded-p)
+	(goto-char (org-fold-next-visibility-change))
+        (skip-chars-forward " \t\n")
+	(end-of-line))
+      (cl-decf arg))
+    (if (> arg 0) (goto-char (point-max)) (beginning-of-line))))
+(defun org-next-visible-heading (arg)
+  "Move to the next visible heading line.
+With ARG, repeats or can move backward if negative."
+  (interactive "p")
+  (if (eq org-fold-core-style 'text-properties)
+      (org-next-visible-heading--text-properties arg)
+    (org-next-visible-heading--overlays arg)))
 
 
 (defun org-previous-visible-heading (arg)
 (defun org-previous-visible-heading (arg)
   "Move to the previous visible heading.
   "Move to the previous visible heading.
@@ -20172,7 +20295,7 @@ Function may return a real element, or a pseudo-element with type
 	(list :begin b :end e :parent p :post-blank 0 :post-affiliated b)))
 	(list :begin b :end e :parent p :post-blank 0 :post-affiliated b)))
       (_ e))))
       (_ e))))
 
 
-(defun org--forward-paragraph-once ()
+(defun org--forward-paragraph-once--overlays ()
   "Move forward to end of paragraph or equivalent, once.
   "Move forward to end of paragraph or equivalent, once.
 See `org-forward-paragraph'."
 See `org-forward-paragraph'."
   (interactive)
   (interactive)
@@ -20244,8 +20367,84 @@ See `org-forward-paragraph'."
 	  (goto-char end)
 	  (goto-char end)
 	  (skip-chars-backward " \t\n")
 	  (skip-chars-backward " \t\n")
 	  (forward-line))))))))
 	  (forward-line))))))))
+(defun org--forward-paragraph-once--text-properties ()
+  "Move forward to end of paragraph or equivalent, once.
+See `org-forward-paragraph'."
+  (interactive)
+  (save-restriction
+    (widen)
+    (skip-chars-forward " \t\n")
+    (cond
+     ((eobp) nil)
+     ;; When inside a folded part, move out of it.
+     ((when (org-invisible-p nil t)
+        (goto-char (cdr (org-fold-get-region-at-point)))
+        (forward-line)
+        t))
+     (t
+      (let* ((element (org--paragraph-at-point))
+	     (type (org-element-type element))
+	     (contents-begin (org-element-property :contents-begin element))
+	     (end (org-element-property :end element))
+	     (post-affiliated (org-element-property :post-affiliated element)))
+	(cond
+	 ((eq type 'plain-list)
+	  (forward-char)
+	  (org--forward-paragraph-once))
+	 ;; If the element is folded, skip it altogether.
+         ((when (org-with-point-at post-affiliated (org-invisible-p (line-end-position) t))
+            (goto-char (cdr (org-fold-get-region-at-point
+			     nil
+			     (org-with-point-at post-affiliated
+			       (line-end-position)))))
+	    (forward-line)
+	    t))
+	 ;; At a greater element, move inside.
+	 ((and contents-begin
+	       (> contents-begin (point))
+	       (not (eq type 'paragraph)))
+	  (goto-char contents-begin)
+	  ;; Items and footnote definitions contents may not start at
+	  ;; the beginning of the line.  In this case, skip until the
+	  ;; next paragraph.
+	  (cond
+	   ((not (bolp)) (org--forward-paragraph-once))
+	   ((org-previous-line-empty-p) (forward-line -1))
+	   (t nil)))
+	 ;; Move between empty lines in some blocks.
+	 ((memq type '(comment-block example-block export-block src-block
+				     verse-block))
+	  (let ((contents-start
+		 (org-with-point-at post-affiliated
+		   (line-beginning-position 2))))
+	    (if (< (point) contents-start)
+		(goto-char contents-start)
+	      (let ((contents-end
+		     (org-with-point-at end
+		       (skip-chars-backward " \t\n")
+		       (line-beginning-position))))
+		(cond
+		 ((>= (point) contents-end)
+		  (goto-char end)
+		  (skip-chars-backward " \t\n")
+		  (forward-line))
+		 ((re-search-forward "^[ \t]*\n" contents-end :move)
+		  (forward-line -1))
+		 (t nil))))))
+	 (t
+	  ;; Move to element's end.
+	  (goto-char end)
+	  (skip-chars-backward " \t\n")
+	  (forward-line))))))))
+(defun org--forward-paragraph-once ()
+  "Move forward to end of paragraph or equivalent, once.
+See `org-forward-paragraph'."
+  (interactive)
+  (if (eq org-fold-core-style 'text-properties)
+      (org--forward-paragraph-once--text-properties)
+    (org--forward-paragraph-once--overlays)))
 
 
-(defun org--backward-paragraph-once ()
+(defun org--backward-paragraph-once--overlays ()
   "Move backward to start of paragraph or equivalent, once.
   "Move backward to start of paragraph or equivalent, once.
 See `org-backward-paragraph'."
 See `org-backward-paragraph'."
   (interactive)
   (interactive)
@@ -20347,6 +20546,108 @@ See `org-backward-paragraph'."
 	 ;; Move to element's start.
 	 ;; Move to element's start.
 	 (t
 	 (t
 	  (funcall reach begin))))))))
 	  (funcall reach begin))))))))
+(defun org--backward-paragraph-once--text-properties ()
+  "Move backward to start of paragraph or equivalent, once.
+See `org-backward-paragraph'."
+  (interactive)
+  (save-restriction
+    (widen)
+    (cond
+     ((bobp) nil)
+     ;; Blank lines at the beginning of the buffer.
+     ((and (org-match-line "^[ \t]*$")
+	   (save-excursion (skip-chars-backward " \t\n") (bobp)))
+      (goto-char (point-min)))
+     ;; When inside a folded part, move out of it.
+     ((when (org-invisible-p (1- (point)) t)
+        (goto-char (1- (car (org-fold-get-region-at-point nil (1- (point))))))
+	(org--backward-paragraph-once)
+	t))
+     (t
+      (let* ((element (org--paragraph-at-point))
+	     (type (org-element-type element))
+	     (begin (org-element-property :begin element))
+	     (post-affiliated (org-element-property :post-affiliated element))
+	     (contents-end (org-element-property :contents-end element))
+	     (end (org-element-property :end element))
+	     (parent (org-element-property :parent element))
+	     (reach
+	      ;; Move to the visible empty line above position P, or
+	      ;; to position P.  Return t.
+	      (lambda (p)
+		(goto-char p)
+		(when (and (org-previous-line-empty-p)
+			   (let ((end (line-end-position 0)))
+			     (or (= end (point-min))
+				 (not (org-invisible-p (1- end))))))
+		  (forward-line -1))
+		t)))
+	(cond
+	 ;; Already at the beginning of an element.
+	 ((= begin (point))
+	  (cond
+	   ;; There is a blank line above.  Move there.
+	   ((and (org-previous-line-empty-p)
+		 (not (org-invisible-p (1- (line-end-position 0)))))
+	    (forward-line -1))
+	   ;; At the beginning of the first element within a greater
+	   ;; element.  Move to the beginning of the greater element.
+	   ((and parent
+                 (not (eq 'section (org-element-type parent)))
+                 (= begin (org-element-property :contents-begin parent)))
+	    (funcall reach (org-element-property :begin parent)))
+	   ;; Since we have to move anyway, find the beginning
+	   ;; position of the element above.
+	   (t
+	    (forward-char -1)
+	    (org--backward-paragraph-once))))
+	 ;; Skip paragraphs at the very beginning of footnote
+	 ;; definitions or items.
+	 ((and (eq type 'paragraph)
+	       (org-with-point-at begin (not (bolp))))
+	  (funcall reach (progn (goto-char begin) (line-beginning-position))))
+	 ;; If the element is folded, skip it altogether.
+	 ((org-with-point-at post-affiliated (org-invisible-p (line-end-position) t))
+	  (funcall reach begin))
+	 ;; At the end of a greater element, move inside.
+	 ((and contents-end
+	       (<= contents-end (point))
+	       (not (eq type 'paragraph)))
+	  (cond
+	   ((memq type '(footnote-definition plain-list))
+	    (skip-chars-backward " \t\n")
+	    (org--backward-paragraph-once))
+	   ((= contents-end (point))
+	    (forward-char -1)
+	    (org--backward-paragraph-once))
+	   (t
+	    (goto-char contents-end))))
+	 ;; Move between empty lines in some blocks.
+	 ((and (memq type '(comment-block example-block export-block src-block
+					  verse-block))
+	       (let ((contents-start
+		      (org-with-point-at post-affiliated
+			(line-beginning-position 2))))
+		 (when (> (point) contents-start)
+		   (let ((contents-end
+			  (org-with-point-at end
+			    (skip-chars-backward " \t\n")
+			    (line-beginning-position))))
+		     (if (> (point) contents-end)
+			 (progn (goto-char contents-end) t)
+		       (skip-chars-backward " \t\n" begin)
+		       (re-search-backward "^[ \t]*\n" contents-start :move)
+		       t))))))
+	 ;; Move to element's start.
+	 (t
+	  (funcall reach begin))))))))
+(defun org--backward-paragraph-once ()
+  "Move backward to start of paragraph or equivalent, once.
+See `org-backward-paragraph'."
+  (interactive)
+  (if (eq org-fold-core-style 'text-properties)
+      (org--backward-paragraph-once--text-properties)
+    (org--backward-paragraph-once--overlays)))
 
 
 (defun org-forward-element ()
 (defun org-forward-element ()
   "Move forward by one element.
   "Move forward by one element.