Browse Source

Fix `org-auto-repeat-maybe'

* lisp/org.el (org-auto-repeat-maybe): Do not remove SCHEDULED time
  stamp when encountering a time stamp without a repeater.  Also, ensure
  "REPEAT_TO_STATE" property can be inherited.  Small refactoring.

Reported-by: "Bradley M. Kuhn" <bkuhn@ebb.org>
<http://permalink.gmane.org/gmane.emacs.orgmode/104103>
Nicolas Goaziou 9 years ago
parent
commit
157f91c31c
1 changed files with 78 additions and 57 deletions
  1. 78 57
      lisp/org.el

+ 78 - 57
lisp/org.el

@@ -13093,11 +13093,12 @@ on INACTIVE-OK."
 (defvar org-log-note-how nil)
 (defvar org-log-note-how nil)
 (defvar org-log-note-extra)
 (defvar org-log-note-extra)
 (defun org-auto-repeat-maybe (done-word)
 (defun org-auto-repeat-maybe (done-word)
-  "Check if the current headline contains a repeated deadline/schedule.
+  "Check if the current headline contains a repeated time-stamp.
+
 If yes, set TODO state back to what it was and change the base date
 If yes, set TODO state back to what it was and change the base date
 of repeating deadline/scheduled time stamps to new date.
 of repeating deadline/scheduled time stamps to new date.
+
 This function is run automatically after each state change to a DONE state."
 This function is run automatically after each state change to a DONE state."
-  ;; last-state is dynamically scoped into this function
   (let* ((repeat (org-get-repeat))
   (let* ((repeat (org-get-repeat))
 	 (aa (assoc org-last-state org-todo-kwd-alist))
 	 (aa (assoc org-last-state org-todo-kwd-alist))
 	 (interpret (nth 1 aa))
 	 (interpret (nth 1 aa))
@@ -13105,78 +13106,98 @@ This function is run automatically after each state change to a DONE state."
 	 (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
 	 (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year)))
 	 (msg "Entry repeats: ")
 	 (msg "Entry repeats: ")
 	 (org-log-done nil)
 	 (org-log-done nil)
-	 (org-todo-log-states nil)
-	 re type n what ts time to-state)
+	 (org-todo-log-states nil))
     (when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
     (when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
       (when (eq org-log-repeat t) (setq org-log-repeat 'state))
       (when (eq org-log-repeat t) (setq org-log-repeat 'state))
-      (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE")
-			 org-todo-repeat-to-state))
-      (unless (and to-state (member to-state org-todo-keywords-1))
-	(setq to-state (if (eq interpret 'type) org-last-state head)))
-      (org-todo to-state)
+      (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
+			  org-todo-repeat-to-state)))
+	(unless (and to-state (member to-state org-todo-keywords-1))
+	  (setq to-state (if (eq interpret 'type) org-last-state head)))
+	(org-todo to-state))
       (when (or org-log-repeat (org-entry-get nil "CLOCK"))
       (when (or org-log-repeat (org-entry-get nil "CLOCK"))
 	(org-entry-put nil "LAST_REPEAT" (format-time-string
 	(org-entry-put nil "LAST_REPEAT" (format-time-string
 					  (org-time-stamp-format t t))))
 					  (org-time-stamp-format t t))))
       (when org-log-repeat
       (when org-log-repeat
 	(if (or (memq 'org-add-log-note (default-value 'post-command-hook))
 	(if (or (memq 'org-add-log-note (default-value 'post-command-hook))
 		(memq 'org-add-log-note post-command-hook))
 		(memq 'org-add-log-note post-command-hook))
-	    ;; OK, we are already setup for some record
+	    ;; We are already setup for some record.
 	    (when (eq org-log-repeat 'note)
 	    (when (eq org-log-repeat 'note)
-	      ;; make sure we take a note, not only a time stamp
+	      ;; Make sure we take a note, not only a time stamp.
 	      (setq org-log-note-how 'note))
 	      (setq org-log-note-how 'note))
-	  ;; Set up for taking a record
+	  ;; Set up for taking a record.
 	  (org-add-log-setup 'state
 	  (org-add-log-setup 'state
 			     (or done-word (car org-done-keywords))
 			     (or done-word (car org-done-keywords))
 			     org-last-state
 			     org-last-state
 			     org-log-repeat)))
 			     org-log-repeat)))
       (org-back-to-heading t)
       (org-back-to-heading t)
       (org-add-planning-info nil nil 'closed)
       (org-add-planning-info nil nil 'closed)
-      (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
-		       org-deadline-time-regexp "\\)\\|\\("
-		       org-ts-regexp "\\)"))
-      (while (re-search-forward
-	      re (save-excursion (outline-next-heading) (point)) t)
-	(setq type (if (match-end 1) org-scheduled-string
-		     (if (match-end 3) org-deadline-string "Plain:"))
-	      ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0))))
-	(if (not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))
-	    (org-remove-timestamp-with-keyword org-scheduled-string)
-	  (setq n (string-to-number (match-string 2 ts))
-		what (match-string 3 ts))
-	  (when (equal what "w") (setq n (* n 7) what "d"))
-	  (when (and (equal what "h")
-		     (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)))
-	    (user-error
-	     "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n))
-	  ;; Preparation, see if we need to modify the start date for the change
-	  (when (match-end 1)
-	    (setq time (save-match-data (org-time-string-to-time ts)))
+      (let ((regexp (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
+			    org-deadline-time-regexp "\\)\\|\\("
+			    org-ts-regexp "\\)"))
+	    (end (save-excursion (outline-next-heading) (point))))
+	(while (re-search-forward regexp end t)
+	  (let ((type (cond ((match-end 1) org-scheduled-string)
+			    ((match-end 3) org-deadline-string)
+			    (t "Plain:")))
+		(ts (or (match-string 2) (match-string 4) (match-string 0))))
 	    (cond
 	    (cond
-	     ((equal (match-string 1 ts) ".")
-	      ;; Shift starting date to today
-	      (org-timestamp-change
-	       (- (org-today) (time-to-days time))
-	       'day))
-	     ((equal (match-string 1 ts) "+")
-	      (let ((nshiftmax 10) (nshift 0))
-		(while (or (= nshift 0)
-			   (<= (time-to-days time)
-			       (time-to-days (current-time))))
-		  (when (= (incf nshift) nshiftmax)
-		    (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today.  Continue? " nshift))
-			(user-error "Abort")))
-		  (org-timestamp-change n (cdr (assoc what whata)))
-		  (org-at-timestamp-p t)
-		  (setq ts (match-string 1))
-		  (setq time (save-match-data (org-time-string-to-time ts)))))
-	      (org-timestamp-change (- n) (cdr (assoc what whata)))
-	      ;; rematch, so that we have everything in place for the real shift
-	      (org-at-timestamp-p t)
-	      (setq ts (match-string 1))
-	      (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))))
-	  (save-excursion
-	    (org-timestamp-change n (cdr (assoc what whata)) nil t))
-	  (setq msg (concat msg type " " org-last-changed-timestamp " "))))
+	     ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))
+	      ;; Time-stamps without a repeater are usually skipped.
+	      ;; However, a SCHEDULED or DEADLINE time-stamp without
+	      ;; one is removed, as it is considered outdated.
+	      (unless (equal type "Plain:")
+		(org-remove-timestamp-with-keyword type)))
+	     (t
+	      (let ((n (string-to-number (match-string 2 ts)))
+		    (what (match-string 3 ts)))
+		(when (equal what "w") (setq n (* n 7) what "d"))
+		(when (and (equal what "h")
+			   (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
+						ts)))
+		  (user-error
+		   "Cannot repeat in Repeat in %d hour(s) because no hour has \
+been set"
+		   n))
+		;; Preparation, see if we need to modify the start
+		;; date for the change.
+		(when (match-end 1)
+		  (let ((time (save-match-data (org-time-string-to-time ts))))
+		    (cond
+		     ((equal (match-string 1 ts) ".")
+		      ;; Shift starting date to today
+		      (org-timestamp-change
+		       (- (org-today) (time-to-days time))
+		       'day))
+		     ((equal (match-string 1 ts) "+")
+		      (let ((nshiftmax 10)
+			    (nshift 0))
+			(while (or (= nshift 0)
+				   (<= (time-to-days time)
+				       (time-to-days (current-time))))
+			  (when (= (incf nshift) nshiftmax)
+			    (or (y-or-n-p
+				 (format "%d repeater intervals were not \
+enough to shift date past today.  Continue? "
+					 nshift))
+				(user-error "Abort")))
+			  (org-timestamp-change n (cdr (assoc what whata)))
+			  (org-at-timestamp-p t)
+			  (setq ts (match-string 1))
+			  (setq time
+				(save-match-data
+				  (org-time-string-to-time ts)))))
+		      (org-timestamp-change (- n) (cdr (assoc what whata)))
+		      ;; Rematch, so that we have everything in place
+		      ;; for the real shift.
+		      (org-at-timestamp-p t)
+		      (setq ts (match-string 1))
+		      (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
+				    ts)))))
+		(save-excursion
+		  (org-timestamp-change n (cdr (assoc what whata)) nil t))
+		(setq msg
+		      (concat
+		       msg type " " org-last-changed-timestamp " "))))))))
       (setq org-log-post-message msg)
       (setq org-log-post-message msg)
       (message "%s" msg))))
       (message "%s" msg))))