Show clock overruns in mode line

Patch by Richard Riley.

3 files changed, 76 insertions, 21 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ef30612..ee1ffc2 100755
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2010-01-23  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org-clock.el (org-task-overrun-text): New option.
+	(org-task-overrun, org-clock-update-period): New variables.
+	(org-clock-get-clock-string, org-clock-update-mode-line): Mark
+	overrun clock.
+	(org-clock-notify-once-if-expired): Check if clock is overrun.
+
+	* org-faces.el: New face `org-mode-line-clock-overrun'.
+
 2010-01-18  Jan Böcker  <jan.boecker@jboecker.de>
 
 	* org.el (org-narrow-to-subtree): Position the end of the narrowed
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index e83971d..72bb7ad 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -200,6 +200,17 @@ auto     Automatically, either `all', or `repeat' for repeating tasks"
 	  (const :tag "All task time" all)
 	  (const :tag "Automatically, `all' or since `repeat'" auto)))
 
+(defcustom org-task-overrun-text nil
+  "The extra modeline text that should indicate that the clock is overrun.
+The can be nil to indicate that instead of adding text, the clock time
+should get a different face (`org-mode-ling-clock-overrun').
+When this is a string, it is prepended to the clock string as an indication,
+also using the face `org-mode-ling-clock-overrun'."
+  :group 'org-clock
+  :type '(choice
+	  (const :tag "Just mark the time string" nil)
+	  (string :tag "Text to prepend")))
+
 (defcustom org-show-notification-handler nil
   "Function or program to send notification with.
 The function or program will be called with the notification
@@ -388,6 +399,11 @@ pointing to it."
 	(insert (format "[%c] %-15s %s\n" i cat task))
 	(cons i marker)))))
 
