forked from mirrors/org-mode
Fix `org-clone-subtree-with-time-shift'
* lisp/org.el (org-clone-subtree-with-time-shift): Fix commit
8fc9ab83b. Small refactoring.
* testing/lisp/test-org.el (test-org/clone-with-time-shift): Add
tests.
Reported-by: Kyle Meyer <kyle@kyleam.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/111477>
This commit is contained in:
Nicolas Goaziou
parent
8c08ee0f8d
commit
c31462f33e
141
lisp/org.el
141
lisp/org.el
|
|
@ -8976,77 +8976,78 @@ subtree has a repeater. Setting N to 0, then, can be used to
|
|||
remove the repeater from a subtree and create a shifted clone
|
||||
with the original repeater."
|
||||
(interactive "nNumber of clones to produce: ")
|
||||
(unless (wholenump n) (user-error "Invalid number of replications %s" n))
|
||||
(when (org-before-first-heading-p) (user-error "No subtree to clone"))
|
||||
(let ((shift
|
||||
(or shift
|
||||
(if (and (not (equal current-prefix-arg '(4)))
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(re-search-forward
|
||||
org-ts-regexp-both
|
||||
(save-excursion (org-end-of-subtree t) (point)) t)))
|
||||
(read-from-minibuffer
|
||||
"Date shift per clone (e.g. +1w, empty to copy unchanged): ")
|
||||
""))) ;; No time shift
|
||||
(n-no-remove -1)
|
||||
(drawer-re org-drawer-regexp)
|
||||
(org-clock-re (format "^[ \t]*%s.*$" org-clock-string))
|
||||
beg end template task idprop
|
||||
shift-n shift-what doshift nmin nmax)
|
||||
(unless (wholenump n)
|
||||
(user-error "Invalid number of replications %s" n))
|
||||
(when (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
|
||||
(not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'"
|
||||
shift)))
|
||||
(user-error "Invalid shift specification %s" shift))
|
||||
(when doshift
|
||||
(setq shift-n (string-to-number (match-string 1 shift))
|
||||
shift-what (cdr (assoc (match-string 2 shift)
|
||||
'(("d" . day) ("w" . week)
|
||||
("m" . month) ("y" . year))))))
|
||||
(when (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day))
|
||||
(setq nmin 1 nmax n)
|
||||
(setq beg (point))
|
||||
(setq idprop (org-entry-get nil "ID"))
|
||||
(org-end-of-subtree t t)
|
||||
(or (bolp) (insert "\n"))
|
||||
(setq end (point))
|
||||
(setq template (buffer-substring beg end))
|
||||
(when (and doshift
|
||||
(string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template))
|
||||
(delete-region beg end)
|
||||
(setq end beg)
|
||||
(setq nmin 0 nmax (1+ nmax) n-no-remove nmax))
|
||||
(goto-char end)
|
||||
(cl-loop for n from nmin to nmax do
|
||||
;; prepare clone
|
||||
(with-temp-buffer
|
||||
(insert template)
|
||||
(org-mode)
|
||||
(goto-char (point-min))
|
||||
(org-show-subtree)
|
||||
(and idprop (if org-clone-delete-id
|
||||
(org-entry-delete nil "ID")
|
||||
(org-id-get-create t)))
|
||||
(unless (= n 0)
|
||||
(while (re-search-forward org-clock-re nil t)
|
||||
(kill-whole-line))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward drawer-re nil t)
|
||||
(org-remove-empty-drawer-at (point))))
|
||||
(goto-char (point-min))
|
||||
(when doshift
|
||||
(while (re-search-forward org-ts-regexp-both nil t)
|
||||
(org-timestamp-change (* n shift-n) shift-what))
|
||||
(unless (= n n-no-remove)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-ts-regexp nil t)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
|
||||
(delete-region (match-beginning 1) (match-end 1)))))))
|
||||
(setq task (buffer-string)))
|
||||
(insert task))
|
||||
(let* ((beg (save-excursion (org-back-to-heading t) (point)))
|
||||
(end-of-tree (save-excursion (org-end-of-subtree t t) (point)))
|
||||
(shift
|
||||
(or shift
|
||||
(if (and (not (equal current-prefix-arg '(4)))
|
||||
(save-excursion
|
||||
(goto-char beg)
|
||||
(re-search-forward org-ts-regexp-both end-of-tree t)))
|
||||
(read-from-minibuffer
|
||||
"Date shift per clone (e.g. +1w, empty to copy unchanged): ")
|
||||
""))) ;No time shift
|
||||
(doshift
|
||||
(or (not (org-string-nw-p shift))
|
||||
(string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'"
|
||||
shift)
|
||||
(user-error "Invalid shift specification %s" shift))))
|
||||
(goto-char end-of-tree)
|
||||
(unless (bolp) (insert "\n"))
|
||||
(let* ((end (point))
|
||||
(template (buffer-substring beg end))
|
||||
(shift-n (and doshift (string-to-number (match-string 1 shift))))
|
||||
(shift-what (pcase (match-string 2 shift)
|
||||
("d" 'day)
|
||||
("w" (setq shift-n (* 7 shift-n)) 'day)
|
||||
("m" 'month)
|
||||
("y" 'year)
|
||||
(_ (error "Unsupported time unit"))))
|
||||
(nmin 1)
|
||||
(nmax n)
|
||||
(n-no-remove -1)
|
||||
(idprop (org-entry-get nil "ID")))
|
||||
(when (and doshift
|
||||
(string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>"
|
||||
template))
|
||||
(delete-region beg end)
|
||||
(setq end beg)
|
||||
(setq nmin 0)
|
||||
(setq nmax (1+ nmax))
|
||||
(setq n-no-remove nmax))
|
||||
(goto-char end)
|
||||
(cl-loop for n from nmin to nmax do
|
||||
(insert
|
||||
;; Prepare clone.
|
||||
(with-temp-buffer
|
||||
(insert template)
|
||||
(org-mode)
|
||||
(goto-char (point-min))
|
||||
(org-show-subtree)
|
||||
(and idprop (if org-clone-delete-id
|
||||
(org-entry-delete nil "ID")
|
||||
(org-id-get-create t)))
|
||||
(unless (= n 0)
|
||||
(while (re-search-forward org-clock-line-re nil t)
|
||||
(delete-region (line-beginning-position)
|
||||
(line-beginning-position 2)))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-drawer-regexp nil t)
|
||||
(org-remove-empty-drawer-at (point))))
|
||||
(goto-char (point-min))
|
||||
(when doshift
|
||||
(while (re-search-forward org-ts-regexp-both nil t)
|
||||
(org-timestamp-change (* n shift-n) shift-what))
|
||||
(unless (= n n-no-remove)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-ts-regexp nil t)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
|
||||
(delete-region (match-beginning 1) (match-end 1)))))))
|
||||
(buffer-string)))))
|
||||
(goto-char beg)))
|
||||
|
||||
;;; Outline Sorting
|
||||
|
|
|
|||
|
|
@ -1317,6 +1317,10 @@
|
|||
(should-error
|
||||
(org-test-with-temp-text ""
|
||||
(org-clone-subtree-with-time-shift 1)))
|
||||
;; Raise an error on invalid number of clones.
|
||||
(should-error
|
||||
(org-test-with-temp-text "* Clone me"
|
||||
(org-clone-subtree-with-time-shift -1)))
|
||||
;; Clone non-repeating once.
|
||||
(should
|
||||
(equal "\
|
||||
|
|
@ -1360,7 +1364,25 @@
|
|||
(org-clone-subtree-with-time-shift 0 "+2d")
|
||||
(replace-regexp-in-string
|
||||
"\\( [.A-Za-z]+\\)\\( \\+[0-9][hdmwy]\\)?>" "" (buffer-string)
|
||||
nil nil 1)))))
|
||||
nil nil 1))))
|
||||
;; Find time stamps before point. If SHIFT is not specified, ask
|
||||
;; for a time shift.
|
||||
(should
|
||||
(string-prefix-p
|
||||
"* H <2012-03-30"
|
||||
(org-test-with-temp-text "* H <2012-03-29 Thu><point>"
|
||||
(org-clone-subtree-with-time-shift 1 "+1d")
|
||||
(buffer-substring-no-properties (line-beginning-position 2)
|
||||
(line-end-position 2)))))
|
||||
(should
|
||||
(string-prefix-p
|
||||
"* H <2014-03-05"
|
||||
(org-test-with-temp-text "* H <2014-03-04 Tue><point>"
|
||||
(cl-letf (((symbol-function 'read-from-minibuffer)
|
||||
(lambda (&rest args) "+1d")))
|
||||
(org-clone-subtree-with-time-shift 1 "+1d"))
|
||||
(buffer-substring-no-properties (line-beginning-position 2)
|
||||
(line-end-position 2))))))
|
||||
|
||||
|
||||
;;; Fixed-Width Areas
|
||||
|
|
|
|||
Loading…
Reference in New Issue