;;; 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.3
+;; Version: 2.6
;; Keywords: calendar data
;; 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:
: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 '(choice (const nil) (function-item timeclock-workday) 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)
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))))
-(defsubst 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)))
-
(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)))
-(defsubst 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)))
+(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 at when the workday ends today.
+ "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.
(project (match-string 8)))
(list code (encode-time sec min hour mday mon year) project))))
-(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))))
-
-(defsubst timeclock-time-to-date (time)
- "Convert the TIME value to a textual date string."
- (format-time-string "%Y/%m/%d" time))
-
(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
(defsubst timeclock-day-required (day)
- (car day))
+ (or (car day) timeclock-workday))
(defsubst timeclock-day-length (day)
(timeclock-entry-list-length (cdr day)))
(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:
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 that must be worked. Floating point
- amounts are allowed.
+ 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.
(now (current-time))
(todays-date (timeclock-time-to-date now))
last-date-limited last-date-seconds last-date
- (line 0) last beg day entry)
+ (line 0) last beg day entry event)
(with-temp-buffer
(insert-file-contents (or filename timeclock-file))
(when recent-only
(let ((date (timeclock-time-to-date (cadr event))))
(if (and last-date
(not (equal date last-date)))
- (setcar (cdr log-data)
- (cons (cons last-date day)
- (cadr log-data)))
- (setq day (list (and last-date-limited
- last-date-seconds))))
+ (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")
(nconc day (list entry))
(setq desc (nth 2 entry))
(let ((proj (assoc desc (nth 2 log-data))))
- (if (not proj)
+ (if (null proj)
(setcar (cddr log-data)
(cons (cons desc (list entry))
(car (cddr log-data))))
(cadr log-data))))
log-data)))
-(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."
+(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)
+ (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
- 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)
+ (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 timeclock-relative
- (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
+ (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