summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-01-25 23:27:33 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-01-25 23:27:33 +0100
commit7d52a8c3cc86c8ce03eda006752af1ab4bed4316 (patch)
treea0f28b20a165fcde212cd0ff9995dff2ebaad928
parentb6b1e35f33093f45df1e8973d90889a53b03d53b (diff)
downloadorg-mode-7d52a8c3cc86c8ce03eda006752af1ab4bed4316.tar.gz
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 <mwe012008@gmx.net> <http://permalink.gmane.org/gmane.emacs.orgmode/111569>
-rw-r--r--lisp/org.el214
-rw-r--r--testing/lisp/test-org.el234
2 files changed, 327 insertions, 121 deletions
diff --git a/lisp/org.el b/lisp/org.el
index 27f68eb..a6657a4 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 113114f..b4bcaae 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3995,6 +3995,240 @@ Paragraph<point>"
"\\( [.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