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
|
|
87 (defcustom timeclock-file "~/.timelog"
|
|
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
|
|
682 (string-to-number (nth 2 event))))
|
|
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
|