;;; timeclock.el --- mode for keeping track of how much you work
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Created: 25 Mar 1999
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
:group 'timeclock)
(defcustom timeclock-workday (* 8 60 60)
- "The length of a work period."
+ "The length of a work period in seconds."
:type 'integer
:group 'timeclock)
(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
+many hours in it to be worked. If ARG is a non-numeric prefix argument
\(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
60 60.0) 60))))))
(timeclock-log "i" (or project
(and timeclock-get-project-function
- (or find-project (interactive-p))
+ (or find-project
+ (called-interactively-p 'interactive))
(funcall timeclock-get-project-function))))
(run-hooks 'timeclock-in-hook)))
(if arg "O" "o")
(or reason
(and timeclock-get-reason-function
- (or find-reason (interactive-p))
+ (or find-reason (called-interactively-p 'interactive))
(funcall timeclock-get-reason-function))))
(run-hooks 'timeclock-out-hook)
(if arg
(if (> remainder 0)
"remaining" "over")
(timeclock-when-to-leave-string show-seconds today-only)))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s" status)
status)))
working on."
(interactive "P")
(timeclock-out arg)
- (timeclock-in nil project (interactive-p)))
+ (timeclock-in nil project (called-interactively-p 'interactive)))
;;;###autoload
(defun timeclock-query-out ()
(let ((string (timeclock-seconds-to-string
(timeclock-workday-remaining today-only)
show-seconds t)))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s" string)
string)))
(interactive)
(let ((string (timeclock-seconds-to-string (timeclock-workday-elapsed)
show-seconds)))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(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)))
+(defalias 'timeclock-time-to-seconds (if (fboundp 'float-time) 'float-time
+ 'time-to-seconds))
-(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))))
+(defalias 'timeclock-seconds-to-time 'seconds-to-time)
;; Should today-only be removed in favour of timeclock-relative? - gm
(defsubst timeclock-when-to-leave (&optional today-only)
(if show-seconds
(format-time-string "%-I:%M:%S %p" then)
(format-time-string "%-I:%M %p" then))))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%s" string)
string)))
OLD-DEFAULT hours are set for every day that has no number indicated."
(interactive "P")
(if old-default (setq old-default (prefix-numeric-value old-default))
- (error "timelog-make-hours-explicit requires an explicit argument"))
+ (error "`timelog-make-hours-explicit' requires an explicit argument"))
(let ((extant-timelog (find-buffer-visiting timeclock-file))
current-date)
(with-current-buffer (find-file-noselect timeclock-file t)
(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."
+ "A version of `completing-read' that works on both Emacs and XEmacs.
+PROMPT, ALIST and DEFAULT are used for the PROMPT, COLLECTION and DEF
+arguments of `completing-read'."
(if (featurep 'xemacs)
(let ((str (completing-read prompt alist)))
- (if (or (null str) (= (length str) 0))
+ (if (or (null str) (zerop (length str)))
default
str))
(completing-read prompt alist nil nil nil nil default)))
timeclock-last-period))
(defsubst timeclock-entry-length (entry)
+ "Return the length of ENTRY in seconds."
(- (timeclock-time-to-seconds (cadr entry))
(timeclock-time-to-seconds (car entry))))
(defsubst timeclock-entry-begin (entry)
+ "Return the start time of ENTRY."
(car entry))
(defsubst timeclock-entry-end (entry)
+ "Return the end time of ENTRY."
(cadr entry))
(defsubst timeclock-entry-project (entry)
+ "Return the project of ENTRY."
(nth 2 entry))
(defsubst timeclock-entry-comment (entry)
+ "Return the comment of ENTRY."
(nth 3 entry))
-
(defsubst timeclock-entry-list-length (entry-list)
+ "Return the total length of ENTRY-LIST in seconds."
(let ((length 0))
- (while entry-list
- (setq length (+ length (timeclock-entry-length (car entry-list))))
- (setq entry-list (cdr entry-list)))
+ (dolist (entry entry-list)
+ (setq length (+ length (timeclock-entry-length entry))))
length))
(defsubst timeclock-entry-list-begin (entry-list)
+ "Return the start time of the first element of ENTRY-LIST."
(timeclock-entry-begin (car entry-list)))
(defsubst timeclock-entry-list-end (entry-list)
+ "Return the end time of the last element of ENTRY-LIST."
(timeclock-entry-end (car (last entry-list))))
(defsubst timeclock-entry-list-span (entry-list)
+ "Return the total time in seconds spanned by 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)
+ "Return the total break time (span - length) in 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)))
+ "Return a list of all the projects in ENTRY-LIST."
+ (let (projects proj)
+ (dolist (entry entry-list)
+ (setq proj (timeclock-entry-project entry))
+ (if projects
+ (add-to-list 'projects proj)
+ (setq projects (list proj))))
projects))
-
(defsubst timeclock-day-required (day)
+ "Return the required length of DAY in seconds, default `timeclock-workday'."
(or (car day) timeclock-workday))
(defsubst timeclock-day-length (day)
+ "Return the actual length of DAY in seconds."
(timeclock-entry-list-length (cdr day)))
(defsubst timeclock-day-debt (day)
+ "Return the debt (required - actual) associated with DAY, in seconds."
(- (timeclock-day-required day)
(timeclock-day-length day)))
(defsubst timeclock-day-begin (day)
+ "Return the start time of DAY."
(timeclock-entry-list-begin (cdr day)))
(defsubst timeclock-day-end (day)
+ "Return the end time of DAY."
(timeclock-entry-list-end (cdr day)))
(defsubst timeclock-day-span (day)
+ "Return the span of DAY."
(timeclock-entry-list-span (cdr day)))
(defsubst timeclock-day-break (day)
+ "Return the total break time of DAY."
(timeclock-entry-list-break (cdr day)))
(defsubst timeclock-day-projects (day)
- (timeclock-entry-list-projects (cdr day)))
+ "Return a list of all the projects in DAY."
+ (timeclock-entry-list-projects (cddr day)))
(defmacro timeclock-day-list-template (func)
+ "Template for summing the result of FUNC on each element of DAY-LIST."
`(let ((length 0))
(while day-list
- (setq length (+ length (,(eval func) (car day-list))))
- (setq day-list (cdr day-list)))
+ (setq length (+ length (,(eval func) (car day-list)))
+ day-list (cdr day-list)))
length))
(defun timeclock-day-list-required (day-list)
+ "Return total required length of DAY-LIST, in seconds."
(timeclock-day-list-template 'timeclock-day-required))
(defun timeclock-day-list-length (day-list)
+ "Return actual length of DAY-LIST, in seconds."
(timeclock-day-list-template 'timeclock-day-length))
(defun timeclock-day-list-debt (day-list)
+ "Return total debt (required - actual) of DAY-LIST."
(timeclock-day-list-template 'timeclock-day-debt))
(defsubst timeclock-day-list-begin (day-list)
+ "Return the start time of DAY-LIST."
(timeclock-day-begin (car day-list)))
(defsubst timeclock-day-list-end (day-list)
+ "Return the end time of DAY-LIST."
(timeclock-day-end (car (last day-list))))
(defun timeclock-day-list-span (day-list)
+ "Return the span of DAY-LIST."
(timeclock-day-list-template 'timeclock-day-span))
(defun timeclock-day-list-break (day-list)
+ "Return the total break of DAY-LIST."
(timeclock-day-list-template 'timeclock-day-break))
(defun timeclock-day-list-projects (day-list)
+ "Return a list of all the projects in 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)))
+ (dolist (day day-list)
+ (dolist (proj (timeclock-day-projects day))
+ (if projects
+ (add-to-list 'projects proj)
+ (setq projects (list proj)))))
projects))
-
(defsubst timeclock-current-debt (&optional log-data)
+ "Return the seconds debt from LOG-DATA, default `timeclock-log-data'."
(nth 0 (or log-data (timeclock-log-data))))
(defsubst timeclock-day-alist (&optional log-data)
+ "Return the date alist from LOG-DATA, default `timeclock-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)))
+ "Return a list of the cdrs of the date alist from LOG-DATA."
+ (let (day-list)
+ (dolist (date-list (timeclock-day-alist log-data))
+ (setq day-list (cons (cdr date-list) day-list)))
day-list))
(defsubst timeclock-project-alist (&optional log-data)
+ "Return the project alist from LOG-DATA, default `timeclock-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
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)
+ (let ((log-data (list 0.0 nil nil))
+ (now (current-time))
+ 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
(if (null proj)
(setcar (cddr log-data)
(cons (cons desc (list entry))
- (car (cddr log-data))))
+ (nth 2 log-data)))
(nconc (cdr proj) (list entry)))))))
(forward-line))
(if day
(let* ((now (current-time))
(todays-date (timeclock-time-to-date now))
(first t) (accum 0) (elapsed 0)
- event beg last-date avg
+ event beg last-date
last-date-limited last-date-seconds)
(unless timeclock-discrepancy
(when (file-readable-p timeclock-file)
"Compute the arithmetic 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)))
+ (dolist (thisl l)
+ (setq total (+ total thisl)
+ count (1+ count)))
+ (if (zerop count)
+ 0
+ (/ total count))))
(defun timeclock-generate-report (&optional html-p)
"Generate a summary report based on the current timelog file.
done)
(if (timeclock-currently-in-p)
(insert "IN")
- (if (or (null project) (= (length project) 0))
+ (if (zerop (length project))
(progn (insert "Done Working Today")
(setq done t))
(insert "OUT")))
(lengths (vector '(0 0) thirty-days-ago three-months-ago
six-months-ago one-year-ago)))
;; collect statistics from complete timelog
- (while day-list
+ (dolist (day day-list)
(let ((i 0) (l 5))
(while (< i l)
(unless (time-less-p
- (timeclock-day-begin (car day-list))
+ (timeclock-day-begin day)
(aref lengths i))
(let ((base (timeclock-time-to-seconds
(timeclock-day-base
- (timeclock-day-begin (car day-list))))))
+ (timeclock-day-begin day)))))
(nconc (aref time-in i)
(list (- (timeclock-time-to-seconds
- (timeclock-day-begin (car day-list)))
+ (timeclock-day-begin day))
base)))
- (let ((span (timeclock-day-span (car day-list)))
- (len (timeclock-day-length (car day-list)))
- (req (timeclock-day-required (car day-list))))
+ (let ((span (timeclock-day-span day))
+ (len (timeclock-day-length day))
+ (req (timeclock-day-required day)))
;; 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
(> (/ (float len) (float span)) 0.70))
(nconc (aref time-out i)
(list (- (timeclock-time-to-seconds
- (timeclock-day-end (car day-list)))
+ (timeclock-day-end day))
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)))
+ (setq i (1+ i)))))
;; average statistics
(let ((i 0) (l 5))
(while (< i l)
(if (file-readable-p timeclock-file)
(timeclock-reread-log))
-;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40
;;; timeclock.el ends here