diff --git a/lisp/org-element.el b/lisp/org-element.el index 99999fb32..bf9f3b69d 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -7905,7 +7905,7 @@ (defun org-element-nested-p (elem-A elem-B) (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." @@ -7973,6 +7973,58 @@ (defun org-element-swap-A-B (elem-A elem-B) (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) diff --git a/lisp/org-fold.el b/lisp/org-fold.el index 52717fd86..e48a528bf 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -53,10 +53,7 @@ (defvar org-drawer-regexp) (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 @@ (defun org-fold-check-before-invisible-edit--text-properties (kind) (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 diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index 581370bb5..a63704a05 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -305,7 +305,22 @@ (defun org-inlinetask-fontify (limit) (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 @@ (defun org-inlinetask-toggle-visibility () ((= 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'. diff --git a/lisp/org-list.el b/lisp/org-list.el index 187e9a9ff..3e76eb6b2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1079,7 +1079,65 @@ (defsubst org-list-bullet-string (bullet) (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 @@ (defun org-list-swap-items (beg-A beg-B 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. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 2968e2ba5..8f2133dd0 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -1103,7 +1103,18 @@ (defun org-find-text-property-in-string (prop s) (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 @@ -1112,7 +1123,16 @@ (defun org-invisible-p (&optional pos folding-only) (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-truely-invisible-p () "Check if point is at a character currently not visible. @@ -1130,17 +1150,43 @@ (defun org-invisible-p2 () (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 diff --git a/lisp/org.el b/lisp/org.el index 5465ed3ea..0967cbf1c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4911,7 +4911,7 @@ (defconst org-nonsticky-props (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 @@ -4926,13 +4926,13 @@ (defun org-activate-links (limit) (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)))) @@ -4982,6 +4982,99 @@ (defun org-activate-links (limit) (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) @@ -6739,81 +6832,82 @@ (defun org-paste-subtree (&optional level tree for-yank remove) (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. @@ -19996,7 +20090,7 @@ (defun org-backward-heading-same-level (arg &optional invisible-ok) (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") @@ -20022,6 +20116,35 @@ (defun org-next-visible-heading (arg) 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. @@ -20154,7 +20277,7 @@ (defun org--paragraph-at-point () (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) @@ -20226,8 +20349,84 @@ (defun org--forward-paragraph-once () (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) @@ -20329,6 +20528,108 @@ (defun org--backward-paragraph-once () ;; 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.