From 7d52a8c3cc86c8ce03eda006752af1ab4bed4316 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 25 Jan 2017 23:27:33 +0100 Subject: [PATCH] Fix `org-schedule' with repeater * lisp/org.el (org--deadline-or-schedule): New function. (org-schedule): (org-deadline): Use new function. * testing/lisp/test-org.el (test-org/deadline): (test-org/schedule): New tests. Reported-by: Michael Welle --- lisp/org.el | 214 +++++++++++++++++++------------------------ testing/lisp/test-org.el | 234 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 327 insertions(+), 121 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 27f68eb16..a6657a429 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -13432,6 +13432,83 @@ of `org-todo-keywords-1'." (message "%d TODO entries found" (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) +(defun org--deadline-or-schedule (arg type time) + "Insert DEADLINE or SCHEDULE information in current entry. +TYPE is either `deadline' or `scheduled'. See `org-deadline' or +`org-schedule' for information about ARG and TIME arguments." + (let* ((deadline? (eq type 'deadline)) + (keyword (if deadline? org-deadline-string org-scheduled-string)) + (log (if deadline? org-log-redeadline org-log-reschedule)) + (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) + (old-date-time (and old-date (org-time-string-to-time old-date))) + ;; Save repeater cookie from either TIME or current scheduled + ;; time stamp. We are going to insert it back at the end of + ;; the process. + (repeater (or (and (org-string-nw-p time) + ;; We use `org-repeat-re' because we need + ;; to tell the difference between a real + ;; repeater and a time delta, e.g. "+2d". + (string-match org-repeat-re time) + (match-string 1 time)) + (and (org-string-nw-p old-date) + (string-match "\\([.+-]+[0-9]+ [hdwmy]\ +\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" + old-date) + (match-string 1 old-date))))) + (pcase arg + (`(4) + (when (and old-date log) + (org-add-log-setup (if deadline? 'deldeadline 'delschedule) + nil old-date log)) + (org-remove-timestamp-with-keyword keyword) + (message (if deadline? "Item no longer has a deadline." + "Item is no longer scheduled."))) + (`(16) + (save-excursion + (org-back-to-heading t) + (let ((regexp (if deadline? org-deadline-time-regexp + org-scheduled-time-regexp))) + (if (not (re-search-forward regexp (line-end-position 2) t)) + (user-error (if deadline? "No deadline information to update" + "No scheduled information to update")) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) + (msg (if deadline? "Warn starting from" "Delay until"))) + (replace-match + (concat keyword + " <" rpl + (format " -%dd" + (abs (- (time-to-days + (save-match-data + (org-read-date + nil t nil msg old-date-time))) + (time-to-days old-date-time)))) + ">") t t)))))) + (_ + (org-add-planning-info type time 'closed) + (when (and old-date + log + (not (equal old-date org-last-inserted-timestamp))) + (org-add-log-setup (if deadline? 'redeadline 'reschedule) + org-last-inserted-timestamp + old-date + log)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward + (concat keyword " " org-last-inserted-timestamp) + (line-end-position 2) + t) + (goto-char (1- (match-end 0))) + (insert " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message (if deadline? "Deadline on %s" "Scheduled to %s") + org-last-inserted-timestamp))))) + (defun org-deadline (arg &optional time) "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. With one universal prefix argument, remove any deadline from the item. @@ -13440,66 +13517,14 @@ With argument TIME, set the deadline at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-deadline ',arg ,time) - org-loop-over-headlines-in-active-region - cl (when (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((old-date (org-entry-get nil "DEADLINE")) - (old-date-time (when old-date (org-time-string-to-time old-date))) - (repeater (and old-date - (string-match - "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - old-date) - (match-string 1 old-date)))) - (cond - ((equal arg '(4)) - (when (and old-date org-log-redeadline) - (org-add-log-setup 'deldeadline nil old-date org-log-redeadline)) - (org-remove-timestamp-with-keyword org-deadline-string) - (message "Item no longer has a deadline.")) - ((equal arg '(16)) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward - org-deadline-time-regexp - (save-excursion (outline-next-heading) (point)) t) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) - (replace-match - (concat org-deadline-string - " <" rpl - (format " -%dd" - (abs - (- (time-to-days - (save-match-data - (org-read-date nil t nil "Warn starting from" old-date-time))) - (time-to-days old-date-time)))) - ">") t t)) - (user-error "No deadline information to update")))) - (t - (org-add-planning-info 'deadline time 'closed) - (when (and old-date - org-log-redeadline - (not (equal old-date org-last-inserted-timestamp))) - (org-add-log-setup - 'redeadline org-last-inserted-timestamp old-date org-log-redeadline)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward (concat org-deadline-string " " - org-last-inserted-timestamp) - (save-excursion - (outline-next-heading) (point)) t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message "Deadline on %s" org-last-inserted-timestamp)))))) + (org-map-entries + (lambda () (org--deadline-or-schedule arg 'deadline time)) + nil + (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level + 'region) + (lambda () (when (outline-invisible-p) (org-end-of-subtree nil t)))) + (org--deadline-or-schedule arg 'deadline time))) (defun org-schedule (arg &optional time) "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. @@ -13509,67 +13534,14 @@ With argument TIME, scheduled at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-schedule ',arg ,time) - org-loop-over-headlines-in-active-region - cl (when (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((old-date (org-entry-get nil "SCHEDULED")) - (old-date-time (when old-date (org-time-string-to-time old-date))) - (repeater (and old-date - (string-match - "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - old-date) - (match-string 1 old-date)))) - (cond - ((equal arg '(4)) - (progn - (when (and old-date org-log-reschedule) - (org-add-log-setup 'delschedule nil old-date org-log-reschedule)) - (org-remove-timestamp-with-keyword org-scheduled-string) - (message "Item is no longer scheduled."))) - ((equal arg '(16)) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward - org-scheduled-time-regexp - (save-excursion (outline-next-heading) (point)) t) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) - (replace-match - (concat org-scheduled-string - " <" rpl - (format " -%dd" - (abs - (- (time-to-days - (save-match-data - (org-read-date nil t nil "Delay until" old-date-time))) - (time-to-days old-date-time)))) - ">") t t)) - (user-error "No scheduled information to update")))) - (t - (org-add-planning-info 'scheduled time 'closed) - (when (and old-date - org-log-reschedule - (not (equal old-date org-last-inserted-timestamp))) - (org-add-log-setup - 'reschedule org-last-inserted-timestamp old-date org-log-reschedule)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward (concat org-scheduled-string " " - org-last-inserted-timestamp) - (save-excursion - (outline-next-heading) (point)) t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message "Scheduled to %s" org-last-inserted-timestamp)))))) + (org-map-entries + (lambda () (org--deadline-or-schedule arg 'scheduled time)) + nil + (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level + 'region) + (lambda () (when (outline-invisible-p) (org-end-of-subtree nil t)))) + (org--deadline-or-schedule arg 'scheduled time))) (defun org-get-scheduled-time (pom &optional inherit) "Get the scheduled time as a time tuple, of a format suitable diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 113114fec..b4bcaae24 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -3995,6 +3995,240 @@ Paragraph" "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1))))) +(ert-deftest test-org/deadline () + "Test `org-deadline' specifications." + ;; Insert a new value or replace existing one. + (should + (equal "* H\nDEADLINE: <2012-03-29>\n" + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline nil "<2012-03-29 Tue>")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) + nil nil 1)))) + (should + (equal "* H\nDEADLINE: <2014-03-04>" + (org-test-with-temp-text "* H\nDEADLINE: <2012-03-29>" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline nil "<2014-03-04 Thu>")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) + nil nil 1)))) + ;; Accept delta time, e.g., "+2d". + (should + (equal "* H\nDEADLINE: <2015-03-04>\n" + (cl-letf (((symbol-function 'current-time) + (lambda (&rest args) + (apply #'encode-time + (org-parse-time-string "2014-03-04"))))) + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline nil "+1y")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1))))) + ;; Preserve repeater. + (should + (equal "* H\nDEADLINE: <2012-03-29 +2y>\n" + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline nil "<2012-03-29 Tue +2y>")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\) " "" (buffer-string) nil nil 1)))) + ;; Remove CLOSED keyword, if any. + (should + (equal "* H\nDEADLINE: <2012-03-29>" + (org-test-with-temp-text "* H\nCLOSED: [2017-01-25 Wed]" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline nil "<2012-03-29 Tue>")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1)))) + ;; With C-u argument, remove DEADLINE keyword. + (should + (equal "* H\n" + (org-test-with-temp-text "* H\nDEADLINE: <2012-03-29>" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline '(4))) + (buffer-string)))) + (should + (equal "* H" + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline '(4))) + (buffer-string)))) + ;; With C-u C-u argument, prompt for a delay cookie. + (should + (equal "* H\nDEADLINE: <2012-03-29 -705d>" + (cl-letf (((symbol-function 'org-read-date) + (lambda (&rest args) + (apply #'encode-time + (org-parse-time-string "2014-03-04"))))) + (org-test-with-temp-text "* H\nDEADLINE: <2012-03-29>" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline '(16))) + (buffer-string))))) + (should-error + (cl-letf (((symbol-function 'org-read-date) + (lambda (&rest args) + (apply #'encode-time + (org-parse-time-string "2014-03-04"))))) + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-deadline '(16))) + (buffer-string)))) + ;; When a region is active and + ;; `org-loop-over-headlines-in-active-region' is non-nil, insert the + ;; same value in all headlines in region. + (should + (equal "* H1\nDEADLINE: <2012-03-29>\n* H2\nDEADLINE: <2012-03-29>\n" + (org-test-with-temp-text "* H1\n* H2" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil) + (org-loop-over-headlines-in-active-region t)) + (transient-mark-mode 1) + (push-mark (point) t t) + (goto-char (point-max)) + (org-deadline nil "2012-03-29")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1)))) + (should-not + (equal "* H1\nDEADLINE: <2012-03-29>\n* H2\nDEADLINE: <2012-03-29>\n" + (org-test-with-temp-text "* H1\n* H2" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil) + (org-loop-over-headlines-in-active-region nil)) + (transient-mark-mode 1) + (push-mark (point) t t) + (goto-char (point-max)) + (org-deadline nil "2012-03-29")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1))))) + +(ert-deftest test-org/schedule () + "Test `org-schedule' specifications." + ;; Insert a new value or replace existing one. + (should + (equal "* H\nSCHEDULED: <2012-03-29>\n" + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule nil "<2012-03-29 Tue>")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) + nil nil 1)))) + (should + (equal "* H\nSCHEDULED: <2014-03-04>" + (org-test-with-temp-text "* H\nSCHEDULED: <2012-03-29>" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule nil "<2014-03-04 Thu>")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) + nil nil 1)))) + ;; Accept delta time, e.g., "+2d". + (should + (equal "* H\nSCHEDULED: <2015-03-04>\n" + (cl-letf (((symbol-function 'current-time) + (lambda (&rest args) + (apply #'encode-time + (org-parse-time-string "2014-03-04"))))) + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule nil "+1y")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1))))) + ;; Preserve repeater. + (should + (equal "* H\nSCHEDULED: <2012-03-29 +2y>\n" + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule nil "<2012-03-29 Tue +2y>")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\) " "" (buffer-string) nil nil 1)))) + ;; Remove CLOSED keyword, if any. + (should + (equal "* H\nSCHEDULED: <2012-03-29>" + (org-test-with-temp-text "* H\nCLOSED: [2017-01-25 Wed]" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule nil "<2012-03-29 Tue>")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1)))) + ;; With C-u argument, remove SCHEDULED keyword. + (should + (equal "* H\n" + (org-test-with-temp-text "* H\nSCHEDULED: <2012-03-29>" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule '(4))) + (buffer-string)))) + (should + (equal "* H" + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule '(4))) + (buffer-string)))) + ;; With C-u C-u argument, prompt for a delay cookie. + (should + (equal "* H\nSCHEDULED: <2012-03-29 -705d>" + (cl-letf (((symbol-function 'org-read-date) + (lambda (&rest args) + (apply #'encode-time + (org-parse-time-string "2014-03-04"))))) + (org-test-with-temp-text "* H\nSCHEDULED: <2012-03-29>" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule '(16))) + (buffer-string))))) + (should-error + (cl-letf (((symbol-function 'org-read-date) + (lambda (&rest args) + (apply #'encode-time + (org-parse-time-string "2014-03-04"))))) + (org-test-with-temp-text "* H" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil)) + (org-schedule '(16))) + (buffer-string)))) + ;; When a region is active and + ;; `org-loop-over-headlines-in-active-region' is non-nil, insert the + ;; same value in all headlines in region. + (should + (equal "* H1\nSCHEDULED: <2012-03-29>\n* H2\nSCHEDULED: <2012-03-29>\n" + (org-test-with-temp-text "* H1\n* H2" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil) + (org-loop-over-headlines-in-active-region t)) + (transient-mark-mode 1) + (push-mark (point) t t) + (goto-char (point-max)) + (org-schedule nil "2012-03-29")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1)))) + (should-not + (equal "* H1\nSCHEDULED: <2012-03-29>\n* H2\nSCHEDULED: <2012-03-29>\n" + (org-test-with-temp-text "* H1\n* H2" + (let ((org-adapt-indentation nil) + (org-last-inserted-timestamp nil) + (org-loop-over-headlines-in-active-region nil)) + (transient-mark-mode 1) + (push-mark (point) t t) + (goto-char (point-max)) + (org-schedule nil "2012-03-29")) + (replace-regexp-in-string + "\\( [.A-Za-z]+\\)>" "" (buffer-string) nil nil 1))))) + ;;; Property API -- 2.11.4.GIT