mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-07 08:59:41 +00:00
1c226f2ba5
(timeclock-generate-report): Use `time-less-p'.
1363 lines
48 KiB
EmacsLisp
1363 lines
48 KiB
EmacsLisp
;;; timeclock.el --- mode for keeping track of how much you work
|
|
|
|
;; Copyright (C) 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
|
|
|
|
;; Author: John Wiegley <johnw@gnu.org>
|
|
;; Created: 25 Mar 1999
|
|
;; Version: 2.6
|
|
;; Keywords: calendar data
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
;; Boston, MA 02111-1307, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This mode is for keeping track of time intervals. You can use it
|
|
;; for whatever purpose you like, but the typical scenario is to keep
|
|
;; track of how much time you spend working on certain projects.
|
|
;;
|
|
;; Use `timeclock-in' when you start on a project, and `timeclock-out'
|
|
;; when you're done. Once you've collected some data, you can use
|
|
;; `timeclock-workday-remaining' to see how much time is left to be
|
|
;; worked today (where `timeclock-workday' specifies the length of the
|
|
;; working day), and `timeclock-when-to-leave' to calculate when you're free.
|
|
|
|
;; You'll probably want to bind the timeclock commands to some handy
|
|
;; keystrokes. At the moment, C-x t is unused:
|
|
;;
|
|
;; (require 'timeclock)
|
|
;;
|
|
;; (define-key ctl-x-map "ti" 'timeclock-in)
|
|
;; (define-key ctl-x-map "to" 'timeclock-out)
|
|
;; (define-key ctl-x-map "tc" 'timeclock-change)
|
|
;; (define-key ctl-x-map "tr" 'timeclock-reread-log)
|
|
;; (define-key ctl-x-map "tu" 'timeclock-update-modeline)
|
|
;; (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)
|
|
|
|
;; If you want Emacs to display the amount of time "left" to your
|
|
;; workday in the modeline, you can either set the value of
|
|
;; `timeclock-modeline-display' to t using M-x customize, or you
|
|
;; can add this code to your .emacs file:
|
|
;;
|
|
;; (require 'timeclock)
|
|
;; (timeclock-modeline-display)
|
|
;;
|
|
;; To cancel this modeline display at any time, just call
|
|
;; `timeclock-modeline-display' again.
|
|
|
|
;; You may also want Emacs to ask you before exiting, if you are
|
|
;; currently working on a project. This can be done either by setting
|
|
;; `timeclock-ask-before-exiting' to t using M-x customize (this is
|
|
;; the default), or by adding the following to your .emacs file:
|
|
;;
|
|
;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
|
|
|
|
;; NOTE: If you change your .timelog file without using timeclock's
|
|
;; functions, or if you change the value of any of timeclock's
|
|
;; customizable variables, you should run the command
|
|
;; `timeclock-reread-log'. This will recompute any discrepancies in
|
|
;; your average working time, and will make sure that the various
|
|
;; display functions return the correct value.
|
|
|
|
;;; History:
|
|
|
|
;;; Code:
|
|
|
|
(defgroup timeclock nil
|
|
"Keeping track time of the time that gets spent."
|
|
:group 'data)
|
|
|
|
;;; User Variables:
|
|
|
|
(defcustom timeclock-file (convert-standard-filename "~/.timelog")
|
|
"*The file used to store timeclock data in."
|
|
:type 'file
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-workday (* 8 60 60)
|
|
"*The length of a work period."
|
|
:type 'integer
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-relative t
|
|
"*Whether to maken reported time relative to `timeclock-workday'.
|
|
For example, if the length of a normal workday is eight hours, and you
|
|
work four hours on Monday, then the amount of time \"remaining\" on
|
|
Tuesday is twelve hours -- relative to an averaged work period of
|
|
eight hours -- or eight hours, non-relative. So relative time takes
|
|
into account any discrepancy of time under-worked or over-worked on
|
|
previous days. This only affects the timeclock modeline display."
|
|
:type 'boolean
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-get-project-function 'timeclock-ask-for-project
|
|
"*The function used to determine the name of the current project.
|
|
When clocking in, and no project is specified, this function will be
|
|
called to determine what is the current project to be worked on.
|
|
If this variable is nil, no questions will be asked."
|
|
:type 'function
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason
|
|
"*A function used to determine the reason for clocking out.
|
|
When clocking out, and no reason is specified, this function will be
|
|
called to determine what is the reason.
|
|
If this variable is nil, no questions will be asked."
|
|
:type 'function
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-get-workday-function nil
|
|
"*A function used to determine the length of today's workday.
|
|
The first time that a user clocks in each day, this function will be
|
|
called to determine what is the length of the current workday. If
|
|
the return value is nil, or equal to `timeclock-workday', nothing special
|
|
will be done. If it is a quantity different from `timeclock-workday',
|
|
however, a record will be output to the timelog file to note the fact that
|
|
that day has a length that is different from the norm."
|
|
:type '(choice (const nil) function)
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-ask-before-exiting t
|
|
"*If non-nil, ask if the user wants to clock out before exiting Emacs.
|
|
This variable only has effect if set with \\[customize]."
|
|
:set (lambda (symbol value)
|
|
(if value
|
|
(add-hook 'kill-emacs-query-functions 'timeclock-query-out)
|
|
(remove-hook 'kill-emacs-query-functions 'timeclock-query-out))
|
|
(setq timeclock-ask-before-exiting value))
|
|
:type 'boolean
|
|
:group 'timeclock)
|
|
|
|
(defvar timeclock-update-timer nil
|
|
"The timer used to update `timeclock-mode-string'.")
|
|
|
|
;; For byte-compiler.
|
|
(defvar display-time-hook)
|
|
(defvar timeclock-modeline-display)
|
|
|
|
(defcustom timeclock-use-display-time t
|
|
"*If non-nil, use `display-time-hook' for doing modeline updates.
|
|
The advantage of this is that one less timer has to be set running
|
|
amok in Emacs' process space. The disadvantage is that it requires
|
|
you to have `display-time' running. If you don't want to use
|
|
`display-time', but still want the modeline to show how much time is
|
|
left, set this variable to nil. Changing the value of this variable
|
|
while timeclock information is being displayed in the modeline has no
|
|
effect. You should call the function `timeclock-modeline-display' with
|
|
a positive argument to force an update."
|
|
:set (lambda (symbol value)
|
|
(let ((currently-displaying
|
|
(and (boundp 'timeclock-modeline-display)
|
|
timeclock-modeline-display)))
|
|
;; if we're changing to the state that
|
|
;; `timeclock-modeline-display' is already using, don't
|
|
;; bother toggling it. This happens on the initial loading
|
|
;; of timeclock.el.
|
|
(if (and currently-displaying
|
|
(or (and value
|
|
(boundp 'display-time-hook)
|
|
(memq 'timeclock-update-modeline
|
|
display-time-hook))
|
|
(and (not value)
|
|
timeclock-update-timer)))
|
|
(setq currently-displaying nil))
|
|
(and currently-displaying
|
|
(set-variable 'timeclock-modeline-display nil))
|
|
(setq timeclock-use-display-time value)
|
|
(and currently-displaying
|
|
(set-variable 'timeclock-modeline-display t))
|
|
timeclock-use-display-time))
|
|
:type 'boolean
|
|
:group 'timeclock
|
|
:require 'time)
|
|
|
|
(defcustom timeclock-first-in-hook nil
|
|
"*A hook run for the first \"in\" event each day.
|
|
Note that this hook is run before recording any events. Thus the
|
|
value of `timeclock-hours-today', `timeclock-last-event' and the
|
|
return value of function `timeclock-last-period' are relative previous
|
|
to today."
|
|
:type 'hook
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-load-hook nil
|
|
"*Hook that gets run after timeclock has been loaded."
|
|
:type 'hook
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-in-hook nil
|
|
"*A hook run every time an \"in\" event is recorded."
|
|
:type 'hook
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-day-over-hook nil
|
|
"*A hook that is run when the workday has been completed.
|
|
This hook is only run if the current time remaining is being displayed
|
|
in the modeline. See the variable `timeclock-modeline-display'."
|
|
:type 'hook
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-out-hook nil
|
|
"*A hook run every time an \"out\" event is recorded."
|
|
:type 'hook
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-done-hook nil
|
|
"*A hook run every time a project is marked as completed."
|
|
:type 'hook
|
|
:group 'timeclock)
|
|
|
|
(defcustom timeclock-event-hook nil
|
|
"*A hook run every time any event is recorded."
|
|
:type 'hook
|
|
:group 'timeclock)
|
|
|
|
(defvar timeclock-last-event nil
|
|
"A list containing the last event that was recorded.
|
|
The format of this list is (CODE TIME PROJECT).")
|
|
|
|
(defvar timeclock-last-event-workday nil
|
|
"The number of seconds in the workday of `timeclock-last-event'.")
|
|
|
|
;;; Internal Variables:
|
|
|
|
(defvar timeclock-discrepancy nil
|
|
"A variable containing the time discrepancy before the last event.
|
|
Normally, timeclock assumes that you intend to work for
|
|
`timeclock-workday' seconds every day. Any days in which you work
|
|
more or less than this amount is considered either a positive or
|
|
a negative discrepancy. If you work in such a manner that the
|
|
discrepancy is always brought back to zero, then you will by
|
|
definition have worked an average amount equal to `timeclock-workday'
|
|
each day.")
|
|
|
|
(defvar timeclock-elapsed nil
|
|
"A variable containing the time elapsed for complete periods today.
|
|
This value is not accurate enough to be useful by itself. Rather,
|
|
call `timeclock-workday-elapsed', to determine how much time has been
|
|
worked so far today. Also, if `timeclock-relative' is nil, this value
|
|
will be the same as `timeclock-discrepancy'.") ; ? gm
|
|
|
|
(defvar timeclock-last-period nil
|
|
"Integer representing the number of seconds in the last period.
|
|
Note that you shouldn't access this value, but instead should use the
|
|
function `timeclock-last-period'.")
|
|
|
|
(defvar timeclock-mode-string nil
|
|
"The timeclock string (optionally) displayed in the modeline.
|
|
The time is bracketed by <> if you are clocked in, otherwise by [].")
|
|
|
|
(defvar timeclock-day-over nil
|
|
"The date of the last day when notified \"day over\" for.")
|
|
|
|
;;; User Functions:
|
|
|
|
;;;###autoload
|
|
(defun timeclock-modeline-display (&optional arg)
|
|
"Toggle display of the amount of time left today in the modeline.
|
|
If `timeclock-use-display-time' is non-nil (the default), then
|
|
the function `display-time-mode' must be active, and the modeline
|
|
will be updated whenever the time display is updated. Otherwise,
|
|
the timeclock will use its own sixty second timer to do its
|
|
updating. With prefix ARG, turn modeline display on if and only
|
|
if ARG is positive. Returns the new status of timeclock modeline
|
|
display (non-nil means on)."
|
|
(interactive "P")
|
|
;; cf display-time-mode.
|
|
(setq timeclock-mode-string "")
|
|
(or global-mode-string (setq global-mode-string '("")))
|
|
(let ((on-p (if arg
|
|
(> (prefix-numeric-value arg) 0)
|
|
(not timeclock-modeline-display))))
|
|
(if on-p
|
|
(progn
|
|
(or (memq 'timeclock-mode-string global-mode-string)
|
|
(setq global-mode-string
|
|
(append global-mode-string '(timeclock-mode-string))))
|
|
(unless (memq 'timeclock-update-modeline timeclock-event-hook)
|
|
(add-hook 'timeclock-event-hook 'timeclock-update-modeline))
|
|
(when timeclock-update-timer
|
|
(cancel-timer timeclock-update-timer)
|
|
(setq timeclock-update-timer nil))
|
|
(if (boundp 'display-time-hook)
|
|
(remove-hook 'display-time-hook 'timeclock-update-modeline))
|
|
(if timeclock-use-display-time
|
|
(progn
|
|
;; Update immediately so there is a visible change
|
|
;; on calling this function.
|
|
(if display-time-mode (timeclock-update-modeline)
|
|
(message "Activate `display-time-mode' to see \
|
|
timeclock information"))
|
|
(add-hook 'display-time-hook 'timeclock-update-modeline))
|
|
(setq timeclock-update-timer
|
|
(run-at-time nil 60 'timeclock-update-modeline))))
|
|
(setq global-mode-string
|
|
(delq 'timeclock-mode-string global-mode-string))
|
|
(remove-hook 'timeclock-event-hook 'timeclock-update-modeline)
|
|
(if (boundp 'display-time-hook)
|
|
(remove-hook 'display-time-hook
|
|
'timeclock-update-modeline))
|
|
(when timeclock-update-timer
|
|
(cancel-timer timeclock-update-timer)
|
|
(setq timeclock-update-timer nil)))
|
|
(force-mode-line-update)
|
|
(setq timeclock-modeline-display on-p)))
|
|
|
|
;; This has to be here so that the function definition of
|
|
;; `timeclock-modeline-display' is known to the "set" function.
|
|
(defcustom timeclock-modeline-display nil
|
|
"Toggle modeline display of time remaining.
|
|
You must modify via \\[customize] for this variable to have an effect."
|
|
:set (lambda (symbol value)
|
|
(setq timeclock-modeline-display
|
|
(timeclock-modeline-display (or value 0))))
|
|
:type 'boolean
|
|
:group 'timeclock
|
|
:require 'timeclock)
|
|
|
|
(defsubst timeclock-time-to-date (time)
|
|
"Convert the TIME value to a textual date string."
|
|
(format-time-string "%Y/%m/%d" time))
|
|
|
|
;;;###autoload
|
|
(defun timeclock-in (&optional arg project find-project)
|
|
"Clock in, recording the current time moment in the timelog.
|
|
With a numeric prefix ARG, record the fact that today has only that
|
|
many hours in it to be worked. If arg is a non-numeric prefix arg
|
|
\(non-nil, but not a number), 0 is assumed (working on a holiday or
|
|
weekend). *If not called interactively, ARG should be the number of
|
|
_seconds_ worked today*. This feature only has effect the first time
|
|
this function is called within a day.
|
|
|
|
PROJECT is the project being clocked into. If PROJECT is nil, and
|
|
FIND-PROJECT is non-nil -- or the user calls `timeclock-in'
|
|
interactively -- call the function `timeclock-get-project-function' to
|
|
discover the name of the project."
|
|
(interactive
|
|
(list (and current-prefix-arg
|
|
(if (numberp current-prefix-arg)
|
|
(* current-prefix-arg 60 60)
|
|
0))))
|
|
(if (equal (car timeclock-last-event) "i")
|
|
(error "You've already clocked in!")
|
|
(unless timeclock-last-event
|
|
(timeclock-reread-log))
|
|
;; Either no log file, or day has rolled over.
|
|
(unless (and timeclock-last-event
|
|
(equal (timeclock-time-to-date
|
|
(cadr timeclock-last-event))
|
|
(timeclock-time-to-date (current-time))))
|
|
(let ((workday (or (and (numberp arg) arg)
|
|
(and arg 0)
|
|
(and timeclock-get-workday-function
|
|
(funcall timeclock-get-workday-function))
|
|
timeclock-workday)))
|
|
(run-hooks 'timeclock-first-in-hook)
|
|
;; settle the discrepancy for the new day
|
|
(setq timeclock-discrepancy
|
|
(- (or timeclock-discrepancy 0) workday))
|
|
(if (not (= workday timeclock-workday))
|
|
(timeclock-log "h" (and (numberp arg)
|
|
(number-to-string arg))))))
|
|
(timeclock-log "i" (or project
|
|
(and timeclock-get-project-function
|
|
(or find-project (interactive-p))
|
|
(funcall timeclock-get-project-function))))
|
|
(run-hooks 'timeclock-in-hook)))
|
|
|
|
;;;###autoload
|
|
(defun timeclock-out (&optional arg reason find-reason)
|
|
"Clock out, recording the current time moment in the timelog.
|
|
If a prefix ARG is given, the user has completed the project that was
|
|
begun during the last time segment.
|
|
|
|
REASON is the user's reason for clocking out. If REASON is nil, and
|
|
FIND-REASON is non-nil -- or the user calls `timeclock-out'
|
|
interactively -- call the function `timeclock-get-reason-function' to
|
|
discover the reason."
|
|
(interactive "P")
|
|
(or timeclock-last-event
|
|
(error "You haven't clocked in!"))
|
|
(if (equal (downcase (car timeclock-last-event)) "o")
|
|
(error "You've already clocked out!")
|
|
(timeclock-log
|
|
(if arg "O" "o")
|
|
(or reason
|
|
(and timeclock-get-reason-function
|
|
(or find-reason (interactive-p))
|
|
(funcall timeclock-get-reason-function))))
|
|
(run-hooks 'timeclock-out-hook)
|
|
(if arg
|
|
(run-hooks 'timeclock-done-hook))))
|
|
|
|
;; Should today-only be removed in favour of timeclock-relative? - gm
|
|
(defsubst timeclock-workday-remaining (&optional today-only)
|
|
"Return the number of seconds until the workday is complete.
|
|
The amount returned is relative to the value of `timeclock-workday'.
|
|
If TODAY-ONLY is non-nil, the value returned will be relative only to
|
|
the time worked today, and not to past time."
|
|
(let ((discrep (timeclock-find-discrep)))
|
|
(if discrep
|
|
(- (if today-only (cadr discrep)
|
|
(car discrep)))
|
|
0.0)))
|
|
|
|
;;;###autoload
|
|
(defun timeclock-status-string (&optional show-seconds today-only)
|
|
"Report the overall timeclock status at the present moment.
|
|
If SHOW-SECONDS is non-nil, display second resolution.
|
|
If TODAY-ONLY is non-nil, the display will be relative only to time
|
|
worked today, ignoring the time worked on previous days."
|
|
(interactive "P")
|
|
(let ((remainder (timeclock-workday-remaining)) ; today-only?
|
|
(last-in (equal (car timeclock-last-event) "i"))
|
|
status)
|
|
(setq status
|
|
(format "Currently %s since %s (%s), %s %s, leave at %s"
|
|
(if last-in "IN" "OUT")
|
|
(if show-seconds
|
|
(format-time-string "%-I:%M:%S %p"
|
|
(nth 1 timeclock-last-event))
|
|
(format-time-string "%-I:%M %p"
|
|
(nth 1 timeclock-last-event)))
|
|
(or (nth 2 timeclock-last-event)
|
|
(if last-in "**UNKNOWN**" "workday over"))
|
|
(timeclock-seconds-to-string remainder show-seconds t)
|
|
(if (> remainder 0)
|
|
"remaining" "over")
|
|
(timeclock-when-to-leave-string show-seconds today-only)))
|
|
(if (interactive-p)
|
|
(message status)
|
|
status)))
|
|
|
|
;;;###autoload
|
|
(defun timeclock-change (&optional arg project)
|
|
"Change to working on a different project.
|
|
This clocks out of the current project, then clocks in on a new one.
|
|
With a prefix ARG, consider the previous project as finished at the
|
|
time of changeover. PROJECT is the name of the last project you were
|
|
working on."
|
|
(interactive "P")
|
|
(timeclock-out arg)
|
|
(timeclock-in nil project (interactive-p)))
|
|
|
|
;;;###autoload
|
|
(defun timeclock-query-out ()
|
|
"Ask the user whether to clock out.
|
|
This is a useful function for adding to `kill-emacs-query-functions'."
|
|
(and (equal (car timeclock-last-event) "i")
|
|
(y-or-n-p "You're currently clocking time, clock out? ")
|
|
(timeclock-out))
|
|
;; Unconditionally return t for `kill-emacs-query-functions'.
|
|
t)
|
|
|
|
;;;###autoload
|
|
(defun timeclock-reread-log ()
|
|
"Re-read the timeclock, to account for external changes.
|
|
Returns the new value of `timeclock-discrepancy'."
|
|
(interactive)
|
|
(setq timeclock-discrepancy nil)
|
|
(timeclock-find-discrep)
|
|
(if (and timeclock-discrepancy timeclock-modeline-display)
|
|
(timeclock-update-modeline))
|
|
timeclock-discrepancy)
|
|
|
|
(defun timeclock-seconds-to-string (seconds &optional show-seconds
|
|
reverse-leader)
|
|
"Convert SECONDS into a compact time string.
|
|
If SHOW-SECONDS is non-nil, make the resolution of the return string
|
|
include the second count. If REVERSE-LEADER is non-nil, it means to
|
|
output a \"+\" if the time value is negative, rather than a \"-\".
|
|
This is used when negative time values have an inverted meaning (such
|
|
as with time remaining, where negative time really means overtime)."
|
|
(if show-seconds
|
|
(format "%s%d:%02d:%02d"
|
|
(if (< seconds 0) (if reverse-leader "+" "-") "")
|
|
(truncate (/ (abs seconds) 60 60))
|
|
(% (truncate (/ (abs seconds) 60)) 60)
|
|
(% (truncate (abs seconds)) 60))
|
|
(format "%s%d:%02d"
|
|
(if (< seconds 0) (if reverse-leader "+" "-") "")
|
|
(truncate (/ (abs seconds) 60 60))
|
|
(% (truncate (/ (abs seconds) 60)) 60))))
|
|
|
|
(defsubst timeclock-currently-in-p ()
|
|
"Return non-nil if the user is currently clocked in."
|
|
(equal (car timeclock-last-event) "i"))
|
|
|
|
;;;###autoload
|
|
(defun timeclock-workday-remaining-string (&optional show-seconds
|
|
today-only)
|
|
"Return a string representing the amount of time left today.
|
|
Display second resolution if SHOW-SECONDS is non-nil. If TODAY-ONLY
|
|
is non-nil, the display will be relative only to time worked today.
|
|
See `timeclock-relative' for more information about the meaning of
|
|
\"relative to today\"."
|
|
(interactive)
|
|
(let ((string (timeclock-seconds-to-string
|
|
(timeclock-workday-remaining today-only)
|
|
show-seconds t)))
|
|
(if (interactive-p)
|
|
(message string)
|
|
string)))
|
|
|
|
(defsubst timeclock-workday-elapsed ()
|
|
"Return the number of seconds worked so far today.
|
|
If RELATIVE is non-nil, the amount returned will be relative to past
|
|
time worked. The default is to return only the time that has elapsed
|
|
so far today."
|
|
(let ((discrep (timeclock-find-discrep)))
|
|
(if discrep
|
|
(nth 2 discrep)
|
|
0.0)))
|
|
|
|
;;;###autoload
|
|
(defun timeclock-workday-elapsed-string (&optional show-seconds)
|
|
"Return a string representing the amount of time worked today.
|
|
Display seconds resolution if SHOW-SECONDS is non-nil. If RELATIVE is
|
|
non-nil, the amount returned will be relative to past time worked."
|
|
(interactive)
|
|
(let ((string (timeclock-seconds-to-string (timeclock-workday-elapsed)
|
|
show-seconds)))
|
|
(if (interactive-p)
|
|
(message string)
|
|
string)))
|
|
|
|
(defsubst timeclock-time-to-seconds (time)
|
|
"Convert TIME to a floating point number."
|
|
(+ (* (car time) 65536.0)
|
|
(cadr time)
|
|
(/ (or (car (cdr (cdr time))) 0) 1000000.0)))
|
|
|
|
(defsubst timeclock-seconds-to-time (seconds)
|
|
"Convert SECONDS (a floating point number) to an Emacs time structure."
|
|
(list (floor seconds 65536)
|
|
(floor (mod seconds 65536))
|
|
(floor (* (- seconds (ffloor seconds)) 1000000))))
|
|
|
|
;; Should today-only be removed in favour of timeclock-relative? - gm
|
|
(defsubst timeclock-when-to-leave (&optional today-only)
|
|
"Return a time value representing the end of today's workday.
|
|
If TODAY-ONLY is non-nil, the value returned will be relative only to
|
|
the time worked today, and not to past time."
|
|
(timeclock-seconds-to-time
|
|
(- (timeclock-time-to-seconds (current-time))
|
|
(let ((discrep (timeclock-find-discrep)))
|
|
(if discrep
|
|
(if today-only
|
|
(cadr discrep)
|
|
(car discrep))
|
|
0.0)))))
|
|
|
|
;;;###autoload
|
|
(defun timeclock-when-to-leave-string (&optional show-seconds
|
|
today-only)
|
|
"Return a string representing the end of today's workday.
|
|
This string is relative to the value of `timeclock-workday'. If
|
|
SHOW-SECONDS is non-nil, the value printed/returned will include
|
|
seconds. If TODAY-ONLY is non-nil, the value returned will be
|
|
relative only to the time worked today, and not to past time."
|
|
;; Should today-only be removed in favour of timeclock-relative? - gm
|
|
(interactive)
|
|
(let* ((then (timeclock-when-to-leave today-only))
|
|
(string
|
|
(if show-seconds
|
|
(format-time-string "%-I:%M:%S %p" then)
|
|
(format-time-string "%-I:%M %p" then))))
|
|
(if (interactive-p)
|
|
(message string)
|
|
string)))
|
|
|
|
;;; Internal Functions:
|
|
|
|
(defvar timeclock-project-list nil)
|
|
(defvar timeclock-last-project nil)
|
|
|
|
(defun timeclock-completing-read (prompt alist &optional default)
|
|
"A version of `completing-read' that works on both Emacs and XEmacs."
|
|
(if (featurep 'xemacs)
|
|
(let ((str (completing-read prompt alist)))
|
|
(if (or (null str) (= (length str) 0))
|
|
default
|
|
str))
|
|
(completing-read prompt alist nil nil nil nil default)))
|
|
|
|
(defun timeclock-ask-for-project ()
|
|
"Ask the user for the project they are clocking into."
|
|
(timeclock-completing-read
|
|
(format "Clock into which project (default \"%s\"): "
|
|
(or timeclock-last-project
|
|
(car timeclock-project-list)))
|
|
(mapcar 'list timeclock-project-list)
|
|
(or timeclock-last-project
|
|
(car timeclock-project-list))))
|
|
|
|
(defvar timeclock-reason-list nil)
|
|
|
|
(defun timeclock-ask-for-reason ()
|
|
"Ask the user for the reason they are clocking out."
|
|
(timeclock-completing-read "Reason for clocking out: "
|
|
(mapcar 'list timeclock-reason-list)))
|
|
|
|
(defun timeclock-update-modeline ()
|
|
"Update the `timeclock-mode-string' displayed in the modeline.
|
|
The value of `timeclock-relative' affects the display as described in
|
|
that variable's documentation."
|
|
(interactive)
|
|
(let ((remainder (timeclock-workday-remaining (not timeclock-relative)))
|
|
(last-in (equal (car timeclock-last-event) "i")))
|
|
(when (and (< remainder 0)
|
|
(not (and timeclock-day-over
|
|
(equal timeclock-day-over
|
|
(timeclock-time-to-date
|
|
(current-time))))))
|
|
(setq timeclock-day-over
|
|
(timeclock-time-to-date (current-time)))
|
|
(run-hooks 'timeclock-day-over-hook))
|
|
(setq timeclock-mode-string
|
|
(propertize
|
|
(format " %c%s%c "
|
|
(if last-in ?< ?[)
|
|
(timeclock-seconds-to-string remainder nil t)
|
|
(if last-in ?> ?]))
|
|
'help-echo "timeclock: time remaining"))))
|
|
|
|
(put 'timeclock-mode-string 'risky-local-variable t)
|
|
|
|
(defun timeclock-log (code &optional project)
|
|
"Log the event CODE to the timeclock log, at the time of call.
|
|
If PROJECT is a string, it represents the project which the event is
|
|
being logged for. Normally only \"in\" events specify a project."
|
|
(with-current-buffer (find-file-noselect timeclock-file)
|
|
(goto-char (point-max))
|
|
(if (not (bolp))
|
|
(insert "\n"))
|
|
(let ((now (current-time)))
|
|
(insert code " "
|
|
(format-time-string "%Y/%m/%d %H:%M:%S" now)
|
|
(or (and project
|
|
(stringp project)
|
|
(> (length project) 0)
|
|
(concat " " project))
|
|
"")
|
|
"\n")
|
|
(if (equal (downcase code) "o")
|
|
(setq timeclock-last-period
|
|
(- (timeclock-time-to-seconds now)
|
|
(timeclock-time-to-seconds
|
|
(cadr timeclock-last-event)))
|
|
timeclock-discrepancy
|
|
(+ timeclock-discrepancy
|
|
timeclock-last-period)))
|
|
(setq timeclock-last-event (list code now project)))
|
|
(save-buffer)
|
|
(run-hooks 'timeclock-event-hook)
|
|
(kill-buffer (current-buffer))))
|
|
|
|
(defvar timeclock-moment-regexp
|
|
(concat "\\([bhioO]\\)\\s-+"
|
|
"\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+"
|
|
"\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)"))
|
|
|
|
(defsubst timeclock-read-moment ()
|
|
"Read the moment under point from the timelog."
|
|
(if (looking-at timeclock-moment-regexp)
|
|
(let ((code (match-string 1))
|
|
(year (string-to-number (match-string 2)))
|
|
(mon (string-to-number (match-string 3)))
|
|
(mday (string-to-number (match-string 4)))
|
|
(hour (string-to-number (match-string 5)))
|
|
(min (string-to-number (match-string 6)))
|
|
(sec (string-to-number (match-string 7)))
|
|
(project (match-string 8)))
|
|
(list code (encode-time sec min hour mday mon year) project))))
|
|
|
|
(defun timeclock-last-period (&optional moment)
|
|
"Return the value of the last event period.
|
|
If the last event was a clock-in, the period will be open ended, and
|
|
growing every second. Otherwise, it is a fixed amount which has been
|
|
recorded to disk. If MOMENT is non-nil, use that as the current time.
|
|
This is only provided for coherency when used by
|
|
`timeclock-discrepancy'."
|
|
(if (equal (car timeclock-last-event) "i")
|
|
(- (timeclock-time-to-seconds (or moment (current-time)))
|
|
(timeclock-time-to-seconds
|
|
(cadr timeclock-last-event)))
|
|
timeclock-last-period))
|
|
|
|
(defsubst timeclock-entry-length (entry)
|
|
(- (timeclock-time-to-seconds (cadr entry))
|
|
(timeclock-time-to-seconds (car entry))))
|
|
|
|
(defsubst timeclock-entry-begin (entry)
|
|
(car entry))
|
|
|
|
(defsubst timeclock-entry-end (entry)
|
|
(cadr entry))
|
|
|
|
(defsubst timeclock-entry-project (entry)
|
|
(nth 2 entry))
|
|
|
|
(defsubst timeclock-entry-comment (entry)
|
|
(nth 3 entry))
|
|
|
|
|
|
(defsubst timeclock-entry-list-length (entry-list)
|
|
(let ((length 0))
|
|
(while entry-list
|
|
(setq length (+ length (timeclock-entry-length (car entry-list))))
|
|
(setq entry-list (cdr entry-list)))
|
|
length))
|
|
|
|
(defsubst timeclock-entry-list-begin (entry-list)
|
|
(timeclock-entry-begin (car entry-list)))
|
|
|
|
(defsubst timeclock-entry-list-end (entry-list)
|
|
(timeclock-entry-end (car (last entry-list))))
|
|
|
|
(defsubst timeclock-entry-list-span (entry-list)
|
|
(- (timeclock-time-to-seconds (timeclock-entry-list-end entry-list))
|
|
(timeclock-time-to-seconds (timeclock-entry-list-begin entry-list))))
|
|
|
|
(defsubst timeclock-entry-list-break (entry-list)
|
|
(- (timeclock-entry-list-span entry-list)
|
|
(timeclock-entry-list-length entry-list)))
|
|
|
|
(defsubst timeclock-entry-list-projects (entry-list)
|
|
(let (projects)
|
|
(while entry-list
|
|
(let ((project (timeclock-entry-project (car entry-list))))
|
|
(if projects
|
|
(add-to-list 'projects project)
|
|
(setq projects (list project))))
|
|
(setq entry-list (cdr entry-list)))
|
|
projects))
|
|
|
|
|
|
(defsubst timeclock-day-required (day)
|
|
(or (car day) timeclock-workday))
|
|
|
|
(defsubst timeclock-day-length (day)
|
|
(timeclock-entry-list-length (cdr day)))
|
|
|
|
(defsubst timeclock-day-debt (day)
|
|
(- (timeclock-day-required day)
|
|
(timeclock-day-length day)))
|
|
|
|
(defsubst timeclock-day-begin (day)
|
|
(timeclock-entry-list-begin (cdr day)))
|
|
|
|
(defsubst timeclock-day-end (day)
|
|
(timeclock-entry-list-end (cdr day)))
|
|
|
|
(defsubst timeclock-day-span (day)
|
|
(timeclock-entry-list-span (cdr day)))
|
|
|
|
(defsubst timeclock-day-break (day)
|
|
(timeclock-entry-list-break (cdr day)))
|
|
|
|
(defsubst timeclock-day-projects (day)
|
|
(timeclock-entry-list-projects (cdr day)))
|
|
|
|
(defmacro timeclock-day-list-template (func)
|
|
`(let ((length 0))
|
|
(while day-list
|
|
(setq length (+ length (,(eval func) (car day-list))))
|
|
(setq day-list (cdr day-list)))
|
|
length))
|
|
|
|
(defun timeclock-day-list-required (day-list)
|
|
(timeclock-day-list-template 'timeclock-day-required))
|
|
|
|
(defun timeclock-day-list-length (day-list)
|
|
(timeclock-day-list-template 'timeclock-day-length))
|
|
|
|
(defun timeclock-day-list-debt (day-list)
|
|
(timeclock-day-list-template 'timeclock-day-debt))
|
|
|
|
(defsubst timeclock-day-list-begin (day-list)
|
|
(timeclock-day-begin (car day-list)))
|
|
|
|
(defsubst timeclock-day-list-end (day-list)
|
|
(timeclock-day-end (car (last day-list))))
|
|
|
|
(defun timeclock-day-list-span (day-list)
|
|
(timeclock-day-list-template 'timeclock-day-span))
|
|
|
|
(defun timeclock-day-list-break (day-list)
|
|
(timeclock-day-list-template 'timeclock-day-break))
|
|
|
|
(defun timeclock-day-list-projects (day-list)
|
|
(let (projects)
|
|
(while day-list
|
|
(let ((projs (timeclock-day-projects (car day-list))))
|
|
(while projs
|
|
(if projects
|
|
(add-to-list 'projects (car projs))
|
|
(setq projects (list (car projs))))
|
|
(setq projs (cdr projs))))
|
|
(setq day-list (cdr day-list)))
|
|
projects))
|
|
|
|
|
|
(defsubst timeclock-current-debt (&optional log-data)
|
|
(nth 0 (or log-data (timeclock-log-data))))
|
|
|
|
(defsubst timeclock-day-alist (&optional log-data)
|
|
(nth 1 (or log-data (timeclock-log-data))))
|
|
|
|
(defun timeclock-day-list (&optional log-data)
|
|
(let ((alist (timeclock-day-alist log-data))
|
|
day-list)
|
|
(while alist
|
|
(setq day-list (cons (cdar alist) day-list)
|
|
alist (cdr alist)))
|
|
day-list))
|
|
|
|
(defsubst timeclock-project-alist (&optional log-data)
|
|
(nth 2 (or log-data (timeclock-log-data))))
|
|
|
|
|
|
(defun timeclock-log-data (&optional recent-only filename)
|
|
"Return the contents of the timelog file, in a useful format.
|
|
If the optional argument RECENT-ONLY is non-nil, only show the contents
|
|
from the last point where the time debt (see below) was set.
|
|
If the optional argument FILENAME is non-nil, it is used instead of
|
|
the file specified by `timeclock-file.'
|
|
|
|
A timelog contains data in the form of a single entry per line.
|
|
Each entry has the form:
|
|
|
|
CODE YYYY/MM/DD HH:MM:SS [COMMENT]
|
|
|
|
CODE is one of: b, h, i, o or O. COMMENT is optional when the code is
|
|
i, o or O. The meanings of the codes are:
|
|
|
|
b Set the current time balance, or \"time debt\". Useful when
|
|
archiving old log data, when a debt must be carried forward.
|
|
The COMMENT here is the number of seconds of debt.
|
|
|
|
h Set the required working time for the given day. This must
|
|
be the first entry for that day. The COMMENT in this case is
|
|
the number of hours in this workday. Floating point amounts
|
|
are allowed.
|
|
|
|
i Clock in. The COMMENT in this case should be the name of the
|
|
project worked on.
|
|
|
|
o Clock out. COMMENT is unnecessary, but can be used to provide
|
|
a description of how the period went, for example.
|
|
|
|
O Final clock out. Whatever project was being worked on, it is
|
|
now finished. Useful for creating summary reports.
|
|
|
|
When this function is called, it will return a data structure with the
|
|
following format:
|
|
|
|
(DEBT ENTRIES-BY-DAY ENTRIES-BY-PROJECT)
|
|
|
|
DEBT is a floating point number representing the number of seconds
|
|
\"owed\" before any work was done. For a new file (one without a 'b'
|
|
entry), this is always zero.
|
|
|
|
The two entries lists have similar formats. They are both alists,
|
|
where the CAR is the index, and the CDR is a list of time entries.
|
|
For ENTRIES-BY-DAY, the CAR is a textual date string, of the form
|
|
YYYY/MM/DD. For ENTRIES-BY-PROJECT, it is the name of the project
|
|
worked on, or t for the default project.
|
|
|
|
The CDR for ENTRIES-BY-DAY is slightly different than for
|
|
ENTRIES-BY-PROJECT. It has the following form:
|
|
|
|
(DAY-LENGTH TIME-ENTRIES...)
|
|
|
|
For ENTRIES-BY-PROJECT, there is no DAY-LENGTH member. It is simply a
|
|
list of TIME-ENTRIES. Note that if DAY-LENGTH is nil, it means
|
|
whatever is the default should be used.
|
|
|
|
A TIME-ENTRY is a recorded time interval. It has the following format
|
|
\(although generally one does not have to manipulate these entries
|
|
directly; see below):
|
|
|
|
(BEGIN-TIME END-TIME PROJECT [COMMENT] [FINAL-P])
|
|
|
|
Anyway, suffice it to say there are a lot of structures. Typically
|
|
the user is expected to manipulate to the day(s) or project(s) that he
|
|
or she wants, at which point the following helper functions may be
|
|
used:
|
|
|
|
timeclock-day-required
|
|
timeclock-day-length
|
|
timeclock-day-debt
|
|
timeclock-day-begin
|
|
timeclock-day-end
|
|
timeclock-day-span
|
|
timeclock-day-break
|
|
timeclock-day-projects
|
|
|
|
timeclock-day-list-required
|
|
timeclock-day-list-length
|
|
timeclock-day-list-debt
|
|
timeclock-day-list-begin
|
|
timeclock-day-list-end
|
|
timeclock-day-list-span
|
|
timeclock-day-list-break
|
|
timeclock-day-list-projects
|
|
|
|
timeclock-entry-length
|
|
timeclock-entry-begin
|
|
timeclock-entry-end
|
|
timeclock-entry-project
|
|
timeclock-entry-comment
|
|
|
|
timeclock-entry-list-length
|
|
timeclock-entry-list-begin
|
|
timeclock-entry-list-end
|
|
timeclock-entry-list-span
|
|
timeclock-entry-list-break
|
|
timeclock-entry-list-projects
|
|
|
|
A few comments should make the use of the above functions obvious:
|
|
|
|
`required' is the amount of time that must be spent during a day, or
|
|
sequence of days, in order to have no debt.
|
|
|
|
`length' is the actual amount of time that was spent.
|
|
|
|
`debt' is the difference between required time and length. A
|
|
negative debt signifies overtime.
|
|
|
|
`begin' is the earliest moment at which work began.
|
|
|
|
`end' is the final moment work was done.
|
|
|
|
`span' is the difference between begin and end.
|
|
|
|
`break' is the difference between span and length.
|
|
|
|
`project' is the project that was worked on, and `projects' is a
|
|
list of all the projects that were worked on during a given period.
|
|
|
|
`comment', where it applies, could mean anything.
|
|
|
|
There are a few more functions available, for locating day and entry
|
|
lists:
|
|
|
|
timeclock-day-alist LOG-DATA
|
|
timeclock-project-alist LOG-DATA
|
|
timeclock-current-debt LOG-DATA
|
|
|
|
See the documentation for the given function if more info is needed."
|
|
(let* ((log-data (list 0.0 nil nil))
|
|
(now (current-time))
|
|
(todays-date (timeclock-time-to-date now))
|
|
last-date-limited last-date-seconds last-date
|
|
(line 0) last beg day entry event)
|
|
(with-temp-buffer
|
|
(insert-file-contents (or filename timeclock-file))
|
|
(when recent-only
|
|
(goto-char (point-max))
|
|
(unless (re-search-backward "^b\\s-+" nil t)
|
|
(goto-char (point-min))))
|
|
(while (or (setq event (timeclock-read-moment))
|
|
(and beg (not last)
|
|
(setq last t event (list "o" now))))
|
|
(setq line (1+ line))
|
|
(cond ((equal (car event) "b")
|
|
(setcar log-data (string-to-number (nth 2 event))))
|
|
((equal (car event) "h")
|
|
(setq last-date-limited (timeclock-time-to-date (cadr event))
|
|
last-date-seconds (* (string-to-number (nth 2 event))
|
|
3600.0)))
|
|
((equal (car event) "i")
|
|
(if beg
|
|
(error "Error in format of timelog file, line %d" line)
|
|
(setq beg t))
|
|
(setq entry (list (cadr event) nil
|
|
(and (> (length (nth 2 event)) 0)
|
|
(nth 2 event))))
|
|
(let ((date (timeclock-time-to-date (cadr event))))
|
|
(if (and last-date
|
|
(not (equal date last-date)))
|
|
(progn
|
|
(setcar (cdr log-data)
|
|
(cons (cons last-date day)
|
|
(cadr log-data)))
|
|
(setq day (list (and last-date-limited
|
|
last-date-seconds))))
|
|
(unless day
|
|
(setq day (list (and last-date-limited
|
|
last-date-seconds)))))
|
|
(setq last-date date
|
|
last-date-limited nil)))
|
|
((equal (downcase (car event)) "o")
|
|
(if (not beg)
|
|
(error "Error in format of timelog file, line %d" line)
|
|
(setq beg nil))
|
|
(setcar (cdr entry) (cadr event))
|
|
(let ((desc (and (> (length (nth 2 event)) 0)
|
|
(nth 2 event))))
|
|
(if desc
|
|
(nconc entry (list (nth 2 event))))
|
|
(if (equal (car event) "O")
|
|
(nconc entry (if desc
|
|
(list t)
|
|
(list nil t))))
|
|
(nconc day (list entry))
|
|
(setq desc (nth 2 entry))
|
|
(let ((proj (assoc desc (nth 2 log-data))))
|
|
(if (null proj)
|
|
(setcar (cddr log-data)
|
|
(cons (cons desc (list entry))
|
|
(car (cddr log-data))))
|
|
(nconc (cdr proj) (list entry)))))))
|
|
(forward-line))
|
|
(if day
|
|
(setcar (cdr log-data)
|
|
(cons (cons last-date day)
|
|
(cadr log-data))))
|
|
log-data)))
|
|
|
|
(defun timeclock-find-discrep ()
|
|
"Calculate time discrepancies, in seconds.
|
|
The result is a three element list, containing the total time
|
|
discrepancy, today's discrepancy, and the time worked today."
|
|
;; This is not implemented in terms of the functions above, because
|
|
;; it's a bit wasteful to read all of that data in, just to throw
|
|
;; away more than 90% of the information afterwards.
|
|
;;
|
|
;; If it were implemented using those functions, it would look
|
|
;; something like this:
|
|
;; (let ((days (timeclock-day-alist (timeclock-log-data)))
|
|
;; (total 0.0))
|
|
;; (while days
|
|
;; (setq total (+ total (- (timeclock-day-length (cdar days))
|
|
;; (timeclock-day-required (cdar days))))
|
|
;; days (cdr days)))
|
|
;; total)
|
|
(let* ((now (current-time))
|
|
(todays-date (timeclock-time-to-date now))
|
|
(first t) (accum 0) (elapsed 0)
|
|
event beg last-date avg
|
|
last-date-limited last-date-seconds)
|
|
(unless timeclock-discrepancy
|
|
(when (file-readable-p timeclock-file)
|
|
(setq timeclock-project-list nil
|
|
timeclock-last-project nil
|
|
timeclock-reason-list nil
|
|
timeclock-elapsed 0)
|
|
(with-temp-buffer
|
|
(insert-file-contents timeclock-file)
|
|
(goto-char (point-max))
|
|
(unless (re-search-backward "^b\\s-+" nil t)
|
|
(goto-char (point-min)))
|
|
(while (setq event (timeclock-read-moment))
|
|
(cond ((equal (car event) "b")
|
|
(setq accum (string-to-number (nth 2 event))))
|
|
((equal (car event) "h")
|
|
(setq last-date-limited
|
|
(timeclock-time-to-date (cadr event))
|
|
last-date-seconds
|
|
(* (string-to-number (nth 2 event)) 3600.0)))
|
|
((equal (car event) "i")
|
|
(when (and (nth 2 event)
|
|
(> (length (nth 2 event)) 0))
|
|
(add-to-list 'timeclock-project-list (nth 2 event))
|
|
(setq timeclock-last-project (nth 2 event)))
|
|
(let ((date (timeclock-time-to-date (cadr event))))
|
|
(if (if last-date
|
|
(not (equal date last-date))
|
|
first)
|
|
(setq first nil
|
|
accum (- accum (if last-date-limited
|
|
last-date-seconds
|
|
timeclock-workday))))
|
|
(setq last-date date
|
|
last-date-limited nil)
|
|
(if beg
|
|
(error "Error in format of timelog file!")
|
|
(setq beg (timeclock-time-to-seconds (cadr event))))))
|
|
((equal (downcase (car event)) "o")
|
|
(if (and (nth 2 event)
|
|
(> (length (nth 2 event)) 0))
|
|
(add-to-list 'timeclock-reason-list (nth 2 event)))
|
|
(if (not beg)
|
|
(error "Error in format of timelog file!")
|
|
(setq timeclock-last-period
|
|
(- (timeclock-time-to-seconds (cadr event)) beg)
|
|
accum (+ timeclock-last-period accum)
|
|
beg nil))
|
|
(if (equal last-date todays-date)
|
|
(setq timeclock-elapsed
|
|
(+ timeclock-last-period timeclock-elapsed)))))
|
|
(setq timeclock-last-event event
|
|
timeclock-last-event-workday
|
|
(if (equal (timeclock-time-to-date now) last-date-limited)
|
|
last-date-seconds
|
|
timeclock-workday))
|
|
(forward-line))
|
|
(setq timeclock-discrepancy accum))))
|
|
(unless timeclock-last-event-workday
|
|
(setq timeclock-last-event-workday timeclock-workday))
|
|
(setq accum (or timeclock-discrepancy 0)
|
|
elapsed (or timeclock-elapsed elapsed))
|
|
(if timeclock-last-event
|
|
(if (equal (car timeclock-last-event) "i")
|
|
(let ((last-period (timeclock-last-period now)))
|
|
(setq accum (+ accum last-period)
|
|
elapsed (+ elapsed last-period)))
|
|
(if (not (equal (timeclock-time-to-date
|
|
(cadr timeclock-last-event))
|
|
(timeclock-time-to-date now)))
|
|
(setq accum (- accum timeclock-last-event-workday)))))
|
|
(list accum (- elapsed timeclock-last-event-workday)
|
|
elapsed)))
|
|
|
|
;;; A reporting function that uses timeclock-log-data
|
|
|
|
(defun timeclock-day-base (&optional time)
|
|
"Given a time within a day, return 0:0:0 within that day.
|
|
If optional argument TIME is non-nil, use that instead of the current time."
|
|
(let ((decoded (decode-time (or time (current-time)))))
|
|
(setcar (nthcdr 0 decoded) 0)
|
|
(setcar (nthcdr 1 decoded) 0)
|
|
(setcar (nthcdr 2 decoded) 0)
|
|
(apply 'encode-time decoded)))
|
|
|
|
(defun timeclock-geometric-mean (l)
|
|
"Compute the geometric mean of the values in the list L."
|
|
(let ((total 0)
|
|
(count 0))
|
|
(while l
|
|
(setq total (+ total (car l))
|
|
count (1+ count)
|
|
l (cdr l)))
|
|
(if (> count 0)
|
|
(/ total count)
|
|
0)))
|
|
|
|
(defun timeclock-generate-report (&optional html-p)
|
|
"Generate a summary report based on the current timelog file.
|
|
By default, the report is in plain text, but if the optional argument
|
|
HTML-P is non-nil, HTML markup is added."
|
|
(interactive)
|
|
(let ((log (timeclock-log-data))
|
|
(today (timeclock-day-base)))
|
|
(if html-p (insert "<p>"))
|
|
(insert "Currently ")
|
|
(let ((project (nth 2 timeclock-last-event))
|
|
(begin (nth 1 timeclock-last-event))
|
|
done)
|
|
(if (timeclock-currently-in-p)
|
|
(insert "IN")
|
|
(if (or (null project) (= (length project) 0))
|
|
(progn (insert "Done Working Today")
|
|
(setq done t))
|
|
(insert "OUT")))
|
|
(unless done
|
|
(insert " since " (format-time-string "%Y/%m/%d %-I:%M %p" begin))
|
|
(if html-p
|
|
(insert "<br>\n<b>")
|
|
(insert "\n*"))
|
|
(if (timeclock-currently-in-p)
|
|
(insert "Working on "))
|
|
(if html-p
|
|
(insert project "</b><br>\n")
|
|
(insert project "*\n"))
|
|
(let ((proj-data (cdr (assoc project (timeclock-project-alist log))))
|
|
(two-weeks-ago (timeclock-seconds-to-time
|
|
(- (timeclock-time-to-seconds today)
|
|
(* 2 7 24 60 60))))
|
|
two-week-len today-len)
|
|
(while proj-data
|
|
(if (not (time-less-p
|
|
(timeclock-entry-begin (car proj-data)) today))
|
|
(setq today-len (timeclock-entry-list-length proj-data)
|
|
proj-data nil)
|
|
(if (and (null two-week-len)
|
|
(not (time-less-p
|
|
(timeclock-entry-begin (car proj-data))
|
|
two-weeks-ago)))
|
|
(setq two-week-len (timeclock-entry-list-length proj-data)))
|
|
(setq proj-data (cdr proj-data))))
|
|
(if (null two-week-len)
|
|
(setq two-week-len today-len))
|
|
(if html-p (insert "<p>"))
|
|
(if today-len
|
|
(insert "\nTime spent on this task today: "
|
|
(timeclock-seconds-to-string today-len)
|
|
". In the last two weeks: "
|
|
(timeclock-seconds-to-string two-week-len))
|
|
(if two-week-len
|
|
(insert "\nTime spent on this task in the last two weeks: "
|
|
(timeclock-seconds-to-string two-week-len))))
|
|
(if html-p (insert "<br>"))
|
|
(insert "\n"
|
|
(timeclock-seconds-to-string (timeclock-workday-elapsed))
|
|
" worked today, "
|
|
(timeclock-seconds-to-string (timeclock-workday-remaining))
|
|
" remaining, done at "
|
|
(timeclock-when-to-leave-string) "\n")))
|
|
(if html-p (insert "<p>"))
|
|
(insert "\nThere have been "
|
|
(number-to-string
|
|
(length (timeclock-day-alist log)))
|
|
" days of activity, starting "
|
|
(caar (last (timeclock-day-alist log))))
|
|
(if html-p (insert "</p>"))
|
|
(when html-p
|
|
(insert "<p>
|
|
<table>
|
|
<td width=\"25\"><br></td><td>
|
|
<table border=1 cellpadding=3>
|
|
<tr><th><i>Statistics</i></th>
|
|
<th>Entire</th>
|
|
<th>-30 days</th>
|
|
<th>-3 mons</th>
|
|
<th>-6 mons</th>
|
|
<th>-1 year</th>
|
|
</tr>")
|
|
(let* ((day-list (timeclock-day-list))
|
|
(thirty-days-ago (timeclock-seconds-to-time
|
|
(- (timeclock-time-to-seconds today)
|
|
(* 30 24 60 60))))
|
|
(three-months-ago (timeclock-seconds-to-time
|
|
(- (timeclock-time-to-seconds today)
|
|
(* 90 24 60 60))))
|
|
(six-months-ago (timeclock-seconds-to-time
|
|
(- (timeclock-time-to-seconds today)
|
|
(* 180 24 60 60))))
|
|
(one-year-ago (timeclock-seconds-to-time
|
|
(- (timeclock-time-to-seconds today)
|
|
(* 365 24 60 60))))
|
|
(time-in (vector (list t) (list t) (list t) (list t) (list t)))
|
|
(time-out (vector (list t) (list t) (list t) (list t) (list t)))
|
|
(breaks (vector (list t) (list t) (list t) (list t) (list t)))
|
|
(workday (vector (list t) (list t) (list t) (list t) (list t)))
|
|
(lengths (vector '(0 0) thirty-days-ago three-months-ago
|
|
six-months-ago one-year-ago)))
|
|
;; collect statistics from complete timelog
|
|
(while day-list
|
|
(let ((i 0) (l 5))
|
|
(while (< i l)
|
|
(unless (time-less-p
|
|
(timeclock-day-begin (car day-list))
|
|
(aref lengths i))
|
|
(let ((base (timeclock-time-to-seconds
|
|
(timeclock-day-base
|
|
(timeclock-day-begin (car day-list))))))
|
|
(nconc (aref time-in i)
|
|
(list (- (timeclock-time-to-seconds
|
|
(timeclock-day-begin (car day-list)))
|
|
base)))
|
|
(let ((span (timeclock-day-span (car day-list)))
|
|
(len (timeclock-day-length (car day-list)))
|
|
(req (timeclock-day-required (car day-list))))
|
|
;; If the day's actual work length is less than
|
|
;; 70% of its span, then likely the exit time
|
|
;; and break amount are not worthwhile adding to
|
|
;; the statistic
|
|
(when (and (> span 0)
|
|
(> (/ (float len) (float span)) 0.70))
|
|
(nconc (aref time-out i)
|
|
(list (- (timeclock-time-to-seconds
|
|
(timeclock-day-end (car day-list)))
|
|
base)))
|
|
(nconc (aref breaks i) (list (- span len))))
|
|
(if req
|
|
(setq len (+ len (- timeclock-workday req))))
|
|
(nconc (aref workday i) (list len)))))
|
|
(setq i (1+ i))))
|
|
(setq day-list (cdr day-list)))
|
|
;; average statistics
|
|
(let ((i 0) (l 5))
|
|
(while (< i l)
|
|
(aset time-in i (timeclock-geometric-mean
|
|
(cdr (aref time-in i))))
|
|
(aset time-out i (timeclock-geometric-mean
|
|
(cdr (aref time-out i))))
|
|
(aset breaks i (timeclock-geometric-mean
|
|
(cdr (aref breaks i))))
|
|
(aset workday i (timeclock-geometric-mean
|
|
(cdr (aref workday i))))
|
|
(setq i (1+ i))))
|
|
;; Output the HTML table
|
|
(insert "<tr>\n")
|
|
(insert "<td align=\"center\">Time in</td>\n")
|
|
(let ((i 0) (l 5))
|
|
(while (< i l)
|
|
(insert "<td align=\"right\">"
|
|
(timeclock-seconds-to-string (aref time-in i))
|
|
"</td>\n")
|
|
(setq i (1+ i))))
|
|
(insert "</tr>\n")
|
|
|
|
(insert "<tr>\n")
|
|
(insert "<td align=\"center\">Time out</td>\n")
|
|
(let ((i 0) (l 5))
|
|
(while (< i l)
|
|
(insert "<td align=\"right\">"
|
|
(timeclock-seconds-to-string (aref time-out i))
|
|
"</td>\n")
|
|
(setq i (1+ i))))
|
|
(insert "</tr>\n")
|
|
|
|
(insert "<tr>\n")
|
|
(insert "<td align=\"center\">Break</td>\n")
|
|
(let ((i 0) (l 5))
|
|
(while (< i l)
|
|
(insert "<td align=\"right\">"
|
|
(timeclock-seconds-to-string (aref breaks i))
|
|
"</td>\n")
|
|
(setq i (1+ i))))
|
|
(insert "</tr>\n")
|
|
|
|
(insert "<tr>\n")
|
|
(insert "<td align=\"center\">Workday</td>\n")
|
|
(let ((i 0) (l 5))
|
|
(while (< i l)
|
|
(insert "<td align=\"right\">"
|
|
(timeclock-seconds-to-string (aref workday i))
|
|
"</td>\n")
|
|
(setq i (1+ i))))
|
|
(insert "</tr>\n"))
|
|
(insert "<tfoot>
|
|
<td colspan=\"6\" align=\"center\">
|
|
<i>These are approximate figures</i></td>
|
|
</tfoot>
|
|
</table>
|
|
</td></table>")))))
|
|
|
|
;;; A helpful little function
|
|
|
|
(defun timeclock-visit-timelog ()
|
|
"Open the file named by `timeclock-file' in another window."
|
|
(interactive)
|
|
(find-file-other-window timeclock-file))
|
|
|
|
(provide 'timeclock)
|
|
|
|
(run-hooks 'timeclock-load-hook)
|
|
|
|
;; make sure we know the list of reasons, projects, and have computed
|
|
;; the last event and current discrepancy.
|
|
(if (file-readable-p timeclock-file)
|
|
(timeclock-reread-log))
|
|
|
|
;;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40
|
|
;;; timeclock.el ends here
|