Fine-tuning the behavior of `org-yank'.

Org-mode's `org-yank' command is used as a replacement for the normal
`yank' command.  It differs by giving special treatment to subtrees or
sets of subtrees when yanking them, by adjusting the level to fit the
outline, and by folding the trees after the yank.

This patch does fine-tune this behavior.

First of all, if any prefix argument is given to the command, it
immediately hands over the action to the standard `yank' command.  In
particular, you can use `C-u C-y' to yank as-is, with the only minor
side effect that the cursor will end up at the beginning of the yanked
text.

Secondly, the folding of the yanked trees will only happen if there is
no text directly after the insertion point that would be swallowed by
the folding process.  This was confusing in the past and is much
better now, with a message announcing that folding has been
suppressed.

3 files changed, 79 insertions, 36 deletions

diff --git a/doc/org.texi b/doc/org.texi
index bad7736..6189ba5 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -949,7 +949,11 @@ headline marker like @samp{****}.
 Depending on the variables @code{org-yank-adjusted-subtrees} and
 @code{org-yank-folded-subtrees}, Org's internal @code{yank} command will
 paste subtrees folded and in a clever way, using the same command as @kbd{C-c
-C-x C-y}.
+C-x C-y}.  With the default settings, level adjustment will take place and
+yanked trees will be folded unless doing so would swallow text previously
+visible.  Any prefix argument to this command will force a normal @code{yank}
+to be executed, with the prefix passed along.  A good way to force a normal
+yank is @kbd{C-u C-y}.
 @kindex C-c C-w
 @item C-c C-w
 Refile entry or region to a different location.  @xref{Refiling notes}.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 406cdb9..73b6aed 100755
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
 2008-11-11  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org.el (org-yank): Make any prefix force normal yanking.
+	Suppress folding if text would be swallowed into a folded
+	subtree.
+	(org-yank-folded-subtrees, org-yank): Docstring updates.
+
 	* org-agenda.el (org-agenda-compare-effort): Treat no effort
 	defined as 0.
 
diff --git a/lisp/org.el b/lisp/org.el
index fe9c891..8c3373c 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -637,7 +637,8 @@ When t, the following will happen while the cursor is in the headline:
   "Non-nil means, when yanking subtrees, fold them.
 If the kill is a single subtree, or a sequence of subtrees, i.e. if
 it starts with a heading and all other headings in it are either children
-or siblings, then fold all the subtrees."
+or siblings, then fold all the subtrees.  However, do this only if no
+text after the yank would be swallowed into a folded tree by this action."
   :group 'org-edit-structure
   :type 'boolean)
 
@@ -13985,7 +13986,7 @@ beyond the end of the headline."
 
 (define-key org-mode-map "\C-k" 'org-kill-line)
 
-(defun org-yank ()
+(defun org-yank (&optional arg)
   "Yank.  If the kill is a subtree, treat it specially.
 This command will look at the current kill and check if is a single
 subtree, or a series of subtrees[1].  If it passes the test, and if the
@@ -13994,46 +13995,79 @@ empty headline, then the yank is handeled specially.  How exactly depends
 on the value of the following variables, both set by default.
 
 org-yank-folded-subtrees
-    When set, the subree(s) wiil be folded after insertion.
+    When set, the subree(s) will be folded after insertion, but only
+    if doing so would now swallow text after the yanked text.
 
 org-yank-adjusted-subtrees
     When set, the subtree will be promoted or demoted in order to
-    fit into the local outline tree structure.
+    fit into the local outline tree structure, which means that the level
+    will be adjusted so that it becomes the smaller of the two *visible*
+    surrounding headings.
+
+Any prefix to this command will cause `yank' to be caalled directly with
+no special treatment.  In particular, a simple `C-u' prefix will just
+plainly yank the text as it is.
 
 \[1] Basically, the test checks if the first non-white line is a heading
     and if there are no other headings with fewer stars."
-  (interactive)
-  (let ((subtreep ; is kill a subtree, and the yank position appropriate?
-	 (and (org-kill-is-subtree-p)
-	      (or (bolp)
-		  (and (looking-at "[ \t]*$")
-		       (string-match 
-			"\\`\\*+\\'"
-			(buffer-substring (point-at-bol) (point))))))))
-    (cond
-     ((and subtreep org-yank-folded-subtrees)
-      (let ((beg (point))
-	    end)
-	(if (and subtreep org-yank-adjusted-subtrees)
-	    (org-paste-subtree nil nil 'for-yank)
-	  (call-interactively 'yank))
-	(setq end (point))
-	(goto-char beg)
-	(when (and (bolp) subtreep)
-	  (or (looking-at outline-regexp)
-	      (re-search-forward (concat "^" outline-regexp) end t))
-	  (while (and (< (point) end) (looking-at outline-regexp))
-	    (hide-subtree)
-	    (org-cycle-show-empty-lines 'folded)
-	    (condition-case nil
-		(outline-forward-same-level 1)
-	      (error (goto-char end)))))
-	(goto-char end)
-	(skip-chars-forward " \t\n\r")))
-     ((and subtreep org-yank-adjusted-subtrees)
-      (org-paste-subtree nil nil 'for-yank))
-     (t	(call-interactively 'yank)))))
+  (interactive "P")
+  (if arg
+      (call-interactively 'yank)
+    (let ((subtreep ; is kill a subtree, and the yank position appropriate?
+	   (and (org-kill-is-subtree-p)
+		(or (bolp)
+		    (and (looking-at "[ \t]*$")
+			 (string-match 
+			  "\\`\\*+\\'"
+			  (buffer-substring (point-at-bol) (point)))))))
+	  swallowp)
+      (cond
+       ((and subtreep org-yank-folded-subtrees)
+	(let ((beg (point))
+	      end)
+	  (if (and subtreep org-yank-adjusted-subtrees)
+	      (org-paste-subtree nil nil 'for-yank)
+	    (call-interactively 'yank))
+	  (setq end (point))
+	  (goto-char beg)
+	  (when (and (bolp) subtreep
+		     (not (setq swallowp
+				(org-yank-folding-would-swallow-text beg end))))
+	    (or (looking-at outline-regexp)
+		(re-search-forward (concat "^" outline-regexp) end t))
+	    (while (and (< (point) end) (looking-at 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
+	     "Yanked text not folded because that would swallow text"))
+	  (goto-char end)
+	  (skip-chars-forward " \t\n\r")
+	  (beginning-of-line 1)))
+       ((and subtreep org-yank-adjusted-subtrees)
+	(org-paste-subtree nil nil 'for-yank))
+       (t
+	(call-interactively 'yank))))))
   
+(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 outline-regexp)
+		(re-search-forward (concat "^" outline-regexp) 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)
 
 (defun org-invisible-p ()