From 0b3e63b2ea85ce50bca0df887f539c943b29dd97 Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Thu, 25 Dec 2014 21:52:14 -0500 Subject: Add command org-clone-and-shift-by-repeater --- lisp/init-org.el | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/lisp/init-org.el b/lisp/init-org.el index 9d00495..3c96d71 100644 --- a/lisp/init-org.el +++ b/lisp/init-org.el @@ -185,6 +185,45 @@ Before running `org-tree-to-indirect-buffer', (let ((org-indirect-buffer-display 'current-window)) (org-tree-to-indirect-buffer arg))) +(defun km/org-clone-and-shift-by-repeater () + "Clone current subtree, shifting new timestamp by repeater. +The repeater is removed from the original subtree." + (interactive) + (save-excursion + (org-back-to-heading) + (let* ((heading (org-element-at-point)) + (tree-begin (org-element-property :begin heading)) + (tree-end (org-element-property :end heading)) + (tree (buffer-substring tree-begin tree-end)) + (deadline (org-element-property :deadline heading)) + (deadline-end (org-element-property :end deadline)) + (repeat-val (org-element-property :repeater-value deadline)) + (repeat-unit (org-element-property :repeater-unit deadline)) + new-tree) + (cond + ((not deadline) (user-error "Heading doesn't have deadline")) + ((not repeat-val) (user-error "Deadline isn't repeating")) + ((eq repeat-unit 'week) + ;; `org-timestamp-change' doesn't recognize weeks. + (setq repeat-val (* repeat-val 7) + repeat-unit 'day))) + ;; Make new tree with repeater shifted one cycle. + (with-temp-buffer + (insert tree) + (goto-char (point-min)) + (re-search-forward org-ts-regexp) + (org-timestamp-change repeat-val repeat-unit) + (setq new-tree (buffer-string))) + ;; Insert new tree with shifted repeater. + (goto-char tree-end) + (insert new-tree) + ;; Remove the repeater from the original tree. + (goto-char tree-begin) + (re-search-forward + ;; Regexp taken from `org-clone-subtree-with-time-shift'. + "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)" deadline-end) + (delete-region (match-beginning 1) (match-end 1))))) + (defun km/org-sort-parent (arg) "Sort on parent heading ARG levels up. After sorting, the point is returned to its previous location -- cgit v1.2.3