Browse Source

Make `yank-pop' work after an adjusting tree yank.

Org's `org-yank' now identifies itself as being `yank' by setting
`this-command', and by making sure that the mark is set correctly.  In
this way, `yank-pop' will work correctly after using `C-y' in an
Org-mode buffer.  Org-mode does not have its own implementation, to
`yank-pop' will insert content plainly, without adjusting tree levels,
and without folding.

Samuel Wales pointed out that `yank-pop' doe not work anymore.
Carsten Dominik 16 years ago
parent
commit
f9f3c27b13
3 changed files with 35 additions and 25 deletions
  1. 2 1
      doc/org.texi
  2. 5 0
      lisp/ChangeLog
  3. 28 24
      lisp/org.el

+ 2 - 1
doc/org.texi

@@ -953,7 +953,8 @@ 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
 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}
 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
 to be executed, with the prefix passed along.  A good way to force a normal
-yank is @kbd{C-u C-y}.
+yank is @kbd{C-u C-y}.  If you use @code{yank-pop} after a yank, it will yank
+previous kill items plainly, without adjustment and folding.
 @kindex C-c C-w
 @kindex C-c C-w
 @item C-c C-w
 @item C-c C-w
 Refile entry or region to a different location.  @xref{Refiling notes}.
 Refile entry or region to a different location.  @xref{Refiling notes}.

+ 5 - 0
lisp/ChangeLog

