Merge commit 'johnw/master'

lisp/ChangeLog

@@ -1,3 +1,35 @@
+2009-10-24  John Wiegley  <jwiegley@gmail.com>
+
+	* org-clock.el (org-clock-display, org-clock-put-overlay): Use
+	`org-time-clock-use-fractional'.
+
+	* org.el (org-time-clocksum-use-fractional)
+	(org-time-clocksum-fractional-format): Two new customizable
+	variables which allow the user to select fractional times (1.25
+	instead of 1:25) in the `org-clock-display' report.
+
+2009-10-23  John Wiegley  <jwiegley@gmail.com>
+
+	* org-habit.el (org-habit-build-graph): None of the arguments
+	should be optional.
+	(org-habit-parse-todo, org-habit-deadline)
+	(org-habit-get-priority, org-habit-get-faces)
+	(org-habit-build-graph): Further simplifications by storing all
+	past, scheduled and deadline dates as a number of days past the
+	epoch, and not as times.
+
+	* org-habit.el (org-habit-warning-face)
+	(org-habit-warning-future-face): Removed because these are no
+	longer used.
+	(org-habit-deadline, org-habit-deadline-repeat): Now always
+	returns a date; computed if there was a scheduled repeater but no
+	deadline repeater.
+	(org-habit-get-priority): Further improvements to the priority
+	algorithm.  In particular, items past due should always appear
+	before items due or not yet due.
+	(org-habit-get-faces): Greatly simplified the logic, now that
+	`org-habit-deadline' always returns a valid time.
+
 2009-10-23  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-ascii.el (org-export-ascii-table-keep-all-vertical-lines):
@@ -14,6 +46,9 @@
 
 2009-10-22  John Wiegley  <jwiegley@gmail.com>
 
+	* org-habit.el (org-habit-build-graph): Fix to the graph building
+	when last DONE date is earlier than `org-habit-preceding-days'.
+
 	* org-clock.el (org-resolve-clocks-if-idle): Fix to the way idle
 	time is reported after the user comes back (but before they
 	resolve time).

lisp/org-clock.el

