Move markers with some cut-and-paste operations.

Clock-related markers and agenda markers used to get lost
when editing a file using cut and paste.  Now some cut
and past operations move the markers with them.  In particular,
structure editing like moving subtrees up and down.
Also, when exiting a remember buffer with a running clock, the clock
can now be moved along with the entry to the target location.

ChangeLog

@@ -1,3 +1,26 @@
+2008-05-01  Carsten Dominik  <dominik@science.uva.nl>
+
+	* lisp/org-archive.el (org-archive-subtree): No longer remove an
+	extra line after cutting the subtree.  `org-cut-subtree' already
+	takes care of this.
+
+	* lisp/org-remember.el (org-remember-handler): Only kill the target
+	buffer if it does not contain the running clock.
+
+	* lisp/org.el (org-markers-to-move): New variable.
+	(org-save-markers-in-region, org-check-and-save-marker)
+	(org-reinstall-markers-in-region): New function.
+	(org-move-subtree-down, org-copy-subtree): Remember relative
+	marker positions before cutting.
+	(org-move-subtree-down, org-paste-subtree): Restore relative
+	marker positions after pasting.
+
+	* lisp/org-remember.el (org-remember-clock-out-on-exit): New option.
+	(org-remember-finalize): Clock out only if the setting in
+	`org-remember-clock-out-on-exit' requires it.
+	(org-remember-handler): Do the cleanup in the buffer, to make sure
+	that the clock marker remains in tact.
+
 2008-04-29  Carsten Dominik  <dominik@science.uva.nl>
 
 	* lisp/org-clock.el (org-clock-goto): Widen buffer if necessary.

doc/org.texi

@@ -5691,13 +5691,13 @@ Toggle the ARCHIVE tag for the current headline.
 @c
 @kindex A
 @item A
-Move the subtree correspoding to the current entry to its @emph{Archive
+Move the subtree corresponding to the current entry to its @emph{Archive
 Sibling}.
 @c
 @kindex $
 @item $
 Archive the subtree corresponding to the current headline.  This means the
-entry will be moved to the configured archive locatin, most likely a
+entry will be moved to the configured archive location, most likely a
 different file.
 @c
 @kindex T

lisp/org-archive.el

@@ -182,7 +182,7 @@ this heading."
 		 (current-time)))
 	  category todo priority ltags itags
           ;; end of variables that will be used for saving context
-	  location afile heading buffer level newfile-p)
+	  location afile heading buffer level newfile-p visiting)
 
       ;; Find the local archive location
       (setq location (org-get-local-archive-location)
@@ -193,7 +193,8 @@ this heading."
 
       (if (> (length afile) 0)
 	  (setq newfile-p (not (file-exists-p afile))
-		buffer (find-file-noselect afile))
+		visiting (find-buffer-visiting afile)
+		buffer (or visiting (find-file-noselect afile)))
 	(setq buffer (current-buffer)))
       (unless buffer
 	(error "Cannot access file \"%s\"" afile))
