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 16 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>
 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
 	* org-habit.el (org-habit-build-graph): Start displaying colors
 	from the first scheduled date, if that date is earlier than the
 	from the first scheduled date, if that date is earlier than the
 	first completion date.
 	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)
 		     ((and (not habitp) pastschedp)
 		      'org-scheduled-previously)
 		      'org-scheduled-previously)
 		     (todayp 'org-scheduled-today)
 		     (todayp 'org-scheduled-today)
-		     (t 'org-scheduled)))
+		     (t 'org-scheduled))
+		    habitp (and habitp (org-habit-parse-todo)))
 	      (org-add-props txt props
 	      (org-add-props txt props
 		'undone-face face
 		'undone-face face
 		'face (if donep 'org-agenda-done 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)
 		'org-hd-marker (org-agenda-new-marker pos1)
 		'type (if pastschedp "past-scheduled" "scheduled")
 		'type (if pastschedp "past-scheduled" "scheduled")
 		'date (if pastschedp d2 date)
 		'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-category category
-		'org-habit-p (and habitp (org-habit-parse-todo))
+		'org-habit-p habitp
 		'todo-state todo-state)
 		'todo-state todo-state)
 	      (push txt ee))))))
 	      (push txt ee))))))
     (nreverse 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)
 (defsubst org-habit-done-dates (habit)
   (nth 4 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)
 (defun org-habit-get-faces (habit &optional moment scheduled-time donep)
   "Return faces for HABIT relative to MOMENT and SCHEDULED-TIME.
   "Return faces for HABIT relative to MOMENT and SCHEDULED-TIME.
 MOMENT defaults to the current time if it is nil.
 MOMENT defaults to the current time if it is nil.