use xmalloc_unsafe in current_minor_maps

[bpt/emacs.git] / lisp / org / org-habit.el

diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index 33c55cf..721718d 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-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <johnw at gnu dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 7.4
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -68,6 +67,30 @@ relative to the current effective date."
   :group 'org-habit
   :type 'boolean)
 
+(defcustom org-habit-show-all-today nil
+  "If non-nil, will show the consistency graph of all habits on
+today's agenda, even if they are not scheduled."
+  :group 'org-habit
+  :type 'boolean)
+
+(defcustom org-habit-today-glyph ?!
+  "Glyph character used to identify today."
+  :group 'org-habit
+  :version "24.1"
+  :type 'character)
+
+(defcustom org-habit-completed-glyph ?*
+  "Glyph character used to show completed days on which a task was done."
+  :group 'org-habit
+  :version "24.1"
+  :type 'character)
+
+(defcustom org-habit-show-done-always-green nil
+  "Non-nil means DONE days will always be green in the consistency graph.
+It will be green even if it was done after the deadline."
+  :group 'org-habit
+  :type 'boolean)
+
 (defface org-habit-clear-face
   '((((background light)) (:background "#8270f9"))
     (((background dark)) (:background "blue")))
@@ -170,10 +193,20 @@ 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 (format "- State \"%s\".*\\[\\([^]]+\\)\\]"
+                                           (regexp-opt org-done-keywords))
+                            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)
@@ -247,8 +280,9 @@ Habits are assigned colors on the following basis:
       (if donep
          '(org-habit-ready-face . org-habit-ready-future-face)
        '(org-habit-alert-face . org-habit-alert-future-face)))
-     (t
-      '(org-habit-overdue-face . org-habit-overdue-future-face)))))
+     ((and org-habit-show-done-always-green donep)
+      '(org-habit-ready-face . org-habit-ready-future-face))
+     (t '(org-habit-overdue-face . org-habit-overdue-future-face)))))
 
 (defun org-habit-build-graph (habit starting current ending)
   "Build a graph for the given HABIT, from STARTING to ENDING.
@@ -289,7 +323,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
@@ -299,7 +333,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)))
@@ -317,7 +351,14 @@ current time."
   (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))))
+                              (list 0 (* 3600 org-extend-today-until) 0)))
+       disabled-overlays)
+    ;; Disable filters; this helps with alignment if there are links.
+    (mapc (lambda (ol)
+           (when (overlay-get ol 'invisible)
+             (overlay-put ol 'invisible nil)
+             (setq disabled-overlays (cons ol disabled-overlays))))
+         (overlays-in (point-min) (point-max)))
     (save-excursion
       (goto-char (if line (point-at-bol) (point-min)))
       (while (not (eobp))
@@ -327,14 +368,15 @@ current time."
            (delete-char (min (+ 1 org-habit-preceding-days
                                 org-habit-following-days)
                              (- (line-end-position) (point))))
-           (insert (org-habit-build-graph
-                    habit
-                    (time-subtract moment
-                                   (days-to-time org-habit-preceding-days))
-                    moment
-                    (time-add moment
-                              (days-to-time org-habit-following-days))))))
-       (forward-line)))))
+           (insert-before-markers
+            (org-habit-build-graph
+             habit
+             (time-subtract moment (days-to-time org-habit-preceding-days))
+             moment
+             (time-add moment (days-to-time org-habit-following-days))))))
+       (forward-line)))
+    (mapc (lambda (ol) (overlay-put ol 'invisible t))
+         disabled-overlays)))
 
 (defun org-habit-toggle-habits ()
   "Toggle display of habits in an agenda buffer."
@@ -350,5 +392,4 @@ current time."
 
 (provide 'org-habit)
 
-
 ;;; org-habit.el ends here