;;; timeclock.el --- mode for keeping track of how much you work
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+;; Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Created: 25 Mar 1999
-;; Version: 2.2
+;; Version: 2.6
;; Keywords: calendar data
-;; X-URL: http://www.emacs.org/~johnw/emacs.html
;; This file is part of GNU Emacs.
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; 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 (assuming a typical average of 8 hours a day), and
-;; `timeclock-when-to-leave' which will calculate when you're free.
+;; 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 in Emacs 20:
+;; keystrokes. At the moment, C-x t is unused:
;;
;; (require 'timeclock)
;;
;; `timeclock-modeline-display' again.
;; You may also want Emacs to ask you before exiting, if you are
-;; current working on a project. This can be done either by setting
+;; 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-hook 'timeclock-query-out)
+;; (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
;;; Code:
(defgroup timeclock nil
- "Keeping track time of the time that gets spent."
+ "Keeping track of the time that gets spent."
:group 'data)
;;; User Variables:
-(defcustom timeclock-file "~/.timelog"
+(defcustom timeclock-file (convert-standard-filename "~/.timelog")
"*The file used to store timeclock data in."
:type 'file
:group 'timeclock)
:group 'timeclock)
(defcustom timeclock-relative t
- "*When reporting time, make it relative to `timeclock-workday'?
+ "*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 overworked on
-previous days."
+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 the current project to be worked on is.
+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 the reason is.
+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 the length of the current workday is. If
-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 different length from the norm."
- :type 'function
+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."
+ "*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-hook 'timeclock-query-out)
- (remove-hook 'kill-emacs-hook 'timeclock-query-out))
+ (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 to this is that it means 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
+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. You will need to restart Emacs (or
-toggle the value of `timeclock-modeline-display') for the change to
-take effect."
+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-update-timer)))
(setq currently-displaying nil))
(and currently-displaying
- (set-variable timeclock-modeline-display nil))
+ (set-variable 'timeclock-modeline-display nil))
(setq timeclock-use-display-time value)
(and currently-displaying
- (set-variable timeclock-modeline-display t))
+ (set-variable 'timeclock-modeline-display t))
timeclock-use-display-time))
:type 'boolean
: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 display
+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)
(defvar timeclock-last-event nil
"A list containing the last event that was recorded.
-The format of this list is (CODE TIME PROJECT). PROJECT will be
-non-nil only if CODE is \"o\" or \"O\".")
+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'.")
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
-negative discrepancy. If you work in such a manner that the
+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.")
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'.")
+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 should use the function
-`timeclock-last-period' instead.")
+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 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.")
;;;###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 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)."
+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
- (let ((list-entry (memq 'global-mode-string
- mode-line-format)))
- (unless (memq 'timeclock-mode-string mode-line-format)
- (setcdr list-entry
- (cons 'timeclock-mode-string
- (cdr list-entry))))
+ (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
(if (boundp 'display-time-hook)
(remove-hook 'display-time-hook 'timeclock-update-modeline))
(if timeclock-use-display-time
- (add-hook 'display-time-hook 'timeclock-update-modeline)
+ (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 mode-line-format
- (delq 'timeclock-mode-string mode-line-format))
+ (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
(cancel-timer timeclock-update-timer)
(setq timeclock-update-timer nil)))
(force-mode-line-update)
- on-p))
+ (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.
: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.
_seconds_ worked today*. This feature only has effect the first time
this function is called within a day.
-PROJECT as the project being clocked into. If PROJECT is nil, and
+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."
(error "You've already clocked in!")
(unless timeclock-last-event
(timeclock-reread-log))
- (unless (equal (timeclock-time-to-date
- (cadr timeclock-last-event))
- (timeclock-time-to-date (current-time)))
+ ;; 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
(run-hooks 'timeclock-first-in-hook)
;; settle the discrepancy for the new day
(setq timeclock-discrepancy
- (- timeclock-discrepancy workday))
+ (- (or timeclock-discrepancy 0) workday))
(if (not (= workday timeclock-workday))
(timeclock-log "h" (and (numberp arg)
(number-to-string arg))))))
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
(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."
+ "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))
- (last-in (equal (car timeclock-last-event) "i"))
- status)
+ (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")
"remaining" "over")
(timeclock-when-to-leave-string show-seconds today-only)))
(if (interactive-p)
- (message status)
+ (message "%s" status)
status)))
;;;###autoload
(defun timeclock-change (&optional arg project)
- "Change to working on a different project, by clocking in then out.
-With a prefix ARG, consider the previous project as having been
-finished at the time of changeover. PROJECT is the name of the last
-project you were working on."
+ "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 before clocking out.
-This is a useful function for adding to `kill-emacs-hook'."
- (if (and (equal (car timeclock-last-event) "i")
- (y-or-n-p "You're currently clocking time, clock out? "))
- (timeclock-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 ()
(interactive)
(setq timeclock-discrepancy nil)
(timeclock-find-discrep)
- (if timeclock-modeline-display
+ (if (and timeclock-discrepancy timeclock-modeline-display)
(timeclock-update-modeline))
timeclock-discrepancy)
(truncate (/ (abs seconds) 60 60))
(% (truncate (/ (abs seconds) 60)) 60))))
-(defun timeclock-workday-remaining (&optional today-only)
- "Return a 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. This argument only makes
-a difference if `timeclock-relative' is non-nil."
- (- (timeclock-find-discrep today-only)))
-
-(defun timeclock-currently-in-p ()
+(defsubst timeclock-currently-in-p ()
"Return non-nil if the user is currently clocked in."
(equal (car timeclock-last-event) "i"))
(timeclock-workday-remaining today-only)
show-seconds t)))
(if (interactive-p)
- (message string)
+ (message "%s" string)
string)))
-(defun timeclock-workday-elapsed (&optional relative)
- "Return a the number of seconds worked so far today.
+(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."
- (+ timeclock-workday
- (timeclock-find-discrep (not relative))))
+ (let ((discrep (timeclock-find-discrep)))
+ (if discrep
+ (nth 2 discrep)
+ 0.0)))
;;;###autoload
-(defun timeclock-workday-elapsed-string (&optional show-seconds
- relative)
+(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 relative)
- show-seconds)))
+ (let ((string (timeclock-seconds-to-string (timeclock-workday-elapsed)
+ show-seconds)))
(if (interactive-p)
- (message string)
+ (message "%s" string)
string)))
-(defun timeclock-when-to-leave (&optional today-only)
- "Return a time value representing at when the workday ends today.
+(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. This argument only makes
-a difference if `timeclock-relative' is non-nil."
+the time worked today, and not to past time."
(timeclock-seconds-to-time
(- (timeclock-time-to-seconds (current-time))
- (timeclock-find-discrep today-only))))
+ (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 at what time the workday ends today.
+ "Return a string representing the end of today's workday.
This string is relative to the value of `timeclock-workday'. If
-NO-MESSAGE is non-nil, no messages will be displayed in the
-minibuffer. 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.
-This argument only makes a difference if `timeclock-relative' is
-non-nil."
+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
(format-time-string "%-I:%M:%S %p" then)
(format-time-string "%-I:%M %p" then))))
(if (interactive-p)
- (message string)
+ (message "%s" 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."
- (completing-read (format "Clock into which project (default \"%s\"): "
- (or timeclock-last-project
- (car timeclock-project-list)))
- (mapcar 'list timeclock-project-list)
- nil nil nil nil (or timeclock-last-project
- (car timeclock-project-list))))
+ (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."
- (completing-read "Reason for clocking out: "
- (mapcar 'list timeclock-reason-list)))
+ (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."
+ "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))
- (last-in (equal (car timeclock-last-event) "i")))
+ (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)))
(run-hooks 'timeclock-day-over-hook))
(setq timeclock-mode-string
- (format " %c%s%c"
- (if last-in ?< ?[)
- (timeclock-seconds-to-string remainder nil t)
- (if last-in ?> ?])))))
+ (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 \"out\" events specify a project."
- (save-excursion
- (set-buffer (find-file-noselect timeclock-file))
+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"))
timeclock-last-period)))
(setq timeclock-last-event (list code now project)))
(save-buffer)
- (run-hooks 'timeclock-event-hook)))
+ (run-hooks 'timeclock-event-hook)
+ (kill-buffer (current-buffer))))
-(defun timeclock-read-moment ()
- "Read the moment under point from the timelog."
- (save-excursion
- (beginning-of-line)
- (let ((eol (save-excursion (end-of-line) (point))))
- (if (re-search-forward
- (concat "^\\(.\\)\\s-+"
- "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+"
- "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\s-*"
- "\\(.*\\)") eol t)
- (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-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)))
+(defvar timeclock-moment-regexp
+ (concat "\\([bhioO]\\)\\s-+"
+ "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+"
+ "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)[ \t]*" "\\([^\n]*\\)"))
-(defun 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))))
-
-(defun timeclock-time-to-date (time)
- "Convert the TIME value to a textual date string."
- (format-time-string "%Y/%m/%d" time))
+(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.
(cadr timeclock-last-event)))
timeclock-last-period))
-(defun timeclock-find-discrep (&optional today-only)
- "Find overall discrepancy from `timeclock-workday' (in seconds).
-If TODAY-ONLY is non-nil, the discrepancy will be not be relative, and
-will correspond only to the amount of time elapsed today. This is
-identical to what would be return if `timeclock-relative' were nil."
- (let* ((now (current-time)) (first t)
+(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))
- accum event beg last-date
- last-date-limited last-date-seconds avg)
+ 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
- (setq timeclock-project-list nil
- timeclock-last-project nil
- timeclock-reason-list nil)
- (save-excursion
- (set-buffer (find-file-noselect timeclock-file))
- (goto-char (point-min))
- (setq accum 0)
- (setq timeclock-elapsed 0)
- (while (setq event (timeclock-read-moment))
- (cond ((equal (car event) "h")
- (setq last-date-limited
- (timeclock-time-to-date (cadr event))
- last-date-seconds
- (string-to-number (nth 2 event))))
- ((equal (car event) "i")
- (when (and (nth 2 event)
+ (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-project-list (nth 2 event))
- (setq timeclock-last-project (nth 2 event)))
- (let ((date (timeclock-time-to-date (cadr event))))
- (if (and last-date
- timeclock-relative
- (not (equal date last-date)))
- (setq accum (- accum
- (if last-date-limited
- last-date-seconds
- timeclock-workday)))
- (unless (or last-date (not 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
+ (add-to-list 'timeclock-reason-list (nth 2 event)))
+ (if (not 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 (or timeclock-relative
- (equal last-date todays-date))
- (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)))
- (setq accum (if today-only
- timeclock-elapsed
- timeclock-discrepancy))
+ (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")
- (setq accum (+ accum (timeclock-last-period now)))
+ (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)))))
- (setq accum
- (- accum
- (if (and timeclock-last-event
- (equal (timeclock-time-to-date
- (cadr timeclock-last-event))
- (timeclock-time-to-date now)))
- timeclock-last-event-workday
- timeclock-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)
(if (file-readable-p timeclock-file)
(timeclock-reread-log))
+;;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40
;;; timeclock.el ends here