summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2011-07-21 13:45:01 +0200
committerNicolas Goaziou <n.goaziou@gmail.com>2011-07-21 13:47:55 +0200
commit5b39df0523c8aa2e7166d917b419dc141c027564 (patch)
treec00bd801d905ad52caafed266d6456478de11c6e
parent71f654a18254233d5ff67eb0b84529713ce16f03 (diff)
downloadorg-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.el214
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)