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

lisp/org-element.el

@@ -7913,7 +7913,7 @@ parse tree."
     (or (and (>= beg-A beg-B) (<= end-A end-B))
 	(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.
 Assume ELEM-B is after ELEM-A in the buffer.  Leave point at the
 end of ELEM-A."
@@ -7981,6 +7981,58 @@ end of ELEM-A."
 	(dolist (o (cdr overlays))
 	  (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
       (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)

lisp/org-fold.el

@@ -53,10 +53,7 @@
 (defvar org-property-end-re)
 (defvar org-link-descriptive)
 (defvar org-outline-regexp-bol)
-(defvar org-custom-properties-hidden-p)
 (defvar org-archive-tag)
-
-;; Needed for overlays only
 (defvar org-custom-properties-overlays)
 
 (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 (eq org-fold-catch-invisible-edits 'error)
 	  (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? "))
 	    (org-toggle-custom-properties-visibility)
 	  ;; Make the area visible

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)
 			   '(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."
   (let ((end (save-excursion
 	       (org-inlinetask-goto-end)
@@ -318,8 +333,13 @@ If the task has an end part, also demote it."
      ((= end start))
      ;; Inlinetask was folded: expand it.
      ((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)
   "Hide inline tasks in buffer when STATE is `contents' or `children'.

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)
 	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.
 
 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))))
       ;; Return structure.
       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)
   "Return number of blank lines that should separate items in list.

lisp/org-macs.el

@@ -1109,7 +1109,18 @@ the value in cadr."
       (get-text-property (or (next-single-property-change 0 prop s) 0)
 			 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.
 If POS is nil, use `point' instead.  When optional argument
 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)))
     (cond ((not value) nil)
 	  (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 ()
   "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))
     (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'."
   (if (org-invisible-p)
       (next-single-char-property-change (point) 'invisible)
     (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'."
   (if (org-invisible-p)
       (point)
     (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

lisp/org.el

@@ -4912,7 +4912,7 @@ prompted for."
 (defsubst org-rear-nonsticky-at (pos)
   (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.
 This includes angle, plain, and bracket links."
   (catch :exit
@@ -4927,13 +4927,13 @@ This includes angle, plain, and bracket links."
 	(when (and (memq style org-highlight-links)
 		   ;; Do not span over paragraph boundaries.
 		   (not (string-match-p org-element-paragraph-separate
-					(match-string 0)))
+				      (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 ((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))))
@@ -4983,6 +4983,99 @@ This includes angle, plain, and bracket links."
 		(funcall f start end path (eq style 'bracket))))
 	    (throw :exit t)))))		;signal success
     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)
   (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
       "The kill is not a (set of) tree(s).  Use `\\[yank]' to yank anyway")))
   (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)
   "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")
   (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.
 With ARG, repeats or can move backward if negative."
   (interactive "p")
@@ -20040,6 +20134,35 @@ With ARG, repeats or can move backward if negative."
 		nil)))			;leave the loop
       (cl-decf arg))
     (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)
   "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)))
       (_ e))))
 
-(defun org--forward-paragraph-once ()
+(defun org--forward-paragraph-once--overlays ()
   "Move forward to end of paragraph or equivalent, once.
 See `org-forward-paragraph'."
   (interactive)
@@ -20244,8 +20367,84 @@ See `org-forward-paragraph'."
 	  (goto-char end)
 	  (skip-chars-backward " \t\n")
 	  (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.
 See `org-backward-paragraph'."
   (interactive)
@@ -20347,6 +20546,108 @@ See `org-backward-paragraph'."
 	 ;; Move to element's start.
 	 (t
 	  (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 ()
   "Move forward by one element.