+(defvar org-task-overrun nil
+  "Internal flag indicating if the clock has overrun the planned time.")
+(defvar org-clock-update-period 60
+  "Number of seconds between mode line clock string updates.")
+
 (defun org-clock-get-clock-string ()
   "Form a clock-string, that will be show in the mode line.
 If an effort estimate was defined for current item, use
@@ -396,29 +412,50 @@ If not, show simply the clocked time like 01:50."
   (let* ((clocked-time (org-clock-get-clocked-time))
 	 (h (floor clocked-time 60))
 	 (m (- clocked-time (* 60 h))))
-    (if (and org-clock-effort)
-	(let* ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))
+    (if org-clock-effort
+	(let* ((effort-in-minutes
+		(org-hh:mm-string-to-minutes org-clock-effort))
 	       (effort-h (floor effort-in-minutes 60))
-	       (effort-m (- effort-in-minutes (* effort-h 60))))
-	  (format (concat "-[" org-time-clocksum-format "/" org-time-clocksum-format " (%s)]")
-		  h m effort-h effort-m  org-clock-heading))
-      (format (concat "-[" org-time-clocksum-format " (%s)]")
-	      h m org-clock-heading))))
+	       (effort-m (- effort-in-minutes (* effort-h 60)))
+	       (work-done-str
+		(org-propertize
+		 (format org-time-clocksum-format h m)
+		 'face (if (and org-task-overrun (not org-task-overrun-text))
+			   'org-mode-line-clock-overrun 'org-mode-line-clock)))
+	       (effort-str (format org-time-clocksum-format effort-h effort-m))
+	       (clockstr (org-propertize
+			  (concat  "[%s/" effort-str
+				   "] (" org-clock-heading ")")
+			  'face 'org-mode-line-clock)))
+	  (format clockstr work-done-str))
+      (org-propertize (format
+		       (concat "[" org-time-clocksum-format " (%s)]")
+		       h m org-clock-heading)
+		      'face 'org-mode-line-clock))))
 
 (defun org-clock-update-mode-line ()
+  (if org-clock-effort
+      (org-clock-notify-once-if-expired)
+    (setq org-task-overrun nil))
   (setq org-mode-line-string
 	(org-propertize
 	 (let ((clock-string (org-clock-get-clock-string))
 	       (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task"))
 	   (if (and (> org-clock-string-limit 0)
 		    (> (length clock-string) org-clock-string-limit))
-	       (org-propertize (substring clock-string 0 org-clock-string-limit)
-			       'help-echo (concat help-text ": " org-clock-heading))
+	       (org-propertize
+		(substring clock-string 0 org-clock-string-limit)
+		'help-echo (concat help-text ": " org-clock-heading))
 	     (org-propertize clock-string 'help-echo help-text)))
 	 'local-map org-clock-mode-line-map
 	 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)
-	 'face 'org-mode-line-clock))
-  (if org-clock-effort (org-clock-notify-once-if-expired))
+	 ))
+  (if (and org-task-overrun org-task-overrun-text)
+      (setq org-mode-line-string
+	    (concat (org-propertize
+		     org-task-overrun-text
+		     'face 'org-mode-line-clock-overrun) org-mode-line-string)))
+ 
   (force-mode-line-update))
 
 (defun org-clock-get-clocked-time ()
@@ -473,7 +510,10 @@ Notification is shown only once."
   (when (marker-buffer org-clock-marker)
     (let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))
 	  (clocked-time (org-clock-get-clocked-time)))
-      (if (>= clocked-time effort-in-minutes)
+      (if (setq org-task-overrun 
+		(if (or (null effort-in-minutes) (zerop effort-in-minutes))
+		    nil
+		  (>= clocked-time effort-in-minutes)))
 	  (unless org-clock-notification-was-shown
 	    (setq org-clock-notification-was-shown t)
 	    (org-notify
@@ -989,7 +1029,9 @@ the clocking selection, associated with the letter `d'."
 	      (cancel-timer org-clock-mode-line-timer)
 	      (setq org-clock-mode-line-timer nil))
 	    (setq org-clock-mode-line-timer
-		  (run-with-timer 60 60 'org-clock-update-mode-line))
+		  (run-with-timer org-clock-update-period
+				  org-clock-update-period
+				  'org-clock-update-mode-line))
 	    (when org-clock-idle-timer
 	      (cancel-timer org-clock-idle-timer)
 	      (setq org-clock-idle-timer nil))
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
index dc62e96..093905a 100644
--- a/lisp/org-faces.el
+++ b/lisp/org-faces.el
@@ -378,10 +378,10 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
 
 
 (org-copy-face 'org-todo 'org-checkbox-statistics-todo
-	       "Face used for unfinished checkbox statistics.")
+  "Face used for unfinished checkbox statistics.")
 
 (org-copy-face 'org-done 'org-checkbox-statistics-done
-	       "Face used for finished checkbox statistics.")
+  "Face used for finished checkbox statistics.")
 
 (defcustom org-tag-faces nil
   "Faces for specific tags.
@@ -502,17 +502,17 @@ changes."
   :group 'org-faces)
 
 (org-copy-face 'org-agenda-structure 'org-agenda-date
-	       "Face used in agenda for normal days.")
+  "Face used in agenda for normal days.")
 
 (org-copy-face 'org-agenda-date 'org-agenda-date-today
-	       "Face used in agenda for today."
-	       :weight 'bold :italic 't)
+  "Face used in agenda for today."
+  :weight 'bold :italic 't)
 
 (org-copy-face 'secondary-selection 'org-agenda-clocking
-	       "Face marking the current clock item in the agenda.")
+  "Face marking the current clock item in the agenda.")
 
 (org-copy-face 'org-agenda-date 'org-agenda-date-weekend
-	       "Face used in agenda for weekend days.
+  "Face used in agenda for weekend days.
 See the variable `org-agenda-weekend-days' for a definition of which days
 belong to the weekend."
 	       :weight 'bold)
@@ -640,7 +640,10 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
   :group 'org-faces)
 
 (org-copy-face 'modeline 'org-mode-line-clock
-	       "Face used for clock display in mode line.")
+  "Face used for clock display in mode line.")
+(org-copy-face 'modeline 'org-mode-line-clock-overrun 
+  "Face used for clock display for overrun tasks in mode line."
+  :background "red")
 
 (provide 'org-faces)