Implement clock consistency check functionality for agenda
authorCarsten Dominik <carsten.dominik@gmail.com>
Tue, 19 Apr 2011 22:13:31 +0000 (00:13 +0200)
committerCarsten Dominik <carsten.dominik@gmail.com>
Sun, 24 Apr 2011 15:17:25 +0000 (17:17 +0200)
* lisp/org-agenda.el (org-agenda-clock-consistency-checks): New option.
(org-agenda-list): Handle display change to clock check.
(org-agenda-get-progress): Show only clock entries if we are doing the
consistency check.
(org-agenda-show-clocking-issues): New function.
(org-agenda-check-clock-gap): New function.
(org-agenda-view-mode-dispatch): Offer consistency check.
(org-agenda-log-mode): Handle switch to clock only display.
(org-agenda-set-mode-name): Show lighter for Clockcheck.
* lisp/org.el (org-hh:mm-string-to-minutes): Accept an integer argument
and return it unchanged.
* doc/org.texi (Agenda commands): Document clock consistency checks.
* doc/orgcard.tex: Document key for clock consistency check.

doc/org.texi
doc/orgcard.tex
lisp/org-agenda.el
lisp/org-clock.el
lisp/org.el

index 1cf058b..7142ce0 100644 (file)
@@ -7774,6 +7774,15 @@ when toggling this mode (i.e.@: @kbd{C-u R}), the clock table will not show
 contributions from entries that are hidden by agenda filtering@footnote{Only
 tags filtering will be respected here, effort filtering is ignored.}.
 @c
+@orgkey{v c}
+@vindex org-agenda-clock-consistency-checks
+Show overlapping clock entries, clocking gaps, and other clocking problems in
+the current agenda range.  You can then visit clocking lines and fix them
+manually. See the variable @code{org-agenda-clock-consistency-checks} for
+information on how to customize the definition of what constituted a clocking
+problem.  To return to normal agenda display, press @kbd{l} to exit Logbook
+mode.
+@c
 @orgcmdkskc{v E,E,org-agenda-entry-text-mode}
 @vindex org-agenda-start-with-entry-text-mode
 @vindex org-agenda-entry-text-maxlines
index 45266ab..16460e3 100644 (file)
@@ -589,7 +589,7 @@ after  ``{\tt :}'', and dictionary words elsewhere.
 \key{switch to day/week/month/year/def view}{d w vm vy vSP}
 \key{toggle diary entries / time grid / habits}{D / G / K}
 \key{toggle entry text / clock report}{E / R}
-\key{toggle display of logbook entries}{l / v l/L}
+\key{toggle display of logbook entries}{l / v l/L/c}
 \key{toggle inclusion of archived trees/files}{v a/A}
 \key{refresh agenda buffer with any changes}{r / g}
 \key{filter with respect to a tag}{/}
index 6bd6973..734c35f 100644 (file)
@@ -1096,6 +1096,36 @@ the agenda to display all available LOG items temporarily."
   :group 'org-agenda-daily/weekly
   :type '(set :greedy t (const closed) (const clock) (const state)))
 
+(defcustom org-agenda-clock-consistency-checks
+  '(:max-duration "10:00" :min-duration 0 :max-gap "0:05" :gap-ok ("4:00"))
+  "How to check clock times for consistency.
+This is a property list, with the following keys:
+
+:max-duration    Mark clocking chunks that are longer than this time.
+                 This is a time string like \"HH:MM\", or the number
+                 of minutes as an integer.
+
+:min-duration    Mark clocking chunks that are shorter that this.
+                 This is a time string like \"HH:MM\", or the number
+                 of minutes as an integer.
+
+:max-gap         Mark gaps between clocking chunks that are longer than
+                 this duration.  A number of minutes, or a string
+                 like \"HH:MM\".
+
+:gap-ok-around   List of times during the day which are usually not working
+                 times.  When a gap is detected, but the gap contains any
+                 of these times, the gap is *not* reported.  For example,
+                 if this is (\"4:00\" \"13:00\") then gaps that contain
+                 4:00 in the morning (i.e. the night) and 13:00
+                 (i.e. a typical lunch time) do not cause a warning.
+                 You should have at least one time during the night in this
+                 list, or otherwise the first task each morning will trigger
+                 a warning because it follows a long gap."
+  :group 'org-agenda-daily/weekly
+  :group 'org-clock
+  :type 'plist)
+
 (defcustom org-agenda-log-mode-add-notes t
   "Non-nil means add first line of notes to log entries in agenda views.
 If a log item like a state change or a clock entry is associated with
@@ -3550,7 +3580,7 @@ given in `org-agenda-start-on-weekday'."
              (setq org-agenda-entry-types
                    (delq :deadline org-agenda-entry-types)))
            (cond
-            ((eq org-agenda-show-log 'only)
+            ((memq org-agenda-show-log '(only clockcheck))
              (setq rtn (org-agenda-get-day-entries
                         file date :closed)))
             (org-agenda-show-log
@@ -3621,6 +3651,8 @@ given in `org-agenda-start-on-weekday'."
            (recenter 1))))
     (goto-char (or start-pos 1))
     (add-text-properties (point-min) (point-max) '(org-agenda-type agenda))
+    (if (eq org-agenda-show-log 'clockcheck)
+       (org-agenda-show-clocking-issues))
     (org-finalize-agenda)
     (setq buffer-read-only t)
     (message "")))
