Remove inline tasks from subtrees yanking
authorNicolas Goaziou <n.goaziou@gmail.com>
Thu, 21 Jul 2011 11:45:01 +0000 (13:45 +0200)
committerNicolas Goaziou <n.goaziou@gmail.com>
Thu, 21 Jul 2011 11:47:55 +0000 (13:47 +0200)
* 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.

lisp/org.el

index 1af3a25..ac60e4e 100644 (file)
@@ -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)