mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2025-01-16 17:19:49 +00:00
Code

Move markers with some cut-and-paste operations.

Browse Source 
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.
This commit is contained in:
Carsten Dominik 2008-05-01 09:52:45 +02:00
parent f476a046f5
commit 6d6c6e1d5d
6 changed files with 133 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
ChangeLog
View File

@ -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.

4
doc/org.texi
View File

@ -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

22
lisp/org-archive.el
View File

@ -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)

10
lisp/org-clock.el
View File

@ -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."

81
lisp/org-remember.el
View File

@ -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.

49
lisp/org.el
View File

@ -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