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>

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

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