;; Author: Carsten Dominik <carsten at orgmode dot org>

;; Keywords: outlines, hypermedia, calendar, wp

;; Homepage: http://orgmode.org

;;

;; This file is part of GNU Emacs.

;;

;; This file contains the time clocking code for Org-mode

(require 'org)

(eval-when-compile

(defvar org-time-stamp-formats)

(defgroup org-clock nil

(defcustom org-clock-out-when-done t

"When non-nil, clock will be stopped when the clocked entry is marked DONE.

:group 'org-clock

(defcustom org-clock-out-remove-zero-time-clocks nil

:group 'org-clock

:type 'boolean)

(defcustom org-clock-in-switch-to-state nil

"Set task to a special todo state while clocking it.

The value should be the state to which the entry should be

parameter (the current TODO state of the item) and return the

state to switch it to."

:group 'org-clock

(defcustom org-clock-out-switch-to-state nil

"Set task to a special todo state after clocking out.

The value should be the state to which the entry should be

parameter (the current TODO state of the item) and return the

state to switch it to."

:group 'org-clock

:type 'integer)

(defcustom org-clock-goto-may-find-recent-task t

:group 'org-clock

:type 'boolean)

:type 'function)

(defcustom org-clock-string-limit 0

:group 'org-clock

:type 'integer)

:type 'boolean)

(defcustom org-clock-persist nil

When this is t, both the running clock, and the entire clock

history are saved. When this is the symbol `clock', only the

running clock is saved.

(const :tag "All task time" all)

(const :tag "Automatically, `all' or since `repeat'" auto)))

(defcustom org-show-notification-handler nil

"Function or program to send notification with.

The function or program will be called with the notification

(string :tag "Program")

(function :tag "Function")))

:group 'org-clock

:type 'plist)

(defcustom org-clock-idle-time nil

"When non-nil, resolve open clocks if the user is idle more than X minutes."

:group 'org-clock

(const :tag "Always" t)

(const :tag "When no clock is running" when-no-clock-is-running)))

(defvar org-clock-in-prepare-hook nil

"Hook run when preparing the clock.

This hook is run before anything happens to the task that

(defvar org-clock-heading-for-remember "")

(defvar org-clock-start-time "")

"If non-nil, user cancelled a clock; this is when leftover time started.")

(defvar org-clock-effort ""

(defvar org-clock-total-time nil

"Holds total time, spent previously on currently clocked item.

(defun org-clock-history-push (&optional pos buffer)

"Push a marker to the clock history."

(setq org-clock-history-length (max 1 (min 35 org-clock-history-length)))

(while (setq n (member m org-clock-history))

(move-marker (car n) nil))

(setq org-clock-history

(mapc (lambda (m) (org-check-and-save-marker m beg end))

org-clock-history))

(defun org-clock-select-task (&optional prompt)

"Select a task that recently was associated with clocking."

(interactive)

(insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold))

(setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task))

(push s sel-list))

(insert (org-add-props "Current Clocking Task\n" nil 'face 'bold))

(setq s (org-clock-insert-selection-line ?c org-clock-marker))

(push s sel-list))

(if (< i 10)

(+ i ?0)

(+ i (- ?A 10))) m))

(push s sel-list)))

org-clock-history)

(org-fit-window-to-buffer)

(save-excursion

(save-restriction

(widen)

(when (and cat task)

(insert (format "[%c] %-15s %s\n" i cat task))

(cons i marker)))))

(defun org-clock-get-clock-string ()

01:30/01:50 format (clocked/estimated).

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))))

(effort-h (floor effort-in-minutes 60))

(defun org-clock-update-mode-line ()

(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 clock-string 'help-echo help-text)))

'local-map org-clock-mode-line-map

'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)

(force-mode-line-update))

(defun org-clock-get-clocked-time ()

;; A string. See if it is a delta

(setq sign (string-to-char value))

(if (member sign '(?- ?+))

(setq current 0))

(setq value (org-hh:mm-string-to-minutes value))

(if (equal ?- sign)

(defun org-clock-notify-once-if-expired ()

"Show notification if we spent more time than we estimated before.

Notification is shown only once."

(let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort))

(clocked-time (org-clock-get-clocked-time)))

(unless org-clock-notification-was-shown

(setq org-clock-notification-was-shown t)

(org-notify

((stringp org-show-notification-handler)

(start-process "emacs-timer-notification" nil

org-show-notification-handler notification))

((org-program-exists "notify-send")

(start-process "emacs-timer-notification" nil

"notify-send" notification))

(save-excursion

(goto-char (point-min))

(while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t)

(org-time-string-to-time (match-string 1))) clocks))))

clocks))

