Browse Source

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>
Nicolas Goaziou 9 years ago
parent
commit
81c0ea92f8
1 changed files with 52 additions and 31 deletions
  1. 52 31
      lisp/org-habit.el

+ 52 - 31
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
 CURRENT gives the current time between STARTING and ENDING, for
 the purpose of drawing the graph.  It need not be the actual
 the purpose of drawing the graph.  It need not be the actual
 current time."
 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))
 	 (scheduled (org-habit-scheduled habit))
 	 (s-repeat (org-habit-scheduled-repeat habit))
 	 (s-repeat (org-habit-scheduled-repeat habit))
 	 (start (time-to-days starting))
 	 (start (time-to-days starting))
 	 (now (time-to-days current))
 	 (now (time-to-days current))
 	 (end (time-to-days ending))
 	 (end (time-to-days ending))
-	 (graph (make-string (1+ (- end start)) ?\ ))
+	 (graph (make-string (1+ (- end start)) ?\s))
 	 (index 0)
 	 (index 0)
 	 last-done-date)
 	 last-done-date)
     (while (and done-dates (< (car done-dates) start))
     (while (and done-dates (< (car done-dates) start))
@@ -324,35 +325,55 @@ current time."
     (while (< start end)
     (while (< start end)
       (let* ((in-the-past-p (< start now))
       (let* ((in-the-past-p (< start now))
 	     (todayp (= 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)
 	     markedp face)
 	(if donep
 	(if donep
 	    (let ((done-time (time-add
 	    (let ((done-time (time-add