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-extra)
 (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
 of repeating deadline/scheduled time stamps to new date.
+
 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))
 	 (aa (assoc org-last-state org-todo-kwd-alist))
 	 (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)))
 	 (msg "Entry repeats: ")
 	 (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 (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"))
 	(org-entry-put nil "LAST_REPEAT" (format-time-string
 					  (org-time-stamp-format t t))))
       (when org-log-repeat
 	(if (or (memq 'org-add-log-note (default-value '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)
-	      ;; 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))
-	  ;; Set up for taking a record
+	  ;; Set up for taking a record.
 	  (org-add-log-setup 'state
 			     (or done-word (car org-done-keywords))
 			     org-last-state
 			     org-log-repeat)))
       (org-back-to-heading t)
       (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
-	     ((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)
       (message "%s" msg))))