(put 'org-with-clock 'lisp-indent-function 1)

"Clock in to the clock located by CLOCK.

If necessary, clock-out of the currently active clock."

(org-with-clock-position clock

(let ((org-clock-in-resume (or resume org-clock-in-resume)))

(defsubst org-clock-clock-out (clock &optional fail-quietly at-time)

"Clock out of the clock located by CLOCK."

(defvar org-clock-resolving-clocks nil)

(defvar org-clock-resolving-clocks-due-to-idleness nil)

"Resolve `CLOCK' given the time `RESOLVE-TO', and the present.

(let ((org-clock-resolving-clocks t))

(cond

((null resolve-to)

(t

(if restart-p

(error "RESTART-P is not valid here"))

(unless org-clock-clocking-in

(if close-p

(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)

"Resolve an open org-mode clock.

(save-window-excursion

(save-excursion

(unless org-clock-resolving-clocks-due-to-idleness

(let (char-pressed)

(setq char-pressed

(read-char (concat (funcall prompt-fn clock)

nil 45)))

(subtractp (memq ch '(?s ?S)))

(barely-started-p (< (- (org-float-time last-valid)

(org-float-time (cdr clock))) 45))

(start-over (and subtractp barely-started-p)))

(org-clock-resolve-clock

clock (cond

((or (eq ch ?C)

;; time...

start-over)

nil)

last-valid)

'now)

(t

(and start-over

"Resolve all currently open org-mode clocks.

(interactive "P")

(unless org-clock-resolving-clocks

(let ((org-clock-resolving-clocks t))

(dolist (clock clocks)

(let ((dangling (or (not (org-clock-is-active))

(/= (car clock) org-clock-marker))))

(org-clock-resolve

clock

(or prompt-fn

0)))

(defun org-mac-idle-seconds ()

(string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'")))

(defun org-x11-idle-seconds ()

(/ (string-to-number (shell-command-to-string "x11idle")) 1000))

(defun org-user-idle-seconds ()

"Return the number of seconds the user has been idle for.

This routine returns a floating point number."

(defvar org-clock-user-idle-seconds)

so long."

(when (and org-clock-idle-time (not org-clock-resolving-clocks)

org-clock-marker)

(if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time))

(org-clock-resolve

(cons org-clock-marker

60.0))))

org-clock-user-idle-start)))))

"Start the clock on the current item.

If necessary, clock-out of the currently active clock.

is as the default task, a special task that will always be offered in

the clocking selection, associated with the letter `d'."

(interactive "P")

(setq org-clock-notification-was-shown nil)

(catch 'abort

(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)

ts selected-task target-pos (msg-extra "")

(when (and org-clock-auto-clock-resolution

(or (not interrupting)

(eq t org-clock-auto-clock-resolution))

(not org-clock-clocking-in)

(not org-clock-resolving-clocks))

(let ((org-clock-clocking-in t))

(org-resolve-clocks))) ; check if any clocks are dangling

(when (equal select '(4))

(when interrupting

;; We are interrupting the clocking of a different task.

;; Save a marker to this task, so that we can go back.

(move-marker org-clock-interrupted-task

(marker-position org-clock-marker)

(marker-buffer org-clock-marker))

(when (equal select '(16))

;; Mark as default clocking task

(org-clock-mark-default-task))

;; Clock in at which position?

(setq target-pos

(if (and (eobp) (not (org-on-heading-p)))

(org-back-to-heading t)

(or interrupting (move-marker org-clock-interrupted-task nil))

(org-clock-history-push)

(cond ((functionp org-clock-in-switch-to-state)

(looking-at org-complex-heading-regexp)

(let ((newstate (funcall org-clock-in-switch-to-state

(functionp org-clock-heading-function))

(funcall org-clock-heading-function))

((looking-at org-complex-heading-regexp)

(t "???")))

(setq org-clock-heading (org-propertize org-clock-heading

'face nil))

(setq org-clock-total-time (org-clock-sum-current-item

(org-clock-get-sum-start)))

(setq org-clock-start-time

(y-or-n-p

(format

"You stopped another clock %d mins ago; start this one from then? "

(/ (- (org-float-time (current-time))

(current-time)))

(setq ts (org-insert-time-stamp org-clock-start-time

'with-hm 'inactive))))

(cancel-timer org-clock-mode-line-timer)

(setq org-clock-mode-line-timer nil))

(setq org-clock-mode-line-timer

(when org-clock-idle-timer

(cancel-timer org-clock-idle-timer)

(setq org-clock-idle-timer nil))

(message "Clock starts at %s - %s" ts msg-extra)

(run-hooks 'org-clock-in-hook)))))))

(defun org-clock-mark-default-task ()

"Mark current task as default task."

(interactive)

If there is no running clock, throw an error, unless FAIL-QUIETLY is set."

(interactive)

(catch 'exit

(let (ts te s h m remove)

(save-restriction

(widen)

(goto-char org-clock-marker)

(when org-clock-out-switch-to-state

(save-excursion

(org-back-to-heading t)

(cond

((functionp org-clock-out-switch-to-state)

(looking-at org-complex-heading-regexp)

(force-mode-line-update)

(message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m

(if remove " => LINE REMOVED" ""))

(defun org-clock-cancel ()

(interactive)

(goto-char org-clock-marker)

(delete-region (1- (point-at-bol)) (point-at-eol))

;; Just in case, remove any empty LOGBOOK left over

(select

(or (org-clock-select-task "Select task to go to: ")

(error "No task selected")))

((and org-clock-goto-may-find-recent-task

(car org-clock-history)

(marker-buffer (car org-clock-history)))

(org-back-to-heading t)

(org-cycle-hide-drawers 'children)

(recenter)

(if recent

(message "No running clock, this is the most recently clocked task"))

(run-hooks 'org-clock-goto-hook)))

"Holds the file total time in minutes, after a call to `org-clock-sum'.")

(make-variable-buffer-local 'org-clock-file-total-minutes)

"Sum the times for each subtree.

Puts the resulting times in minutes as a text property on each headline.

(interactive)

(let* ((bmp (buffer-modified-p))

(re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"

(if (stringp tend) (setq tend (org-time-string-to-seconds tend)))

(if (consp tstart) (setq tstart (org-float-time tstart)))

(if (consp tend) (setq tend (org-float-time tend)))

(save-excursion

(goto-char (point-max))

(while (re-search-backward re nil t)

(setq t1 (+ t1 (string-to-number (match-string 5))

(* 60 (string-to-number (match-string 4))))))

(t ;; A headline

(setq org-clock-file-total-minutes (aref ltimes 0)))

(set-buffer-modified-p bmp)))

(defun org-clock-sum-current-item (&optional tstart)

(save-excursion

(save-restriction

(org-narrow-to-subtree)

(org-move-to-column c)

(unless (eolp) (skip-chars-backward "^ \t"))

(skip-chars-backward " \t")

tx (concat (buffer-substring (1- (point)) (point))

(make-string (+ off (max 0 (- c (current-column)))) ?.)

(org-add-props (if org-time-clocksum-use-fractional

(list 'face 'org-clock-overlay))

""))

(if (not (featurep 'xemacs))

(push ov org-clock-overlays)))

(defun org-clock-remove-overlays (&optional beg end noremove)

from the `before-change-functions' in the current buffer."

(interactive)

(unless org-inhibit-highlight-removal

(setq org-clock-overlays nil)

(unless noremove

(remove-hook 'before-change-functions

This is used to stop the clock after a TODO entry is marked DONE,

and is only done if the variable `org-clock-out-when-done' is not nil."

(when (and org-clock-out-when-done

(or (buffer-base-buffer (current-buffer))

(current-buffer)))

(< (point) org-clock-marker)

(> (save-excursion (outline-next-heading) (point))

org-clock-marker))

;; Clock out, but don't accept a logging message for this.

(org-clock-out))))

(add-hook 'org-after-todo-state-change-hook

(font-lock-fontify-buffer)

(forward-line 2)

(buffer-substring (point) (progn

(point-at-bol)))))

(defun org-clock-report (&optional arg)

(let ((pos (point)) start)

(save-excursion

(end-of-line 1)

(setq start (match-beginning 0))

(>= (match-end 0) pos)

start))))

(defun org-clock-special-range (key &optional time as-strings)

"Return two times bordering a special time range.

Key is a symbol specifying the range and can be one of `today', `yesterday',

(dow (nth 6 tm))

(skey (symbol-name key))

(shift 0)

(cond

((string-match "^[0-9]+$" skey)

(setq y (string-to-number skey) m 1 d 1 key 'year))

(setq d (nth 1 date) month (car date) y (nth 2 date)

dow 1

key 'week))

((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)

(setq y (string-to-number (match-string 1 skey))

month (string-to-number (match-string 2 skey))

key 'day))

((string-match "\\([-+][0-9]+\\)$" skey)

(setq shift (string-to-number (match-string 1 skey))

(when (= shift 0)

(cond

((memq key '(day today))

(setq d (+ d shift) h 0 m 0 h1 24 m1 0))

m 0 h 0 d (- d diff) d1 (+ 7 d)))

((memq key '(month thismonth))

(setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0))

((memq key '(year thisyear))

(setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))

(t (error "No such time block %s" key)))

((memq key '(month thismonth))

(setq txt (format-time-string "%B %Y" ts)))

((memq key '(year thisyear))

(if as-strings

(list (format-time-string fm ts) (format-time-string fm te) txt)

(list ts te txt))))

(defun org-clocktable-shift (dir n)

"Try to shift the :block date of the clocktable at point.

Point must be in the #+BEGIN: line of a clocktable, or this function

(and (memq dir '(left down)) (setq n (- n)))

(save-excursion

(goto-char (point-at-bol))

(error "Line needs a :block definition before this command works")

(let* ((b (match-beginning 1)) (e (match-end 1))

(s (match-string 1))

((equal s "yesterday") (setq s "today-1"))

((equal s "lastweek") (setq s "thisweek-1"))

((equal s "lastmonth") (setq s "thismonth-1"))

(defun org-dblock-write:clocktable (params)

"Write the standard clocktable."

(catch 'exit

(ts (plist-get params :tstart))

(te (plist-get params :tend))

(link (plist-get params :link))

(when step

(unless (or block (and ts te))

(error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'"))

(org-clocktable-steps params)

(throw 'exit nil))

;; Get the right scope

(setq pos (point))

(setq scope (org-add-archive-files scope)))

((eq scope 'file-with-archives)

(setq scope (org-add-archive-files (list (buffer-file-name)))

(setq scope-is-list (and scope (listp scope)))

(let* ((files scope)

file)

(org-prepare-agenda-buffers files)

(while (setq file (pop files))

(with-current-buffer (find-buffer-visiting file)

(defun org-clocktable-steps (params)

(let* ((p1 (copy-sequence params))

(ts (plist-get p1 :tstart))

(te (plist-get p1 :tend))

(step0 (plist-get p1 :step))

(step (cdr (assoc step0 '((day . 86400) (week . 604800)))))

(block (plist-get p1 :block))

(when block

(setq cc (org-clock-special-range block nil t)

ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))

(setq p1 (plist-put p1 :header ""))

(setq p1 (plist-put p1 :step nil))

(setq p1 (plist-put p1 :block nil))

(setq p1 (plist-put p1 :tend (format-time-string

(org-time-stamp-format nil t)

(seconds-to-time (setq ts (+ ts step))))))

(plist-get p1 :tstart) "\n")

(end-of-line 0))))

(defun org-clock-time% (total &rest strings)

"Compute a time fraction in percent.

(if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s)

(throw 'exit

(/ (* 100.0 (+ (string-to-number (match-string 2 s))

tot))))

0))))

system-name (format-time-string

(cdr org-time-stamp-formats))))

(if (and (memq org-clock-persist '(t clock))

(setq b (or (buffer-base-buffer b) b))

(buffer-live-p b)

(buffer-file-name b)

(or (not org-clock-persist-query-save)

(y-or-n-p (concat "Save current clock ("

") "))))

(insert "(setq resume-clock '(\""

"\" . " (int-to-string (marker-position org-clock-marker))

"))\n"))

;; Store clocked task history. Tasks are stored reversed to make

;;;###autoload

(defun org-clock-persistence-insinuate ()

(add-hook 'org-mode-hook 'org-clock-load)

(add-hook 'kill-emacs-hook 'org-clock-save))

;; arch-tag: 7b42c5d4-9b36-48be-97c0-66a869daed4c

;;; org-clock.el ends here