Browse Source

Added custom priorities to the habit code

org-habit.el (org-habit-get-priority): A new function that determines
the relative priority of a habit, based on how long past its scheduled
date it is, and how near the deadline is.

org-agenda.el (org-agenda-get-scheduled): Set habit priority using
`org-habit-get-priority'.
John Wiegley 15 years ago
parent
commit
09b1564bb4
3 changed files with 40 additions and 3 deletions
  1. 7 0
      lisp/ChangeLog
  2. 6 3
      lisp/org-agenda.el
  3. 27 0
      lisp/org-habit.el

+ 7 - 0
lisp/ChangeLog

@@ -1,5 +1,12 @@
 2009-10-20  John Wiegley  <jwiegley@gmail.com>
 
+	* org-habit.el (org-habit-get-priority): A new function that
+	determines the relative priority of a habit, based on how long
+	past its scheduled date it is, and how near the deadline is.
+
+	* org-agenda.el (org-agenda-get-scheduled): Set habit priority
+	using `org-habit-get-priority'.
+
 	* org-habit.el (org-habit-build-graph): Start displaying colors
 	from the first scheduled date, if that date is earlier than the
 	first completion date.

+ 6 - 3
lisp/org-agenda.el

@@ -4398,7 +4398,8 @@ FRACTION is what fraction of the head-warning time has passed."
 		     ((and (not habitp) pastschedp)
 		      'org-scheduled-previously)
 		     (todayp 'org-scheduled-today)
-		     (t 'org-scheduled)))
+		     (t 'org-scheduled))
+		    habitp (and habitp (org-habit-parse-todo)))
 	      (org-add-props txt props
 		'undone-face face
 		'face (if donep 'org-agenda-done face)
@@ -4406,9 +4407,11 @@ FRACTION is what fraction of the head-warning time has passed."
 		'org-hd-marker (org-agenda-new-marker pos1)
 		'type (if pastschedp "past-scheduled" "scheduled")
 		'date (if pastschedp d2 date)
-		'priority (+ 94 (- 5 diff) (org-get-priority txt))
+		'priority (if habitp
+			      (org-habit-get-priority habitp)
+			    (+ 94 (- 5 diff) (org-get-priority txt)))
 		'org-category category
-		'org-habit-p (and habitp (org-habit-parse-todo))
+		'org-habit-p habitp
 		'todo-state todo-state)
 	      (push txt ee))))))
     (nreverse ee)))

+ 27 - 0
lisp/org-habit.el

@@ -191,6 +191,33 @@ This list represents a \"habit\" for the rest of this module."
 (defsubst org-habit-done-dates (habit)
   (nth 4 habit))
 
+(defsubst org-habit-get-priority (habit)
+  "Determine the relative priority of a habit.
+This must take into account not just urgency, but consistency as well."
+  (let ((pri 1000)
+	(days (time-to-days
+	       (time-subtract (current-time)
+			      (list 0 (* 3600 org-extend-today-until) 0))))
+	(s-days (time-to-days (org-habit-scheduled habit)))
+	(d-days (time-to-days (org-habit-deadline habit))))
+    ;; add 10 for every day past the scheduled date, and subtract for every
+    ;; day before it
+    (let ((slip (- days s-days)))
+      (if (> slip 0)
+	  (setq pri (+ pri (* slip 10)))
+	(setq pri (+ pri (* slip 10)))))
+    ;; add 20 for every day beyond the deadline date, and subtract 5 for every
+    ;; day before it
+    (if (/= s-days d-days)
+	;; add 100 if the deadline is today
+	(if (= days d-days)
+	    (setq pri (+ pri 100))))
+    (let ((slip (- days d-days)))
+      (if (> slip 0)
+	  (setq pri (+ pri (* slip 20)))
+	(setq pri (+ pri (* slip 5)))))
+    pri))
+
 (defun org-habit-get-faces (habit &optional moment scheduled-time donep)
   "Return faces for HABIT relative to MOMENT and SCHEDULED-TIME.
 MOMENT defaults to the current time if it is nil.