diff options
author | Nicolas Goaziou <n.goaziou@gmail.com> | 2011-07-21 13:45:01 +0200 |
---|---|---|
committer | Nicolas Goaziou <n.goaziou@gmail.com> | 2011-07-21 13:47:55 +0200 |
commit | 5b39df0523c8aa2e7166d917b419dc141c027564 (patch) | |
tree | c00bd801d905ad52caafed266d6456478de11c6e | |
parent | 71f654a18254233d5ff67eb0b84529713ce16f03 (diff) | |
download | org-mode-5b39df0523c8aa2e7166d917b419dc141c027564.tar.gz |
Remove inline tasks from subtrees yanking
* lisp/org.el (org-paste-subtree, org-kill-is-subtree-p,
org-yank-folding-would-swallow-text, org-yank-generic): use
`org-with-limited-levels' macro.
-rw-r--r-- | lisp/org.el | 214 |
1 files changed, 107 insertions, 107 deletions
diff --git a/lisp/org.el b/lisp/org.el index 1af3a25..ac60e4e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7517,88 +7517,86 @@ the inserted text when done." (error "%s" (substitute-command-keys "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) - (let* ((visp (not (outline-invisible-p))) - (txt tree) - (^re (concat "^\\(" org-outline-regexp "\\)")) - (re (concat "\\(" org-outline-regexp "\\)")) - (^re_ (concat "\\(\\*+\\)[ \t]*")) - - (old-level (if (string-match ^re txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level (cond (level (prefix-numeric-value level)) - ((and (looking-at "[ \t]*$") - (string-match - ^re_ (buffer-substring - (point-at-bol) (point)))) - (- (match-end 1) (match-beginning 1))) - ((and (bolp) - (looking-at org-outline-regexp)) - (- (match-end 0) (point) 1)) - (t nil))) - (previous-level (save-excursion - (condition-case nil - (progn - (outline-previous-visible-heading 1) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (next-level (save-excursion - (condition-case nil - (progn - (or (looking-at org-outline-regexp) - (outline-next-visible-heading 1)) - (if (looking-at re) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 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 - (if force-level - (delete-region (point-at-bol) (point))) - ;; Paste - (beginning-of-line 1) - (unless for-yank (org-back-over-empty-lines)) - (setq beg (point)) - (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) - (insert-before-markers txt) - (unless (string-match "\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)) - (if (and (outline-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 (org-called-interactively-p 'interactive) for-yank) - (message "Clipboard pasted as level %d subtree" new-level)) - (if (and (not for-yank) ; in this case, org-yank will decide about folding - kill-ring - (eq org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (hide-subtree)) - (and for-yank (goto-char newend)))) + (org-with-limited-levels + (let* ((visp (not (outline-invisible-p))) + (txt tree) + (^re_ (concat "\\(\\*+\\)[ \t]*")) + (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)) + ((and (looking-at "[ \t]*$") + (string-match + ^re_ (buffer-substring + (point-at-bol) (point)))) + (- (match-end 1) (match-beginning 1))) + ((and (bolp) + (looking-at org-outline-regexp)) + (- (match-end 0) (point) 1)) + (t nil))) + (previous-level (save-excursion + (condition-case nil + (progn + (outline-previous-visible-heading 1) + (if (looking-at re) + (- (match-end 0) (match-beginning 0) 1) + 1)) + (error 1)))) + (next-level (save-excursion + (condition-case nil + (progn + (or (looking-at org-outline-regexp) + (outline-next-visible-heading 1)) + (if (looking-at re) + (- (match-end 0) (match-beginning 0) 1) + 1)) + (error 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 + (if force-level + (delete-region (point-at-bol) (point))) + ;; Paste + (beginning-of-line 1) + (unless for-yank (org-back-over-empty-lines)) + (setq beg (point)) + (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) + (insert-before-markers txt) + (unless (string-match "\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)) + (if (and (outline-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 (org-called-interactively-p 'interactive) for-yank) + (message "Clipboard pasted as level %d subtree" new-level)) + (if (and (not for-yank) ; in this case, org-yank will decide about folding + kill-ring + (eq org-subtree-clip (current-kill 0)) + org-subtree-clip-folded) + ;; The tree was folded before it was killed/copied + (hide-subtree)) + (and for-yank (goto-char newend))))) (defun org-kill-is-subtree-p (&optional txt) "Check if the current kill is an outline subtree, or a set of trees. @@ -7608,12 +7606,12 @@ So this will actually accept several entries of equal levels as well, which is OK for `org-paste-subtree'. If optional TXT is given, check this string instead of the current kill." (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) + (re (org-get-limited-outline-regexp)) (start-level (and kill - (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" - org-outline-regexp "\\)") - kill) + (string-match + (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)") + kill) (- (match-end 2) (match-beginning 2) 1))) - (re org-outline-regexp-bol) (start (1+ (or (match-beginning 2) -1)))) (if (not start-level) (progn @@ -19840,17 +19838,18 @@ interactive command with similar behavior." (when (and (bolp) subtreep (not (setq swallowp (org-yank-folding-would-swallow-text beg end)))) - (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp-bol end t)) - (while (and (< (point) end) (looking-at org-outline-regexp)) - (hide-subtree) - (org-cycle-show-empty-lines 'folded) - (condition-case nil - (outline-forward-same-level 1) - (error (goto-char end))))) + (org-with-limited-levels + (or (looking-at org-outline-regexp) + (re-search-forward org-outline-regexp-bol end t)) + (while (and (< (point) end) (looking-at org-outline-regexp)) + (hide-subtree) + (org-cycle-show-empty-lines 'folded) + (condition-case nil + (outline-forward-same-level 1) + (error (goto-char end)))))) (when swallowp (message - "Inserted text not folded because that would swallow text")) + "Inserted text not folded because that would swallow text")) (goto-char end) (skip-chars-forward " \t\n\r") @@ -19866,18 +19865,19 @@ interactive command with similar behavior." (defun org-yank-folding-would-swallow-text (beg end) "Would hide-subtree at BEG swallow any text after END?" (let (level) - (save-excursion - (goto-char beg) - (when (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp-bol end t)) - (setq level (org-outline-level))) - (goto-char end) - (skip-chars-forward " \t\r\n\v\f") - (if (or (eobp) - (and (bolp) (looking-at org-outline-regexp) - (<= (org-outline-level) level))) - nil ; Nothing would be swallowed - t)))) ; something would swallow + (org-with-limited-levels + (save-excursion + (goto-char beg) + (when (or (looking-at org-outline-regexp) + (re-search-forward org-outline-regexp-bol end t)) + (setq level (org-outline-level))) + (goto-char end) + (skip-chars-forward " \t\r\n\v\f") + (if (or (eobp) + (and (bolp) (looking-at org-outline-regexp) + (<= (org-outline-level) level))) + nil ; Nothing would be swallowed + t))))) ; something would swallow (define-key org-mode-map "\C-y" 'org-yank) |