From c31462f33e73e37cb076bf4292c80702589cddd9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 17 Jan 2017 09:49:48 +0100 Subject: [PATCH] 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 --- lisp/org.el | 141 ++++++++++++++++++++------------------- testing/lisp/test-org.el | 24 ++++++- 2 files changed, 94 insertions(+), 71 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 03c05dc13..00498f4bd 100644 --- a/lisp/org.el +++ b/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 diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index ef2a68a0c..767e18ab6 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -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>" + (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>" + (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