@@ -4808,7 +4840,9 @@ be skipped."
                              (abbreviate-file-name buffer-file-name))))
         (items (if (consp org-agenda-show-log)
                    org-agenda-show-log
-                 org-agenda-log-mode-items))
+                 (if (eq org-agenda-show-log 'clockcheck)
+                     '(clock)
+                   org-agenda-log-mode-items)))
         (parts
          (delq nil
                (list
@@ -4890,6 +4924,117 @@ be skipped."
        (goto-char (point-at-eol))))
     (nreverse ee)))
 
+(defun org-agenda-show-clocking-issues ()
+  "Add overlays, showing issues with clocking.
+See also the user option `org-agenda-clock-consistency-checks'."
+  (interactive)
+  (let* ((pl org-agenda-clock-consistency-checks)
+        (re (concat "^[ \t]*"
+                    org-clock-string
+                    "[ \t]+"
+                    "\\(\\[.*?\\]\\)" ; group 1 is first stamp
+                    "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
+        (tlstart 0.)
+        (tlend 0.)
+        (maxtime (org-hh:mm-string-to-minutes 
+                  (or (plist-get pl :max-duration) "24:00")))
+        (mintime (org-hh:mm-string-to-minutes 
+                  (or (plist-get pl :min-duration) 0)))
+        (maxgap  (org-hh:mm-string-to-minutes
+                  ;; default 30:00 means never complain
+                  (or (plist-get pl :max-gap) "30:00")))
+        (gapok (mapcar 'org-hh:mm-string-to-minutes
+                       (plist-get pl :gap-ok-around)))
+        issue)
+    (goto-char (point-min))
+    (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t)
+      (setq issue nil)
+      (catch 'next
+       (setq m (org-get-at-bol 'org-marker)
+             te nil ts nil)
+       (unless (and m (markerp m))
+         (setq issue "No valid clock line") (throw 'next t))
+       (org-with-point-at m
+         (save-excursion
+           (goto-char (point-at-bol))
+           (unless (looking-at re)
+             (error "No valid Clock line")
+             (throw 'next t))
+           (unless (match-end 3)
+             (setq issue "No end time")
+             (throw 'next t))
+           (setq ts (match-string 1)
+                 te (match-string 3)
+                 ts (org-float-time
+                     (apply 'encode-time (org-parse-time-string ts)))
+                 te (org-float-time
+                     (apply 'encode-time (org-parse-time-string te)))
+                 dt (- te ts))))
+       (cond
+        ((> dt (* 60 maxtime))
+         ;; a very long clocking chunk
+         (setq issue (format "Clocking interval is very long: %s"
+                             (org-minutes-to-hh:mm-string
+                              (floor (/ (float dt) 60.))))))
+        ((< dt (* 60 mintime))
+         ;; a very short clocking chunk
+         (setq issue (format "Clocking interval is very short: %s"
+                             (org-minutes-to-hh:mm-string
+                              (floor (/ (float dt) 60.))))))
+        ((and (> tlend 0) (< ts tlend))
+         ;; Two clock entries are overlapping
+         (setq issue (format "Clocking overlap: %d minutes" (/ (- tlend ts) 60))))
+        ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
+         ;; There is a gap, lets see if we need to report it
+         (unless (org-agenda-check-clock-gap tlend ts gapok)
+           (setq issue (format "Clocking gap: %d minutes"
+                                 (/ (- ts tlend) 60)))))
+        (t nil)))
+      (setq tlend (or te tlend) tlstart (or ts tlstart))
+      (when issue
+       ;; OK, there was some issue, add an overlay to show the issue
+       (setq ov (make-overlay (point-at-bol) (point-at-eol)))
+       (overlay-put ov 'before-string
+                    (concat
+                     (org-add-props
+                         (format "%-43s" (concat " " issue))
+                         nil
+                       'face '((:background "DarkRed") (:foreground "white")))
+                     "\n"))
+       (overlay-put ov 'evaporate t)))))
+
+(defun org-agenda-check-clock-gap (t1 t2 ok-list)
+  "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values."
+  (catch 'exit
+    (unless ok-list
+      ;; there are no OK times for gaps...
+      (throw 'exit nil))
+    (if (> (- (/ t2 36000) (/ t1 36000)) 24)
+       ;; This is more than 24 hours, so it is OK.
+       ;; because we have at least one OK time, that must be in the
+       ;; 24 hour interval.
+       (throw 'exit t))
+    ;; We have a shorter gap.
+    ;; Now we have to get the minute of the day when these times are
+    (let* ((t1dec (decode-time (seconds-to-time t1)))
+          (t2dec (decode-time (seconds-to-time t2)))
+          ;; compute the minute on the day
+          (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
+          (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
+      (when (< min2 min1)
+       ;; if min2 is smaller than min1, this means it is on the next day.
+       ;; Wrap it to after midnight.
+       (setq min2 (+ min2 1440)))
+      ;; Now check if any of the OK times is in the gap
+      (mapcar (lambda (x)
+               ;; Wrap the time to after midnight if necessary
+               (if (< x min1) (setq x (+ x 1440)))
+               ;; Check if in interval
+               (and (<= min1 x) (>= min2 x) (throw 'exit t)))
+             ok-list)
+      ;; Nope, this gap is not OK
+      nil)))
+
 (defun org-agenda-get-deadlines ()
   "Return the deadline information for agenda display."
   (let* ((props (list 'mouse-face 'highlight
@@ -6194,9 +6339,10 @@ With prefix ARG, go backward that many times the current span."
 (defun org-agenda-view-mode-dispatch ()
   "Call one of the view mode commands."
   (interactive)
-  (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset                [q]uit/abort
-      time[G]rid     [[]inactive [f]ollow [l]og [L]og-all   [E]ntryText
-      [a]rch-trees   [A]rch-files    clock[R]eport   include[D]iary")
+  (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset    [q]uit/abort
+      time[G]rid     [[]inactive [f]ollow [l]og [L]og-all   [c]lockcheck
+      [a]rch-trees   [A]rch-files    clock[R]eport   include[D]iary
+      [E]ntryText")
   (let ((a (read-char-exclusive)))
     (case a
       (?\  (call-interactively 'org-agenda-reset-view))
@@ -6206,6 +6352,7 @@ With prefix ARG, go backward that many times the current span."
       (?y (call-interactively 'org-agenda-year-view))
       (?l (call-interactively 'org-agenda-log-mode))
       (?L (org-agenda-log-mode '(4)))
+      (?c (org-agenda-log-mode 'clockcheck))
       ((?F ?f) (call-interactively 'org-agenda-follow-mode))
       (?a (call-interactively 'org-agenda-archives-mode))
       (?A (org-agenda-archives-mode 'files))
@@ -6409,10 +6556,13 @@ With a double `C-u' prefix arg, show *only* log items, nothing else."
   (interactive "P")
   (org-agenda-check-type t 'agenda 'timeline)
   (setq org-agenda-show-log
-       (if (equal special '(16))
-           'only
-         (if special '(closed clock state)
-           (not org-agenda-show-log))))
+       (cond
+        ((equal special '(16)) 'only)
+        ((eq special 'clockcheck)
+         (if (eq org-agenda-show-log 'clockcheck)
+             nil 'clockcheck))
+        (special '(closed clock state))
+        (t (not org-agenda-show-log))))
   (org-agenda-set-mode-name)
   (org-agenda-redo)
   (message "Log mode is %s"
@@ -6481,8 +6631,11 @@ When called with a prefix argument, include all archive files as well."
              (if org-agenda-use-time-grid   " Grid"   "")
              (if (and (boundp 'org-habit-show-habits)
                       org-habit-show-habits) " Habit"   "")
-             (if (consp org-agenda-show-log) " LogAll"
-               (if org-agenda-show-log " Log" ""))
+             (cond
+              ((consp org-agenda-show-log) " LogAll")
+              ((eq org-agenda-show-log 'clockcheck) " ClkCk")
+              (org-agenda-show-log " Log")
+              (t ""))
              (if (or org-agenda-filter (get 'org-agenda-filter
                                             :preset-filter))
                  (concat " {" (mapconcat
index 87b175c..efeb72f 100644 (file)
@@ -2424,6 +2424,8 @@ This function is made for clock tables."
                        tot))))
        0))))
 
+;; Saving and loading the clock
+
 (defvar org-clock-loaded nil
   "Was the clock file loaded?")
 
index cb9f37c..e17c90f 100644 (file)
@@ -15592,6 +15592,7 @@ In fact, the first hh:mm or number in the string will be taken,
 there can be extra stuff in the string.
 If no number is found, the return value is 0."
   (cond
+   ((integerp s) s)
    ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
     (+ (* (string-to-number (match-string 1 s)) 60)
        (string-to-number (match-string 2 s))))