@@ -1,3 +1,8 @@
+2008-11-14  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org.el (org-yank): Set `this-command' to `yank', so that
+	`yank-pop' will work.
+
 2008-11-13  Carsten Dominik  <carsten.dominik@gmail.com>
 2008-11-13  Carsten Dominik  <carsten.dominik@gmail.com>
 
 
 	* org-exp.el (org-icalendar-cleanup-string): Improve RFC2455
 	* org-exp.el (org-icalendar-cleanup-string): Improve RFC2455

+ 28 - 24
lisp/org.el

@@ -1701,7 +1701,7 @@ end of the second format."
 org-mode generates a time duration."
 org-mode generates a time duration."
   :group 'org-time
   :group 'org-time
   :type 'string)
   :type 'string)
-  
+
 (defcustom org-deadline-warning-days 14
 (defcustom org-deadline-warning-days 14
   "No. of days before expiration during which a deadline becomes active.
   "No. of days before expiration during which a deadline becomes active.
 This variable governs the display in sparse trees and in the agenda.
 This variable governs the display in sparse trees and in the agenda.
@@ -2567,7 +2567,7 @@ Otherwise, return nil."
 		     (<= org-clock-marker (point-at-eol)))
 		     (<= org-clock-marker (point-at-eol)))
 	    ;; The clock is running here
 	    ;; The clock is running here
 	    (setq org-clock-start-time
 	    (setq org-clock-start-time
-		  (apply 'encode-time 
+		  (apply 'encode-time
 			 (org-parse-time-string (match-string 1))))
 			 (org-parse-time-string (match-string 1))))
 	    (org-update-mode-line)))
 	    (org-update-mode-line)))
 	 (t
 	 (t
@@ -2740,8 +2740,8 @@ collapsed state."
 ;; Autoload ID code
 ;; Autoload ID code
 
 
 (org-autoload "org-id"
 (org-autoload "org-id"
- '(org-id-get-create org-id-new org-id-copy org-id-get 
-   org-id-get-with-outline-path-completion 
+ '(org-id-get-create org-id-new org-id-copy org-id-get
+   org-id-get-with-outline-path-completion
    org-id-get-with-outline-drilling
    org-id-get-with-outline-drilling
    org-id-goto org-id-find))
    org-id-goto org-id-find))
 
 
@@ -5096,7 +5096,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
 (defun org-paste-subtree (&optional level tree for-yank)
 (defun org-paste-subtree (&optional level tree for-yank)
   "Paste the clipboard as a subtree, with modification of headline level.
   "Paste the clipboard as a subtree, with modification of headline level.
 The entire subtree is promoted or demoted in order to match a new headline
 The entire subtree is promoted or demoted in order to match a new headline
-level.  
+level.
 
 
 If the cursor is at the beginning of a headline, the same level as
 If the cursor is at the beginning of a headline, the same level as
 that headline is used to paste the tree
 that headline is used to paste the tree
@@ -5686,7 +5686,7 @@ the language, a switch telling of the content should be in a single line."
 	   (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
 	   (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
       (match-string 1 m))
       (match-string 1 m))
      (t "fundamental"))))
      (t "fundamental"))))
-      
+
 (defun org-edit-src-exit ()
 (defun org-edit-src-exit ()
   "Exit special edit and protect problematic lines."
   "Exit special edit and protect problematic lines."
   (interactive)
   (interactive)
@@ -7316,7 +7316,7 @@ on the system \"/user@host:\"."
   (while (string-match "/" s)
   (while (string-match "/" s)
     (setq s (replace-match "\\" t t s)))
     (setq s (replace-match "\\" t t s)))
   s)
   s)
-    
+
 (defun org-get-outline-path ()
 (defun org-get-outline-path ()
   "Return the outline path to the current entry, as a list."
   "Return the outline path to the current entry, as a list."
   (let (rtn)
   (let (rtn)
@@ -7439,7 +7439,7 @@ operation has put the subtree."
 (defun org-olpath-completing-read (prompt collection &rest args)
 (defun org-olpath-completing-read (prompt collection &rest args)
   "Read an outline path like a file name."
   "Read an outline path like a file name."
   (let ((thetable collection))
   (let ((thetable collection))
-    (apply 
+    (apply
      'completing-read prompt
      'completing-read prompt
      (lambda (string predicate &optional flag)
      (lambda (string predicate &optional flag)
        (let (rtn r s f (l (length string)))
        (let (rtn r s f (l (length string)))
@@ -7596,7 +7596,7 @@ This function can be used in a hook."
 
 
 (defcustom org-structure-template-alist
 (defcustom org-structure-template-alist
   '(
   '(
-    ("s" "#+begin_src ?\n\n#+end_src" 
+    ("s" "#+begin_src ?\n\n#+end_src"
          "<src lang=\"?\">\n\n</src>")
          "<src lang=\"?\">\n\n</src>")
     ("e" "#+begin_example\n?\n#+end_example"
     ("e" "#+begin_example\n?\n#+end_example"
          "<example>\n?\n</example>")
          "<example>\n?\n</example>")
@@ -7659,7 +7659,7 @@ expands them."
        (t (newline))))
        (t (newline))))
     (setq start (point))
     (setq start (point))
     (if (string-match "%file" rpl)
     (if (string-match "%file" rpl)
-	(setq rpl (replace-match 
+	(setq rpl (replace-match
 		   (concat
 		   (concat
 		    "\""
 		    "\""
 		    (save-match-data
 		    (save-match-data
@@ -7668,7 +7668,7 @@ expands them."
 		   t t rpl)))
 		   t t rpl)))
     (insert rpl)
     (insert rpl)
     (if (re-search-backward "\\?" start t) (delete-char 1))))
     (if (re-search-backward "\\?" start t) (delete-char 1))))
-    
+
 
 
 (defun org-complete (&optional arg)
 (defun org-complete (&optional arg)
   "Perform completion on word at point.
   "Perform completion on word at point.
@@ -8074,7 +8074,7 @@ For calling through lisp, arg is also interpreted in the following way:
 	    (condition-case nil
 	    (condition-case nil
 		(org-forward-same-level 1)
 		(org-forward-same-level 1)
 	      (error (end-of-line 1)))))
 	      (error (end-of-line 1)))))
-	(replace-match 
+	(replace-match
 	 (if is-percent
 	 (if is-percent
 	     (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
 	     (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
 	   (format "[%d/%d]" cnt-done cnt-all)))
 	   (format "[%d/%d]" cnt-done cnt-all)))
@@ -8111,7 +8111,7 @@ when there is a statistics cookie in the headline!
       (setq changes (append changes (cdr (assoc 'done l)))))
       (setq changes (append changes (cdr (assoc 'done l)))))
     (dolist (c changes)
     (dolist (c changes)
       (org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
       (org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
-	 
+
 (defun org-local-logging (value)
 (defun org-local-logging (value)
   "Get logging settings from a property VALUE."
   "Get logging settings from a property VALUE."
   (let* (words w a)
   (let* (words w a)
@@ -8512,7 +8512,7 @@ EXTRA is additional text that will be inserted into the notes buffer."
     (save-excursion
     (save-excursion
       (when findpos
       (when findpos
 	(org-back-to-heading t)
 	(org-back-to-heading t)
-	(narrow-to-region (point) (save-excursion 
+	(narrow-to-region (point) (save-excursion
 				    (outline-next-heading) (point)))
 				    (outline-next-heading) (point)))
 	(looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"
 	(looking-at (concat outline-regexp "\\( *\\)[^\r\n]*"
 			    "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
 			    "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
@@ -9743,12 +9743,12 @@ the scanner.  The following items can be given here:
      ((eq match t)   (setq matcher t))
      ((eq match t)   (setq matcher t))
      ((eq match nil) (setq matcher t))
      ((eq match nil) (setq matcher t))
      (t (setq matcher (if match (org-make-tags-matcher match) t))))
      (t (setq matcher (if match (org-make-tags-matcher match) t))))
-    
+
     (when (eq scope 'tree)
     (when (eq scope 'tree)
       (org-back-to-heading t)
       (org-back-to-heading t)
       (org-narrow-to-subtree)
       (org-narrow-to-subtree)
       (setq scope nil))
       (setq scope nil))
-    
+
     (if (not scope)
     (if (not scope)
 	(progn
 	(progn
 	  (org-prepare-agenda-buffers
 	  (org-prepare-agenda-buffers
@@ -10083,7 +10083,7 @@ is set.")
 	      (move-marker org-entry-property-inherited-from (point))
 	      (move-marker org-entry-property-inherited-from (point))
 	      (throw 'ex tmp))
 	      (throw 'ex tmp))
 	    (or (org-up-heading-safe) (throw 'ex nil)))))
 	    (or (org-up-heading-safe) (throw 'ex nil)))))
-      (or tmp 
+      (or tmp
 	  (cdr (assoc property org-file-properties))
 	  (cdr (assoc property org-file-properties))
 	  (cdr (assoc property org-global-properties))
 	  (cdr (assoc property org-global-properties))
 	  (cdr (assoc property org-global-properties-fixed))))))
 	  (cdr (assoc property org-global-properties-fixed))))))
@@ -11605,11 +11605,11 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers."
 	    (lambda (b) (string-match "\*Org .*Export" (buffer-name b))))
 	    (lambda (b) (string-match "\*Org .*Export" (buffer-name b))))
 	   ((eq predicate 'agenda)
 	   ((eq predicate 'agenda)
 	    (lambda (b)
 	    (lambda (b)
-	      (with-current-buffer b 
+	      (with-current-buffer b
 		(and (eq major-mode 'org-mode)
 		(and (eq major-mode 'org-mode)
 		     (setq bfn (buffer-file-name b))
 		     (setq bfn (buffer-file-name b))
 		     (member (file-truename bfn) agenda-files)))))
 		     (member (file-truename bfn) agenda-files)))))
-	   (t (lambda (b) (with-current-buffer b 
+	   (t (lambda (b) (with-current-buffer b
 			    (or (eq major-mode 'org-mode)
 			    (or (eq major-mode 'org-mode)
 				(string-match "\*Org .*Export"
 				(string-match "\*Org .*Export"
 					      (buffer-name b)))))))))
 					      (buffer-name b)))))))))
@@ -11827,7 +11827,7 @@ When a buffer is unmodified, it is just killed.  When modified, it is saved
 		(append org-done-keywords-for-agenda org-done-keywords))
 		(append org-done-keywords-for-agenda org-done-keywords))
 	  (setq org-todo-keyword-alist-for-agenda
 	  (setq org-todo-keyword-alist-for-agenda
 		(append org-todo-keyword-alist-for-agenda org-todo-key-alist))
 		(append org-todo-keyword-alist-for-agenda org-todo-key-alist))
-	  (setq org-tag-alist-for-agenda 
+	  (setq org-tag-alist-for-agenda
 		(append org-tag-alist-for-agenda org-tag-alist))
 		(append org-tag-alist-for-agenda org-tag-alist))
 
 
 	  (save-excursion
 	  (save-excursion
@@ -14016,13 +14016,14 @@ plainly yank the text as it is.
 \[1] Basically, the test checks if the first non-white line is a heading
 \[1] Basically, the test checks if the first non-white line is a heading
     and if there are no other headings with fewer stars."
     and if there are no other headings with fewer stars."
   (interactive "P")
   (interactive "P")
+  (setq this-command 'yank)
   (if arg
   (if arg
       (call-interactively 'yank)
       (call-interactively 'yank)
     (let ((subtreep ; is kill a subtree, and the yank position appropriate?
     (let ((subtreep ; is kill a subtree, and the yank position appropriate?
 	   (and (org-kill-is-subtree-p)
 	   (and (org-kill-is-subtree-p)
 		(or (bolp)
 		(or (bolp)
 		    (and (looking-at "[ \t]*$")
 		    (and (looking-at "[ \t]*$")
-			 (string-match 
+			 (string-match
 			  "\\`\\*+\\'"
 			  "\\`\\*+\\'"
 			  (buffer-substring (point-at-bol) (point)))))))
 			  (buffer-substring (point-at-bol) (point)))))))
 	  swallowp)
 	  swallowp)
@@ -14051,12 +14052,15 @@ plainly yank the text as it is.
 	     "Yanked text not folded because that would swallow text"))
 	     "Yanked text not folded because that would swallow text"))
 	  (goto-char end)
 	  (goto-char end)
 	  (skip-chars-forward " \t\n\r")
 	  (skip-chars-forward " \t\n\r")
-	  (beginning-of-line 1)))
+	  (beginning-of-line 1)
+	  (push-mark beg 'nomsg)))
        ((and subtreep org-yank-adjusted-subtrees)
        ((and subtreep org-yank-adjusted-subtrees)
-	(org-paste-subtree nil nil 'for-yank))
+	(let ((beg (point-at-bol)))
+	  (org-paste-subtree nil nil 'for-yank)
+	  (push-mark beg 'nomsg)))
        (t
        (t
 	(call-interactively 'yank))))))
 	(call-interactively 'yank))))))
-  
+
 (defun org-yank-folding-would-swallow-text (beg end)
 (defun org-yank-folding-would-swallow-text (beg end)
   "Would hide-subtree at BEG swallow any text after END?"
   "Would hide-subtree at BEG swallow any text after END?"
   (let (level)
   (let (level)