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