Merge from emacs-23

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

diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index dd1bacdea71783079642f5293d9477a8963fc0a1..ec58b746d686e7eb8f590d8be1ff8d0aaf5519a5 100644 (file)
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -5,7 +5,7 @@
 ;; Author: John Wiegley <johnw at gnu dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 6.33x
+;; Version: 7.4
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -27,11 +27,13 @@
 
 ;; This file contains the habit tracking code for Org-mode
 
+;;; Code:
+
 (require 'org)
 (require 'org-agenda)
+
 (eval-when-compile
-  (require 'cl)
-  (require 'calendar))
+  (require 'cl))
 
 (defgroup org-habit nil
   "Options concerning habit tracking in Org-mode."
@@ -67,52 +69,52 @@ relative to the current effective date."
   :type 'boolean)
 
 (defface org-habit-clear-face
-  '((((background light)) (:background "slateblue"))
+  '((((background light)) (:background "#8270f9"))
     (((background dark)) (:background "blue")))
   "Face for days on which a task shouldn't be done yet."
   :group 'org-habit
   :group 'org-faces)
 (defface org-habit-clear-future-face
-  '((((background light)) (:background "powderblue"))
+  '((((background light)) (:background "#d6e4fc"))
     (((background dark)) (:background "midnightblue")))
   "Face for future days on which a task shouldn't be done yet."
   :group 'org-habit
   :group 'org-faces)
 
 (defface org-habit-ready-face
-  '((((background light)) (:background "green"))
+  '((((background light)) (:background "#4df946"))
     (((background dark)) (:background "forestgreen")))
   "Face for days on which a task should start to be done."
   :group 'org-habit
   :group 'org-faces)
 (defface org-habit-ready-future-face
-  '((((background light)) (:background "palegreen"))
+  '((((background light)) (:background "#acfca9"))
     (((background dark)) (:background "darkgreen")))
   "Face for days on which a task should start to be done."
   :group 'org-habit
   :group 'org-faces)
 
 (defface org-habit-alert-face
-  '((((background light)) (:background "yellow"))
+  '((((background light)) (:background "#f5f946"))
     (((background dark)) (:background "gold")))
   "Face for days on which a task is due."
   :group 'org-habit
   :group 'org-faces)
 (defface org-habit-alert-future-face
-  '((((background light)) (:background "palegoldenrod"))
+  '((((background light)) (:background "#fafca9"))
     (((background dark)) (:background "darkgoldenrod")))
   "Face for days on which a task is due."
   :group 'org-habit
   :group 'org-faces)
 
 (defface org-habit-overdue-face
-  '((((background light)) (:background "red"))
+  '((((background light)) (:background "#f9372d"))
     (((background dark)) (:background "firebrick")))
   "Face for days on which a task is overdue."
   :group 'org-habit
   :group 'org-faces)
 (defface org-habit-overdue-future-face
-  '((((background light)) (:background "mistyrose"))
+  '((((background light)) (:background "#fc9590"))
     (((background dark)) (:background "darkred")))
   "Face for days on which a task is overdue."
   :group 'org-habit
@@ -147,15 +149,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)
@@ -179,8 +183,10 @@ This list represents a \"habit\" for the rest of this module."
 (defsubst org-habit-deadline (habit)
   (let ((deadline (nth 2 habit)))
     (or deadline
-       (+ (org-habit-scheduled habit)
-          (1- (org-habit-scheduled-repeat habit))))))
+       (if (nth 3 habit)
+           (+ (org-habit-scheduled habit)
+              (1- (org-habit-scheduled-repeat habit)))
+         (org-habit-scheduled habit)))))
 (defsubst org-habit-deadline-repeat (habit)
   (or (nth 3 habit)
       (org-habit-scheduled-repeat habit)))
@@ -191,10 +197,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
@@ -281,9 +284,16 @@ current time."
                       donep)))
             markedp face)
        (if donep
-           (progn
+           (let ((done-time (time-add
+                             starting
+                             (days-to-time
+                              (- start (time-to-days starting))))))
+
              (aset graph index ?*)
              (setq markedp t)
+             (put-text-property
+              index (1+ index) 'help-echo
+              (format-time-string (org-time-stamp-format) done-time) graph)
              (while (and done-dates
                          (= start (car done-dates)))
                (setq last-done-date (car done-dates)
@@ -305,6 +315,7 @@ current time."
 (defun org-habit-insert-consistency-graphs (&optional line)
   "Insert consistency graph for any habitual tasks."
   (let ((inhibit-read-only t) l c
+       (buffer-invisibility-spec '(org-link))
        (moment (time-subtract (current-time)
                               (list 0 (* 3600 org-extend-today-until) 0))))
     (save-excursion