* net/tramp.el (tramp-file-name-handler): Add 'debug to the error
[bpt/emacs.git] / lisp / calendar / timeclock.el
CommitLineData
90cbf47e
GM
1;;; timeclock.el --- mode for keeping track of how much you work
2
73b0cd50 3;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
90cbf47e
GM
4
5;; Author: John Wiegley <johnw@gnu.org>
6;; Created: 25 Mar 1999
7e285b36 7;; Version: 2.6.1
90cbf47e 8;; Keywords: calendar data
90cbf47e
GM
9
10;; This file is part of GNU Emacs.
11
2ed66575 12;; GNU Emacs is free software: you can redistribute it and/or modify
90cbf47e 13;; it under the terms of the GNU General Public License as published by
2ed66575
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
90cbf47e
GM
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
2ed66575 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
90cbf47e
GM
24
25;;; Commentary:
26
27;; This mode is for keeping track of time intervals. You can use it
28;; for whatever purpose you like, but the typical scenario is to keep
29;; track of how much time you spend working on certain projects.
30;;
31;; Use `timeclock-in' when you start on a project, and `timeclock-out'
32;; when you're done. Once you've collected some data, you can use
33;; `timeclock-workday-remaining' to see how much time is left to be
145570df
GM
34;; worked today (where `timeclock-workday' specifies the length of the
35;; working day), and `timeclock-when-to-leave' to calculate when you're free.
90cbf47e
GM
36
37;; You'll probably want to bind the timeclock commands to some handy
145570df 38;; keystrokes. At the moment, C-x t is unused:
90cbf47e
GM
39;;
40;; (require 'timeclock)
41;;
42;; (define-key ctl-x-map "ti" 'timeclock-in)
43;; (define-key ctl-x-map "to" 'timeclock-out)
44;; (define-key ctl-x-map "tc" 'timeclock-change)
45;; (define-key ctl-x-map "tr" 'timeclock-reread-log)
46;; (define-key ctl-x-map "tu" 'timeclock-update-modeline)
47;; (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
48
49;; If you want Emacs to display the amount of time "left" to your
50;; workday in the modeline, you can either set the value of
51;; `timeclock-modeline-display' to t using M-x customize, or you
52;; can add this code to your .emacs file:
53;;
54;; (require 'timeclock)
55;; (timeclock-modeline-display)
56;;
57;; To cancel this modeline display at any time, just call
58;; `timeclock-modeline-display' again.
59
60;; You may also want Emacs to ask you before exiting, if you are
a9dfccd6 61;; currently working on a project. This can be done either by setting
90cbf47e
GM
62;; `timeclock-ask-before-exiting' to t using M-x customize (this is
63;; the default), or by adding the following to your .emacs file:
64;;
9d1137ce 65;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
90cbf47e
GM
66
67;; NOTE: If you change your .timelog file without using timeclock's
68;; functions, or if you change the value of any of timeclock's
69;; customizable variables, you should run the command
70;; `timeclock-reread-log'. This will recompute any discrepancies in
71;; your average working time, and will make sure that the various
72;; display functions return the correct value.
73
74;;; History:
75
76;;; Code:
77
78(defgroup timeclock nil
6a8cf883 79 "Keeping track of the time that gets spent."
90cbf47e
GM
80 :group 'data)
81
82;;; User Variables:
83
e437b491 84(defcustom timeclock-file (convert-standard-filename "~/.timelog")
08f7d912 85 "The file used to store timeclock data in."
90cbf47e
GM
86 :type 'file
87 :group 'timeclock)
88
89(defcustom timeclock-workday (* 8 60 60)
fc250015 90 "The length of a work period in seconds."
90cbf47e
GM
91 :type 'integer
92 :group 'timeclock)
93
94(defcustom timeclock-relative t
08f7d912 95 "Whether to make reported time relative to `timeclock-workday'.
90cbf47e
GM
96For example, if the length of a normal workday is eight hours, and you
97work four hours on Monday, then the amount of time \"remaining\" on
98Tuesday is twelve hours -- relative to an averaged work period of
99eight hours -- or eight hours, non-relative. So relative time takes
145570df
GM
100into account any discrepancy of time under-worked or over-worked on
101previous days. This only affects the timeclock modeline display."
90cbf47e
GM
102 :type 'boolean
103 :group 'timeclock)
104
105(defcustom timeclock-get-project-function 'timeclock-ask-for-project
08f7d912 106 "The function used to determine the name of the current project.
90cbf47e 107When clocking in, and no project is specified, this function will be
a9dfccd6 108called to determine what is the current project to be worked on.
90cbf47e
GM
109If this variable is nil, no questions will be asked."
110 :type 'function
111 :group 'timeclock)
112
113(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason
08f7d912 114 "A function used to determine the reason for clocking out.
90cbf47e 115When clocking out, and no reason is specified, this function will be
a9dfccd6 116called to determine what is the reason.
90cbf47e
GM
117If this variable is nil, no questions will be asked."
118 :type 'function
119 :group 'timeclock)
120
121(defcustom timeclock-get-workday-function nil
08f7d912 122 "A function used to determine the length of today's workday.
90cbf47e 123The first time that a user clocks in each day, this function will be
a9dfccd6 124called to determine what is the length of the current workday. If
a3dd6af2 125the return value is nil, or equal to `timeclock-workday', nothing special
a1506d29 126will be done. If it is a quantity different from `timeclock-workday',
a3dd6af2 127however, a record will be output to the timelog file to note the fact that
a9dfccd6 128that day has a length that is different from the norm."
a3dd6af2 129 :type '(choice (const nil) function)
90cbf47e
GM
130 :group 'timeclock)
131
132(defcustom timeclock-ask-before-exiting t
08f7d912 133 "If non-nil, ask if the user wants to clock out before exiting Emacs.
a9dfccd6 134This variable only has effect if set with \\[customize]."
90cbf47e
GM
135 :set (lambda (symbol value)
136 (if value
9d1137ce
GM
137 (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
138 (remove-hook 'kill-emacs-query-functions 'timeclock-query-out))
90cbf47e
GM
139 (setq timeclock-ask-before-exiting value))
140 :type 'boolean
141 :group 'timeclock)
142
143(defvar timeclock-update-timer nil
144 "The timer used to update `timeclock-mode-string'.")
145
b9c3a97d
GM
146;; For byte-compiler.
147(defvar display-time-hook)
148(defvar timeclock-modeline-display)
149
90cbf47e 150(defcustom timeclock-use-display-time t
08f7d912 151 "If non-nil, use `display-time-hook' for doing modeline updates.
a9dfccd6
EZ
152The advantage of this is that one less timer has to be set running
153amok in Emacs' process space. The disadvantage is that it requires
154you to have `display-time' running. If you don't want to use
90cbf47e 155`display-time', but still want the modeline to show how much time is
145570df
GM
156left, set this variable to nil. Changing the value of this variable
157while timeclock information is being displayed in the modeline has no
158effect. You should call the function `timeclock-modeline-display' with
159a positive argument to force an update."
90cbf47e
GM
160 :set (lambda (symbol value)
161 (let ((currently-displaying
162 (and (boundp 'timeclock-modeline-display)
163 timeclock-modeline-display)))
164 ;; if we're changing to the state that
165 ;; `timeclock-modeline-display' is already using, don't
166 ;; bother toggling it. This happens on the initial loading
167 ;; of timeclock.el.
168 (if (and currently-displaying
169 (or (and value
170 (boundp 'display-time-hook)
171 (memq 'timeclock-update-modeline
172 display-time-hook))
173 (and (not value)
174 timeclock-update-timer)))
175 (setq currently-displaying nil))
176 (and currently-displaying
3dc630b9 177 (set-variable 'timeclock-modeline-display nil))
90cbf47e
GM
178 (setq timeclock-use-display-time value)
179 (and currently-displaying
3dc630b9 180 (set-variable 'timeclock-modeline-display t))
90cbf47e
GM
181 timeclock-use-display-time))
182 :type 'boolean
183 :group 'timeclock
184 :require 'time)
185
186(defcustom timeclock-first-in-hook nil
08f7d912 187 "A hook run for the first \"in\" event each day.
90cbf47e
GM
188Note that this hook is run before recording any events. Thus the
189value of `timeclock-hours-today', `timeclock-last-event' and the
190return value of function `timeclock-last-period' are relative previous
191to today."
192 :type 'hook
193 :group 'timeclock)
194
195(defcustom timeclock-load-hook nil
08f7d912 196 "Hook that gets run after timeclock has been loaded."
90cbf47e
GM
197 :type 'hook
198 :group 'timeclock)
199
200(defcustom timeclock-in-hook nil
08f7d912 201 "A hook run every time an \"in\" event is recorded."
90cbf47e
GM
202 :type 'hook
203 :group 'timeclock)
204
205(defcustom timeclock-day-over-hook nil
08f7d912 206 "A hook that is run when the workday has been completed.
4ee3e788 207This hook is only run if the current time remaining is being displayed
90cbf47e
GM
208in the modeline. See the variable `timeclock-modeline-display'."
209 :type 'hook
210 :group 'timeclock)
211
212(defcustom timeclock-out-hook nil
08f7d912 213 "A hook run every time an \"out\" event is recorded."
90cbf47e
GM
214 :type 'hook
215 :group 'timeclock)
216
217(defcustom timeclock-done-hook nil
08f7d912 218 "A hook run every time a project is marked as completed."
90cbf47e
GM
219 :type 'hook
220 :group 'timeclock)
221
222(defcustom timeclock-event-hook nil
08f7d912 223 "A hook run every time any event is recorded."
90cbf47e
GM
224 :type 'hook
225 :group 'timeclock)
226
227(defvar timeclock-last-event nil
228 "A list containing the last event that was recorded.
dace60cf 229The format of this list is (CODE TIME PROJECT).")
90cbf47e
GM
230
231(defvar timeclock-last-event-workday nil
232 "The number of seconds in the workday of `timeclock-last-event'.")
233
234;;; Internal Variables:
235
236(defvar timeclock-discrepancy nil
237 "A variable containing the time discrepancy before the last event.
238Normally, timeclock assumes that you intend to work for
239`timeclock-workday' seconds every day. Any days in which you work
240more or less than this amount is considered either a positive or
a9dfccd6 241a negative discrepancy. If you work in such a manner that the
90cbf47e
GM
242discrepancy is always brought back to zero, then you will by
243definition have worked an average amount equal to `timeclock-workday'
244each day.")
245
246(defvar timeclock-elapsed nil
247 "A variable containing the time elapsed for complete periods today.
248This value is not accurate enough to be useful by itself. Rather,
249call `timeclock-workday-elapsed', to determine how much time has been
250worked so far today. Also, if `timeclock-relative' is nil, this value
43f5aea1
JW
251will be the same as `timeclock-discrepancy'.")
252
253(defvar timeclock-use-elapsed nil
254 "Non-nil if the modeline should display time elapsed, not remaining.")
90cbf47e
GM
255
256(defvar timeclock-last-period nil
257 "Integer representing the number of seconds in the last period.
a9dfccd6
EZ
258Note that you shouldn't access this value, but instead should use the
259function `timeclock-last-period'.")
90cbf47e
GM
260
261(defvar timeclock-mode-string nil
9d1137ce
GM
262 "The timeclock string (optionally) displayed in the modeline.
263The time is bracketed by <> if you are clocked in, otherwise by [].")
90cbf47e
GM
264
265(defvar timeclock-day-over nil
266 "The date of the last day when notified \"day over\" for.")
267
268;;; User Functions:
269
270;;;###autoload
271(defun timeclock-modeline-display (&optional arg)
272 "Toggle display of the amount of time left today in the modeline.
9d1137ce
GM
273If `timeclock-use-display-time' is non-nil (the default), then
274the function `display-time-mode' must be active, and the modeline
275will be updated whenever the time display is updated. Otherwise,
276the timeclock will use its own sixty second timer to do its
277updating. With prefix ARG, turn modeline display on if and only
278if ARG is positive. Returns the new status of timeclock modeline
279display (non-nil means on)."
90cbf47e 280 (interactive "P")
9d1137ce
GM
281 ;; cf display-time-mode.
282 (setq timeclock-mode-string "")
283 (or global-mode-string (setq global-mode-string '("")))
90cbf47e
GM
284 (let ((on-p (if arg
285 (> (prefix-numeric-value arg) 0)
286 (not timeclock-modeline-display))))
287 (if on-p
9d1137ce
GM
288 (progn
289 (or (memq 'timeclock-mode-string global-mode-string)
290 (setq global-mode-string
291 (append global-mode-string '(timeclock-mode-string))))
90cbf47e
GM
292 (unless (memq 'timeclock-update-modeline timeclock-event-hook)
293 (add-hook 'timeclock-event-hook 'timeclock-update-modeline))
294 (when timeclock-update-timer
295 (cancel-timer timeclock-update-timer)
296 (setq timeclock-update-timer nil))
297 (if (boundp 'display-time-hook)
298 (remove-hook 'display-time-hook 'timeclock-update-modeline))
299 (if timeclock-use-display-time
9d1137ce
GM
300 (progn
301 ;; Update immediately so there is a visible change
302 ;; on calling this function.
145570df 303 (if display-time-mode (timeclock-update-modeline)
7e285b36
CY
304 (message "Activate `display-time-mode' or turn off \
305`timeclock-use-display-time' to see timeclock information"))
9d1137ce 306 (add-hook 'display-time-hook 'timeclock-update-modeline))
90cbf47e
GM
307 (setq timeclock-update-timer
308 (run-at-time nil 60 'timeclock-update-modeline))))
4ee3e788 309 (setq global-mode-string
9d1137ce 310 (delq 'timeclock-mode-string global-mode-string))
90cbf47e
GM
311 (remove-hook 'timeclock-event-hook 'timeclock-update-modeline)
312 (if (boundp 'display-time-hook)
313 (remove-hook 'display-time-hook
314 'timeclock-update-modeline))
315 (when timeclock-update-timer
316 (cancel-timer timeclock-update-timer)
317 (setq timeclock-update-timer nil)))
318 (force-mode-line-update)
4ee3e788 319 (setq timeclock-modeline-display on-p)))
90cbf47e
GM
320
321;; This has to be here so that the function definition of
322;; `timeclock-modeline-display' is known to the "set" function.
323(defcustom timeclock-modeline-display nil
324 "Toggle modeline display of time remaining.
325You must modify via \\[customize] for this variable to have an effect."
326 :set (lambda (symbol value)
327 (setq timeclock-modeline-display
328 (timeclock-modeline-display (or value 0))))
329 :type 'boolean
330 :group 'timeclock
331 :require 'timeclock)
332
b9c3a97d
GM
333(defsubst timeclock-time-to-date (time)
334 "Convert the TIME value to a textual date string."
335 (format-time-string "%Y/%m/%d" time))
336
90cbf47e
GM
337;;;###autoload
338(defun timeclock-in (&optional arg project find-project)
339 "Clock in, recording the current time moment in the timelog.
340With a numeric prefix ARG, record the fact that today has only that
fc250015 341many hours in it to be worked. If ARG is a non-numeric prefix argument
90cbf47e
GM
342\(non-nil, but not a number), 0 is assumed (working on a holiday or
343weekend). *If not called interactively, ARG should be the number of
344_seconds_ worked today*. This feature only has effect the first time
345this function is called within a day.
346
a9dfccd6 347PROJECT is the project being clocked into. If PROJECT is nil, and
90cbf47e
GM
348FIND-PROJECT is non-nil -- or the user calls `timeclock-in'
349interactively -- call the function `timeclock-get-project-function' to
350discover the name of the project."
351 (interactive
352 (list (and current-prefix-arg
353 (if (numberp current-prefix-arg)
354 (* current-prefix-arg 60 60)
355 0))))
356 (if (equal (car timeclock-last-event) "i")
357 (error "You've already clocked in!")
358 (unless timeclock-last-event
359 (timeclock-reread-log))
4105dd52
GM
360 ;; Either no log file, or day has rolled over.
361 (unless (and timeclock-last-event
362 (equal (timeclock-time-to-date
363 (cadr timeclock-last-event))
364 (timeclock-time-to-date (current-time))))
90cbf47e
GM
365 (let ((workday (or (and (numberp arg) arg)
366 (and arg 0)
367 (and timeclock-get-workday-function
368 (funcall timeclock-get-workday-function))
369 timeclock-workday)))
370 (run-hooks 'timeclock-first-in-hook)
371 ;; settle the discrepancy for the new day
372 (setq timeclock-discrepancy
4105dd52 373 (- (or timeclock-discrepancy 0) workday))
90cbf47e 374 (if (not (= workday timeclock-workday))
9adcbb0c
RS
375 (timeclock-log "h" (number-to-string
376 (/ workday (if (zerop (% workday (* 60 60)))
377 60 60.0) 60))))))
90cbf47e
GM
378 (timeclock-log "i" (or project
379 (and timeclock-get-project-function
32226619
JB
380 (or find-project
381 (called-interactively-p 'interactive))
90cbf47e
GM
382 (funcall timeclock-get-project-function))))
383 (run-hooks 'timeclock-in-hook)))
384
385;;;###autoload
386(defun timeclock-out (&optional arg reason find-reason)
387 "Clock out, recording the current time moment in the timelog.
388If a prefix ARG is given, the user has completed the project that was
389begun during the last time segment.
390
391REASON is the user's reason for clocking out. If REASON is nil, and
392FIND-REASON is non-nil -- or the user calls `timeclock-out'
393interactively -- call the function `timeclock-get-reason-function' to
394discover the reason."
395 (interactive "P")
9ca8a5a0
EZ
396 (or timeclock-last-event
397 (error "You haven't clocked in!"))
90cbf47e
GM
398 (if (equal (downcase (car timeclock-last-event)) "o")
399 (error "You've already clocked out!")
400 (timeclock-log
401 (if arg "O" "o")
402 (or reason
403 (and timeclock-get-reason-function
32226619 404 (or find-reason (called-interactively-p 'interactive))
90cbf47e
GM
405 (funcall timeclock-get-reason-function))))
406 (run-hooks 'timeclock-out-hook)
407 (if arg
408 (run-hooks 'timeclock-done-hook))))
409
4ee3e788 410;; Should today-only be removed in favour of timeclock-relative? - gm
b9c3a97d
GM
411(defsubst timeclock-workday-remaining (&optional today-only)
412 "Return the number of seconds until the workday is complete.
413The amount returned is relative to the value of `timeclock-workday'.
414If TODAY-ONLY is non-nil, the value returned will be relative only to
4ee3e788 415the time worked today, and not to past time."
b9c3a97d
GM
416 (let ((discrep (timeclock-find-discrep)))
417 (if discrep
4ee3e788
GM
418 (- (if today-only (cadr discrep)
419 (car discrep)))
b9c3a97d
GM
420 0.0)))
421
90cbf47e
GM
422;;;###autoload
423(defun timeclock-status-string (&optional show-seconds today-only)
4ee3e788
GM
424 "Report the overall timeclock status at the present moment.
425If SHOW-SECONDS is non-nil, display second resolution.
426If TODAY-ONLY is non-nil, the display will be relative only to time
427worked today, ignoring the time worked on previous days."
90cbf47e 428 (interactive "P")
43f5aea1
JW
429 (let ((remainder (timeclock-workday-remaining
430 (or today-only
431 (not timeclock-relative))))
b9c3a97d
GM
432 (last-in (equal (car timeclock-last-event) "i"))
433 status)
90cbf47e
GM
434 (setq status
435 (format "Currently %s since %s (%s), %s %s, leave at %s"
436 (if last-in "IN" "OUT")
437 (if show-seconds
438 (format-time-string "%-I:%M:%S %p"
439 (nth 1 timeclock-last-event))
440 (format-time-string "%-I:%M %p"
441 (nth 1 timeclock-last-event)))
442 (or (nth 2 timeclock-last-event)
443 (if last-in "**UNKNOWN**" "workday over"))
444 (timeclock-seconds-to-string remainder show-seconds t)
445 (if (> remainder 0)
446 "remaining" "over")
447 (timeclock-when-to-leave-string show-seconds today-only)))
32226619 448 (if (called-interactively-p 'interactive)
80070cca 449 (message "%s" status)
90cbf47e
GM
450 status)))
451
452;;;###autoload
453(defun timeclock-change (&optional arg project)
a9dfccd6
EZ
454 "Change to working on a different project.
455This clocks out of the current project, then clocks in on a new one.
456With a prefix ARG, consider the previous project as finished at the
457time of changeover. PROJECT is the name of the last project you were
458working on."
90cbf47e
GM
459 (interactive "P")
460 (timeclock-out arg)
32226619 461 (timeclock-in nil project (called-interactively-p 'interactive)))
90cbf47e
GM
462
463;;;###autoload
464(defun timeclock-query-out ()
a9dfccd6 465 "Ask the user whether to clock out.
9d1137ce 466This is a useful function for adding to `kill-emacs-query-functions'."
b9c3a97d
GM
467 (and (equal (car timeclock-last-event) "i")
468 (y-or-n-p "You're currently clocking time, clock out? ")
469 (timeclock-out))
470 ;; Unconditionally return t for `kill-emacs-query-functions'.
471 t)
90cbf47e
GM
472
473;;;###autoload
474(defun timeclock-reread-log ()
475 "Re-read the timeclock, to account for external changes.
476Returns the new value of `timeclock-discrepancy'."
477 (interactive)
478 (setq timeclock-discrepancy nil)
479 (timeclock-find-discrep)
9329ea14 480 (if (and timeclock-discrepancy timeclock-modeline-display)
90cbf47e
GM
481 (timeclock-update-modeline))
482 timeclock-discrepancy)
483
484(defun timeclock-seconds-to-string (seconds &optional show-seconds
485 reverse-leader)
486 "Convert SECONDS into a compact time string.
487If SHOW-SECONDS is non-nil, make the resolution of the return string
488include the second count. If REVERSE-LEADER is non-nil, it means to
489output a \"+\" if the time value is negative, rather than a \"-\".
490This is used when negative time values have an inverted meaning (such
491as with time remaining, where negative time really means overtime)."
492 (if show-seconds
493 (format "%s%d:%02d:%02d"
494 (if (< seconds 0) (if reverse-leader "+" "-") "")
495 (truncate (/ (abs seconds) 60 60))
496 (% (truncate (/ (abs seconds) 60)) 60)
497 (% (truncate (abs seconds)) 60))
498 (format "%s%d:%02d"
499 (if (< seconds 0) (if reverse-leader "+" "-") "")
500 (truncate (/ (abs seconds) 60 60))
501 (% (truncate (/ (abs seconds) 60)) 60))))
502
dace60cf 503(defsubst timeclock-currently-in-p ()
90cbf47e
GM
504 "Return non-nil if the user is currently clocked in."
505 (equal (car timeclock-last-event) "i"))
506
507;;;###autoload
508(defun timeclock-workday-remaining-string (&optional show-seconds
509 today-only)
510 "Return a string representing the amount of time left today.
511Display second resolution if SHOW-SECONDS is non-nil. If TODAY-ONLY
512is non-nil, the display will be relative only to time worked today.
513See `timeclock-relative' for more information about the meaning of
514\"relative to today\"."
515 (interactive)
516 (let ((string (timeclock-seconds-to-string
517 (timeclock-workday-remaining today-only)
518 show-seconds t)))
32226619 519 (if (called-interactively-p 'interactive)
80070cca 520 (message "%s" string)
90cbf47e
GM
521 string)))
522
1c8c9fb8 523(defsubst timeclock-workday-elapsed ()
69a04106 524 "Return the number of seconds worked so far today.
90cbf47e
GM
525If RELATIVE is non-nil, the amount returned will be relative to past
526time worked. The default is to return only the time that has elapsed
527so far today."
1c8c9fb8
JW
528 (let ((discrep (timeclock-find-discrep)))
529 (if discrep
530 (nth 2 discrep)
531 0.0)))
90cbf47e
GM
532
533;;;###autoload
1c8c9fb8 534(defun timeclock-workday-elapsed-string (&optional show-seconds)
90cbf47e
GM
535 "Return a string representing the amount of time worked today.
536Display seconds resolution if SHOW-SECONDS is non-nil. If RELATIVE is
537non-nil, the amount returned will be relative to past time worked."
538 (interactive)
1c8c9fb8
JW
539 (let ((string (timeclock-seconds-to-string (timeclock-workday-elapsed)
540 show-seconds)))
32226619 541 (if (called-interactively-p 'interactive)
80070cca 542 (message "%s" string)
90cbf47e
GM
543 string)))
544
6f0d4bb6
GM
545(defalias 'timeclock-time-to-seconds (if (fboundp 'float-time) 'float-time
546 'time-to-seconds))
b9c3a97d 547
5777162a 548(defalias 'timeclock-seconds-to-time 'seconds-to-time)
b9c3a97d 549
4ee3e788 550;; Should today-only be removed in favour of timeclock-relative? - gm
dace60cf 551(defsubst timeclock-when-to-leave (&optional today-only)
a9dfccd6 552 "Return a time value representing the end of today's workday.
90cbf47e 553If TODAY-ONLY is non-nil, the value returned will be relative only to
4ee3e788 554the time worked today, and not to past time."
90cbf47e
GM
555 (timeclock-seconds-to-time
556 (- (timeclock-time-to-seconds (current-time))
1c8c9fb8
JW
557 (let ((discrep (timeclock-find-discrep)))
558 (if discrep
559 (if today-only
560 (cadr discrep)
561 (car discrep))
562 0.0)))))
90cbf47e
GM
563
564;;;###autoload
565(defun timeclock-when-to-leave-string (&optional show-seconds
566 today-only)
a9dfccd6 567 "Return a string representing the end of today's workday.
90cbf47e 568This string is relative to the value of `timeclock-workday'. If
4ee3e788
GM
569SHOW-SECONDS is non-nil, the value printed/returned will include
570seconds. If TODAY-ONLY is non-nil, the value returned will be
571relative only to the time worked today, and not to past time."
572 ;; Should today-only be removed in favour of timeclock-relative? - gm
90cbf47e
GM
573 (interactive)
574 (let* ((then (timeclock-when-to-leave today-only))
575 (string
576 (if show-seconds
577 (format-time-string "%-I:%M:%S %p" then)
578 (format-time-string "%-I:%M %p" then))))
32226619 579 (if (called-interactively-p 'interactive)
80070cca 580 (message "%s" string)
90cbf47e
GM
581 string)))
582
7e285b36
CY
583(defun timeclock-make-hours-explicit (old-default)
584 "Specify all workday lengths in `timeclock-file'.
585OLD-DEFAULT hours are set for every day that has no number indicated."
586 (interactive "P")
587 (if old-default (setq old-default (prefix-numeric-value old-default))
fc250015 588 (error "`timelog-make-hours-explicit' requires an explicit argument"))
7e285b36
CY
589 (let ((extant-timelog (find-buffer-visiting timeclock-file))
590 current-date)
591 (with-current-buffer (find-file-noselect timeclock-file t)
592 (unwind-protect
593 (save-excursion
594 (save-restriction
595 (widen)
596 (goto-char (point-min))
597 (while (progn (skip-chars-forward "\n") (not (eobp)))
598 ;; This is just a variant of `timeclock-moment-regexp'.
599 (unless (looking-at
600 (concat "^\\([bhioO]\\) \\([0-9]+/[0-9]+/[0-9]+\\) "
601 "\\([0-9]+:[0-9]+:[0-9]+\\)"))
602 (error "Can't parse `%s'" timeclock-file))
603 (let ((this-date (match-string 2)))
604 (unless (or (and current-date
605 (string= this-date current-date))
606 (string= (match-string 1) "h"))
607 (insert (format "h %s %s %s\n" (match-string 2)
608 (match-string 3) old-default)))
609 (if (string-match "^[ih]" (match-string 1)) ; ignore logouts
610 (setq current-date this-date)))
611 (forward-line))
612 (save-buffer)))
613 (unless extant-timelog (kill-buffer (current-buffer)))))))
614
90cbf47e
GM
615;;; Internal Functions:
616
617(defvar timeclock-project-list nil)
618(defvar timeclock-last-project nil)
619
978bd3ea 620(defun timeclock-completing-read (prompt alist &optional default)
fc250015
GM
621 "A version of `completing-read' that works on both Emacs and XEmacs.
622PROMPT, ALIST and DEFAULT are used for the PROMPT, COLLECTION and DEF
623arguments of `completing-read'."
978bd3ea
JW
624 (if (featurep 'xemacs)
625 (let ((str (completing-read prompt alist)))
55dfee43 626 (if (or (null str) (zerop (length str)))
978bd3ea
JW
627 default
628 str))
629 (completing-read prompt alist nil nil nil nil default)))
630
90cbf47e
GM
631(defun timeclock-ask-for-project ()
632 "Ask the user for the project they are clocking into."
978bd3ea 633 (timeclock-completing-read
5b76833f 634 (format "Clock into which project (default %s): "
978bd3ea
JW
635 (or timeclock-last-project
636 (car timeclock-project-list)))
637 (mapcar 'list timeclock-project-list)
638 (or timeclock-last-project
639 (car timeclock-project-list))))
90cbf47e
GM
640
641(defvar timeclock-reason-list nil)
642
643(defun timeclock-ask-for-reason ()
644 "Ask the user for the reason they are clocking out."
978bd3ea
JW
645 (timeclock-completing-read "Reason for clocking out: "
646 (mapcar 'list timeclock-reason-list)))
90cbf47e
GM
647
648(defun timeclock-update-modeline ()
4ee3e788
GM
649 "Update the `timeclock-mode-string' displayed in the modeline.
650The value of `timeclock-relative' affects the display as described in
651that variable's documentation."
90cbf47e 652 (interactive)
43f5aea1
JW
653 (let ((remainder
654 (if timeclock-use-elapsed
655 (timeclock-workday-elapsed)
656 (timeclock-workday-remaining (not timeclock-relative))))
9d1137ce 657 (last-in (equal (car timeclock-last-event) "i")))
90cbf47e
GM
658 (when (and (< remainder 0)
659 (not (and timeclock-day-over
660 (equal timeclock-day-over
661 (timeclock-time-to-date
662 (current-time))))))
663 (setq timeclock-day-over
664 (timeclock-time-to-date (current-time)))
665 (run-hooks 'timeclock-day-over-hook))
666 (setq timeclock-mode-string
9d1137ce
GM
667 (propertize
668 (format " %c%s%c "
669 (if last-in ?< ?[)
670 (timeclock-seconds-to-string remainder nil t)
671 (if last-in ?> ?]))
672 'help-echo "timeclock: time remaining"))))
673
674(put 'timeclock-mode-string 'risky-local-variable t)
90cbf47e
GM
675
676(defun timeclock-log (code &optional project)
677 "Log the event CODE to the timeclock log, at the time of call.
678If PROJECT is a string, it represents the project which the event is
dace60cf 679being logged for. Normally only \"in\" events specify a project."
9adcbb0c 680 (let ((extant-timelog (find-buffer-visiting timeclock-file)))
7e285b36 681 (with-current-buffer (find-file-noselect timeclock-file t)
9adcbb0c
RS
682 (save-excursion
683 (save-restriction
684 (widen)
685 (goto-char (point-max))
686 (if (not (bolp))
687 (insert "\n"))
688 (let ((now (current-time)))
689 (insert code " "
690 (format-time-string "%Y/%m/%d %H:%M:%S" now)
7e285b36 691 (or (and (stringp project)
9adcbb0c
RS
692 (> (length project) 0)
693 (concat " " project))
694 "")
695 "\n")
696 (if (equal (downcase code) "o")
697 (setq timeclock-last-period
698 (- (timeclock-time-to-seconds now)
699 (timeclock-time-to-seconds
700 (cadr timeclock-last-event)))
701 timeclock-discrepancy
702 (+ timeclock-discrepancy
703 timeclock-last-period)))
704 (setq timeclock-last-event (list code now project)))))
705 (save-buffer)
7e285b36
CY
706 (unless extant-timelog (kill-buffer (current-buffer)))))
707 (run-hooks 'timeclock-event-hook))
90cbf47e 708
dace60cf
JW
709(defvar timeclock-moment-regexp
710 (concat "\\([bhioO]\\)\\s-+"
711 "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+"
712 "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)"))
713
714(defsubst timeclock-read-moment ()
90cbf47e 715 "Read the moment under point from the timelog."
dace60cf
JW
716 (if (looking-at timeclock-moment-regexp)
717 (let ((code (match-string 1))
718 (year (string-to-number (match-string 2)))
719 (mon (string-to-number (match-string 3)))
720 (mday (string-to-number (match-string 4)))
721 (hour (string-to-number (match-string 5)))
722 (min (string-to-number (match-string 6)))
723 (sec (string-to-number (match-string 7)))
724 (project (match-string 8)))
725 (list code (encode-time sec min hour mday mon year) project))))
726
90cbf47e
GM
727(defun timeclock-last-period (&optional moment)
728 "Return the value of the last event period.
729If the last event was a clock-in, the period will be open ended, and
730growing every second. Otherwise, it is a fixed amount which has been
731recorded to disk. If MOMENT is non-nil, use that as the current time.
732This is only provided for coherency when used by
733`timeclock-discrepancy'."
734 (if (equal (car timeclock-last-event) "i")
735 (- (timeclock-time-to-seconds (or moment (current-time)))
736 (timeclock-time-to-seconds
737 (cadr timeclock-last-event)))
738 timeclock-last-period))
739
dace60cf 740(defsubst timeclock-entry-length (entry)
fc250015 741 "Return the length of ENTRY in seconds."
dace60cf
JW
742 (- (timeclock-time-to-seconds (cadr entry))
743 (timeclock-time-to-seconds (car entry))))
744
745(defsubst timeclock-entry-begin (entry)
fc250015 746 "Return the start time of ENTRY."
dace60cf
JW
747 (car entry))
748
749(defsubst timeclock-entry-end (entry)
fc250015 750 "Return the end time of ENTRY."
dace60cf
JW
751 (cadr entry))
752
753(defsubst timeclock-entry-project (entry)
fc250015 754 "Return the project of ENTRY."
dace60cf
JW
755 (nth 2 entry))
756
757(defsubst timeclock-entry-comment (entry)
fc250015 758 "Return the comment of ENTRY."
dace60cf
JW
759 (nth 3 entry))
760
dace60cf 761(defsubst timeclock-entry-list-length (entry-list)
fc250015 762 "Return the total length of ENTRY-LIST in seconds."
dace60cf 763 (let ((length 0))
fc250015
GM
764 (dolist (entry entry-list)
765 (setq length (+ length (timeclock-entry-length entry))))
dace60cf
JW
766 length))
767
768(defsubst timeclock-entry-list-begin (entry-list)
fc250015 769 "Return the start time of the first element of ENTRY-LIST."
dace60cf
JW
770 (timeclock-entry-begin (car entry-list)))
771
772(defsubst timeclock-entry-list-end (entry-list)
fc250015 773 "Return the end time of the last element of ENTRY-LIST."
dace60cf
JW
774 (timeclock-entry-end (car (last entry-list))))
775
776(defsubst timeclock-entry-list-span (entry-list)
fc250015 777 "Return the total time in seconds spanned by ENTRY-LIST."
dace60cf
JW
778 (- (timeclock-time-to-seconds (timeclock-entry-list-end entry-list))
779 (timeclock-time-to-seconds (timeclock-entry-list-begin entry-list))))
780
781(defsubst timeclock-entry-list-break (entry-list)
fc250015 782 "Return the total break time (span - length) in ENTRY-LIST."
dace60cf
JW
783 (- (timeclock-entry-list-span entry-list)
784 (timeclock-entry-list-length entry-list)))
785
786(defsubst timeclock-entry-list-projects (entry-list)
fc250015
GM
787 "Return a list of all the projects in ENTRY-LIST."
788 (let (projects proj)
789 (dolist (entry entry-list)
790 (setq proj (timeclock-entry-project entry))
791 (if projects
792 (add-to-list 'projects proj)
793 (setq projects (list proj))))
dace60cf
JW
794 projects))
795
dace60cf 796(defsubst timeclock-day-required (day)
fc250015 797 "Return the required length of DAY in seconds, default `timeclock-workday'."
3dc630b9 798 (or (car day) timeclock-workday))
dace60cf
JW
799
800(defsubst timeclock-day-length (day)
fc250015 801 "Return the actual length of DAY in seconds."
dace60cf
JW
802 (timeclock-entry-list-length (cdr day)))
803
804(defsubst timeclock-day-debt (day)
fc250015 805 "Return the debt (required - actual) associated with DAY, in seconds."
dace60cf
JW
806 (- (timeclock-day-required day)
807 (timeclock-day-length day)))
808
809(defsubst timeclock-day-begin (day)
fc250015 810 "Return the start time of DAY."
dace60cf
JW
811 (timeclock-entry-list-begin (cdr day)))
812
813(defsubst timeclock-day-end (day)
fc250015 814 "Return the end time of DAY."
dace60cf
JW
815 (timeclock-entry-list-end (cdr day)))
816
817(defsubst timeclock-day-span (day)
fc250015 818 "Return the span of DAY."
dace60cf
JW
819 (timeclock-entry-list-span (cdr day)))
820
821(defsubst timeclock-day-break (day)
fc250015 822 "Return the total break time of DAY."
dace60cf
JW
823 (timeclock-entry-list-break (cdr day)))
824
825(defsubst timeclock-day-projects (day)
fc250015 826 "Return a list of all the projects in DAY."
1661df02 827 (timeclock-entry-list-projects (cddr day)))
dace60cf
JW
828
829(defmacro timeclock-day-list-template (func)
fc250015 830 "Template for summing the result of FUNC on each element of DAY-LIST."
dace60cf
JW
831 `(let ((length 0))
832 (while day-list
55dfee43
GM
833 (setq length (+ length (,(eval func) (car day-list)))
834 day-list (cdr day-list)))
dace60cf
JW
835 length))
836
837(defun timeclock-day-list-required (day-list)
fc250015 838 "Return total required length of DAY-LIST, in seconds."
dace60cf
JW
839 (timeclock-day-list-template 'timeclock-day-required))
840
841(defun timeclock-day-list-length (day-list)
fc250015 842 "Return actual length of DAY-LIST, in seconds."
dace60cf
JW
843 (timeclock-day-list-template 'timeclock-day-length))
844
845(defun timeclock-day-list-debt (day-list)
fc250015 846 "Return total debt (required - actual) of DAY-LIST."
dace60cf
JW
847 (timeclock-day-list-template 'timeclock-day-debt))
848
849(defsubst timeclock-day-list-begin (day-list)
fc250015 850 "Return the start time of DAY-LIST."
dace60cf
JW
851 (timeclock-day-begin (car day-list)))
852
853(defsubst timeclock-day-list-end (day-list)
fc250015 854 "Return the end time of DAY-LIST."
dace60cf
JW
855 (timeclock-day-end (car (last day-list))))
856
857(defun timeclock-day-list-span (day-list)
fc250015 858 "Return the span of DAY-LIST."
dace60cf
JW
859 (timeclock-day-list-template 'timeclock-day-span))
860
861(defun timeclock-day-list-break (day-list)
fc250015 862 "Return the total break of DAY-LIST."
dace60cf
JW
863 (timeclock-day-list-template 'timeclock-day-break))
864
865(defun timeclock-day-list-projects (day-list)
fc250015 866 "Return a list of all the projects in DAY-LIST."
dace60cf 867 (let (projects)
fc250015
GM
868 (dolist (day day-list)
869 (dolist (proj (timeclock-day-projects day))
870 (if projects
871 (add-to-list 'projects proj)
872 (setq projects (list proj)))))
dace60cf
JW
873 projects))
874
dace60cf 875(defsubst timeclock-current-debt (&optional log-data)
fc250015 876 "Return the seconds debt from LOG-DATA, default `timeclock-log-data'."
dace60cf
JW
877 (nth 0 (or log-data (timeclock-log-data))))
878
879(defsubst timeclock-day-alist (&optional log-data)
fc250015 880 "Return the date alist from LOG-DATA, default `timeclock-log-data'."
dace60cf
JW
881 (nth 1 (or log-data (timeclock-log-data))))
882
883(defun timeclock-day-list (&optional log-data)
fc250015
GM
884 "Return a list of the cdrs of the date alist from LOG-DATA."
885 (let (day-list)
886 (dolist (date-list (timeclock-day-alist log-data))
887 (setq day-list (cons (cdr date-list) day-list)))
dace60cf
JW
888 day-list))
889
890(defsubst timeclock-project-alist (&optional log-data)
fc250015 891 "Return the project alist from LOG-DATA, default `timeclock-log-data'."
dace60cf
JW
892 (nth 2 (or log-data (timeclock-log-data))))
893
dace60cf
JW
894(defun timeclock-log-data (&optional recent-only filename)
895 "Return the contents of the timelog file, in a useful format.
4ee3e788
GM
896If the optional argument RECENT-ONLY is non-nil, only show the contents
897from the last point where the time debt (see below) was set.
898If the optional argument FILENAME is non-nil, it is used instead of
899the file specified by `timeclock-file.'
900
dace60cf
JW
901A timelog contains data in the form of a single entry per line.
902Each entry has the form:
903
904 CODE YYYY/MM/DD HH:MM:SS [COMMENT]
905
906CODE is one of: b, h, i, o or O. COMMENT is optional when the code is
907i, o or O. The meanings of the codes are:
908
909 b Set the current time balance, or \"time debt\". Useful when
910 archiving old log data, when a debt must be carried forward.
911 The COMMENT here is the number of seconds of debt.
912
913 h Set the required working time for the given day. This must
914 be the first entry for that day. The COMMENT in this case is
a9dfccd6
EZ
915 the number of hours in this workday. Floating point amounts
916 are allowed.
dace60cf
JW
917
918 i Clock in. The COMMENT in this case should be the name of the
919 project worked on.
920
921 o Clock out. COMMENT is unnecessary, but can be used to provide
922 a description of how the period went, for example.
923
924 O Final clock out. Whatever project was being worked on, it is
925 now finished. Useful for creating summary reports.
926
927When this function is called, it will return a data structure with the
928following format:
929
930 (DEBT ENTRIES-BY-DAY ENTRIES-BY-PROJECT)
931
932DEBT is a floating point number representing the number of seconds
933\"owed\" before any work was done. For a new file (one without a 'b'
934entry), this is always zero.
935
936The two entries lists have similar formats. They are both alists,
937where the CAR is the index, and the CDR is a list of time entries.
938For ENTRIES-BY-DAY, the CAR is a textual date string, of the form
939YYYY/MM/DD. For ENTRIES-BY-PROJECT, it is the name of the project
940worked on, or t for the default project.
941
942The CDR for ENTRIES-BY-DAY is slightly different than for
943ENTRIES-BY-PROJECT. It has the following form:
944
945 (DAY-LENGTH TIME-ENTRIES...)
946
947For ENTRIES-BY-PROJECT, there is no DAY-LENGTH member. It is simply a
948list of TIME-ENTRIES. Note that if DAY-LENGTH is nil, it means
949whatever is the default should be used.
950
951A TIME-ENTRY is a recorded time interval. It has the following format
952\(although generally one does not have to manipulate these entries
953directly; see below):
954
955 (BEGIN-TIME END-TIME PROJECT [COMMENT] [FINAL-P])
956
957Anyway, suffice it to say there are a lot of structures. Typically
958the user is expected to manipulate to the day(s) or project(s) that he
959or she wants, at which point the following helper functions may be
960used:
961
962 timeclock-day-required
963 timeclock-day-length
964 timeclock-day-debt
965 timeclock-day-begin
966 timeclock-day-end
967 timeclock-day-span
968 timeclock-day-break
969 timeclock-day-projects
970
971 timeclock-day-list-required
972 timeclock-day-list-length
973 timeclock-day-list-debt
974 timeclock-day-list-begin
975 timeclock-day-list-end
976 timeclock-day-list-span
977 timeclock-day-list-break
978 timeclock-day-list-projects
979
980 timeclock-entry-length
981 timeclock-entry-begin
982 timeclock-entry-end
983 timeclock-entry-project
984 timeclock-entry-comment
985
986 timeclock-entry-list-length
987 timeclock-entry-list-begin
988 timeclock-entry-list-end
989 timeclock-entry-list-span
990 timeclock-entry-list-break
991 timeclock-entry-list-projects
992
993A few comments should make the use of the above functions obvious:
994
995 `required' is the amount of time that must be spent during a day, or
996 sequence of days, in order to have no debt.
997
998 `length' is the actual amount of time that was spent.
999
1000 `debt' is the difference between required time and length. A
1001 negative debt signifies overtime.
1002
1003 `begin' is the earliest moment at which work began.
1004
1005 `end' is the final moment work was done.
1006
1007 `span' is the difference between begin and end.
1008
1009 `break' is the difference between span and length.
1010
1011 `project' is the project that was worked on, and `projects' is a
1012 list of all the projects that were worked on during a given period.
1013
1014 `comment', where it applies, could mean anything.
1015
1016There are a few more functions available, for locating day and entry
1017lists:
1018
1019 timeclock-day-alist LOG-DATA
1020 timeclock-project-alist LOG-DATA
1021 timeclock-current-debt LOG-DATA
1022
1023See the documentation for the given function if more info is needed."
a3961c3e
GM
1024 (let ((log-data (list 0.0 nil nil))
1025 (now (current-time))
1026 last-date-limited last-date-seconds last-date
1027 (line 0) last beg day entry event)
dace60cf
JW
1028 (with-temp-buffer
1029 (insert-file-contents (or filename timeclock-file))
1030 (when recent-only
1031 (goto-char (point-max))
1032 (unless (re-search-backward "^b\\s-+" nil t)
1033 (goto-char (point-min))))
1034 (while (or (setq event (timeclock-read-moment))
1035 (and beg (not last)
1036 (setq last t event (list "o" now))))
1037 (setq line (1+ line))
1038 (cond ((equal (car event) "b")
1039 (setcar log-data (string-to-number (nth 2 event))))
1040 ((equal (car event) "h")
1041 (setq last-date-limited (timeclock-time-to-date (cadr event))
1042 last-date-seconds (* (string-to-number (nth 2 event))
1043 3600.0)))
1044 ((equal (car event) "i")
1045 (if beg
1046 (error "Error in format of timelog file, line %d" line)
1047 (setq beg t))
1048 (setq entry (list (cadr event) nil
1049 (and (> (length (nth 2 event)) 0)
1050 (nth 2 event))))
1051 (let ((date (timeclock-time-to-date (cadr event))))
1052 (if (and last-date
1053 (not (equal date last-date)))
9329ea14
JW
1054 (progn
1055 (setcar (cdr log-data)
1056 (cons (cons last-date day)
1057 (cadr log-data)))
1058 (setq day (list (and last-date-limited
1059 last-date-seconds))))
1060 (unless day
1061 (setq day (list (and last-date-limited
1062 last-date-seconds)))))
dace60cf
JW
1063 (setq last-date date
1064 last-date-limited nil)))
1065 ((equal (downcase (car event)) "o")
1066 (if (not beg)
1067 (error "Error in format of timelog file, line %d" line)
1068 (setq beg nil))
1069 (setcar (cdr entry) (cadr event))
1070 (let ((desc (and (> (length (nth 2 event)) 0)
1071 (nth 2 event))))
1072 (if desc
1073 (nconc entry (list (nth 2 event))))
1074 (if (equal (car event) "O")
1075 (nconc entry (if desc
1076 (list t)
1077 (list nil t))))
1078 (nconc day (list entry))
1079 (setq desc (nth 2 entry))
1080 (let ((proj (assoc desc (nth 2 log-data))))
9329ea14 1081 (if (null proj)
dace60cf
JW
1082 (setcar (cddr log-data)
1083 (cons (cons desc (list entry))
55dfee43 1084 (nth 2 log-data)))
dace60cf
JW
1085 (nconc (cdr proj) (list entry)))))))
1086 (forward-line))
1087 (if day
1088 (setcar (cdr log-data)
1089 (cons (cons last-date day)
1090 (cadr log-data))))
1091 log-data)))
1092
1c8c9fb8 1093(defun timeclock-find-discrep ()
4ee3e788
GM
1094 "Calculate time discrepancies, in seconds.
1095The result is a three element list, containing the total time
1096discrepancy, today's discrepancy, and the time worked today."
dace60cf
JW
1097 ;; This is not implemented in terms of the functions above, because
1098 ;; it's a bit wasteful to read all of that data in, just to throw
1099 ;; away more than 90% of the information afterwards.
3dc630b9
JW
1100 ;;
1101 ;; If it were implemented using those functions, it would look
1102 ;; something like this:
1103 ;; (let ((days (timeclock-day-alist (timeclock-log-data)))
1104 ;; (total 0.0))
1105 ;; (while days
1106 ;; (setq total (+ total (- (timeclock-day-length (cdar days))
1107 ;; (timeclock-day-required (cdar days))))
1108 ;; days (cdr days)))
1109 ;; total)
1110 (let* ((now (current-time))
1111 (todays-date (timeclock-time-to-date now))
4bd0908b 1112 (first t) (accum 0) (elapsed 0)
a3961c3e 1113 event beg last-date
3dc630b9
JW
1114 last-date-limited last-date-seconds)
1115 (unless timeclock-discrepancy
1116 (when (file-readable-p timeclock-file)
9329ea14
JW
1117 (setq timeclock-project-list nil
1118 timeclock-last-project nil
1119 timeclock-reason-list nil
1120 timeclock-elapsed 0)
1121 (with-temp-buffer
1122 (insert-file-contents timeclock-file)
1123 (goto-char (point-max))
1124 (unless (re-search-backward "^b\\s-+" nil t)
1125 (goto-char (point-min)))
1126 (while (setq event (timeclock-read-moment))
1127 (cond ((equal (car event) "b")
1128 (setq accum (string-to-number (nth 2 event))))
1129 ((equal (car event) "h")
1130 (setq last-date-limited
1131 (timeclock-time-to-date (cadr event))
1132 last-date-seconds
1133 (* (string-to-number (nth 2 event)) 3600.0)))
1134 ((equal (car event) "i")
1135 (when (and (nth 2 event)
1136 (> (length (nth 2 event)) 0))
1137 (add-to-list 'timeclock-project-list (nth 2 event))
1138 (setq timeclock-last-project (nth 2 event)))
1139 (let ((date (timeclock-time-to-date (cadr event))))
1c8c9fb8
JW
1140 (if (if last-date
1141 (not (equal date last-date))
1142 first)
9329ea14 1143 (setq first nil
1c8c9fb8
JW
1144 accum (- accum (if last-date-limited
1145 last-date-seconds
1146 timeclock-workday))))
9329ea14
JW
1147 (setq last-date date
1148 last-date-limited nil)
1149 (if beg
90cbf47e 1150 (error "Error in format of timelog file!")
9329ea14
JW
1151 (setq beg (timeclock-time-to-seconds (cadr event))))))
1152 ((equal (downcase (car event)) "o")
1153 (if (and (nth 2 event)
1154 (> (length (nth 2 event)) 0))
1155 (add-to-list 'timeclock-reason-list (nth 2 event)))
1c8c9fb8
JW
1156 (if (not beg)
1157 (error "Error in format of timelog file!")
1158 (setq timeclock-last-period
1159 (- (timeclock-time-to-seconds (cadr event)) beg)
1160 accum (+ timeclock-last-period accum)
1161 beg nil))
9329ea14
JW
1162 (if (equal last-date todays-date)
1163 (setq timeclock-elapsed
1164 (+ timeclock-last-period timeclock-elapsed)))))
1165 (setq timeclock-last-event event
1166 timeclock-last-event-workday
3dc630b9 1167 (if (equal (timeclock-time-to-date now) last-date-limited)
9329ea14
JW
1168 last-date-seconds
1169 timeclock-workday))
1170 (forward-line))
3dc630b9 1171 (setq timeclock-discrepancy accum))))
3b774a0c
JW
1172 (unless timeclock-last-event-workday
1173 (setq timeclock-last-event-workday timeclock-workday))
9d1137ce 1174 (setq accum (or timeclock-discrepancy 0)
8c9245e2 1175 elapsed (or timeclock-elapsed elapsed))
3dc630b9
JW
1176 (if timeclock-last-event
1177 (if (equal (car timeclock-last-event) "i")
1c8c9fb8
JW
1178 (let ((last-period (timeclock-last-period now)))
1179 (setq accum (+ accum last-period)
1180 elapsed (+ elapsed last-period)))
3dc630b9
JW
1181 (if (not (equal (timeclock-time-to-date
1182 (cadr timeclock-last-event))
1183 (timeclock-time-to-date now)))
1184 (setq accum (- accum timeclock-last-event-workday)))))
1c8c9fb8
JW
1185 (list accum (- elapsed timeclock-last-event-workday)
1186 elapsed)))
9329ea14
JW
1187
1188;;; A reporting function that uses timeclock-log-data
1189
9329ea14 1190(defun timeclock-day-base (&optional time)
4ee3e788
GM
1191 "Given a time within a day, return 0:0:0 within that day.
1192If optional argument TIME is non-nil, use that instead of the current time."
9329ea14
JW
1193 (let ((decoded (decode-time (or time (current-time)))))
1194 (setcar (nthcdr 0 decoded) 0)
1195 (setcar (nthcdr 1 decoded) 0)
1196 (setcar (nthcdr 2 decoded) 0)
1197 (apply 'encode-time decoded)))
1198
7e285b36
CY
1199(defun timeclock-mean (l)
1200 "Compute the arithmetic mean of the values in the list L."
9329ea14
JW
1201 (let ((total 0)
1202 (count 0))
55dfee43
GM
1203 (dolist (thisl l)
1204 (setq total (+ total thisl)
1205 count (1+ count)))
1206 (if (zerop count)
1207 0
1208 (/ total count))))
9329ea14
JW
1209
1210(defun timeclock-generate-report (&optional html-p)
4ee3e788
GM
1211 "Generate a summary report based on the current timelog file.
1212By default, the report is in plain text, but if the optional argument
a9dfccd6 1213HTML-P is non-nil, HTML markup is added."
7e285b36 1214 (interactive "P")
9329ea14
JW
1215 (let ((log (timeclock-log-data))
1216 (today (timeclock-day-base)))
1217 (if html-p (insert "<p>"))
1218 (insert "Currently ")
1219 (let ((project (nth 2 timeclock-last-event))
1220 (begin (nth 1 timeclock-last-event))
1221 done)
1222 (if (timeclock-currently-in-p)
1223 (insert "IN")
55dfee43 1224 (if (zerop (length project))
9329ea14
JW
1225 (progn (insert "Done Working Today")
1226 (setq done t))
1227 (insert "OUT")))
1228 (unless done
1229 (insert " since " (format-time-string "%Y/%m/%d %-I:%M %p" begin))
1230 (if html-p
1231 (insert "<br>\n<b>")
1232 (insert "\n*"))
1233 (if (timeclock-currently-in-p)
1234 (insert "Working on "))
1235 (if html-p
40e7276a 1236 (insert project "</b><br>\n")
9329ea14
JW
1237 (insert project "*\n"))
1238 (let ((proj-data (cdr (assoc project (timeclock-project-alist log))))
1239 (two-weeks-ago (timeclock-seconds-to-time
1240 (- (timeclock-time-to-seconds today)
1241 (* 2 7 24 60 60))))
1242 two-week-len today-len)
1243 (while proj-data
1c226f2b 1244 (if (not (time-less-p
9329ea14
JW
1245 (timeclock-entry-begin (car proj-data)) today))
1246 (setq today-len (timeclock-entry-list-length proj-data)
1247 proj-data nil)
1248 (if (and (null two-week-len)
1c226f2b 1249 (not (time-less-p
9329ea14
JW
1250 (timeclock-entry-begin (car proj-data))
1251 two-weeks-ago)))
1252 (setq two-week-len (timeclock-entry-list-length proj-data)))
1253 (setq proj-data (cdr proj-data))))
1254 (if (null two-week-len)
1255 (setq two-week-len today-len))
1256 (if html-p (insert "<p>"))
3dc630b9
JW
1257 (if today-len
1258 (insert "\nTime spent on this task today: "
1259 (timeclock-seconds-to-string today-len)
1260 ". In the last two weeks: "
1261 (timeclock-seconds-to-string two-week-len))
1262 (if two-week-len
1263 (insert "\nTime spent on this task in the last two weeks: "
1264 (timeclock-seconds-to-string two-week-len))))
9329ea14
JW
1265 (if html-p (insert "<br>"))
1266 (insert "\n"
1267 (timeclock-seconds-to-string (timeclock-workday-elapsed))
1268 " worked today, "
1269 (timeclock-seconds-to-string (timeclock-workday-remaining))
1270 " remaining, done at "
1271 (timeclock-when-to-leave-string) "\n")))
1272 (if html-p (insert "<p>"))
1273 (insert "\nThere have been "
1274 (number-to-string
1275 (length (timeclock-day-alist log)))
1276 " days of activity, starting "
1277 (caar (last (timeclock-day-alist log))))
1278 (if html-p (insert "</p>"))
1279 (when html-p
1280 (insert "<p>
1281<table>
1282<td width=\"25\"><br></td><td>
1283<table border=1 cellpadding=3>
1284<tr><th><i>Statistics</i></th>
1285 <th>Entire</th>
1286 <th>-30 days</th>
1287 <th>-3 mons</th>
1288 <th>-6 mons</th>
1289 <th>-1 year</th>
1290</tr>")
1291 (let* ((day-list (timeclock-day-list))
1292 (thirty-days-ago (timeclock-seconds-to-time
1293 (- (timeclock-time-to-seconds today)
1294 (* 30 24 60 60))))
1295 (three-months-ago (timeclock-seconds-to-time
1296 (- (timeclock-time-to-seconds today)
1297 (* 90 24 60 60))))
1298 (six-months-ago (timeclock-seconds-to-time
1299 (- (timeclock-time-to-seconds today)
1300 (* 180 24 60 60))))
1301 (one-year-ago (timeclock-seconds-to-time
1302 (- (timeclock-time-to-seconds today)
1303 (* 365 24 60 60))))
1304 (time-in (vector (list t) (list t) (list t) (list t) (list t)))
1305 (time-out (vector (list t) (list t) (list t) (list t) (list t)))
1306 (breaks (vector (list t) (list t) (list t) (list t) (list t)))
1307 (workday (vector (list t) (list t) (list t) (list t) (list t)))
1308 (lengths (vector '(0 0) thirty-days-ago three-months-ago
1309 six-months-ago one-year-ago)))
1310 ;; collect statistics from complete timelog
55dfee43 1311 (dolist (day day-list)
9329ea14
JW
1312 (let ((i 0) (l 5))
1313 (while (< i l)
1c226f2b 1314 (unless (time-less-p
55dfee43 1315 (timeclock-day-begin day)
9329ea14
JW
1316 (aref lengths i))
1317 (let ((base (timeclock-time-to-seconds
1318 (timeclock-day-base
55dfee43 1319 (timeclock-day-begin day)))))
9329ea14
JW
1320 (nconc (aref time-in i)
1321 (list (- (timeclock-time-to-seconds
55dfee43 1322 (timeclock-day-begin day))
9329ea14 1323 base)))
55dfee43
GM
1324 (let ((span (timeclock-day-span day))
1325 (len (timeclock-day-length day))
1326 (req (timeclock-day-required day)))
9329ea14
JW
1327 ;; If the day's actual work length is less than
1328 ;; 70% of its span, then likely the exit time
1329 ;; and break amount are not worthwhile adding to
1330 ;; the statistic
1331 (when (and (> span 0)
1332 (> (/ (float len) (float span)) 0.70))
1333 (nconc (aref time-out i)
1334 (list (- (timeclock-time-to-seconds
55dfee43 1335 (timeclock-day-end day))
9329ea14
JW
1336 base)))
1337 (nconc (aref breaks i) (list (- span len))))
1338 (if req
1339 (setq len (+ len (- timeclock-workday req))))
1340 (nconc (aref workday i) (list len)))))
55dfee43 1341 (setq i (1+ i)))))
9329ea14
JW
1342 ;; average statistics
1343 (let ((i 0) (l 5))
1344 (while (< i l)
7e285b36
CY
1345 (aset time-in i (timeclock-mean (cdr (aref time-in i))))
1346 (aset time-out i (timeclock-mean (cdr (aref time-out i))))
1347 (aset breaks i (timeclock-mean (cdr (aref breaks i))))
1348 (aset workday i (timeclock-mean (cdr (aref workday i))))
9329ea14
JW
1349 (setq i (1+ i))))
1350 ;; Output the HTML table
1351 (insert "<tr>\n")
1352 (insert "<td align=\"center\">Time in</td>\n")
1353 (let ((i 0) (l 5))
1354 (while (< i l)
1355 (insert "<td align=\"right\">"
1356 (timeclock-seconds-to-string (aref time-in i))
1357 "</td>\n")
1358 (setq i (1+ i))))
1359 (insert "</tr>\n")
3dc630b9 1360
9329ea14
JW
1361 (insert "<tr>\n")
1362 (insert "<td align=\"center\">Time out</td>\n")
1363 (let ((i 0) (l 5))
1364 (while (< i l)
1365 (insert "<td align=\"right\">"
1366 (timeclock-seconds-to-string (aref time-out i))
1367 "</td>\n")
1368 (setq i (1+ i))))
1369 (insert "</tr>\n")
3dc630b9 1370
9329ea14
JW
1371 (insert "<tr>\n")
1372 (insert "<td align=\"center\">Break</td>\n")
1373 (let ((i 0) (l 5))
1374 (while (< i l)
1375 (insert "<td align=\"right\">"
1376 (timeclock-seconds-to-string (aref breaks i))
1377 "</td>\n")
1378 (setq i (1+ i))))
1379 (insert "</tr>\n")
3dc630b9 1380
9329ea14
JW
1381 (insert "<tr>\n")
1382 (insert "<td align=\"center\">Workday</td>\n")
1383 (let ((i 0) (l 5))
1384 (while (< i l)
1385 (insert "<td align=\"right\">"
1386 (timeclock-seconds-to-string (aref workday i))
1387 "</td>\n")
1388 (setq i (1+ i))))
1389 (insert "</tr>\n"))
1390 (insert "<tfoot>
1391<td colspan=\"6\" align=\"center\">
1392 <i>These are approximate figures</i></td>
1393</tfoot>
1394</table>
1395</td></table>")))))
1396
1397;;; A helpful little function
1398
1399(defun timeclock-visit-timelog ()
4ee3e788 1400 "Open the file named by `timeclock-file' in another window."
9329ea14
JW
1401 (interactive)
1402 (find-file-other-window timeclock-file))
90cbf47e
GM
1403
1404(provide 'timeclock)
1405
1406(run-hooks 'timeclock-load-hook)
1407
1408;; make sure we know the list of reasons, projects, and have computed
1409;; the last event and current discrepancy.
1410(if (file-readable-p timeclock-file)
1411 (timeclock-reread-log))
1412
1413;;; timeclock.el ends here