Merge from emacs-23; up to 2012-01-19T07:15:48Z!rgm@gnu.org.

[gnu-emacs] / lisp / org / org-habit.el

diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index 71e0a9583f134fbd13f50e95ca4230fbcfeb330b..67f87797cb1bd83aad6c162d2d63ba82429f1d43 100644 (file)
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -1,11 +1,10 @@
 ;;; org-habit.el --- The habit tracking code for Org-mode
 
-;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <johnw at gnu dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 7.01
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -68,6 +67,16 @@ relative to the current effective date."
   :group 'org-habit
   :type 'boolean)
 
+(defcustom org-habit-today-glyph ?!
+  "Glyph character used to identify today."
+  :group 'org-habit
+  :type 'character)
+
+(defcustom org-habit-completed-glyph ?*
+  "Glyph character used to show completed days on which a task was done."
+  :group 'org-habit
+  :type 'character)
+
 (defface org-habit-clear-face
   '((((background light)) (:background "#8270f9"))
     (((background dark)) (:background "blue")))
@@ -149,15 +158,17 @@ This list represents a \"habit\" for the rest of this module."
     (assert (org-is-habit-p (point)))
     (let* ((scheduled (org-get-scheduled-time (point)))
           (scheduled-repeat (org-get-repeat org-scheduled-string))
-          (sr-days (org-habit-duration-to-days scheduled-repeat))
           (end (org-entry-end-position))
-          (habit-entry (org-no-properties (nth 5 (org-heading-components))))
-          closed-dates deadline dr-days)
+          (habit-entry (org-no-properties (nth 4 (org-heading-components))))
+          closed-dates deadline dr-days sr-days)
       (if scheduled
          (setq scheduled (time-to-days scheduled))
        (error "Habit %s has no scheduled date" habit-entry))
       (unless scheduled-repeat
-       (error "Habit %s has no scheduled repeat period" habit-entry))
+       (error
+        "Habit '%s' has no scheduled repeat period or has an incorrect one"
+        habit-entry))
+      (setq sr-days (org-habit-duration-to-days scheduled-repeat))
       (unless (> sr-days 0)
        (error "Habit %s scheduled repeat period is less than 1d" habit-entry))
       (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)
@@ -168,10 +179,18 @@ This list represents a \"habit\" for the rest of this module."
                   habit-entry scheduled-repeat))
        (setq deadline (+ scheduled (- dr-days sr-days))))
       (org-back-to-heading t)
-      (while (re-search-forward "- State \"DONE\".*\\[\\([^]]+\\)\\]" end t)
-       (push (time-to-days
-              (org-time-string-to-time (match-string-no-properties 1)))
-             closed-dates))
+      (let* ((maxdays (+ org-habit-preceding-days org-habit-following-days))
+            (reversed org-log-states-order-reversed)
+            (search (if reversed 're-search-forward 're-search-backward))
+            (limit (if reversed end (point)))
+            (count 0))
+       (unless reversed (goto-char end))
+       (while (and (< count maxdays)
+                   (funcall search "- State \"DONE\".*\\[\\([^]]+\\)\\]" limit t))
+         (push (time-to-days
+                (org-time-string-to-time (match-string-no-properties 1)))
+               closed-dates)
+         (setq count (1+ count))))
       (list scheduled sr-days deadline dr-days closed-dates))))
 
 (defsubst org-habit-scheduled (habit)
@@ -195,10 +214,7 @@ This list represents a \"habit\" for the rest of this module."
   "Determine the relative priority of a habit.
 This must take into account not just urgency, but consistency as well."
   (let ((pri 1000)
-       (now (time-to-days
-             (or moment
-                 (time-subtract (current-time)
-                                (list 0 (* 3600 org-extend-today-until) 0)))))
+       (now (if moment (time-to-days moment) (org-today)))
        (scheduled (org-habit-scheduled habit))
        (deadline (org-habit-deadline habit)))
     ;; add 10 for every day past the scheduled date, and subtract for every
@@ -290,7 +306,7 @@ current time."
                              (days-to-time
                               (- start (time-to-days starting))))))
 
-             (aset graph index ?*)
+             (aset graph index org-habit-completed-glyph)
              (setq markedp t)
              (put-text-property
               index (1+ index) 'help-echo
@@ -300,7 +316,7 @@ current time."
                (setq last-done-date (car done-dates)
                      done-dates (cdr done-dates))))
          (if todayp
-             (aset graph index ?!)))
+             (aset graph index org-habit-today-glyph)))
        (setq face (if (or in-the-past-p todayp)
                       (car faces)
                     (cdr faces)))
@@ -351,6 +367,4 @@ current time."
 
 (provide 'org-habit)
 
-;; arch-tag: 64e070d9-bd09-4917-bd44-44465f5ed348
-
 ;;; org-habit.el ends here