Function: org-agenda-show-clocking-issues

org-agenda-show-clocking-issues is an interactive and byte-compiled function defined in org-agenda.el.gz.

Signature

(org-agenda-show-clocking-issues)

Documentation

Add overlays, showing issues with clocking.

See also the user option org-agenda-clock-consistency-checks.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-agenda.el.gz
(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-duration-to-minutes
		   (or (plist-get pl :max-duration) "24:00")))
	 (mintime (org-duration-to-minutes
		   (or (plist-get pl :min-duration) 0)))
	 (maxgap  (org-duration-to-minutes
		   ;; default 30:00 means never complain
		   (or (plist-get pl :max-gap) "30:00")))
	 (gapok (mapcar #'org-duration-to-minutes
			(plist-get pl :gap-ok-around)))
	 (def-face (or (plist-get pl :default-face)
		       '((:background "DarkRed") (:foreground "white"))))
	 issue face m te ts dt ov)
    (goto-char (point-min))
    (while (re-search-forward " Clocked: +(\\(?:-\\|\\([0-9]+:[0-9]+\\)\\))" nil t)
      (setq issue nil face def-face)
      (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 (line-beginning-position))
	    (unless (looking-at re)
	      (error "No valid Clock line")
	      (throw 'next t))
	    (unless (match-end 3)
	      (setq issue
		    (format
		     "No end time: (%s)"
		     (org-duration-from-minutes
		      (floor
		       (- (float-time (org-current-time))
			  (float-time (org-time-string-to-time (match-string 1))))
		       60)))
		    face (or (plist-get pl :no-end-time-face) face))
	      (throw 'next t))
	    (setq ts (match-string 1)
		  te (match-string 3)
		  ts (float-time (org-time-string-to-time ts))
		  te (float-time (org-time-string-to-time te))
		  dt (- te ts))))
	(cond
	 ((> dt (* 60 maxtime))
	  ;; a very long clocking chunk
	  (setq issue (format "Clocking interval is very long: %s"
			      (org-duration-from-minutes (floor dt 60)))
		face (or (plist-get pl :long-face) face)))
	 ((< dt (* 60 mintime))
	  ;; a very short clocking chunk
	  (setq issue (format "Clocking interval is very short: %s"
			      (org-duration-from-minutes (floor dt 60)))
		face (or (plist-get pl :short-face) face)))
	 ((and (> tlend 0) (< ts tlend))
	  ;; Two clock entries are overlapping
	  (setq issue (format "Clocking overlap: %d minutes"
			      (/ (- tlend ts) 60))
		face (or (plist-get pl :overlap-face) face)))
	 ((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))
		  face (or (plist-get pl :gap-face) face))))
	 (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 (line-beginning-position) (line-end-position)))
	(overlay-put ov 'before-string
		     (concat
		      (org-add-props
			  (format "%-43s" (concat " " issue))
			  nil
			'face face)
		      "\n"))
	(overlay-put ov 'evaporate t)))))