comparison lisp/calendar/timeclock.el @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; timeclock.el --- mode for keeping track of how much you work 1 ;;; timeclock.el --- mode for keeping track of how much you work
2 2
3 ;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. 3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005
4 ;; Free Software Foundation, Inc.
4 5
5 ;; Author: John Wiegley <johnw@gnu.org> 6 ;; Author: John Wiegley <johnw@gnu.org>
6 ;; Created: 25 Mar 1999 7 ;; Created: 25 Mar 1999
7 ;; Version: 2.6 8 ;; Version: 2.6
8 ;; Keywords: calendar data 9 ;; Keywords: calendar data
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details. 21 ;; GNU General Public License for more details.
21 22
22 ;; You should have received a copy of the GNU General Public License 23 ;; 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 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02111-1307, USA. 26 ;; Boston, MA 02110-1301, USA.
26 27
27 ;;; Commentary: 28 ;;; Commentary:
28 29
29 ;; This mode is for keeping track of time intervals. You can use it 30 ;; 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 ;; 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 ;; track of how much time you spend working on certain projects.
32 ;; 33 ;;
33 ;; Use `timeclock-in' when you start on a project, and `timeclock-out' 34 ;; 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 ;; 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 ;; `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 ;; worked today (where `timeclock-workday' specifies the length of the
37 ;; `timeclock-when-to-leave' which will calculate when you're free. 38 ;; working day), and `timeclock-when-to-leave' to calculate when you're free.
38 39
39 ;; You'll probably want to bind the timeclock commands to some handy 40 ;; 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 ;; keystrokes. At the moment, C-x t is unused:
41 ;; 42 ;;
42 ;; (require 'timeclock) 43 ;; (require 'timeclock)
43 ;; 44 ;;
44 ;; (define-key ctl-x-map "ti" 'timeclock-in) 45 ;; (define-key ctl-x-map "ti" 'timeclock-in)
45 ;; (define-key ctl-x-map "to" 'timeclock-out) 46 ;; (define-key ctl-x-map "to" 'timeclock-out)
58 ;; 59 ;;
59 ;; To cancel this modeline display at any time, just call 60 ;; To cancel this modeline display at any time, just call
60 ;; `timeclock-modeline-display' again. 61 ;; `timeclock-modeline-display' again.
61 62
62 ;; You may also want Emacs to ask you before exiting, if you are 63 ;; 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 ;; currently 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 ;; `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 ;; the default), or by adding the following to your .emacs file:
66 ;; 67 ;;
67 ;; (add-hook 'kill-emacs-hook 'timeclock-query-out) 68 ;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
68 69
69 ;; NOTE: If you change your .timelog file without using timeclock's 70 ;; 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 ;; functions, or if you change the value of any of timeclock's
71 ;; customizable variables, you should run the command 72 ;; customizable variables, you should run the command
72 ;; `timeclock-reread-log'. This will recompute any discrepancies in 73 ;; `timeclock-reread-log'. This will recompute any discrepancies in
76 ;;; History: 77 ;;; History:
77 78
78 ;;; Code: 79 ;;; Code:
79 80
80 (defgroup timeclock nil 81 (defgroup timeclock nil
81 "Keeping track time of the time that gets spent." 82 "Keeping track of the time that gets spent."
82 :group 'data) 83 :group 'data)
83 84
84 ;;; User Variables: 85 ;;; User Variables:
85 86
86 (defcustom timeclock-file (convert-standard-filename "~/.timelog") 87 (defcustom timeclock-file (convert-standard-filename "~/.timelog")
92 "*The length of a work period." 93 "*The length of a work period."
93 :type 'integer 94 :type 'integer
94 :group 'timeclock) 95 :group 'timeclock)
95 96
96 (defcustom timeclock-relative t 97 (defcustom timeclock-relative t
97 "*When reporting time, make it relative to `timeclock-workday'? 98 "*Whether to maken reported time relative to `timeclock-workday'.
98 For example, if the length of a normal workday is eight hours, and you 99 For example, if the length of a normal workday is eight hours, and you
99 work four hours on Monday, then the amount of time \"remaining\" on 100 work four hours on Monday, then the amount of time \"remaining\" on
100 Tuesday is twelve hours -- relative to an averaged work period of 101 Tuesday is twelve hours -- relative to an averaged work period of
101 eight hours -- or eight hours, non-relative. So relative time takes 102 eight hours -- or eight hours, non-relative. So relative time takes
102 into account any discrepancy of time under-worked or overworked on 103 into account any discrepancy of time under-worked or over-worked on
103 previous days." 104 previous days. This only affects the timeclock modeline display."
104 :type 'boolean 105 :type 'boolean
105 :group 'timeclock) 106 :group 'timeclock)
106 107
107 (defcustom timeclock-get-project-function 'timeclock-ask-for-project 108 (defcustom timeclock-get-project-function 'timeclock-ask-for-project
108 "*The function used to determine the name of the current project. 109 "*The function used to determine the name of the current project.
109 When clocking in, and no project is specified, this function will be 110 When clocking in, and no project is specified, this function will be
110 called to determine what the current project to be worked on is. 111 called to determine what is the current project to be worked on.
111 If this variable is nil, no questions will be asked." 112 If this variable is nil, no questions will be asked."
112 :type 'function 113 :type 'function
113 :group 'timeclock) 114 :group 'timeclock)
114 115
115 (defcustom timeclock-get-reason-function 'timeclock-ask-for-reason 116 (defcustom timeclock-get-reason-function 'timeclock-ask-for-reason
116 "*A function used to determine the reason for clocking out. 117 "*A function used to determine the reason for clocking out.
117 When clocking out, and no reason is specified, this function will be 118 When clocking out, and no reason is specified, this function will be
118 called to determine what the reason is. 119 called to determine what is the reason.
119 If this variable is nil, no questions will be asked." 120 If this variable is nil, no questions will be asked."
120 :type 'function 121 :type 'function
121 :group 'timeclock) 122 :group 'timeclock)
122 123
123 (defcustom timeclock-get-workday-function nil 124 (defcustom timeclock-get-workday-function nil
124 "*A function used to determine the length of today's workday. 125 "*A function used to determine the length of today's workday.
125 The first time that a user clocks in each day, this function will be 126 The first time that a user clocks in each day, this function will be
126 called to determine what the length of the current workday is. If 127 called to determine what is the length of the current workday. If
127 the return value is nil, or equal to `timeclock-workday', nothing special 128 the return value is nil, or equal to `timeclock-workday', nothing special
128 will be done. If it is a quantity different from `timeclock-workday', 129 will be done. If it is a quantity different from `timeclock-workday',
129 however, a record will be output to the timelog file to note the fact that 130 however, a record will be output to the timelog file to note the fact that
130 that day has a different length from the norm." 131 that day has a length that is different from the norm."
131 :type '(choice (const nil) function) 132 :type '(choice (const nil) function)
132 :group 'timeclock) 133 :group 'timeclock)
133 134
134 (defcustom timeclock-ask-before-exiting t 135 (defcustom timeclock-ask-before-exiting t
135 "*If non-nil, ask if the user wants to clock out before exiting Emacs." 136 "*If non-nil, ask if the user wants to clock out before exiting Emacs.
137 This variable only has effect if set with \\[customize]."
136 :set (lambda (symbol value) 138 :set (lambda (symbol value)
137 (if value 139 (if value
138 (add-hook 'kill-emacs-hook 'timeclock-query-out) 140 (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
139 (remove-hook 'kill-emacs-hook 'timeclock-query-out)) 141 (remove-hook 'kill-emacs-query-functions 'timeclock-query-out))
140 (setq timeclock-ask-before-exiting value)) 142 (setq timeclock-ask-before-exiting value))
141 :type 'boolean 143 :type 'boolean
142 :group 'timeclock) 144 :group 'timeclock)
143 145
144 (defvar timeclock-update-timer nil 146 (defvar timeclock-update-timer nil
145 "The timer used to update `timeclock-mode-string'.") 147 "The timer used to update `timeclock-mode-string'.")
146 148
149 ;; For byte-compiler.
150 (defvar display-time-hook)
151 (defvar timeclock-modeline-display)
152
147 (defcustom timeclock-use-display-time t 153 (defcustom timeclock-use-display-time t
148 "*If non-nil, use `display-time-hook' for doing modeline updates. 154 "*If non-nil, use `display-time-hook' for doing modeline updates.
149 The advantage to this is that it means one less timer has to be set 155 The advantage of this is that one less timer has to be set running
150 running amok in Emacs' process space. The disadvantage is that it 156 amok in Emacs' process space. The disadvantage is that it requires
151 requires you to have `display-time' running. If you don't want to use 157 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 158 `display-time', but still want the modeline to show how much time is
153 left, set this variable to nil. You will need to restart Emacs (or 159 left, set this variable to nil. Changing the value of this variable
154 toggle the value of `timeclock-modeline-display') for the change to 160 while timeclock information is being displayed in the modeline has no
155 take effect." 161 effect. You should call the function `timeclock-modeline-display' with
162 a positive argument to force an update."
156 :set (lambda (symbol value) 163 :set (lambda (symbol value)
157 (let ((currently-displaying 164 (let ((currently-displaying
158 (and (boundp 'timeclock-modeline-display) 165 (and (boundp 'timeclock-modeline-display)
159 timeclock-modeline-display))) 166 timeclock-modeline-display)))
160 ;; if we're changing to the state that 167 ;; if we're changing to the state that
198 :type 'hook 205 :type 'hook
199 :group 'timeclock) 206 :group 'timeclock)
200 207
201 (defcustom timeclock-day-over-hook nil 208 (defcustom timeclock-day-over-hook nil
202 "*A hook that is run when the workday has been completed. 209 "*A hook that is run when the workday has been completed.
203 This hook is only run if the current time remaining is being display 210 This hook is only run if the current time remaining is being displayed
204 in the modeline. See the variable `timeclock-modeline-display'." 211 in the modeline. See the variable `timeclock-modeline-display'."
205 :type 'hook 212 :type 'hook
206 :group 'timeclock) 213 :group 'timeclock)
207 214
208 (defcustom timeclock-out-hook nil 215 (defcustom timeclock-out-hook nil
232 (defvar timeclock-discrepancy nil 239 (defvar timeclock-discrepancy nil
233 "A variable containing the time discrepancy before the last event. 240 "A variable containing the time discrepancy before the last event.
234 Normally, timeclock assumes that you intend to work for 241 Normally, timeclock assumes that you intend to work for
235 `timeclock-workday' seconds every day. Any days in which you work 242 `timeclock-workday' seconds every day. Any days in which you work
236 more or less than this amount is considered either a positive or 243 more or less than this amount is considered either a positive or
237 negative discrepancy. If you work in such a manner that the 244 a negative discrepancy. If you work in such a manner that the
238 discrepancy is always brought back to zero, then you will by 245 discrepancy is always brought back to zero, then you will by
239 definition have worked an average amount equal to `timeclock-workday' 246 definition have worked an average amount equal to `timeclock-workday'
240 each day.") 247 each day.")
241 248
242 (defvar timeclock-elapsed nil 249 (defvar timeclock-elapsed nil
243 "A variable containing the time elapsed for complete periods today. 250 "A variable containing the time elapsed for complete periods today.
244 This value is not accurate enough to be useful by itself. Rather, 251 This value is not accurate enough to be useful by itself. Rather,
245 call `timeclock-workday-elapsed', to determine how much time has been 252 call `timeclock-workday-elapsed', to determine how much time has been
246 worked so far today. Also, if `timeclock-relative' is nil, this value 253 worked so far today. Also, if `timeclock-relative' is nil, this value
247 will be the same as `timeclock-discrepancy'.") 254 will be the same as `timeclock-discrepancy'.") ; ? gm
248 255
249 (defvar timeclock-last-period nil 256 (defvar timeclock-last-period nil
250 "Integer representing the number of seconds in the last period. 257 "Integer representing the number of seconds in the last period.
251 Note that you shouldn't access this value, but should use the function 258 Note that you shouldn't access this value, but instead should use the
252 `timeclock-last-period' instead.") 259 function `timeclock-last-period'.")
253 260
254 (defvar timeclock-mode-string nil 261 (defvar timeclock-mode-string nil
255 "The timeclock string (optionally) displayed in the modeline.") 262 "The timeclock string (optionally) displayed in the modeline.
263 The time is bracketed by <> if you are clocked in, otherwise by [].")
256 264
257 (defvar timeclock-day-over nil 265 (defvar timeclock-day-over nil
258 "The date of the last day when notified \"day over\" for.") 266 "The date of the last day when notified \"day over\" for.")
259 267
260 ;;; User Functions: 268 ;;; User Functions:
261 269
262 ;;;###autoload 270 ;;;###autoload
263 (defun timeclock-modeline-display (&optional arg) 271 (defun timeclock-modeline-display (&optional arg)
264 "Toggle display of the amount of time left today in the modeline. 272 "Toggle display of the amount of time left today in the modeline.
265 If `timeclock-use-display-time' is non-nil, the modeline will be 273 If `timeclock-use-display-time' is non-nil (the default), then
266 updated whenever the time display is updated. Otherwise, the 274 the function `display-time-mode' must be active, and the modeline
267 timeclock will use its own sixty second timer to do its updating. 275 will be updated whenever the time display is updated. Otherwise,
268 With prefix ARG, turn modeline display on if and only if ARG is 276 the timeclock will use its own sixty second timer to do its
269 positive. Returns the new status of timeclock modeline display 277 updating. With prefix ARG, turn modeline display on if and only
270 \(non-nil means on)." 278 if ARG is positive. Returns the new status of timeclock modeline
279 display (non-nil means on)."
271 (interactive "P") 280 (interactive "P")
281 ;; cf display-time-mode.
282 (setq timeclock-mode-string "")
283 (or global-mode-string (setq global-mode-string '("")))
272 (let ((on-p (if arg 284 (let ((on-p (if arg
273 (> (prefix-numeric-value arg) 0) 285 (> (prefix-numeric-value arg) 0)
274 (not timeclock-modeline-display)))) 286 (not timeclock-modeline-display))))
275 (if on-p 287 (if on-p
276 (let ((list-entry (or (memq 'global-mode-string mode-line-format) 288 (progn
277 ;; In Emacs 21.3 we must use assq 289 (or (memq 'timeclock-mode-string global-mode-string)
278 (assq 'global-mode-string mode-line-format)))) 290 (setq global-mode-string
279 (unless (or (null list-entry) 291 (append global-mode-string '(timeclock-mode-string))))
280 (memq 'timeclock-mode-string mode-line-format))
281 (setcdr list-entry (cons 'timeclock-mode-string
282 (cdr list-entry))))
283 (unless (memq 'timeclock-update-modeline timeclock-event-hook) 292 (unless (memq 'timeclock-update-modeline timeclock-event-hook)
284 (add-hook 'timeclock-event-hook 'timeclock-update-modeline)) 293 (add-hook 'timeclock-event-hook 'timeclock-update-modeline))
285 (when timeclock-update-timer 294 (when timeclock-update-timer
286 (cancel-timer timeclock-update-timer) 295 (cancel-timer timeclock-update-timer)
287 (setq timeclock-update-timer nil)) 296 (setq timeclock-update-timer nil))
288 (if (boundp 'display-time-hook) 297 (if (boundp 'display-time-hook)
289 (remove-hook 'display-time-hook 'timeclock-update-modeline)) 298 (remove-hook 'display-time-hook 'timeclock-update-modeline))
290 (if timeclock-use-display-time 299 (if timeclock-use-display-time
291 (add-hook 'display-time-hook 'timeclock-update-modeline) 300 (progn
301 ;; Update immediately so there is a visible change
302 ;; on calling this function.
303 (if display-time-mode (timeclock-update-modeline)
304 (message "Activate `display-time-mode' to see \
305 timeclock information"))
306 (add-hook 'display-time-hook 'timeclock-update-modeline))
292 (setq timeclock-update-timer 307 (setq timeclock-update-timer
293 (run-at-time nil 60 'timeclock-update-modeline)))) 308 (run-at-time nil 60 'timeclock-update-modeline))))
294 (setq mode-line-format 309 (setq global-mode-string
295 (delq 'timeclock-mode-string mode-line-format)) 310 (delq 'timeclock-mode-string global-mode-string))
296 (remove-hook 'timeclock-event-hook 'timeclock-update-modeline) 311 (remove-hook 'timeclock-event-hook 'timeclock-update-modeline)
297 (if (boundp 'display-time-hook) 312 (if (boundp 'display-time-hook)
298 (remove-hook 'display-time-hook 313 (remove-hook 'display-time-hook
299 'timeclock-update-modeline)) 314 'timeclock-update-modeline))
300 (when timeclock-update-timer 315 (when timeclock-update-timer
301 (cancel-timer timeclock-update-timer) 316 (cancel-timer timeclock-update-timer)
302 (setq timeclock-update-timer nil))) 317 (setq timeclock-update-timer nil)))
303 (force-mode-line-update) 318 (force-mode-line-update)
304 on-p)) 319 (setq timeclock-modeline-display on-p)))
305 320
306 ;; This has to be here so that the function definition of 321 ;; This has to be here so that the function definition of
307 ;; `timeclock-modeline-display' is known to the "set" function. 322 ;; `timeclock-modeline-display' is known to the "set" function.
308 (defcustom timeclock-modeline-display nil 323 (defcustom timeclock-modeline-display nil
309 "Toggle modeline display of time remaining. 324 "Toggle modeline display of time remaining.
313 (timeclock-modeline-display (or value 0)))) 328 (timeclock-modeline-display (or value 0))))
314 :type 'boolean 329 :type 'boolean
315 :group 'timeclock 330 :group 'timeclock
316 :require 'timeclock) 331 :require 'timeclock)
317 332
333 (defsubst timeclock-time-to-date (time)
334 "Convert the TIME value to a textual date string."
335 (format-time-string "%Y/%m/%d" time))
336
318 ;;;###autoload 337 ;;;###autoload
319 (defun timeclock-in (&optional arg project find-project) 338 (defun timeclock-in (&optional arg project find-project)
320 "Clock in, recording the current time moment in the timelog. 339 "Clock in, recording the current time moment in the timelog.
321 With a numeric prefix ARG, record the fact that today has only that 340 With a numeric prefix ARG, record the fact that today has only that
322 many hours in it to be worked. If arg is a non-numeric prefix arg 341 many 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 342 \(non-nil, but not a number), 0 is assumed (working on a holiday or
324 weekend). *If not called interactively, ARG should be the number of 343 weekend). *If not called interactively, ARG should be the number of
325 _seconds_ worked today*. This feature only has effect the first time 344 _seconds_ worked today*. This feature only has effect the first time
326 this function is called within a day. 345 this function is called within a day.
327 346
328 PROJECT as the project being clocked into. If PROJECT is nil, and 347 PROJECT is the project being clocked into. If PROJECT is nil, and
329 FIND-PROJECT is non-nil -- or the user calls `timeclock-in' 348 FIND-PROJECT is non-nil -- or the user calls `timeclock-in'
330 interactively -- call the function `timeclock-get-project-function' to 349 interactively -- call the function `timeclock-get-project-function' to
331 discover the name of the project." 350 discover the name of the project."
332 (interactive 351 (interactive
333 (list (and current-prefix-arg 352 (list (and current-prefix-arg
384 (funcall timeclock-get-reason-function)))) 403 (funcall timeclock-get-reason-function))))
385 (run-hooks 'timeclock-out-hook) 404 (run-hooks 'timeclock-out-hook)
386 (if arg 405 (if arg
387 (run-hooks 'timeclock-done-hook)))) 406 (run-hooks 'timeclock-done-hook))))
388 407
408 ;; Should today-only be removed in favour of timeclock-relative? - gm
409 (defsubst timeclock-workday-remaining (&optional today-only)
410 "Return the number of seconds until the workday is complete.
411 The amount returned is relative to the value of `timeclock-workday'.
412 If TODAY-ONLY is non-nil, the value returned will be relative only to
413 the time worked today, and not to past time."
414 (let ((discrep (timeclock-find-discrep)))
415 (if discrep
416 (- (if today-only (cadr discrep)
417 (car discrep)))
418 0.0)))
419
389 ;;;###autoload 420 ;;;###autoload
390 (defun timeclock-status-string (&optional show-seconds today-only) 421 (defun timeclock-status-string (&optional show-seconds today-only)
391 "Report the overall timeclock status at the present moment." 422 "Report the overall timeclock status at the present moment.
423 If SHOW-SECONDS is non-nil, display second resolution.
424 If TODAY-ONLY is non-nil, the display will be relative only to time
425 worked today, ignoring the time worked on previous days."
392 (interactive "P") 426 (interactive "P")
393 (let* ((remainder (timeclock-workday-remaining)) 427 (let ((remainder (timeclock-workday-remaining)) ; today-only?
394 (last-in (equal (car timeclock-last-event) "i")) 428 (last-in (equal (car timeclock-last-event) "i"))
395 status) 429 status)
396 (setq status 430 (setq status
397 (format "Currently %s since %s (%s), %s %s, leave at %s" 431 (format "Currently %s since %s (%s), %s %s, leave at %s"
398 (if last-in "IN" "OUT") 432 (if last-in "IN" "OUT")
399 (if show-seconds 433 (if show-seconds
400 (format-time-string "%-I:%M:%S %p" 434 (format-time-string "%-I:%M:%S %p"
406 (timeclock-seconds-to-string remainder show-seconds t) 440 (timeclock-seconds-to-string remainder show-seconds t)
407 (if (> remainder 0) 441 (if (> remainder 0)
408 "remaining" "over") 442 "remaining" "over")
409 (timeclock-when-to-leave-string show-seconds today-only))) 443 (timeclock-when-to-leave-string show-seconds today-only)))
410 (if (interactive-p) 444 (if (interactive-p)
411 (message status) 445 (message "%s" status)
412 status))) 446 status)))
413 447
414 ;;;###autoload 448 ;;;###autoload
415 (defun timeclock-change (&optional arg project) 449 (defun timeclock-change (&optional arg project)
416 "Change to working on a different project, by clocking in then out. 450 "Change to working on a different project.
417 With a prefix ARG, consider the previous project as having been 451 This clocks out of the current project, then clocks in on a new one.
418 finished at the time of changeover. PROJECT is the name of the last 452 With a prefix ARG, consider the previous project as finished at the
419 project you were working on." 453 time of changeover. PROJECT is the name of the last project you were
454 working on."
420 (interactive "P") 455 (interactive "P")
421 (timeclock-out arg) 456 (timeclock-out arg)
422 (timeclock-in nil project (interactive-p))) 457 (timeclock-in nil project (interactive-p)))
423 458
424 ;;;###autoload 459 ;;;###autoload
425 (defun timeclock-query-out () 460 (defun timeclock-query-out ()
426 "Ask the user before clocking out. 461 "Ask the user whether to clock out.
427 This is a useful function for adding to `kill-emacs-hook'." 462 This is a useful function for adding to `kill-emacs-query-functions'."
428 (if (and (equal (car timeclock-last-event) "i") 463 (and (equal (car timeclock-last-event) "i")
429 (y-or-n-p "You're currently clocking time, clock out? ")) 464 (y-or-n-p "You're currently clocking time, clock out? ")
430 (timeclock-out))) 465 (timeclock-out))
466 ;; Unconditionally return t for `kill-emacs-query-functions'.
467 t)
431 468
432 ;;;###autoload 469 ;;;###autoload
433 (defun timeclock-reread-log () 470 (defun timeclock-reread-log ()
434 "Re-read the timeclock, to account for external changes. 471 "Re-read the timeclock, to account for external changes.
435 Returns the new value of `timeclock-discrepancy'." 472 Returns the new value of `timeclock-discrepancy'."
457 (format "%s%d:%02d" 494 (format "%s%d:%02d"
458 (if (< seconds 0) (if reverse-leader "+" "-") "") 495 (if (< seconds 0) (if reverse-leader "+" "-") "")
459 (truncate (/ (abs seconds) 60 60)) 496 (truncate (/ (abs seconds) 60 60))
460 (% (truncate (/ (abs seconds) 60)) 60)))) 497 (% (truncate (/ (abs seconds) 60)) 60))))
461 498
462 (defsubst timeclock-workday-remaining (&optional today-only)
463 "Return the number of seconds until the workday is complete.
464 The amount returned is relative to the value of `timeclock-workday'.
465 If TODAY-ONLY is non-nil, the value returned will be relative only to
466 the time worked today, and not to past time. This argument only makes
467 a difference if `timeclock-relative' is non-nil."
468 (let ((discrep (timeclock-find-discrep)))
469 (if discrep
470 (if today-only
471 (- (cadr discrep))
472 (- (car discrep)))
473 0.0)))
474
475 (defsubst timeclock-currently-in-p () 499 (defsubst timeclock-currently-in-p ()
476 "Return non-nil if the user is currently clocked in." 500 "Return non-nil if the user is currently clocked in."
477 (equal (car timeclock-last-event) "i")) 501 (equal (car timeclock-last-event) "i"))
478 502
479 ;;;###autoload 503 ;;;###autoload
487 (interactive) 511 (interactive)
488 (let ((string (timeclock-seconds-to-string 512 (let ((string (timeclock-seconds-to-string
489 (timeclock-workday-remaining today-only) 513 (timeclock-workday-remaining today-only)
490 show-seconds t))) 514 show-seconds t)))
491 (if (interactive-p) 515 (if (interactive-p)
492 (message string) 516 (message "%s" string)
493 string))) 517 string)))
494 518
495 (defsubst timeclock-workday-elapsed () 519 (defsubst timeclock-workday-elapsed ()
496 "Return the number of seconds worked so far today. 520 "Return the number of seconds worked so far today.
497 If RELATIVE is non-nil, the amount returned will be relative to past 521 If RELATIVE is non-nil, the amount returned will be relative to past
509 non-nil, the amount returned will be relative to past time worked." 533 non-nil, the amount returned will be relative to past time worked."
510 (interactive) 534 (interactive)
511 (let ((string (timeclock-seconds-to-string (timeclock-workday-elapsed) 535 (let ((string (timeclock-seconds-to-string (timeclock-workday-elapsed)
512 show-seconds))) 536 show-seconds)))
513 (if (interactive-p) 537 (if (interactive-p)
514 (message string) 538 (message "%s" string)
515 string))) 539 string)))
516 540
541 (defsubst timeclock-time-to-seconds (time)
542 "Convert TIME to a floating point number."
543 (+ (* (car time) 65536.0)
544 (cadr time)
545 (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
546
547 (defsubst timeclock-seconds-to-time (seconds)
548 "Convert SECONDS (a floating point number) to an Emacs time structure."
549 (list (floor seconds 65536)
550 (floor (mod seconds 65536))
551 (floor (* (- seconds (ffloor seconds)) 1000000))))
552
553 ;; Should today-only be removed in favour of timeclock-relative? - gm
517 (defsubst timeclock-when-to-leave (&optional today-only) 554 (defsubst timeclock-when-to-leave (&optional today-only)
518 "Return a time value representing at when the workday ends today. 555 "Return a time value representing the end of today's workday.
519 If TODAY-ONLY is non-nil, the value returned will be relative only to 556 If TODAY-ONLY is non-nil, the value returned will be relative only to
520 the time worked today, and not to past time. This argument only makes 557 the time worked today, and not to past time."
521 a difference if `timeclock-relative' is non-nil."
522 (timeclock-seconds-to-time 558 (timeclock-seconds-to-time
523 (- (timeclock-time-to-seconds (current-time)) 559 (- (timeclock-time-to-seconds (current-time))
524 (let ((discrep (timeclock-find-discrep))) 560 (let ((discrep (timeclock-find-discrep)))
525 (if discrep 561 (if discrep
526 (if today-only 562 (if today-only
529 0.0))))) 565 0.0)))))
530 566
531 ;;;###autoload 567 ;;;###autoload
532 (defun timeclock-when-to-leave-string (&optional show-seconds 568 (defun timeclock-when-to-leave-string (&optional show-seconds
533 today-only) 569 today-only)
534 "Return a string representing at what time the workday ends today. 570 "Return a string representing the end of today's workday.
535 This string is relative to the value of `timeclock-workday'. If 571 This string is relative to the value of `timeclock-workday'. If
536 NO-MESSAGE is non-nil, no messages will be displayed in the 572 SHOW-SECONDS is non-nil, the value printed/returned will include
537 minibuffer. If SHOW-SECONDS is non-nil, the value printed/returned 573 seconds. If TODAY-ONLY is non-nil, the value returned will be
538 will include seconds. If TODAY-ONLY is non-nil, the value returned 574 relative only to the time worked today, and not to past time."
539 will be relative only to the time worked today, and not to past time. 575 ;; Should today-only be removed in favour of timeclock-relative? - gm
540 This argument only makes a difference if `timeclock-relative' is
541 non-nil."
542 (interactive) 576 (interactive)
543 (let* ((then (timeclock-when-to-leave today-only)) 577 (let* ((then (timeclock-when-to-leave today-only))
544 (string 578 (string
545 (if show-seconds 579 (if show-seconds
546 (format-time-string "%-I:%M:%S %p" then) 580 (format-time-string "%-I:%M:%S %p" then)
547 (format-time-string "%-I:%M %p" then)))) 581 (format-time-string "%-I:%M %p" then))))
548 (if (interactive-p) 582 (if (interactive-p)
549 (message string) 583 (message "%s" string)
550 string))) 584 string)))
551 585
552 ;;; Internal Functions: 586 ;;; Internal Functions:
553 587
554 (defvar timeclock-project-list nil) 588 (defvar timeclock-project-list nil)
564 (completing-read prompt alist nil nil nil nil default))) 598 (completing-read prompt alist nil nil nil nil default)))
565 599
566 (defun timeclock-ask-for-project () 600 (defun timeclock-ask-for-project ()
567 "Ask the user for the project they are clocking into." 601 "Ask the user for the project they are clocking into."
568 (timeclock-completing-read 602 (timeclock-completing-read
569 (format "Clock into which project (default \"%s\"): " 603 (format "Clock into which project (default %s): "
570 (or timeclock-last-project 604 (or timeclock-last-project
571 (car timeclock-project-list))) 605 (car timeclock-project-list)))
572 (mapcar 'list timeclock-project-list) 606 (mapcar 'list timeclock-project-list)
573 (or timeclock-last-project 607 (or timeclock-last-project
574 (car timeclock-project-list)))) 608 (car timeclock-project-list))))
579 "Ask the user for the reason they are clocking out." 613 "Ask the user for the reason they are clocking out."
580 (timeclock-completing-read "Reason for clocking out: " 614 (timeclock-completing-read "Reason for clocking out: "
581 (mapcar 'list timeclock-reason-list))) 615 (mapcar 'list timeclock-reason-list)))
582 616
583 (defun timeclock-update-modeline () 617 (defun timeclock-update-modeline ()
584 "Update the `timeclock-mode-string' displayed in the modeline." 618 "Update the `timeclock-mode-string' displayed in the modeline.
619 The value of `timeclock-relative' affects the display as described in
620 that variable's documentation."
585 (interactive) 621 (interactive)
586 (let* ((remainder (timeclock-workday-remaining)) 622 (let ((remainder (timeclock-workday-remaining (not timeclock-relative)))
587 (last-in (equal (car timeclock-last-event) "i"))) 623 (last-in (equal (car timeclock-last-event) "i")))
588 (when (and (< remainder 0) 624 (when (and (< remainder 0)
589 (not (and timeclock-day-over 625 (not (and timeclock-day-over
590 (equal timeclock-day-over 626 (equal timeclock-day-over
591 (timeclock-time-to-date 627 (timeclock-time-to-date
592 (current-time)))))) 628 (current-time))))))
593 (setq timeclock-day-over 629 (setq timeclock-day-over
594 (timeclock-time-to-date (current-time))) 630 (timeclock-time-to-date (current-time)))
595 (run-hooks 'timeclock-day-over-hook)) 631 (run-hooks 'timeclock-day-over-hook))
596 (setq timeclock-mode-string 632 (setq timeclock-mode-string
597 (format " %c%s%c" 633 (propertize
598 (if last-in ?< ?[) 634 (format " %c%s%c "
599 (timeclock-seconds-to-string remainder nil t) 635 (if last-in ?< ?[)
600 (if last-in ?> ?]))))) 636 (timeclock-seconds-to-string remainder nil t)
637 (if last-in ?> ?]))
638 'help-echo "timeclock: time remaining"))))
639
640 (put 'timeclock-mode-string 'risky-local-variable t)
601 641
602 (defun timeclock-log (code &optional project) 642 (defun timeclock-log (code &optional project)
603 "Log the event CODE to the timeclock log, at the time of call. 643 "Log the event CODE to the timeclock log, at the time of call.
604 If PROJECT is a string, it represents the project which the event is 644 If PROJECT is a string, it represents the project which the event is
605 being logged for. Normally only \"in\" events specify a project." 645 being logged for. Normally only \"in\" events specify a project."
645 (min (string-to-number (match-string 6))) 685 (min (string-to-number (match-string 6)))
646 (sec (string-to-number (match-string 7))) 686 (sec (string-to-number (match-string 7)))
647 (project (match-string 8))) 687 (project (match-string 8)))
648 (list code (encode-time sec min hour mday mon year) project)))) 688 (list code (encode-time sec min hour mday mon year) project))))
649 689
650 (defsubst timeclock-time-to-seconds (time)
651 "Convert TIME to a floating point number."
652 (+ (* (car time) 65536.0)
653 (cadr time)
654 (/ (or (car (cdr (cdr time))) 0) 1000000.0)))
655
656 (defsubst timeclock-seconds-to-time (seconds)
657 "Convert SECONDS (a floating point number) to an Emacs time structure."
658 (list (floor seconds 65536)
659 (floor (mod seconds 65536))
660 (floor (* (- seconds (ffloor seconds)) 1000000))))
661
662 (defsubst timeclock-time-to-date (time)
663 "Convert the TIME value to a textual date string."
664 (format-time-string "%Y/%m/%d" time))
665
666 (defun timeclock-last-period (&optional moment) 690 (defun timeclock-last-period (&optional moment)
667 "Return the value of the last event period. 691 "Return the value of the last event period.
668 If the last event was a clock-in, the period will be open ended, and 692 If the last event was a clock-in, the period will be open ended, and
669 growing every second. Otherwise, it is a fixed amount which has been 693 growing every second. Otherwise, it is a fixed amount which has been
670 recorded to disk. If MOMENT is non-nil, use that as the current time. 694 recorded to disk. If MOMENT is non-nil, use that as the current time.
809 (nth 2 (or log-data (timeclock-log-data)))) 833 (nth 2 (or log-data (timeclock-log-data))))
810 834
811 835
812 (defun timeclock-log-data (&optional recent-only filename) 836 (defun timeclock-log-data (&optional recent-only filename)
813 "Return the contents of the timelog file, in a useful format. 837 "Return the contents of the timelog file, in a useful format.
838 If the optional argument RECENT-ONLY is non-nil, only show the contents
839 from the last point where the time debt (see below) was set.
840 If the optional argument FILENAME is non-nil, it is used instead of
841 the file specified by `timeclock-file.'
842
814 A timelog contains data in the form of a single entry per line. 843 A timelog contains data in the form of a single entry per line.
815 Each entry has the form: 844 Each entry has the form:
816 845
817 CODE YYYY/MM/DD HH:MM:SS [COMMENT] 846 CODE YYYY/MM/DD HH:MM:SS [COMMENT]
818 847
823 archiving old log data, when a debt must be carried forward. 852 archiving old log data, when a debt must be carried forward.
824 The COMMENT here is the number of seconds of debt. 853 The COMMENT here is the number of seconds of debt.
825 854
826 h Set the required working time for the given day. This must 855 h Set the required working time for the given day. This must
827 be the first entry for that day. The COMMENT in this case is 856 be the first entry for that day. The COMMENT in this case is
828 the number of hours that must be worked. Floating point 857 the number of hours in this workday. Floating point amounts
829 amounts are allowed. 858 are allowed.
830 859
831 i Clock in. The COMMENT in this case should be the name of the 860 i Clock in. The COMMENT in this case should be the name of the
832 project worked on. 861 project worked on.
833 862
834 o Clock out. COMMENT is unnecessary, but can be used to provide 863 o Clock out. COMMENT is unnecessary, but can be used to provide
1003 (cons (cons last-date day) 1032 (cons (cons last-date day)
1004 (cadr log-data)))) 1033 (cadr log-data))))
1005 log-data))) 1034 log-data)))
1006 1035
1007 (defun timeclock-find-discrep () 1036 (defun timeclock-find-discrep ()
1008 "Find overall discrepancy from `timeclock-workday' (in seconds)." 1037 "Calculate time discrepancies, in seconds.
1038 The result is a three element list, containing the total time
1039 discrepancy, today's discrepancy, and the time worked today."
1009 ;; This is not implemented in terms of the functions above, because 1040 ;; This is not implemented in terms of the functions above, because
1010 ;; it's a bit wasteful to read all of that data in, just to throw 1041 ;; it's a bit wasteful to read all of that data in, just to throw
1011 ;; away more than 90% of the information afterwards. 1042 ;; away more than 90% of the information afterwards.
1012 ;; 1043 ;;
1013 ;; If it were implemented using those functions, it would look 1044 ;; If it were implemented using those functions, it would look
1081 timeclock-workday)) 1112 timeclock-workday))
1082 (forward-line)) 1113 (forward-line))
1083 (setq timeclock-discrepancy accum)))) 1114 (setq timeclock-discrepancy accum))))
1084 (unless timeclock-last-event-workday 1115 (unless timeclock-last-event-workday
1085 (setq timeclock-last-event-workday timeclock-workday)) 1116 (setq timeclock-last-event-workday timeclock-workday))
1086 (setq accum timeclock-discrepancy 1117 (setq accum (or timeclock-discrepancy 0)
1087 elapsed (or timeclock-elapsed elapsed)) 1118 elapsed (or timeclock-elapsed elapsed))
1088 (if timeclock-last-event 1119 (if timeclock-last-event
1089 (if (equal (car timeclock-last-event) "i") 1120 (if (equal (car timeclock-last-event) "i")
1090 (let ((last-period (timeclock-last-period now))) 1121 (let ((last-period (timeclock-last-period now)))
1091 (setq accum (+ accum last-period) 1122 (setq accum (+ accum last-period)
1097 (list accum (- elapsed timeclock-last-event-workday) 1128 (list accum (- elapsed timeclock-last-event-workday)
1098 elapsed))) 1129 elapsed)))
1099 1130
1100 ;;; A reporting function that uses timeclock-log-data 1131 ;;; A reporting function that uses timeclock-log-data
1101 1132
1102 (defun timeclock-time-less-p (t1 t2)
1103 "Say whether time T1 is less than time T2."
1104 (or (< (car t1) (car t2))
1105 (and (= (car t1) (car t2))
1106 (< (nth 1 t1) (nth 1 t2)))))
1107
1108 (defun timeclock-day-base (&optional time) 1133 (defun timeclock-day-base (&optional time)
1109 "Given a time within a day, return 0:0:0 within that day." 1134 "Given a time within a day, return 0:0:0 within that day.
1135 If optional argument TIME is non-nil, use that instead of the current time."
1110 (let ((decoded (decode-time (or time (current-time))))) 1136 (let ((decoded (decode-time (or time (current-time)))))
1111 (setcar (nthcdr 0 decoded) 0) 1137 (setcar (nthcdr 0 decoded) 0)
1112 (setcar (nthcdr 1 decoded) 0) 1138 (setcar (nthcdr 1 decoded) 0)
1113 (setcar (nthcdr 2 decoded) 0) 1139 (setcar (nthcdr 2 decoded) 0)
1114 (apply 'encode-time decoded))) 1140 (apply 'encode-time decoded)))
1115 1141
1116 (defun timeclock-geometric-mean (l) 1142 (defun timeclock-geometric-mean (l)
1117 "Compute the geometric mean of the list L." 1143 "Compute the geometric mean of the values in the list L."
1118 (let ((total 0) 1144 (let ((total 0)
1119 (count 0)) 1145 (count 0))
1120 (while l 1146 (while l
1121 (setq total (+ total (car l)) 1147 (setq total (+ total (car l))
1122 count (1+ count) 1148 count (1+ count)
1124 (if (> count 0) 1150 (if (> count 0)
1125 (/ total count) 1151 (/ total count)
1126 0))) 1152 0)))
1127 1153
1128 (defun timeclock-generate-report (&optional html-p) 1154 (defun timeclock-generate-report (&optional html-p)
1129 "Generate a summary report based on the current timelog file." 1155 "Generate a summary report based on the current timelog file.
1156 By default, the report is in plain text, but if the optional argument
1157 HTML-P is non-nil, HTML markup is added."
1130 (interactive) 1158 (interactive)
1131 (let ((log (timeclock-log-data)) 1159 (let ((log (timeclock-log-data))
1132 (today (timeclock-day-base))) 1160 (today (timeclock-day-base)))
1133 (if html-p (insert "<p>")) 1161 (if html-p (insert "<p>"))
1134 (insert "Currently ") 1162 (insert "Currently ")
1155 (two-weeks-ago (timeclock-seconds-to-time 1183 (two-weeks-ago (timeclock-seconds-to-time
1156 (- (timeclock-time-to-seconds today) 1184 (- (timeclock-time-to-seconds today)
1157 (* 2 7 24 60 60)))) 1185 (* 2 7 24 60 60))))
1158 two-week-len today-len) 1186 two-week-len today-len)
1159 (while proj-data 1187 (while proj-data
1160 (if (not (timeclock-time-less-p 1188 (if (not (time-less-p
1161 (timeclock-entry-begin (car proj-data)) today)) 1189 (timeclock-entry-begin (car proj-data)) today))
1162 (setq today-len (timeclock-entry-list-length proj-data) 1190 (setq today-len (timeclock-entry-list-length proj-data)
1163 proj-data nil) 1191 proj-data nil)
1164 (if (and (null two-week-len) 1192 (if (and (null two-week-len)
1165 (not (timeclock-time-less-p 1193 (not (time-less-p
1166 (timeclock-entry-begin (car proj-data)) 1194 (timeclock-entry-begin (car proj-data))
1167 two-weeks-ago))) 1195 two-weeks-ago)))
1168 (setq two-week-len (timeclock-entry-list-length proj-data))) 1196 (setq two-week-len (timeclock-entry-list-length proj-data)))
1169 (setq proj-data (cdr proj-data)))) 1197 (setq proj-data (cdr proj-data))))
1170 (if (null two-week-len) 1198 (if (null two-week-len)
1225 six-months-ago one-year-ago))) 1253 six-months-ago one-year-ago)))
1226 ;; collect statistics from complete timelog 1254 ;; collect statistics from complete timelog
1227 (while day-list 1255 (while day-list
1228 (let ((i 0) (l 5)) 1256 (let ((i 0) (l 5))
1229 (while (< i l) 1257 (while (< i l)
1230 (unless (timeclock-time-less-p 1258 (unless (time-less-p
1231 (timeclock-day-begin (car day-list)) 1259 (timeclock-day-begin (car day-list))
1232 (aref lengths i)) 1260 (aref lengths i))
1233 (let ((base (timeclock-time-to-seconds 1261 (let ((base (timeclock-time-to-seconds
1234 (timeclock-day-base 1262 (timeclock-day-base
1235 (timeclock-day-begin (car day-list)))))) 1263 (timeclock-day-begin (car day-list))))))
1316 </td></table>"))))) 1344 </td></table>")))))
1317 1345
1318 ;;; A helpful little function 1346 ;;; A helpful little function
1319 1347
1320 (defun timeclock-visit-timelog () 1348 (defun timeclock-visit-timelog ()
1321 "Open up the .timelog file in another window." 1349 "Open the file named by `timeclock-file' in another window."
1322 (interactive) 1350 (interactive)
1323 (find-file-other-window timeclock-file)) 1351 (find-file-other-window timeclock-file))
1324 1352
1325 (provide 'timeclock) 1353 (provide 'timeclock)
1326 1354
1329 ;; make sure we know the list of reasons, projects, and have computed 1357 ;; make sure we know the list of reasons, projects, and have computed
1330 ;; the last event and current discrepancy. 1358 ;; the last event and current discrepancy.
1331 (if (file-readable-p timeclock-file) 1359 (if (file-readable-p timeclock-file)
1332 (timeclock-reread-log)) 1360 (timeclock-reread-log))
1333 1361
1362 ;;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40
1334 ;;; timeclock.el ends here 1363 ;;; timeclock.el ends here