(font-lock-comment-face): Change dark-background,
[bpt/emacs.git] / lisp / calendar / timeclock.el
CommitLineData
90cbf47e
GM
1;;; timeclock.el --- mode for keeping track of how much you work
2
3;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
4
5;; Author: John Wiegley <johnw@gnu.org>
6;; Created: 25 Mar 1999
7;; Version: 2.2
8;; Keywords: calendar data
90cbf47e
GM
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
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
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; This mode is for keeping track of time intervals. You can use it
30;; for whatever purpose you like, but the typical scenario is to keep
31;; track of how much time you spend working on certain projects.
32;;
33;; Use `timeclock-in' when you start on a project, and `timeclock-out'
34;; when you're done. Once you've collected some data, you can use
35;; `timeclock-workday-remaining' to see how much time is left to be
36;; worked today (assuming a typical average of 8 hours a day), and
37;; `timeclock-when-to-leave' which will calculate when you're free.
38
39;; You'll probably want to bind the timeclock commands to some handy
40;; keystrokes. At the moment, C-x t is unused in Emacs 20:
41;;
42;; (require 'timeclock)
43;;
44;; (define-key ctl-x-map "ti" 'timeclock-in)
45;; (define-key ctl-x-map "to" 'timeclock-out)
46;; (define-key ctl-x-map "tc" 'timeclock-change)
47;; (define-key ctl-x-map "tr" 'timeclock-reread-log)
48;; (define-key ctl-x-map "tu" 'timeclock-update-modeline)
49;; (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
50
51;; If you want Emacs to display the amount of time "left" to your
52;; workday in the modeline, you can either set the value of
53;; `timeclock-modeline-display' to t using M-x customize, or you
54;; can add this code to your .emacs file:
55;;
56;; (require 'timeclock)
57;; (timeclock-modeline-display)
58;;
59;; To cancel this modeline display at any time, just call
60;; `timeclock-modeline-display' again.
61
62;; You may also want Emacs to ask you before exiting, if you are
63;; current working on a project. This can be done either by setting
64;; `timeclock-ask-before-exiting' to t using M-x customize (this is
65;; the default), or by adding the following to your .emacs file:
66;;
67;; (add-hook 'kill-emacs-hook 'timeclock-query-out)
68
69;; NOTE: If you change your .timelog file without using timeclock's
70;; functions, or if you change the value of any of timeclock's
71;; customizable variables, you should run the command
72;; `timeclock-reread-log'. This will recompute any discrepancies in
73;; your average working time, and will make sure that the various
74;; display functions return the correct value.
75
76;;; History:
77
78;;; Code:
79
80(defgroup timeclock nil
81 "Keeping track time of the time that gets spent."
82 :group 'data)
83
84;;; User Variables:
85
e437b491 86(defcustom timeclock-file (convert-standard-filename "~/.timelog")
90cbf47e
GM
87 "*The file used to store timeclock data in."
88 :type 'file
89 :group 'timeclock)
90
91(defcustom timeclock-workday (* 8 60 60)
92 "*The length of a work period."
93 :type 'integer
94 :group 'timeclock)
95
96(defcustom timeclock-relative t
97 "*When reporting time, make it relative to `timeclock-workday'?
98For example, if the length of a normal workday is eight hours, and you
99work four hours on Monday, then the amount of time \"remaining\" on
100Tuesday is twelve hours -- relative to an averaged work period of
101eight hours -- or eight hours, non-relative. So relative time takes
102into account any discrepancy of time under-worked or overworked on
103previous days."
104 :type 'boolean
105 :group 'timeclock)
106
107(defcustom timeclock-get-project-function 'timeclock-ask-for-project
108 "*The function used to determine the name of the current project.
109When clocking in, and no project is specified, this function will be
110called to determine what the current project to be worked on is.
111If this variable is nil, no questions will be asked."
112 :type 'function
113 :group 'timeclock)
114
115(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason
116 "*A function used to determine the reason for clocking out.
117When clocking out, and no reason is specified, this function will be
118called to determine what the reason is.
119If this variable is nil, no questions will be asked."
120 :type 'function
121 :group 'timeclock)
122
123(defcustom timeclock-get-workday-function nil
124 "*A function used to determine the length of today's workday.
125The first time that a user clocks in each day, this function will be
126called to determine what the length of the current workday is. If
127nil, or equal to `timeclock-workday', nothing special will be done.
128If it is a quantity different from `timeclock-workday', however, a
129record will be output to the timelog file to note the fact that that
130day has a different length from the norm."
131 :type 'function
132 :group 'timeclock)
133
134(defcustom timeclock-ask-before-exiting t
135 "*If non-nil, ask if the user wants to clock out before exiting Emacs."
136 :set (lambda (symbol value)
137 (if value
138 (add-hook 'kill-emacs-hook 'timeclock-query-out)
139 (remove-hook 'kill-emacs-hook 'timeclock-query-out))
140 (setq timeclock-ask-before-exiting value))
141 :type 'boolean
142 :group 'timeclock)
143
144(defvar timeclock-update-timer nil
145 "The timer used to update `timeclock-mode-string'.")
146
147(defcustom timeclock-use-display-time t
148 "*If non-nil, use `display-time-hook' for doing modeline updates.
149The advantage to this is that it means one less timer has to be set
150running amok in Emacs' process space. The disadvantage is that it
151requires you to have `display-time' running. If you don't want to use
152`display-time', but still want the modeline to show how much time is
153left, set this variable to nil. You will need to restart Emacs (or
154toggle the value of `timeclock-modeline-display') for the change to
155take effect."
156 :set (lambda (symbol value)
157 (let ((currently-displaying
158 (and (boundp 'timeclock-modeline-display)
159 timeclock-modeline-display)))
160 ;; if we're changing to the state that
161 ;; `timeclock-modeline-display' is already using, don't
162 ;; bother toggling it. This happens on the initial loading
163 ;; of timeclock.el.
164 (if (and currently-displaying
165 (or (and value
166 (boundp 'display-time-hook)
167 (memq 'timeclock-update-modeline
168 display-time-hook))
169 (and (not value)
170 timeclock-update-timer)))
171 (setq currently-displaying nil))
172 (and currently-displaying
173 (set-variable timeclock-modeline-display nil))
174 (setq timeclock-use-display-time value)
175 (and currently-displaying
176 (set-variable timeclock-modeline-display t))
177 timeclock-use-display-time))
178 :type 'boolean
179 :group 'timeclock
180 :require 'time)
181
182(defcustom timeclock-first-in-hook nil
183 "*A hook run for the first \"in\" event each day.
184Note that this hook is run before recording any events. Thus the
185value of `timeclock-hours-today', `timeclock-last-event' and the
186return value of function `timeclock-last-period' are relative previous
187to today."
188 :type 'hook
189 :group 'timeclock)
190
191(defcustom timeclock-load-hook nil
192 "*Hook that gets run after timeclock has been loaded."
193 :type 'hook
194 :group 'timeclock)
195
196(defcustom timeclock-in-hook nil
197 "*A hook run every time an \"in\" event is recorded."
198 :type 'hook
199 :group 'timeclock)
200
201(defcustom timeclock-day-over-hook nil
202 "*A hook that is run when the workday has been completed.
203This hook is only run if the current time remaining is being display
204in the modeline. See the variable `timeclock-modeline-display'."
205 :type 'hook
206 :group 'timeclock)
207
208(defcustom timeclock-out-hook nil
209 "*A hook run every time an \"out\" event is recorded."
210 :type 'hook
211 :group 'timeclock)
212
213(defcustom timeclock-done-hook nil
214 "*A hook run every time a project is marked as completed."
215 :type 'hook
216 :group 'timeclock)
217
218(defcustom timeclock-event-hook nil
219 "*A hook run every time any event is recorded."
220 :type 'hook
221 :group 'timeclock)
222
223(defvar timeclock-last-event nil
224 "A list containing the last event that was recorded.
225The format of this list is (CODE TIME PROJECT). PROJECT will be
226non-nil only if CODE is \"o\" or \"O\".")
227
228(defvar timeclock-last-event-workday nil
229 "The number of seconds in the workday of `timeclock-last-event'.")
230
231;;; Internal Variables:
232
233(defvar timeclock-discrepancy nil
234 "A variable containing the time discrepancy before the last event.
235Normally, timeclock assumes that you intend to work for
236`timeclock-workday' seconds every day. Any days in which you work
237more or less than this amount is considered either a positive or
238negative discrepancy. If you work in such a manner that the
239discrepancy is always brought back to zero, then you will by
240definition have worked an average amount equal to `timeclock-workday'
241each day.")
242
243(defvar timeclock-elapsed nil
244 "A variable containing the time elapsed for complete periods today.
245This value is not accurate enough to be useful by itself. Rather,
246call `timeclock-workday-elapsed', to determine how much time has been
247worked so far today. Also, if `timeclock-relative' is nil, this value
248will be the same as `timeclock-discrepancy'.")
249
250(defvar timeclock-last-period nil
251 "Integer representing the number of seconds in the last period.
252Note that you shouldn't access this value, but should use the function
253`timeclock-last-period' instead.")
254
255(defvar timeclock-mode-string nil
256 "The timeclock string (optionally) displayed in the modeline.")
257
258(defvar timeclock-day-over nil
259 "The date of the last day when notified \"day over\" for.")
260
261;;; User Functions:
262
263;;;###autoload
264(defun timeclock-modeline-display (&optional arg)
265 "Toggle display of the amount of time left today in the modeline.
266If `timeclock-use-display-time' is non-nil, the modeline will be
267updated whenever the time display is updated. Otherwise, the
268timeclock will use its own sixty second timer to do its updating.
269With prefix ARG, turn modeline display on if and only if ARG is
270positive. Returns the new status of timeclock modeline display
271\(non-nil means on)."
272 (interactive "P")
273 (let ((on-p (if arg
274 (> (prefix-numeric-value arg) 0)
275 (not timeclock-modeline-display))))
276 (if on-p
277 (let ((list-entry (memq 'global-mode-string
278 mode-line-format)))
279 (unless (memq 'timeclock-mode-string mode-line-format)
280 (setcdr list-entry
281 (cons 'timeclock-mode-string
282 (cdr list-entry))))
283 (unless (memq 'timeclock-update-modeline timeclock-event-hook)
284 (add-hook 'timeclock-event-hook 'timeclock-update-modeline))
285 (when timeclock-update-timer
286 (cancel-timer timeclock-update-timer)
287 (setq timeclock-update-timer nil))
288 (if (boundp 'display-time-hook)
289 (remove-hook 'display-time-hook 'timeclock-update-modeline))
290 (if timeclock-use-display-time
291 (add-hook 'display-time-hook 'timeclock-update-modeline)
292 (setq timeclock-update-timer
293 (run-at-time nil 60 'timeclock-update-modeline))))
294 (setq mode-line-format
295 (delq 'timeclock-mode-string mode-line-format))
296 (remove-hook 'timeclock-event-hook 'timeclock-update-modeline)
297 (if (boundp 'display-time-hook)
298 (remove-hook 'display-time-hook
299 'timeclock-update-modeline))
300 (when timeclock-update-timer
301 (cancel-timer timeclock-update-timer)
302 (setq timeclock-update-timer nil)))
303 (force-mode-line-update)
304 on-p))
305
306;; This has to be here so that the function definition of
307;; `timeclock-modeline-display' is known to the "set" function.
308(defcustom timeclock-modeline-display nil
309 "Toggle modeline display of time remaining.
310You must modify via \\[customize] for this variable to have an effect."
311 :set (lambda (symbol value)
312 (setq timeclock-modeline-display
313 (timeclock-modeline-display (or value 0))))
314 :type 'boolean
315 :group 'timeclock
316 :require 'timeclock)
317
318;;;###autoload
319(defun timeclock-in (&optional arg project find-project)
320 "Clock in, recording the current time moment in the timelog.
321With a numeric prefix ARG, record the fact that today has only that
322many hours in it to be worked. If arg is a non-numeric prefix arg
323\(non-nil, but not a number), 0 is assumed (working on a holiday or
324weekend). *If not called interactively, ARG should be the number of
325_seconds_ worked today*. This feature only has effect the first time
326this function is called within a day.
327
328PROJECT as the project being clocked into. If PROJECT is nil, and
329FIND-PROJECT is non-nil -- or the user calls `timeclock-in'
330interactively -- call the function `timeclock-get-project-function' to
331discover the name of the project."
332 (interactive
333 (list (and current-prefix-arg
334 (if (numberp current-prefix-arg)
335 (* current-prefix-arg 60 60)
336 0))))
337 (if (equal (car timeclock-last-event) "i")
338 (error "You've already clocked in!")
339 (unless timeclock-last-event
340 (timeclock-reread-log))
341 (unless (equal (timeclock-time-to-date
342 (cadr timeclock-last-event))
343 (timeclock-time-to-date (current-time)))
344 (let ((workday (or (and (numberp arg) arg)
345 (and arg 0)
346 (and timeclock-get-workday-function
347 (funcall timeclock-get-workday-function))
348 timeclock-workday)))
349 (run-hooks 'timeclock-first-in-hook)
350 ;; settle the discrepancy for the new day
351 (setq timeclock-discrepancy
352 (- timeclock-discrepancy workday))
353 (if (not (= workday timeclock-workday))
354 (timeclock-log "h" (and (numberp arg)
355 (number-to-string arg))))))
356 (timeclock-log "i" (or project
357 (and timeclock-get-project-function
358 (or find-project (interactive-p))
359 (funcall timeclock-get-project-function))))
360 (run-hooks 'timeclock-in-hook)))
361
362;;;###autoload
363(defun timeclock-out (&optional arg reason find-reason)
364 "Clock out, recording the current time moment in the timelog.
365If a prefix ARG is given, the user has completed the project that was
366begun during the last time segment.
367
368REASON is the user's reason for clocking out. If REASON is nil, and
369FIND-REASON is non-nil -- or the user calls `timeclock-out'
370interactively -- call the function `timeclock-get-reason-function' to
371discover the reason."
372 (interactive "P")
373 (if (equal (downcase (car timeclock-last-event)) "o")
374 (error "You've already clocked out!")
375 (timeclock-log
376 (if arg "O" "o")
377 (or reason
378 (and timeclock-get-reason-function
379 (or find-reason (interactive-p))
380 (funcall timeclock-get-reason-function))))
381 (run-hooks 'timeclock-out-hook)
382 (if arg
383 (run-hooks 'timeclock-done-hook))))
384
385;;;###autoload
386(defun timeclock-status-string (&optional show-seconds today-only)
387 "Report the overall timeclock status at the present moment."
388 (interactive "P")
389 (let* ((remainder (timeclock-workday-remaining))
390 (last-in (equal (car timeclock-last-event) "i"))
391 status)
392 (setq status
393 (format "Currently %s since %s (%s), %s %s, leave at %s"
394 (if last-in "IN" "OUT")
395 (if show-seconds
396 (format-time-string "%-I:%M:%S %p"
397 (nth 1 timeclock-last-event))
398 (format-time-string "%-I:%M %p"
399 (nth 1 timeclock-last-event)))
400 (or (nth 2 timeclock-last-event)
401 (if last-in "**UNKNOWN**" "workday over"))
402 (timeclock-seconds-to-string remainder show-seconds t)
403 (if (> remainder 0)
404 "remaining" "over")
405 (timeclock-when-to-leave-string show-seconds today-only)))
406 (if (interactive-p)
407 (message status)
408 status)))
409
410;;;###autoload
411(defun timeclock-change (&optional arg project)
412 "Change to working on a different project, by clocking in then out.
413With a prefix ARG, consider the previous project as having been
414finished at the time of changeover. PROJECT is the name of the last
415project you were working on."
416 (interactive "P")
417 (timeclock-out arg)
418 (timeclock-in nil project (interactive-p)))
419
420;;;###autoload
421(defun timeclock-query-out ()
422 "Ask the user before clocking out.
423This is a useful function for adding to `kill-emacs-hook'."
424 (if (and (equal (car timeclock-last-event) "i")
425 (y-or-n-p "You're currently clocking time, clock out? "))
426 (timeclock-out)))
427
428;;;###autoload
429(defun timeclock-reread-log ()
430 "Re-read the timeclock, to account for external changes.
431Returns the new value of `timeclock-discrepancy'."
432 (interactive)
433 (setq timeclock-discrepancy nil)
434 (timeclock-find-discrep)
435 (if timeclock-modeline-display
436 (timeclock-update-modeline))
437 timeclock-discrepancy)
438
439(defun timeclock-seconds-to-string (seconds &optional show-seconds
440 reverse-leader)
441 "Convert SECONDS into a compact time string.
442If SHOW-SECONDS is non-nil, make the resolution of the return string
443include the second count. If REVERSE-LEADER is non-nil, it means to
444output a \"+\" if the time value is negative, rather than a \"-\".
445This is used when negative time values have an inverted meaning (such
446as with time remaining, where negative time really means overtime)."
447 (if show-seconds
448 (format "%s%d:%02d:%02d"
449 (if (< seconds 0) (if reverse-leader "+" "-") "")
450 (truncate (/ (abs seconds) 60 60))
451 (% (truncate (/ (abs seconds) 60)) 60)
452 (% (truncate (abs seconds)) 60))
453 (format "%s%d:%02d"
454 (if (< seconds 0) (if reverse-leader "+" "-") "")
455 (truncate (/ (abs seconds) 60 60))
456 (% (truncate (/ (abs seconds) 60)) 60))))
457
458(defun timeclock-workday-remaining (&optional today-only)
459 "Return a the number of seconds until the workday is complete.
460The amount returned is relative to the value of `timeclock-workday'.
461If TODAY-ONLY is non-nil, the value returned will be relative only to
462the time worked today, and not to past time. This argument only makes
463a difference if `timeclock-relative' is non-nil."
464 (- (timeclock-find-discrep today-only)))
465
466(defun timeclock-currently-in-p ()
467 "Return non-nil if the user is currently clocked in."
468 (equal (car timeclock-last-event) "i"))
469
470;;;###autoload
471(defun timeclock-workday-remaining-string (&optional show-seconds
472 today-only)
473 "Return a string representing the amount of time left today.
474Display second resolution if SHOW-SECONDS is non-nil. If TODAY-ONLY
475is non-nil, the display will be relative only to time worked today.
476See `timeclock-relative' for more information about the meaning of
477\"relative to today\"."
478 (interactive)
479 (let ((string (timeclock-seconds-to-string
480 (timeclock-workday-remaining today-only)
481 show-seconds t)))
482 (if (interactive-p)
483 (message string)
484 string)))
485
486(defun timeclock-workday-elapsed (&optional relative)
487 "Return a the number of seconds worked so far today.
488If RELATIVE is non-nil, the amount returned will be relative to past
489time worked. The default is to return only the time that has elapsed
490so far today."
491 (+ timeclock-workday
492 (timeclock-find-discrep (not relative))))
493
494;;;###autoload
495(defun timeclock-workday-elapsed-string (&optional show-seconds
496 relative)
497 "Return a string representing the amount of time worked today.
498Display seconds resolution if SHOW-SECONDS is non-nil. If RELATIVE is
499non-nil, the amount returned will be relative to past time worked."
500 (interactive)
501 (let ((string (timeclock-seconds-to-string
502 (timeclock-workday-elapsed relative)
503 show-seconds)))
504 (if (interactive-p)
505 (message string)
506 string)))
507
508(defun timeclock-when-to-leave (&optional today-only)
509 "Return a time value representing at when the workday ends today.
510If TODAY-ONLY is non-nil, the value returned will be relative only to
511the time worked today, and not to past time. This argument only makes
512a difference if `timeclock-relative' is non-nil."
513 (timeclock-seconds-to-time
514 (- (timeclock-time-to-seconds (current-time))
515 (timeclock-find-discrep today-only))))
516
517;;;###autoload
518(defun timeclock-when-to-leave-string (&optional show-seconds
519 today-only)
520 "Return a string representing at what time the workday ends today.
521This string is relative to the value of `timeclock-workday'. If
522NO-MESSAGE is non-nil, no messages will be displayed in the
523minibuffer. If SHOW-SECONDS is non-nil, the value printed/returned
524will include seconds. If TODAY-ONLY is non-nil, the value returned
525will be relative only to the time worked today, and not to past time.
526This argument only makes a difference if `timeclock-relative' is
527non-nil."
528 (interactive)
529 (let* ((then (timeclock-when-to-leave today-only))
530 (string
531 (if show-seconds
532 (format-time-string "%-I:%M:%S %p" then)
533 (format-time-string "%-I:%M %p" then))))
534 (if (interactive-p)
535 (message string)
536 string)))
537
538;;; Internal Functions:
539
540(defvar timeclock-project-list nil)
541(defvar timeclock-last-project nil)
542
543(defun timeclock-ask-for-project ()
544 "Ask the user for the project they are clocking into."
545 (completing-read (format "Clock into which project (default \"%s\"): "
546 (or timeclock-last-project
547 (car timeclock-project-list)))
548 (mapcar 'list timeclock-project-list)
549 nil nil nil nil (or timeclock-last-project
550 (car timeclock-project-list))))
551
552(defvar timeclock-reason-list nil)
553
554(defun timeclock-ask-for-reason ()
555 "Ask the user for the reason they are clocking out."
556 (completing-read "Reason for clocking out: "
557 (mapcar 'list timeclock-reason-list)))
558
559(defun timeclock-update-modeline ()
560 "Update the `timeclock-mode-string' displayed in the modeline."
561 (interactive)
562 (let* ((remainder (timeclock-workday-remaining))
563 (last-in (equal (car timeclock-last-event) "i")))
564 (when (and (< remainder 0)
565 (not (and timeclock-day-over
566 (equal timeclock-day-over
567 (timeclock-time-to-date
568 (current-time))))))
569 (setq timeclock-day-over
570 (timeclock-time-to-date (current-time)))
571 (run-hooks 'timeclock-day-over-hook))
572 (setq timeclock-mode-string
573 (format " %c%s%c"
574 (if last-in ?< ?[)
575 (timeclock-seconds-to-string remainder nil t)
576 (if last-in ?> ?])))))
577
578(defun timeclock-log (code &optional project)
579 "Log the event CODE to the timeclock log, at the time of call.
580If PROJECT is a string, it represents the project which the event is
581being logged for. Normally only \"out\" events specify a project."
582 (save-excursion
583 (set-buffer (find-file-noselect timeclock-file))
584 (goto-char (point-max))
585 (if (not (bolp))
586 (insert "\n"))
587 (let ((now (current-time)))
588 (insert code " "
589 (format-time-string "%Y/%m/%d %H:%M:%S" now)
590 (or (and project
591 (stringp project)
592 (> (length project) 0)
593 (concat " " project))
594 "")
595 "\n")
596 (if (equal (downcase code) "o")
597 (setq timeclock-last-period
598 (- (timeclock-time-to-seconds now)
599 (timeclock-time-to-seconds
600 (cadr timeclock-last-event)))
601 timeclock-discrepancy
602 (+ timeclock-discrepancy
603 timeclock-last-period)))
604 (setq timeclock-last-event (list code now project)))
605 (save-buffer)
606 (run-hooks 'timeclock-event-hook)))
607
608(defun timeclock-read-moment ()
609 "Read the moment under point from the timelog."
610 (save-excursion
611 (beginning-of-line)
612 (let ((eol (save-excursion (end-of-line) (point))))
613 (if (re-search-forward
614 (concat "^\\(.\\)\\s-+"
615 "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+"
616 "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\s-*"
617 "\\(.*\\)") eol t)
618 (let ((code (match-string 1))
619 (year (string-to-number (match-string 2)))
620 (mon (string-to-number (match-string 3)))
621 (mday (string-to-number (match-string 4)))
622 (hour (string-to-number (match-string 5)))
623 (min (string-to-number (match-string 6)))
624 (sec (string-to-number (match-string 7)))
625 (project (match-string 8)))
626 (list code (encode-time sec min hour mday mon year)
627 project))))))
628
629(defun timeclock-time-to-seconds (time)
630 "Convert TIME to a floating point number."
631 (+ (* (car time) 65536.0)
632 (cadr time)
633 (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
634
635(defun timeclock-seconds-to-time (seconds)
636 "Convert SECONDS (a floating point number) to an Emacs time structure."
637 (list (floor seconds 65536)
638 (floor (mod seconds 65536))
639 (floor (* (- seconds (ffloor seconds)) 1000000))))
640
641(defun timeclock-time-to-date (time)
642 "Convert the TIME value to a textual date string."
643 (format-time-string "%Y/%m/%d" time))
644
645(defun timeclock-last-period (&optional moment)
646 "Return the value of the last event period.
647If the last event was a clock-in, the period will be open ended, and
648growing every second. Otherwise, it is a fixed amount which has been
649recorded to disk. If MOMENT is non-nil, use that as the current time.
650This is only provided for coherency when used by
651`timeclock-discrepancy'."
652 (if (equal (car timeclock-last-event) "i")
653 (- (timeclock-time-to-seconds (or moment (current-time)))
654 (timeclock-time-to-seconds
655 (cadr timeclock-last-event)))
656 timeclock-last-period))
657
658(defun timeclock-find-discrep (&optional today-only)
659 "Find overall discrepancy from `timeclock-workday' (in seconds).
660If TODAY-ONLY is non-nil, the discrepancy will be not be relative, and
661will correspond only to the amount of time elapsed today. This is
662identical to what would be return if `timeclock-relative' were nil."
663 (let* ((now (current-time)) (first t)
664 (todays-date (timeclock-time-to-date now))
665 accum event beg last-date
666 last-date-limited last-date-seconds avg)
667 (unless timeclock-discrepancy
668 (setq timeclock-project-list nil
669 timeclock-last-project nil
670 timeclock-reason-list nil)
671 (save-excursion
672 (set-buffer (find-file-noselect timeclock-file))
673 (goto-char (point-min))
674 (setq accum 0)
675 (setq timeclock-elapsed 0)
676 (while (setq event (timeclock-read-moment))
677 (cond ((equal (car event) "h")
678 (setq last-date-limited
679 (timeclock-time-to-date (cadr event))
680 last-date-seconds
16908a3f 681 (* (string-to-number (nth 2 event)) 3600)))
90cbf47e
GM
682 ((equal (car event) "i")
683 (when (and (nth 2 event)
684 (> (length (nth 2 event)) 0))
685 (add-to-list 'timeclock-project-list (nth 2 event))
686 (setq timeclock-last-project (nth 2 event)))
687 (let ((date (timeclock-time-to-date (cadr event))))
688 (if (and last-date
689 timeclock-relative
690 (not (equal date last-date)))
691 (setq accum (- accum
692 (if last-date-limited
693 last-date-seconds
694 timeclock-workday)))
695 (unless (or last-date (not first))
696 (setq first nil
697 accum (- accum
698 (if last-date-limited
699 last-date-seconds
700 timeclock-workday)))))
701 (setq last-date date
702 last-date-limited nil)
703 (if beg
704 (error "Error in format of timelog file!")
705 (setq beg (timeclock-time-to-seconds (cadr event))))))
706 ((equal (downcase (car event)) "o")
707 (if (and (nth 2 event)
708 (> (length (nth 2 event)) 0))
709 (add-to-list 'timeclock-reason-list (nth 2 event)))
710 (if (or timeclock-relative
711 (equal last-date todays-date))
712 (if (not beg)
713 (error "Error in format of timelog file!")
714 (setq timeclock-last-period
715 (- (timeclock-time-to-seconds (cadr event))
716 beg)
717 accum (+ timeclock-last-period accum)
718 beg nil)))
719 (if (equal last-date todays-date)
720 (setq timeclock-elapsed
721 (+ timeclock-last-period timeclock-elapsed)))))
722 (setq timeclock-last-event event
723 timeclock-last-event-workday
724 (if (equal (timeclock-time-to-date now)
725 last-date-limited)
726 last-date-seconds
727 timeclock-workday))
728 (forward-line))
729 (setq timeclock-discrepancy accum)))
730 (setq accum (if today-only
731 timeclock-elapsed
732 timeclock-discrepancy))
733 (if timeclock-last-event
734 (if (equal (car timeclock-last-event) "i")
735 (setq accum (+ accum (timeclock-last-period now)))
736 (if (not (equal (timeclock-time-to-date
737 (cadr timeclock-last-event))
738 (timeclock-time-to-date now)))
739 (setq accum (- accum timeclock-last-event-workday)))))
740 (setq accum
741 (- accum
742 (if (and timeclock-last-event
743 (equal (timeclock-time-to-date
744 (cadr timeclock-last-event))
745 (timeclock-time-to-date now)))
746 timeclock-last-event-workday
747 timeclock-workday)))))
748
749(provide 'timeclock)
750
751(run-hooks 'timeclock-load-hook)
752
753;; make sure we know the list of reasons, projects, and have computed
754;; the last event and current discrepancy.
755(if (file-readable-p timeclock-file)
756 (timeclock-reread-log))
757
758;;; timeclock.el ends here