@@ -1285,7 +1285,12 @@ in the echo area."
 	(when org-remove-highlights-with-change
 	  (org-add-hook 'before-change-functions 'org-clock-remove-overlays
 			nil 'local))))
-    (message (concat "Total file time: " org-time-clocksum-format " (%d hours and %d minutes)") h m h m)))
+    (if org-time-clocksum-use-fractional
+	(message (concat "Total file time: " org-time-clocksum-fractional-format
+			 " (%d hours and %d minutes)")
+		 (/ (+ (* h 60.0) m) 60.0) h m)
+      (message (concat "Total file time: " org-time-clocksum-format
+		       " (%d hours and %d minutes)") h m h m))))
 
 (defvar org-clock-overlays nil)
 (make-variable-buffer-local 'org-clock-overlays)
@@ -1297,7 +1302,9 @@ This creates a new overlay and stores it in `org-clock-overlays', so that it
 will be easy to remove."
   (let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h)))
 	 (l (if level (org-get-valid-level level 0) 0))
-	 (fmt (concat "%s " org-time-clocksum-format "%s"))
+	 (fmt (concat "%s " (if org-time-clocksum-use-fractional
+				org-time-clocksum-fractional-format
+			      org-time-clocksum-format) "%s"))
 	 (off 0)
 	 ov tx)
     (org-move-to-column c)
@@ -1306,9 +1313,14 @@ will be easy to remove."
     (setq ov (org-make-overlay (1- (point)) (point-at-eol))
 	  tx (concat (buffer-substring (1- (point)) (point))
 		     (make-string (+ off (max 0 (- c (current-column)))) ?.)
-		     (org-add-props (format fmt
-					    (make-string l ?*) h m
-					    (make-string (- 16 l) ?\ ))
+		     (org-add-props (if org-time-clocksum-use-fractional
+					(format fmt
+						(make-string l ?*)
+						(/ (+ (* h 60.0) m) 60.0)
+						(make-string (- 16 l) ?\ ))
+				      (format fmt
+					      (make-string l ?*) h m
+					      (make-string (- 16 l) ?\ )))
 			 (list 'face 'org-clock-overlay))
 		     ""))
     (if (not (featurep 'xemacs))

lisp/org-habit.el

@@ -63,7 +63,7 @@ Note that consistency graphs will overwrite anything else in the buffer."
 (defcustom org-habit-show-habits-only-for-today t
   "If non-nil, only show habits on today's agenda, and not for future days.
 Note that even when shown for future days, the graph is always
-relative to the current effective time."
+relative to the current effective date."
   :group 'org-habit
   :type 'boolean)
 
@@ -93,19 +93,6 @@ relative to the current effective time."
   :group 'org-habit
   :group 'org-faces)
 
-(defface org-habit-warning-face
-  '((((background light)) (:background "yellow"))
-    (((background dark)) (:background "gold")))
-  "Face for days on which a task ought to be done."
-  :group 'org-habit
-  :group 'org-faces)
-(defface org-habit-warning-future-face
-  '((((background light)) (:background "palegoldenrod"))
-    (((background dark)) (:background "darkgoldenrod")))
-  "Face for days on which a task ought be done."
-  :group 'org-habit
-  :group 'org-faces)
-
 (defface org-habit-alert-face
   '((((background light)) (:background "yellow"))
     (((background dark)) (:background "gold")))
@@ -163,7 +150,8 @@ This list represents a \"habit\" for the rest of this module."
 	   (sr-days (org-habit-duration-to-days scheduled-repeat))
 	   (end (org-entry-end-position))
 	   closed-dates deadline dr-days)
-      (unless scheduled
+      (if scheduled
+	  (setq scheduled (time-to-days scheduled))
 	(error "Habit has no scheduled date"))
       (unless scheduled-repeat
 	(error "Habit has no scheduled repeat period"))
@@ -174,11 +162,11 @@ This list represents a \"habit\" for the rest of this module."
 		       (match-string-no-properties 1 scheduled-repeat)))
 	(if (<= dr-days sr-days)
 	    (error "Habit's deadline repeat period is less than or equal to scheduled"))
-	(setq deadline (time-add scheduled
-				 (days-to-time (- dr-days sr-days)))))
+	(setq deadline (+ scheduled (- dr-days sr-days))))
       (org-back-to-heading t)
       (while (re-search-forward "- State \"DONE\".*\\[\\([^]]+\\)\\]" end t)
-	(push (org-time-string-to-time (match-string-no-properties 1))
+	(push (time-to-days
+	       (org-time-string-to-time (match-string-no-properties 1)))
 	      closed-dates))
       (list scheduled sr-days deadline dr-days closed-dates))))
 
@@ -187,43 +175,45 @@ This list represents a \"habit\" for the rest of this module."
 (defsubst org-habit-scheduled-repeat (habit)
   (nth 1 habit))
 (defsubst org-habit-deadline (habit)
-  (nth 2 habit))
+  (let ((deadline (nth 2 habit)))
+    (or deadline
+	(+ (org-habit-scheduled habit)
+	   (1- (org-habit-scheduled-repeat habit))))))
 (defsubst org-habit-deadline-repeat (habit)
-  (nth 3 habit))
+  (or (nth 3 habit)
+      (org-habit-scheduled-repeat habit)))
 (defsubst org-habit-done-dates (habit)
   (nth 4 habit))
 
-(defsubst org-habit-get-priority (habit)
+(defsubst org-habit-get-priority (habit &optional moment)
   "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))))
+	(now (time-to-days
+	      (or moment
+		  (time-subtract (current-time)
+				 (list 0 (* 3600 org-extend-today-until) 0)))))
+	(scheduled (org-habit-scheduled habit))
+	(deadline (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)))
+    (setq pri (+ pri (* (- now scheduled) 10)))
+    ;; add 50 if the deadline is today
+    (if (and (/= scheduled deadline)
+	     (= now deadline))
+	(setq pri (+ pri 50)))
+    ;; add 100 for every day beyond the deadline date, and subtract 10 for
+    ;; every day before it
+    (let ((slip (- now (1- deadline))))
       (if (> slip 0)
-	  (setq pri (+ pri (* slip 10)))
+	  (setq pri (+ pri (* slip 100)))
 	(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)
-  "Return faces for HABIT relative to MOMENT and SCHEDULED-TIME.
-MOMENT defaults to the current time if it is nil.
-SCHEDULED-TIME defaults to the habit's actual scheduled time if nil.
+(defun org-habit-get-faces (habit &optional now-days scheduled-days donep)
+  "Return faces for HABIT relative to NOW-DAYS and SCHEDULED-DAYS.
+NOW-DAYS defaults to the current time's days-past-the-epoch if nil.
+SCHEDULED-DAYS defaults to the habit's actual scheduled days if nil.
 
 Habits are assigned colors on the following basis:
   Blue      Task is before the scheduled date.
@@ -235,69 +225,57 @@ Habits are assigned colors on the following basis:
             no deadline, the end of the schedule's repeat period.
   Red       The task has gone beyond the deadline day or the
             schedule's repeat period."
-  (unless moment (setq moment (current-time)))
-  (let* ((scheduled (or scheduled-time (org-habit-scheduled habit)))
+  (let* ((scheduled (or scheduled-days (org-habit-scheduled habit)))
 	 (s-repeat (org-habit-scheduled-repeat habit))
-	 (scheduled-end (time-add scheduled (days-to-time (1- s-repeat))))
+	 (scheduled-end (+ scheduled (1- s-repeat)))
 	 (d-repeat (org-habit-deadline-repeat habit))
-	 (deadline (if (and scheduled-time d-repeat)
-		       (time-add scheduled-time
-				 (days-to-time (- d-repeat s-repeat)))
+	 (deadline (if scheduled-days
+		       (+ scheduled-days (- d-repeat s-repeat))
 		     (org-habit-deadline habit)))
-	 (m-days (time-to-days moment))
-	 (s-days (time-to-days scheduled))
-	 (s-end-days (time-to-days scheduled-end))
-	 (d-days (and deadline (time-to-days deadline))))
+	 (m-days (or now-days (time-to-days (current-time)))))
     (cond
-     ((< m-days s-days)
+     ((< m-days scheduled)
       '(org-habit-clear-face . org-habit-clear-future-face))
-     ((or (< m-days s-end-days)
-	  (and deadline (< m-days d-days)))
+     ((< m-days deadline)
       '(org-habit-ready-face . org-habit-ready-future-face))
-     ((and deadline (< m-days d-days))
-      (if donep
-	  '(org-habit-ready-face . org-habit-ready-future-face)
-	'(org-habit-warning-face . org-habit-warning-future-face)))
-     ((= m-days (if deadline
-		    d-days
-		  s-end-days))
+     ((= m-days deadline)
       (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)))))
 
-(defun org-habit-build-graph (habit &optional starting current ending)
-  "Build a color graph for the given HABIT, from STARTING to ENDING."
-  (let ((done-dates (sort (org-habit-done-dates habit) 'time-less-p))
-	(scheduled (org-habit-scheduled habit))
-	(s-repeat (org-habit-scheduled-repeat habit))
-	(day starting)
-	(current-days (time-to-days current))
-	last-done-date
-	(graph (make-string (1+ (- (time-to-days ending)
-				   (time-to-days starting))) ?\ ))
-	(index 0))
-    (if done-dates
-	(while (time-less-p (car done-dates) starting)
-	  (setq last-done-date (car done-dates)
-		done-dates (cdr done-dates))))
-    (while (time-less-p day ending)
-      (let* ((now-days (time-to-days day))
-	     (in-the-past-p (< now-days current-days))
-	     (todayp (= now-days current-days))
+(defun org-habit-build-graph (habit starting current ending)
+  "Build a graph for the given HABIT, from STARTING to ENDING.
+CURRENT gives the current time between STARTING and ENDING, for
+the purpose of drawing the graph.  It need not be the actual
+current time."
+  (let* ((done-dates (sort (org-habit-done-dates habit) '<))
+	 (scheduled (org-habit-scheduled habit))
+	 (s-repeat (org-habit-scheduled-repeat habit))
+	 (start (time-to-days starting))
+	 (now (time-to-days current))
+	 (end (time-to-days ending))
+	 (graph (make-string (1+ (- end start)) ?\ ))
+	 (index 0)
+	 last-done-date)
+    (while (and done-dates (< (car done-dates) start))
+      (setq last-done-date (car done-dates)
+	    done-dates (cdr done-dates)))
+    (while (< start end)
+      (let* ((in-the-past-p (< start now))
+	     (todayp (= start now))
 	     (donep (and done-dates
-			 (= now-days (time-to-days (car done-dates)))))
+			 (= start (car done-dates))))
 	     (faces (if (and in-the-past-p
 			     (not last-done-date)
-			     (not (time-less-p scheduled current)))
+			     (not (< scheduled now)))
 			'(org-habit-clear-face . org-habit-clear-future-face)
 		      (org-habit-get-faces
-		       habit day (and in-the-past-p
-				      (if last-done-date
-					  (time-add last-done-date
-						    (days-to-time s-repeat))
-					scheduled))
+		       habit start (and in-the-past-p
+					(if last-done-date
+					    (+ last-done-date s-repeat)
+					  scheduled))
 		       donep)))
 	     markedp face)
 	(if donep
@@ -305,13 +283,12 @@ Habits are assigned colors on the following basis:
 	      (aset graph index ?*)
 	      (setq markedp t)
 	      (while (and done-dates
-			  (= now-days (time-to-days (car done-dates))))
+			  (= start (car done-dates)))
 		(setq last-done-date (car done-dates)
 		      done-dates (cdr done-dates))))
 	  (if todayp
 	      (aset graph index ?!)))
-	(setq face (if (or in-the-past-p
-			   todayp)
+	(setq face (if (or in-the-past-p todayp)
 		       (car faces)
 		     (cdr faces)))
 	(if (and in-the-past-p
@@ -319,7 +296,7 @@ Habits are assigned colors on the following basis:
 		 (not markedp))
 	    (setq face (cdr faces)))
 	(put-text-property index (1+ index) 'face face graph))
-      (setq day (time-add day (days-to-time 1))
+      (setq start (1+ start)
 	    index (1+ index)))
     graph))
 

lisp/org.el

@@ -2175,6 +2175,18 @@ org-mode generates a time duration."
   :group 'org-time
   :type 'string)
 
+(defcustom org-time-clocksum-use-fractional nil
+  "If non-nil, \\[org-clock-display] uses fractional times.
+org-mode generates a time duration."
+  :group 'org-time
+  :type 'boolean)
+
+(defcustom org-time-clocksum-fractional-format "%.2f"
+  "The format string used when creating CLOCKSUM lines, or when
+org-mode generates a time duration."
+  :group 'org-time
+  :type 'string)
+
 (defcustom org-deadline-warning-days 14
   "No. of days before expiration during which a deadline becomes active.
 This variable governs the display in sparse trees and in the agenda.