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>
This commit is contained in:
Nicolas Goaziou 2017-01-25 23:27:33 +01:00
parent b6b1e35f33
commit 7d52a8c3cc
2 changed files with 327 additions and 121 deletions

View File

@ -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

View File

@ -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