@@ -215,9 +216,11 @@ this heading."
 	(setq ltags (mapconcat 'identity ltags " ")
 	      itags (mapconcat 'identity itags " "))
 	;; We first only copy, in case something goes wrong
-	;; we need to protect this-command, to avoid kill-region sets it,
+	;; we need to protect `this-command', to avoid kill-region sets it,
 	;; which would lead to duplication of subtrees
-	(let (this-command) (org-copy-subtree))
+	(let ((org-markers-to-move 'force)
+	      this-command)
+	  (org-copy-subtree))
 	(set-buffer buffer)
 	;; Enforce org-mode for the archive buffer
 	(if (not (org-mode-p))
@@ -285,12 +288,17 @@ this heading."
 		  (org-entry-put (point) n v)))))
 
 	  ;; Save and kill the buffer, if it is not the same buffer.
-	  (if (not (eq this-buffer buffer))
-	      (progn (save-buffer) (kill-buffer buffer)))))
+	  (when (not (eq this-buffer buffer))
+	    (save-buffer)
+	    ;; Check if it is OK to kill the buffer
+	    (unless
+		(or visiting
+		    (equal (marker-buffer org-clock-marker) (current-buffer)))
+	      (kill-buffer buffer)))
+	  ))
       ;; Here we are back in the original buffer.  Everything seems to have
       ;; worked.  So now cut the tree and finish up.
       (let (this-command) (org-cut-subtree))
-      (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line))
       (message "Subtree archived %s"
 	       (if (eq this-buffer buffer)
 		   (concat "under heading: " heading)

lisp/org-clock.el

@@ -99,11 +99,7 @@ The function is called with point at the beginning of the headline."
 (defvar org-clock-start-time "")
 
 (defvar org-clock-history nil
-  "Marker pointing to the previous task teking clock time.
-This is used to find back to the previous task after interrupting work.
-When clocking into a task and the clock is currently running, this marker
-is moved to the position of the currently running task and continues
-to point there even after the task is clocked out.")
+  "List of marker pointing to recent clocked tasks.")
 
 (defvar org-clock-default-task (make-marker)
   "Marker pointing to the default task that should clock time.
@@ -111,9 +107,7 @@ The clock can be made to switch to this task after clocking out
 of a different task.")
 
 (defvar org-clock-interrupted-task (make-marker)
-  "Marker pointing to the default task that should clock time.
-The clock can be made to switch to this task after clocking out
-of a different task.")
+  "Marker pointing to the task that has been interrupted by the current clock.")
 
 (defun org-clock-history-push (&optional pos buffer)
   "Push a marker to the clock history."

lisp/org-remember.el

@@ -179,6 +179,19 @@ calendar           |  %:type %:date"
 			 (symbol :tag "Major mode"))
 		 (function :tag "Perform a check against function")))))
 
+(defcustom org-remember-clock-out-on-exit 'query
+  "Non-nil means, stop the clock when exiting a clocking remember buffer.
+This only applies of the clock is running in the remember buffer.  If the
+clock is not stopped, it continues to run in the storage location.
+Instead of nil or t, this may also be the symbol `query' to prompt the
+user each time a remember buffer with a running clock is filed away.  "
+  :group 'org-remember
+  :type '(choice
+	  (const :tag "Never" nil)
+	  (const :tag "Always" t)
+	  (const :tag "Query user" query)))
+
+
 (defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
 (defvar initial)    ; from remember.el, dynamically scoped in `remember-mode'
 
@@ -478,15 +491,19 @@ from that hook."
   (when org-finish-function
     (funcall org-finish-function)))
 
-(defvar org-clock-marker) ; Defined below
+(defvar org-clock-marker) ; Defined in org.el
 (defun org-remember-finalize ()
   "Finalize the remember process."
   (unless (fboundp 'remember-finalize)
     (defalias 'remember-finalize 'remember-buffer))
   (when (and org-clock-marker
 	     (equal (marker-buffer org-clock-marker) (current-buffer)))
-    ;; FIXME: test this, this is w/o notetaking!
-    (let (org-log-note-clock-out) (org-clock-out)))
+    ;; the clock is running in this buffer.
+    (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
+	       (or (eq org-remember-clock-out-on-exit t)
+		   (and org-remember-clock-out-on-exit
+			(y-or-n-p "The clock is running in this buffer.  Clock out now? "))))
+      (let (org-log-note-clock-out) (org-clock-out))))
   (when buffer-file-name
     (save-buffer)
     (setq buffer-file-name nil))
@@ -606,8 +623,7 @@ See also the variable `org-reverse-note-order'."
     (beginning-of-line 1))
   (catch 'quit
     (if org-note-abort (throw 'quit nil))
-    (let* ((txt (buffer-substring (point-min) (point-max)))
-	   (fastp (org-xor (equal current-prefix-arg '(4))
+    (let* ((fastp (org-xor (equal current-prefix-arg '(4))
 			   org-remember-store-without-prompt))
 	   (file (cond
 		  (fastp org-default-notes-file)
@@ -622,43 +638,35 @@ See also the variable `org-reverse-note-order'."
 	   (org-startup-folded nil)
 	   (org-startup-align-all-tables nil)
 	   (org-goto-start-pos 1)
-	   spos exitcmd level indent reversed)
+	   spos exitcmd level reversed txt)
       (if (and (equal current-prefix-arg '(16)) org-remember-previous-location)
 	  (setq file (car org-remember-previous-location)
 		heading (cdr org-remember-previous-location)
 		fastp t))
       (setq current-prefix-arg nil)
-      (if (string-match "[ \t\n]+\\'" txt)
-	  (setq txt (replace-match "" t t txt)))
       ;; Modify text so that it becomes a nice subtree which can be inserted
       ;; into an org tree.
-      (let* ((lines (split-string txt "\n"))
-	     first)
-	(setq first (car lines) lines (cdr lines))
-	(if (string-match "^\\*+ " first)
-	    ;; Is already a headline
-	    (setq indent nil)
-	  ;; We need to add a headline:  Use time and first buffer line
-	  (setq lines (cons first lines)
-		first (concat "* " (current-time-string)
-			      " (" (remember-buffer-desc) ")")
-		indent "  "))
-	(if (and org-adapt-indentation indent)
-	    (setq lines (mapcar
-			 (lambda (x)
-			   (if (string-match "\\S-" x)
-			       (concat indent x) x))
-			 lines)))
-	(setq txt (concat first "\n"
-			  (mapconcat 'identity lines "\n"))))
-      (if (string-match "\n[ \t]*\n[ \t\n]*\\'" txt)
-	  (setq txt (replace-match "\n\n" t t txt))
-	(if (string-match "[ \t\n]*\\'" txt)
-	    (setq txt (replace-match "\n" t t txt))))
-      ;; Put the modified text back into the remember buffer, for refile.
-      (erase-buffer)
-      (insert txt)
       (goto-char (point-min))
+      (if (re-search-forward "[ \t\n]+\\'" nil t)
+	  ;; remove empty lines at end
+	  (replace-match ""))
+      (goto-char (point-min))
+      (unless (looking-at org-outline-regexp)
+	;; add a headline
+	(insert (concat "* " (current-time-string)
+			" (" (remember-buffer-desc) ")\n"))
+	(backward-char 1)
+	(when org-adapt-indentation
+	  (while (re-search-forward "^" nil t)
+	    (insert "  "))))
+      (goto-char (point-min))
+      (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t)
+	  (replace-match "\n\n")
+	(if (re-search-forward "[ \t\n]*\\'")
+	    (replace-match "\n")))
+      (goto-char (point-min))
+      (setq txt (buffer-string))
+      (org-save-markers-in-region (point-min) (point-max))
       (when (and (eq org-remember-interactive-interface 'refile)
 		 (not fastp))
 	(org-refile nil (or visiting (find-file-noselect file)))
@@ -766,7 +774,10 @@ See also the variable `org-reverse-note-order'."
 		    txt)))
 	    (when remember-save-after-remembering
 	      (save-buffer)
-	      (if (not visiting) (kill-buffer (current-buffer)))))))))
+	      (if (and (not visiting)
+		       (not (equal (marker-buffer org-clock-marker)
+				   (current-buffer))))
+		  (kill-buffer (current-buffer)))))))))
 
   t)    ;; return t to indicate that we took care of this note.
 

