Mercurial > emacs
diff lisp/calendar/timeclock.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
line wrap: on
line diff
--- a/lisp/calendar/timeclock.el Sun Jan 15 23:02:10 2006 +0000 +++ b/lisp/calendar/timeclock.el Mon Jan 16 00:03:54 2006 +0000 @@ -1,6 +1,7 @@ ;;; timeclock.el --- mode for keeping track of how much you work -;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> ;; Created: 25 Mar 1999 @@ -21,8 +22,8 @@ ;; 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: @@ -33,11 +34,11 @@ ;; 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) ;; @@ -60,11 +61,11 @@ ;; `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 @@ -78,7 +79,7 @@ ;;; 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: @@ -94,20 +95,20 @@ :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) @@ -115,7 +116,7 @@ (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) @@ -123,20 +124,21 @@ (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 +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 different length from the norm." +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) @@ -144,15 +146,20 @@ (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) @@ -200,7 +207,7 @@ (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) @@ -234,7 +241,7 @@ 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.") @@ -244,15 +251,16 @@ 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.") @@ -262,24 +270,25 @@ ;;;###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 (or (memq 'global-mode-string mode-line-format) - ;; In Emacs 21.3 we must use assq - (assq 'global-mode-string mode-line-format)))) - (unless (or (null list-entry) - (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 @@ -288,11 +297,17 @@ (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 @@ -301,7 +316,7 @@ (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. @@ -315,6 +330,10 @@ :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. @@ -325,7 +344,7 @@ _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." @@ -386,13 +405,28 @@ (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") @@ -408,26 +442,29 @@ "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 () @@ -459,19 +496,6 @@ (truncate (/ (abs seconds) 60 60)) (% (truncate (/ (abs seconds) 60)) 60)))) -(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. This argument only makes -a difference if `timeclock-relative' is non-nil." - (let ((discrep (timeclock-find-discrep))) - (if discrep - (if today-only - (- (cadr discrep)) - (- (car discrep))) - 0.0))) - (defsubst timeclock-currently-in-p () "Return non-nil if the user is currently clocked in." (equal (car timeclock-last-event) "i")) @@ -489,7 +513,7 @@ (timeclock-workday-remaining today-only) show-seconds t))) (if (interactive-p) - (message string) + (message "%s" string) string))) (defsubst timeclock-workday-elapsed () @@ -511,14 +535,26 @@ (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)) (let ((discrep (timeclock-find-discrep))) @@ -531,14 +567,12 @@ ;;;###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 @@ -546,7 +580,7 @@ (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: @@ -566,7 +600,7 @@ (defun timeclock-ask-for-project () "Ask the user for the project they are clocking into." (timeclock-completing-read - (format "Clock into which project (default \"%s\"): " + (format "Clock into which project (default %s): " (or timeclock-last-project (car timeclock-project-list))) (mapcar 'list timeclock-project-list) @@ -581,10 +615,12 @@ (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 @@ -594,10 +630,14 @@ (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. @@ -647,22 +687,6 @@ (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 @@ -811,6 +835,11 @@ (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: @@ -825,8 +854,8 @@ 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. @@ -1005,7 +1034,9 @@ log-data))) (defun timeclock-find-discrep () - "Find overall discrepancy from `timeclock-workday' (in seconds)." + "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. @@ -1083,7 +1114,7 @@ (setq timeclock-discrepancy accum)))) (unless timeclock-last-event-workday (setq timeclock-last-event-workday timeclock-workday)) - (setq accum timeclock-discrepancy + (setq accum (or timeclock-discrepancy 0) elapsed (or timeclock-elapsed elapsed)) (if timeclock-last-event (if (equal (car timeclock-last-event) "i") @@ -1099,14 +1130,9 @@ ;;; A reporting function that uses timeclock-log-data -(defun timeclock-time-less-p (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - (defun timeclock-day-base (&optional time) - "Given a time within a day, return 0:0:0 within that day." + "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) @@ -1114,7 +1140,7 @@ (apply 'encode-time decoded))) (defun timeclock-geometric-mean (l) - "Compute the geometric mean of the list L." + "Compute the geometric mean of the values in the list L." (let ((total 0) (count 0)) (while l @@ -1126,7 +1152,9 @@ 0))) (defun timeclock-generate-report (&optional html-p) - "Generate a summary report based on the current timelog file." + "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))) @@ -1157,12 +1185,12 @@ (* 2 7 24 60 60)))) two-week-len today-len) (while proj-data - (if (not (timeclock-time-less-p + (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 (timeclock-time-less-p + (not (time-less-p (timeclock-entry-begin (car proj-data)) two-weeks-ago))) (setq two-week-len (timeclock-entry-list-length proj-data))) @@ -1227,7 +1255,7 @@ (while day-list (let ((i 0) (l 5)) (while (< i l) - (unless (timeclock-time-less-p + (unless (time-less-p (timeclock-day-begin (car day-list)) (aref lengths i)) (let ((base (timeclock-time-to-seconds @@ -1318,7 +1346,7 @@ ;;; A helpful little function (defun timeclock-visit-timelog () - "Open up the .timelog file in another window." + "Open the file named by `timeclock-file' in another window." (interactive) (find-file-other-window timeclock-file)) @@ -1331,4 +1359,5 @@ (if (file-readable-p timeclock-file) (timeclock-reread-log)) +;;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40 ;;; timeclock.el ends here