org-habit: Fix ++ repeaters handling

* lisp/org-habit.el (org-habit-build-graph): Fix algorithm handling "++"
  repeaters.

Reported-by: Yasushi SHOJI <yashi@atmark-techno.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/104582>

1 files changed, 52 insertions, 31 deletions

diff --git a/lisp/org-habit.el b/lisp/org-habit.el
index f50b6de..b1aaee9 100644
--- a/lisp/org-habit.el
+++ b/lisp/org-habit.el
@@ -309,13 +309,14 @@ Habits are assigned colors on the following basis:
 CURRENT gives the current time between STARTING and ENDING, for
 the purpose of drawing the graph.  It need not be the actual
 current time."
-  (let* ((done-dates (sort (org-habit-done-dates habit) '<))
+  (let* ((all-done-dates (sort (org-habit-done-dates habit) #'<))
+	 (done-dates all-done-dates)
 	 (scheduled (org-habit-scheduled habit))
 	 (s-repeat (org-habit-scheduled-repeat habit))
 	 (start (time-to-days starting))
 	 (now (time-to-days current))
 	 (end (time-to-days ending))
-	 (graph (make-string (1+ (- end start)) ?\ ))
+	 (graph (make-string (1+ (- end start)) ?\s))
 	 (index 0)
 	 last-done-date)
     (while (and done-dates (< (car done-dates) start))
@@ -324,35 +325,55 @@ current time."
     (while (< start end)
       (let* ((in-the-past-p (< start now))
 	     (todayp (= start now))
-	     (donep (and done-dates
-			 (= start (car done-dates))))
-	     (faces (if (and in-the-past-p
-			     (not last-done-date)
-			     (not (< scheduled now)))
-			'(org-habit-clear-face . org-habit-clear-future-face)
-		      (org-habit-get-faces
-		       habit start
-		       (and in-the-past-p last-done-date
-			    ;; Compute scheduled time for habit at the
-			    ;; time START was current.
-			    (let ((type (org-habit-repeat-type habit)))
-			      (cond
-			       ((equal type ".+")
-				(+ last-done-date s-repeat))
-			       ((equal type "+")
-				;; Since LAST-DONE-DATE, each done
-				;; mark shifted scheduled date by
-				;; S-REPEAT.
-				(- scheduled (* (length done-dates) s-repeat)))
-			       (t
-				;; Scheduled time was the first time
-				;; past LAST-DONE-STATE which can jump
-				;; to current SCHEDULED time by
-				;; S-REPEAT hops.
-				(- scheduled
-				   (* (/ (- scheduled last-done-date) s-repeat)
-				      s-repeat))))))
-		       donep)))
+	     (donep (and done-dates (= start (car done-dates))))
+	     (faces
+	      (if (and in-the-past-p
+		       (not last-done-date)
+		       (not (< scheduled now)))
+		  '(org-habit-clear-face . org-habit-clear-future-face)
+		(org-habit-get-faces
+		 habit start
+		 (and in-the-past-p
+		      last-done-date
+		      ;; Compute scheduled time for habit at the time
+		      ;; START was current.
+		      (let ((type (org-habit-repeat-type habit)))
+			(cond
+			 ;; At the last done date, use current
+			 ;; scheduling in all cases.
+			 ((null done-dates) scheduled)
+			 ((equal type ".+") (+ last-done-date s-repeat))
+			 ((equal type "+")
+			  ;; Since LAST-DONE-DATE, each done mark
+			  ;; shifted scheduled date by S-REPEAT.
+			  (- scheduled (* (length done-dates) s-repeat)))
+			 (t
+			  ;; Compute the scheduled time after the
+			  ;; first repeat.  This is the closest time
+			  ;; past FIRST-DONE which can reach SCHEDULED
+			  ;; by a number of S-REPEAT hops.
+			  ;;
+			  ;; Then, play TODO state change history from
+			  ;; the beginning in order to find current
+			  ;; scheduled time.
+			  (let* ((first-done (car all-done-dates))
+				 (s (let ((shift (mod (- scheduled first-done)
+						      s-repeat)))
+				      (+ (if (= shift 0) s-repeat shift)
+					 first-done))))
+			    (if (= first-done last-done-date) s
+			      (catch :exit
+				(dolist (done (cdr all-done-dates) s)
+				  ;; Each repeat shifts S by any
+				  ;; number of S-REPEAT hops it takes
+				  ;; to get past DONE, with a minimum
+				  ;; of one hop.
+				  (incf s
+					(* (1+ (/ (max (- done s) 0) s-repeat))
+					   s-repeat))
+				  (when (= done last-done-date)
+				    (throw :exit s))))))))))
+		 donep)))
 	     markedp face)
 	(if donep
 	    (let ((done-time (time-add