lisp/org.el

@@ -4671,10 +4671,14 @@ is signaled in this case."
     (setq ne-ins (org-back-over-empty-lines))
     (move-marker ins-point (point))
     (setq txt (buffer-substring beg end))
+    (org-save-markers-in-region beg end)
     (delete-region beg end)
     (outline-flag-region (1- beg) beg nil)
     (outline-flag-region (1- (point)) (point) nil)
-    (insert txt)
+    (let ((bbb (point)))
+      (insert-before-markers txt)
+      (org-reinstall-markers-in-region bbb)
+      (move-marker ins-point bbb))
     (or (bolp) (insert "\n"))
     (setq ins-end (point))
     (goto-char ins-point)
@@ -4736,6 +4740,8 @@ If CUT is non-nil, actually cut the subtree."
     (goto-char beg0)
     (when (> end beg)
       (setq org-subtree-clip-folded folded)
+      (when (or cut (eq org-markers-to-move 'force))
+	(org-save-markers-in-region beg end))
       (if cut (kill-region beg end) (copy-region-as-kill beg end))
       (setq org-subtree-clip (current-kill 0))
       (message "%s: Subtree(s) with %d characters"
@@ -4812,6 +4818,7 @@ If optional TREE is given, use this text instead of the kill ring."
     (org-back-over-empty-lines)
     (setq beg (point))
     (insert-before-markers txt)
+    (org-reinstall-markers-in-region beg)
     (unless (string-match "\n\\'" txt) (insert "\n"))
     (setq end (point))
     (goto-char beg)
@@ -4857,6 +4864,41 @@ If optional TXT is given, check this string instead of the current kill."
 	    (throw 'exit nil)))
 	t))))
 
+(defvar org-markers-to-move nil)
+
+(defun org-save-markers-in-region (beg end)
+  "Check markers in region.
+If these markers are between BEG and END, record their position relative
+to BEG, so that after moving the block of text, we can put the markers back
+into place.
+This function gets called just before an entry or tree gets cut from the
+buffer.  After re-insertion, `org-reinstall-markers-in-region' must be
+called immediately, to move the markers with the entries."
+  (setq org-markers-to-move nil)
+  (when (featurep 'org-clock)
+    (org-check-and-save-marker org-clock-marker beg end)
+    (org-check-and-save-marker org-clock-default-task beg end)
+    (org-check-and-save-marker org-clock-interrupted-task beg end)
+    (mapc (lambda (m) (org-check-and-save-marker m beg end))
+	  org-clock-history))
+  (when (featurep 'org-agenda)
+    (mapc (lambda (m) (org-check-and-save-marker m beg end))
+	  org-agenda-markers)))
+
+(defun org-check-and-save-marker (marker bed end)
+  "Check if MARKER is between BEG and END.
+If yes, remember the marker and the distance to BEG."
+  (when (and (marker-buffer marker)
+	     (equal (marker-buffer marker) (current-buffer)))
+    (if (and (>= marker beg) (< marker end))
+      (push (cons marker (- marker beg)) org-markers-to-move))))
+
+(defun org-reinstall-markers-in-region (beg)
+  "Move all remembered markers to their position relative to BEG."
+  (mapc (lambda (x) (move-marker (car x) (+ beg (cdr x))))
+	org-markers-to-move)
+  (setq org-markers-to-move nil))
+
 (defun org-narrow-to-subtree ()
   "Narrow buffer to the current subtree."
   (interactive)
@@ -7352,7 +7394,8 @@ operation has put the subtree."
 	      (switch-to-buffer nbuf)
 	      (goto-char pos)
 	      (org-show-context 'org-goto))
-	  (org-copy-special)
+	  (let ((org-markers-to-move 'force))
+	    (org-copy-special))
 	  (save-excursion
 	    (set-buffer (setq nbuf (or (find-buffer-visiting file)
 				       (find-file-noselect file))))
@@ -13700,5 +13743,3 @@ Still experimental, may disappear in the future."
 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
 
 ;;; org.el ends here
-
-