X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/fb724e553757e9d3344be443ab5f329afc9bf91c..77ab81d0545e980c57c0a35510ade29a9e43b4cd:/lisp/org/org-habit.el diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index dd1bacdea7..ec58b746d6 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -5,7 +5,7 @@ ;; Author: John Wiegley ;; 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