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