diff options
| -rw-r--r-- | etc/NEWS | 7 | ||||
| -rw-r--r-- | lisp/ChangeLog | 15 | ||||
| -rw-r--r-- | lisp/calendar/timeclock.el | 759 | ||||
| -rw-r--r-- | src/ChangeLog | 5 |
4 files changed, 785 insertions, 1 deletions
| @@ -1105,7 +1105,12 @@ the buffer, just like for the local files. | |||
| 1105 | 1105 | ||
| 1106 | ** New modes and packages | 1106 | ** New modes and packages |
| 1107 | 1107 | ||
| 1108 | *** THe new package hi-lock.el, text matching interactively entered | 1108 | *** The new package timeclock.el is a mode is for keeping track of time |
| 1109 | intervals. You can use it for whatever purpose you like, but the | ||
| 1110 | typical scenario is to keep track of how much time you spend working | ||
| 1111 | on certain projects. | ||
| 1112 | |||
| 1113 | *** The new package hi-lock.el, text matching interactively entered | ||
| 1109 | regexp's can be highlighted. For example, | 1114 | regexp's can be highlighted. For example, |
| 1110 | 1115 | ||
| 1111 | M-x highlight-regexp RET clearly RET RET | 1116 | M-x highlight-regexp RET clearly RET RET |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2bd0fec2463..b38ea208a98 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,18 @@ | |||
| 1 | 2000-08-14 Gerd Moellmann <gerd@gnu.org> | ||
| 2 | |||
| 3 | * calendar/timeclock.el: New file. | ||
| 4 | |||
| 5 | 2000-08-14 David Ponce <david@dponce.com> | ||
| 6 | |||
| 7 | * recentf.el (recent-dialog-mode-map): Bind down-mouse-1 to | ||
| 8 | `widget-button-click'. so that one can use left mouse button to | ||
| 9 | click on dialog buttons. | ||
| 10 | |||
| 11 | 2000-08-14 Emmanuel Briot <briot@gnat.com> | ||
| 12 | |||
| 13 | * xml.el (xml-parse-tag, xml-parse-attlist): Do not downcase | ||
| 14 | identifiers, since XML is case sensitive | ||
| 15 | |||
| 1 | 2000-08-12 Miles Bader <miles@gnu.org> | 16 | 2000-08-12 Miles Bader <miles@gnu.org> |
| 2 | 17 | ||
| 3 | * comint.el (comint-output-filter): Don't bother frobbing | 18 | * comint.el (comint-output-filter): Don't bother frobbing |
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el new file mode 100644 index 00000000000..afab61a977c --- /dev/null +++ b/lisp/calendar/timeclock.el | |||
| @@ -0,0 +1,759 @@ | |||
| 1 | ;;; timeclock.el --- mode for keeping track of how much you work | ||
| 2 | |||
| 3 | ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: John Wiegley <johnw@gnu.org> | ||
| 6 | ;; Created: 25 Mar 1999 | ||
| 7 | ;; Version: 2.2 | ||
| 8 | ;; Keywords: calendar data | ||
| 9 | ;; X-URL: http://www.emacs.org/~johnw/emacs.html | ||
| 10 | |||
| 11 | ;; This file is part of GNU Emacs. | ||
| 12 | |||
| 13 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 14 | ;; it under the terms of the GNU General Public License as published by | ||
| 15 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 16 | ;; any later version. | ||
| 17 | |||
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 21 | ;; GNU General Public License for more details. | ||
| 22 | |||
| 23 | ;; You should have received a copy of the GNU General Public License | ||
| 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 25 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 26 | ;; Boston, MA 02111-1307, USA. | ||
| 27 | |||
| 28 | ;;; Commentary: | ||
| 29 | |||
| 30 | ;; This mode is for keeping track of time intervals. You can use it | ||
| 31 | ;; for whatever purpose you like, but the typical scenario is to keep | ||
| 32 | ;; track of how much time you spend working on certain projects. | ||
| 33 | ;; | ||
| 34 | ;; Use `timeclock-in' when you start on a project, and `timeclock-out' | ||
| 35 | ;; when you're done. Once you've collected some data, you can use | ||
| 36 | ;; `timeclock-workday-remaining' to see how much time is left to be | ||
| 37 | ;; worked today (assuming a typical average of 8 hours a day), and | ||
| 38 | ;; `timeclock-when-to-leave' which will calculate when you're free. | ||
| 39 | |||
| 40 | ;; You'll probably want to bind the timeclock commands to some handy | ||
| 41 | ;; keystrokes. At the moment, C-x t is unused in Emacs 20: | ||
| 42 | ;; | ||
| 43 | ;; (require 'timeclock) | ||
| 44 | ;; | ||
| 45 | ;; (define-key ctl-x-map "ti" 'timeclock-in) | ||
| 46 | ;; (define-key ctl-x-map "to" 'timeclock-out) | ||
| 47 | ;; (define-key ctl-x-map "tc" 'timeclock-change) | ||
| 48 | ;; (define-key ctl-x-map "tr" 'timeclock-reread-log) | ||
| 49 | ;; (define-key ctl-x-map "tu" 'timeclock-update-modeline) | ||
| 50 | ;; (define-key ctl-x-map "tw" 'timeclock-when-to-leave-string) | ||
| 51 | |||
| 52 | ;; If you want Emacs to display the amount of time "left" to your | ||
| 53 | ;; workday in the modeline, you can either set the value of | ||
| 54 | ;; `timeclock-modeline-display' to t using M-x customize, or you | ||
| 55 | ;; can add this code to your .emacs file: | ||
| 56 | ;; | ||
| 57 | ;; (require 'timeclock) | ||
| 58 | ;; (timeclock-modeline-display) | ||
| 59 | ;; | ||
| 60 | ;; To cancel this modeline display at any time, just call | ||
| 61 | ;; `timeclock-modeline-display' again. | ||
| 62 | |||
| 63 | ;; You may also want Emacs to ask you before exiting, if you are | ||
| 64 | ;; current working on a project. This can be done either by setting | ||
| 65 | ;; `timeclock-ask-before-exiting' to t using M-x customize (this is | ||
| 66 | ;; the default), or by adding the following to your .emacs file: | ||
| 67 | ;; | ||
| 68 | ;; (add-hook 'kill-emacs-hook 'timeclock-query-out) | ||
| 69 | |||
| 70 | ;; NOTE: If you change your .timelog file without using timeclock's | ||
| 71 | ;; functions, or if you change the value of any of timeclock's | ||
| 72 | ;; customizable variables, you should run the command | ||
| 73 | ;; `timeclock-reread-log'. This will recompute any discrepancies in | ||
| 74 | ;; your average working time, and will make sure that the various | ||
| 75 | ;; display functions return the correct value. | ||
| 76 | |||
| 77 | ;;; History: | ||
| 78 | |||
| 79 | ;;; Code: | ||
| 80 | |||
| 81 | (defgroup timeclock nil | ||
| 82 | "Keeping track time of the time that gets spent." | ||
| 83 | :group 'data) | ||
| 84 | |||
| 85 | ;;; User Variables: | ||
| 86 | |||
| 87 | (defcustom timeclock-file "~/.timelog" | ||
| 88 | "*The file used to store timeclock data in." | ||
| 89 | :type 'file | ||
| 90 | :group 'timeclock) | ||
| 91 | |||
| 92 | (defcustom timeclock-workday (* 8 60 60) | ||
| 93 | "*The length of a work period." | ||
| 94 | :type 'integer | ||
| 95 | :group 'timeclock) | ||
| 96 | |||
| 97 | (defcustom timeclock-relative t | ||
| 98 | "*When reporting time, make it relative to `timeclock-workday'? | ||
| 99 | For example, if the length of a normal workday is eight hours, and you | ||
| 100 | work four hours on Monday, then the amount of time \"remaining\" on | ||
| 101 | Tuesday is twelve hours -- relative to an averaged work period of | ||
| 102 | eight hours -- or eight hours, non-relative. So relative time takes | ||
| 103 | into account any discrepancy of time under-worked or overworked on | ||
| 104 | previous days." | ||
| 105 | :type 'boolean | ||
| 106 | :group 'timeclock) | ||
| 107 | |||
| 108 | (defcustom timeclock-get-project-function 'timeclock-ask-for-project | ||
| 109 | "*The function used to determine the name of the current project. | ||
| 110 | When clocking in, and no project is specified, this function will be | ||
| 111 | called to determine what the current project to be worked on is. | ||
| 112 | If this variable is nil, no questions will be asked." | ||
| 113 | :type 'function | ||
| 114 | :group 'timeclock) | ||
| 115 | |||
| 116 | (defcustom timeclock-get-reason-function 'timeclock-ask-for-reason | ||
| 117 | "*A function used to determine the reason for clocking out. | ||
| 118 | When clocking out, and no reason is specified, this function will be | ||
| 119 | called to determine what the reason is. | ||
| 120 | If this variable is nil, no questions will be asked." | ||
| 121 | :type 'function | ||
| 122 | :group 'timeclock) | ||
| 123 | |||
| 124 | (defcustom timeclock-get-workday-function nil | ||
| 125 | "*A function used to determine the length of today's workday. | ||
| 126 | The first time that a user clocks in each day, this function will be | ||
| 127 | called to determine what the length of the current workday is. If | ||
| 128 | nil, or equal to `timeclock-workday', nothing special will be done. | ||
| 129 | If it is a quantity different from `timeclock-workday', however, a | ||
| 130 | record will be output to the timelog file to note the fact that that | ||
| 131 | day has a different length from the norm." | ||
| 132 | :type 'function | ||
| 133 | :group 'timeclock) | ||
| 134 | |||
| 135 | (defcustom timeclock-ask-before-exiting t | ||
| 136 | "*If non-nil, ask if the user wants to clock out before exiting Emacs." | ||
| 137 | :set (lambda (symbol value) | ||
| 138 | (if value | ||
| 139 | (add-hook 'kill-emacs-hook 'timeclock-query-out) | ||
| 140 | (remove-hook 'kill-emacs-hook 'timeclock-query-out)) | ||
| 141 | (setq timeclock-ask-before-exiting value)) | ||
| 142 | :type 'boolean | ||
| 143 | :group 'timeclock) | ||
| 144 | |||
| 145 | (defvar timeclock-update-timer nil | ||
| 146 | "The timer used to update `timeclock-mode-string'.") | ||
| 147 | |||
| 148 | (defcustom timeclock-use-display-time t | ||
| 149 | "*If non-nil, use `display-time-hook' for doing modeline updates. | ||
| 150 | The advantage to this is that it means one less timer has to be set | ||
| 151 | running amok in Emacs' process space. The disadvantage is that it | ||
| 152 | requires you to have `display-time' running. If you don't want to use | ||
| 153 | `display-time', but still want the modeline to show how much time is | ||
| 154 | left, set this variable to nil. You will need to restart Emacs (or | ||
| 155 | toggle the value of `timeclock-modeline-display') for the change to | ||
| 156 | take effect." | ||
| 157 | :set (lambda (symbol value) | ||
| 158 | (let ((currently-displaying | ||
| 159 | (and (boundp 'timeclock-modeline-display) | ||
| 160 | timeclock-modeline-display))) | ||
| 161 | ;; if we're changing to the state that | ||
| 162 | ;; `timeclock-modeline-display' is already using, don't | ||
| 163 | ;; bother toggling it. This happens on the initial loading | ||
| 164 | ;; of timeclock.el. | ||
| 165 | (if (and currently-displaying | ||
| 166 | (or (and value | ||
| 167 | (boundp 'display-time-hook) | ||
| 168 | (memq 'timeclock-update-modeline | ||
| 169 | display-time-hook)) | ||
| 170 | (and (not value) | ||
| 171 | timeclock-update-timer))) | ||
| 172 | (setq currently-displaying nil)) | ||
| 173 | (and currently-displaying | ||
| 174 | (set-variable timeclock-modeline-display nil)) | ||
| 175 | (setq timeclock-use-display-time value) | ||
| 176 | (and currently-displaying | ||
| 177 | (set-variable timeclock-modeline-display t)) | ||
| 178 | timeclock-use-display-time)) | ||
| 179 | :type 'boolean | ||
| 180 | :group 'timeclock | ||
| 181 | :require 'time) | ||
| 182 | |||
| 183 | (defcustom timeclock-first-in-hook nil | ||
| 184 | "*A hook run for the first \"in\" event each day. | ||
| 185 | Note that this hook is run before recording any events. Thus the | ||
| 186 | value of `timeclock-hours-today', `timeclock-last-event' and the | ||
| 187 | return value of function `timeclock-last-period' are relative previous | ||
| 188 | to today." | ||
| 189 | :type 'hook | ||
| 190 | :group 'timeclock) | ||
| 191 | |||
| 192 | (defcustom timeclock-load-hook nil | ||
| 193 | "*Hook that gets run after timeclock has been loaded." | ||
| 194 | :type 'hook | ||
| 195 | :group 'timeclock) | ||
| 196 | |||
| 197 | (defcustom timeclock-in-hook nil | ||
| 198 | "*A hook run every time an \"in\" event is recorded." | ||
| 199 | :type 'hook | ||
| 200 | :group 'timeclock) | ||
| 201 | |||
| 202 | (defcustom timeclock-day-over-hook nil | ||
| 203 | "*A hook that is run when the workday has been completed. | ||
| 204 | This hook is only run if the current time remaining is being display | ||
| 205 | in the modeline. See the variable `timeclock-modeline-display'." | ||
| 206 | :type 'hook | ||
| 207 | :group 'timeclock) | ||
| 208 | |||
| 209 | (defcustom timeclock-out-hook nil | ||
| 210 | "*A hook run every time an \"out\" event is recorded." | ||
| 211 | :type 'hook | ||
| 212 | :group 'timeclock) | ||
| 213 | |||
| 214 | (defcustom timeclock-done-hook nil | ||
| 215 | "*A hook run every time a project is marked as completed." | ||
| 216 | :type 'hook | ||
| 217 | :group 'timeclock) | ||
| 218 | |||
| 219 | (defcustom timeclock-event-hook nil | ||
| 220 | "*A hook run every time any event is recorded." | ||
| 221 | :type 'hook | ||
| 222 | :group 'timeclock) | ||
| 223 | |||
| 224 | (defvar timeclock-last-event nil | ||
| 225 | "A list containing the last event that was recorded. | ||
| 226 | The format of this list is (CODE TIME PROJECT). PROJECT will be | ||
| 227 | non-nil only if CODE is \"o\" or \"O\".") | ||
| 228 | |||
| 229 | (defvar timeclock-last-event-workday nil | ||
| 230 | "The number of seconds in the workday of `timeclock-last-event'.") | ||
| 231 | |||
| 232 | ;;; Internal Variables: | ||
| 233 | |||
| 234 | (defvar timeclock-discrepancy nil | ||
| 235 | "A variable containing the time discrepancy before the last event. | ||
| 236 | Normally, timeclock assumes that you intend to work for | ||
| 237 | `timeclock-workday' seconds every day. Any days in which you work | ||
| 238 | more or less than this amount is considered either a positive or | ||
| 239 | negative discrepancy. If you work in such a manner that the | ||
| 240 | discrepancy is always brought back to zero, then you will by | ||
| 241 | definition have worked an average amount equal to `timeclock-workday' | ||
| 242 | each day.") | ||
| 243 | |||
| 244 | (defvar timeclock-elapsed nil | ||
| 245 | "A variable containing the time elapsed for complete periods today. | ||
| 246 | This value is not accurate enough to be useful by itself. Rather, | ||
| 247 | call `timeclock-workday-elapsed', to determine how much time has been | ||
| 248 | worked so far today. Also, if `timeclock-relative' is nil, this value | ||
| 249 | will be the same as `timeclock-discrepancy'.") | ||
| 250 | |||
| 251 | (defvar timeclock-last-period nil | ||
| 252 | "Integer representing the number of seconds in the last period. | ||
| 253 | Note that you shouldn't access this value, but should use the function | ||
| 254 | `timeclock-last-period' instead.") | ||
| 255 | |||
| 256 | (defvar timeclock-mode-string nil | ||
| 257 | "The timeclock string (optionally) displayed in the modeline.") | ||
| 258 | |||
| 259 | (defvar timeclock-day-over nil | ||
| 260 | "The date of the last day when notified \"day over\" for.") | ||
| 261 | |||
| 262 | ;;; User Functions: | ||
| 263 | |||
| 264 | ;;;###autoload | ||
| 265 | (defun timeclock-modeline-display (&optional arg) | ||
| 266 | "Toggle display of the amount of time left today in the modeline. | ||
| 267 | If `timeclock-use-display-time' is non-nil, the modeline will be | ||
| 268 | updated whenever the time display is updated. Otherwise, the | ||
| 269 | timeclock will use its own sixty second timer to do its updating. | ||
| 270 | With prefix ARG, turn modeline display on if and only if ARG is | ||
| 271 | positive. Returns the new status of timeclock modeline display | ||
| 272 | \(non-nil means on)." | ||
| 273 | (interactive "P") | ||
| 274 | (let ((on-p (if arg | ||
| 275 | (> (prefix-numeric-value arg) 0) | ||
| 276 | (not timeclock-modeline-display)))) | ||
| 277 | (if on-p | ||
| 278 | (let ((list-entry (memq 'global-mode-string | ||
| 279 | mode-line-format))) | ||
| 280 | (unless (memq 'timeclock-mode-string mode-line-format) | ||
| 281 | (setcdr list-entry | ||
| 282 | (cons 'timeclock-mode-string | ||
| 283 | (cdr list-entry)))) | ||
| 284 | (unless (memq 'timeclock-update-modeline timeclock-event-hook) | ||
| 285 | (add-hook 'timeclock-event-hook 'timeclock-update-modeline)) | ||
| 286 | (when timeclock-update-timer | ||
| 287 | (cancel-timer timeclock-update-timer) | ||
| 288 | (setq timeclock-update-timer nil)) | ||
| 289 | (if (boundp 'display-time-hook) | ||
| 290 | (remove-hook 'display-time-hook 'timeclock-update-modeline)) | ||
| 291 | (if timeclock-use-display-time | ||
| 292 | (add-hook 'display-time-hook 'timeclock-update-modeline) | ||
| 293 | (setq timeclock-update-timer | ||
| 294 | (run-at-time nil 60 'timeclock-update-modeline)))) | ||
| 295 | (setq mode-line-format | ||
| 296 | (delq 'timeclock-mode-string mode-line-format)) | ||
| 297 | (remove-hook 'timeclock-event-hook 'timeclock-update-modeline) | ||
| 298 | (if (boundp 'display-time-hook) | ||
| 299 | (remove-hook 'display-time-hook | ||
| 300 | 'timeclock-update-modeline)) | ||
| 301 | (when timeclock-update-timer | ||
| 302 | (cancel-timer timeclock-update-timer) | ||
| 303 | (setq timeclock-update-timer nil))) | ||
| 304 | (force-mode-line-update) | ||
| 305 | on-p)) | ||
| 306 | |||
| 307 | ;; This has to be here so that the function definition of | ||
| 308 | ;; `timeclock-modeline-display' is known to the "set" function. | ||
| 309 | (defcustom timeclock-modeline-display nil | ||
| 310 | "Toggle modeline display of time remaining. | ||
| 311 | You must modify via \\[customize] for this variable to have an effect." | ||
| 312 | :set (lambda (symbol value) | ||
| 313 | (setq timeclock-modeline-display | ||
| 314 | (timeclock-modeline-display (or value 0)))) | ||
| 315 | :type 'boolean | ||
| 316 | :group 'timeclock | ||
| 317 | :require 'timeclock) | ||
| 318 | |||
| 319 | ;;;###autoload | ||
| 320 | (defun timeclock-in (&optional arg project find-project) | ||
| 321 | "Clock in, recording the current time moment in the timelog. | ||
| 322 | With a numeric prefix ARG, record the fact that today has only that | ||
| 323 | many hours in it to be worked. If arg is a non-numeric prefix arg | ||
| 324 | \(non-nil, but not a number), 0 is assumed (working on a holiday or | ||
| 325 | weekend). *If not called interactively, ARG should be the number of | ||
| 326 | _seconds_ worked today*. This feature only has effect the first time | ||
| 327 | this function is called within a day. | ||
| 328 | |||
| 329 | PROJECT as the project being clocked into. If PROJECT is nil, and | ||
| 330 | FIND-PROJECT is non-nil -- or the user calls `timeclock-in' | ||
| 331 | interactively -- call the function `timeclock-get-project-function' to | ||
| 332 | discover the name of the project." | ||
| 333 | (interactive | ||
| 334 | (list (and current-prefix-arg | ||
| 335 | (if (numberp current-prefix-arg) | ||
| 336 | (* current-prefix-arg 60 60) | ||
| 337 | 0)))) | ||
| 338 | (if (equal (car timeclock-last-event) "i") | ||
| 339 | (error "You've already clocked in!") | ||
| 340 | (unless timeclock-last-event | ||
| 341 | (timeclock-reread-log)) | ||
| 342 | (unless (equal (timeclock-time-to-date | ||
| 343 | (cadr timeclock-last-event)) | ||
| 344 | (timeclock-time-to-date (current-time))) | ||
| 345 | (let ((workday (or (and (numberp arg) arg) | ||
| 346 | (and arg 0) | ||
| 347 | (and timeclock-get-workday-function | ||
| 348 | (funcall timeclock-get-workday-function)) | ||
| 349 | timeclock-workday))) | ||
| 350 | (run-hooks 'timeclock-first-in-hook) | ||
| 351 | ;; settle the discrepancy for the new day | ||
| 352 | (setq timeclock-discrepancy | ||
| 353 | (- timeclock-discrepancy workday)) | ||
| 354 | (if (not (= workday timeclock-workday)) | ||
| 355 | (timeclock-log "h" (and (numberp arg) | ||
| 356 | (number-to-string arg)))))) | ||
| 357 | (timeclock-log "i" (or project | ||
| 358 | (and timeclock-get-project-function | ||
| 359 | (or find-project (interactive-p)) | ||
| 360 | (funcall timeclock-get-project-function)))) | ||
| 361 | (run-hooks 'timeclock-in-hook))) | ||
| 362 | |||
| 363 | ;;;###autoload | ||
| 364 | (defun timeclock-out (&optional arg reason find-reason) | ||
| 365 | "Clock out, recording the current time moment in the timelog. | ||
| 366 | If a prefix ARG is given, the user has completed the project that was | ||
| 367 | begun during the last time segment. | ||
| 368 | |||
| 369 | REASON is the user's reason for clocking out. If REASON is nil, and | ||
| 370 | FIND-REASON is non-nil -- or the user calls `timeclock-out' | ||
| 371 | interactively -- call the function `timeclock-get-reason-function' to | ||
| 372 | discover the reason." | ||
| 373 | (interactive "P") | ||
| 374 | (if (equal (downcase (car timeclock-last-event)) "o") | ||
| 375 | (error "You've already clocked out!") | ||
| 376 | (timeclock-log | ||
| 377 | (if arg "O" "o") | ||
| 378 | (or reason | ||
| 379 | (and timeclock-get-reason-function | ||
| 380 | (or find-reason (interactive-p)) | ||
| 381 | (funcall timeclock-get-reason-function)))) | ||
| 382 | (run-hooks 'timeclock-out-hook) | ||
| 383 | (if arg | ||
| 384 | (run-hooks 'timeclock-done-hook)))) | ||
| 385 | |||
| 386 | ;;;###autoload | ||
| 387 | (defun timeclock-status-string (&optional show-seconds today-only) | ||
| 388 | "Report the overall timeclock status at the present moment." | ||
| 389 | (interactive "P") | ||
| 390 | (let* ((remainder (timeclock-workday-remaining)) | ||
| 391 | (last-in (equal (car timeclock-last-event) "i")) | ||
| 392 | status) | ||
| 393 | (setq status | ||
| 394 | (format "Currently %s since %s (%s), %s %s, leave at %s" | ||
| 395 | (if last-in "IN" "OUT") | ||
| 396 | (if show-seconds | ||
| 397 | (format-time-string "%-I:%M:%S %p" | ||
| 398 | (nth 1 timeclock-last-event)) | ||
| 399 | (format-time-string "%-I:%M %p" | ||
| 400 | (nth 1 timeclock-last-event))) | ||
| 401 | (or (nth 2 timeclock-last-event) | ||
| 402 | (if last-in "**UNKNOWN**" "workday over")) | ||
| 403 | (timeclock-seconds-to-string remainder show-seconds t) | ||
| 404 | (if (> remainder 0) | ||
| 405 | "remaining" "over") | ||
| 406 | (timeclock-when-to-leave-string show-seconds today-only))) | ||
| 407 | (if (interactive-p) | ||
| 408 | (message status) | ||
| 409 | status))) | ||
| 410 | |||
| 411 | ;;;###autoload | ||
| 412 | (defun timeclock-change (&optional arg project) | ||
| 413 | "Change to working on a different project, by clocking in then out. | ||
| 414 | With a prefix ARG, consider the previous project as having been | ||
| 415 | finished at the time of changeover. PROJECT is the name of the last | ||
| 416 | project you were working on." | ||
| 417 | (interactive "P") | ||
| 418 | (timeclock-out arg) | ||
| 419 | (timeclock-in nil project (interactive-p))) | ||
| 420 | |||
| 421 | ;;;###autoload | ||
| 422 | (defun timeclock-query-out () | ||
| 423 | "Ask the user before clocking out. | ||
| 424 | This is a useful function for adding to `kill-emacs-hook'." | ||
| 425 | (if (and (equal (car timeclock-last-event) "i") | ||
| 426 | (y-or-n-p "You're currently clocking time, clock out? ")) | ||
| 427 | (timeclock-out))) | ||
| 428 | |||
| 429 | ;;;###autoload | ||
| 430 | (defun timeclock-reread-log () | ||
| 431 | "Re-read the timeclock, to account for external changes. | ||
| 432 | Returns the new value of `timeclock-discrepancy'." | ||
| 433 | (interactive) | ||
| 434 | (setq timeclock-discrepancy nil) | ||
| 435 | (timeclock-find-discrep) | ||
| 436 | (if timeclock-modeline-display | ||
| 437 | (timeclock-update-modeline)) | ||
| 438 | timeclock-discrepancy) | ||
| 439 | |||
| 440 | (defun timeclock-seconds-to-string (seconds &optional show-seconds | ||
| 441 | reverse-leader) | ||
| 442 | "Convert SECONDS into a compact time string. | ||
| 443 | If SHOW-SECONDS is non-nil, make the resolution of the return string | ||
| 444 | include the second count. If REVERSE-LEADER is non-nil, it means to | ||
| 445 | output a \"+\" if the time value is negative, rather than a \"-\". | ||
| 446 | This is used when negative time values have an inverted meaning (such | ||
| 447 | as with time remaining, where negative time really means overtime)." | ||
| 448 | (if show-seconds | ||
| 449 | (format "%s%d:%02d:%02d" | ||
| 450 | (if (< seconds 0) (if reverse-leader "+" "-") "") | ||
| 451 | (truncate (/ (abs seconds) 60 60)) | ||
| 452 | (% (truncate (/ (abs seconds) 60)) 60) | ||
| 453 | (% (truncate (abs seconds)) 60)) | ||
| 454 | (format "%s%d:%02d" | ||
| 455 | (if (< seconds 0) (if reverse-leader "+" "-") "") | ||
| 456 | (truncate (/ (abs seconds) 60 60)) | ||
| 457 | (% (truncate (/ (abs seconds) 60)) 60)))) | ||
| 458 | |||
| 459 | (defun timeclock-workday-remaining (&optional today-only) | ||
| 460 | "Return a the number of seconds until the workday is complete. | ||
| 461 | The amount returned is relative to the value of `timeclock-workday'. | ||
| 462 | If TODAY-ONLY is non-nil, the value returned will be relative only to | ||
| 463 | the time worked today, and not to past time. This argument only makes | ||
| 464 | a difference if `timeclock-relative' is non-nil." | ||
| 465 | (- (timeclock-find-discrep today-only))) | ||
| 466 | |||
| 467 | (defun timeclock-currently-in-p () | ||
| 468 | "Return non-nil if the user is currently clocked in." | ||
| 469 | (equal (car timeclock-last-event) "i")) | ||
| 470 | |||
| 471 | ;;;###autoload | ||
| 472 | (defun timeclock-workday-remaining-string (&optional show-seconds | ||
| 473 | today-only) | ||
| 474 | "Return a string representing the amount of time left today. | ||
| 475 | Display second resolution if SHOW-SECONDS is non-nil. If TODAY-ONLY | ||
| 476 | is non-nil, the display will be relative only to time worked today. | ||
| 477 | See `timeclock-relative' for more information about the meaning of | ||
| 478 | \"relative to today\"." | ||
| 479 | (interactive) | ||
| 480 | (let ((string (timeclock-seconds-to-string | ||
| 481 | (timeclock-workday-remaining today-only) | ||
| 482 | show-seconds t))) | ||
| 483 | (if (interactive-p) | ||
| 484 | (message string) | ||
| 485 | string))) | ||
| 486 | |||
| 487 | (defun timeclock-workday-elapsed (&optional relative) | ||
| 488 | "Return a the number of seconds worked so far today. | ||
| 489 | If RELATIVE is non-nil, the amount returned will be relative to past | ||
| 490 | time worked. The default is to return only the time that has elapsed | ||
| 491 | so far today." | ||
| 492 | (+ timeclock-workday | ||
| 493 | (timeclock-find-discrep (not relative)))) | ||
| 494 | |||
| 495 | ;;;###autoload | ||
| 496 | (defun timeclock-workday-elapsed-string (&optional show-seconds | ||
| 497 | relative) | ||
| 498 | "Return a string representing the amount of time worked today. | ||
| 499 | Display seconds resolution if SHOW-SECONDS is non-nil. If RELATIVE is | ||
| 500 | non-nil, the amount returned will be relative to past time worked." | ||
| 501 | (interactive) | ||
| 502 | (let ((string (timeclock-seconds-to-string | ||
| 503 | (timeclock-workday-elapsed relative) | ||
| 504 | show-seconds))) | ||
| 505 | (if (interactive-p) | ||
| 506 | (message string) | ||
| 507 | string))) | ||
| 508 | |||
| 509 | (defun timeclock-when-to-leave (&optional today-only) | ||
| 510 | "Return a time value representing at when the workday ends today. | ||
| 511 | If TODAY-ONLY is non-nil, the value returned will be relative only to | ||
| 512 | the time worked today, and not to past time. This argument only makes | ||
| 513 | a difference if `timeclock-relative' is non-nil." | ||
| 514 | (timeclock-seconds-to-time | ||
| 515 | (- (timeclock-time-to-seconds (current-time)) | ||
| 516 | (timeclock-find-discrep today-only)))) | ||
| 517 | |||
| 518 | ;;;###autoload | ||
| 519 | (defun timeclock-when-to-leave-string (&optional show-seconds | ||
| 520 | today-only) | ||
| 521 | "Return a string representing at what time the workday ends today. | ||
| 522 | This string is relative to the value of `timeclock-workday'. If | ||
| 523 | NO-MESSAGE is non-nil, no messages will be displayed in the | ||
| 524 | minibuffer. If SHOW-SECONDS is non-nil, the value printed/returned | ||
| 525 | will include seconds. If TODAY-ONLY is non-nil, the value returned | ||
| 526 | will be relative only to the time worked today, and not to past time. | ||
| 527 | This argument only makes a difference if `timeclock-relative' is | ||
| 528 | non-nil." | ||
| 529 | (interactive) | ||
| 530 | (let* ((then (timeclock-when-to-leave today-only)) | ||
| 531 | (string | ||
| 532 | (if show-seconds | ||
| 533 | (format-time-string "%-I:%M:%S %p" then) | ||
| 534 | (format-time-string "%-I:%M %p" then)))) | ||
| 535 | (if (interactive-p) | ||
| 536 | (message string) | ||
| 537 | string))) | ||
| 538 | |||
| 539 | ;;; Internal Functions: | ||
| 540 | |||
| 541 | (defvar timeclock-project-list nil) | ||
| 542 | (defvar timeclock-last-project nil) | ||
| 543 | |||
| 544 | (defun timeclock-ask-for-project () | ||
| 545 | "Ask the user for the project they are clocking into." | ||
| 546 | (completing-read (format "Clock into which project (default \"%s\"): " | ||
| 547 | (or timeclock-last-project | ||
| 548 | (car timeclock-project-list))) | ||
| 549 | (mapcar 'list timeclock-project-list) | ||
| 550 | nil nil nil nil (or timeclock-last-project | ||
| 551 | (car timeclock-project-list)))) | ||
| 552 | |||
| 553 | (defvar timeclock-reason-list nil) | ||
| 554 | |||
| 555 | (defun timeclock-ask-for-reason () | ||
| 556 | "Ask the user for the reason they are clocking out." | ||
| 557 | (completing-read "Reason for clocking out: " | ||
| 558 | (mapcar 'list timeclock-reason-list))) | ||
| 559 | |||
| 560 | (defun timeclock-update-modeline () | ||
| 561 | "Update the `timeclock-mode-string' displayed in the modeline." | ||
| 562 | (interactive) | ||
| 563 | (let* ((remainder (timeclock-workday-remaining)) | ||
| 564 | (last-in (equal (car timeclock-last-event) "i"))) | ||
| 565 | (when (and (< remainder 0) | ||
| 566 | (not (and timeclock-day-over | ||
| 567 | (equal timeclock-day-over | ||
| 568 | (timeclock-time-to-date | ||
| 569 | (current-time)))))) | ||
| 570 | (setq timeclock-day-over | ||
| 571 | (timeclock-time-to-date (current-time))) | ||
| 572 | (run-hooks 'timeclock-day-over-hook)) | ||
| 573 | (setq timeclock-mode-string | ||
| 574 | (format " %c%s%c" | ||
| 575 | (if last-in ?< ?[) | ||
| 576 | (timeclock-seconds-to-string remainder nil t) | ||
| 577 | (if last-in ?> ?]))))) | ||
| 578 | |||
| 579 | (defun timeclock-log (code &optional project) | ||
| 580 | "Log the event CODE to the timeclock log, at the time of call. | ||
| 581 | If PROJECT is a string, it represents the project which the event is | ||
| 582 | being logged for. Normally only \"out\" events specify a project." | ||
| 583 | (save-excursion | ||
| 584 | (set-buffer (find-file-noselect timeclock-file)) | ||
| 585 | (goto-char (point-max)) | ||
| 586 | (if (not (bolp)) | ||
| 587 | (insert "\n")) | ||
| 588 | (let ((now (current-time))) | ||
| 589 | (insert code " " | ||
| 590 | (format-time-string "%Y/%m/%d %H:%M:%S" now) | ||
| 591 | (or (and project | ||
| 592 | (stringp project) | ||
| 593 | (> (length project) 0) | ||
| 594 | (concat " " project)) | ||
| 595 | "") | ||
| 596 | "\n") | ||
| 597 | (if (equal (downcase code) "o") | ||
| 598 | (setq timeclock-last-period | ||
| 599 | (- (timeclock-time-to-seconds now) | ||
| 600 | (timeclock-time-to-seconds | ||
| 601 | (cadr timeclock-last-event))) | ||
| 602 | timeclock-discrepancy | ||
| 603 | (+ timeclock-discrepancy | ||
| 604 | timeclock-last-period))) | ||
| 605 | (setq timeclock-last-event (list code now project))) | ||
| 606 | (save-buffer) | ||
| 607 | (run-hooks 'timeclock-event-hook))) | ||
| 608 | |||
| 609 | (defun timeclock-read-moment () | ||
| 610 | "Read the moment under point from the timelog." | ||
| 611 | (save-excursion | ||
| 612 | (beginning-of-line) | ||
| 613 | (let ((eol (save-excursion (end-of-line) (point)))) | ||
| 614 | (if (re-search-forward | ||
| 615 | (concat "^\\(.\\)\\s-+" | ||
| 616 | "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)\\s-+" | ||
| 617 | "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\s-*" | ||
| 618 | "\\(.*\\)") eol t) | ||
| 619 | (let ((code (match-string 1)) | ||
| 620 | (year (string-to-number (match-string 2))) | ||
| 621 | (mon (string-to-number (match-string 3))) | ||
| 622 | (mday (string-to-number (match-string 4))) | ||
| 623 | (hour (string-to-number (match-string 5))) | ||
| 624 | (min (string-to-number (match-string 6))) | ||
| 625 | (sec (string-to-number (match-string 7))) | ||
| 626 | (project (match-string 8))) | ||
| 627 | (list code (encode-time sec min hour mday mon year) | ||
| 628 | project)))))) | ||
| 629 | |||
| 630 | (defun timeclock-time-to-seconds (time) | ||
| 631 | "Convert TIME to a floating point number." | ||
| 632 | (+ (* (car time) 65536.0) | ||
| 633 | (cadr time) | ||
| 634 | (/ (or (car (cdr (cdr time))) 0) 1000000.0))) | ||
| 635 | |||
| 636 | (defun timeclock-seconds-to-time (seconds) | ||
| 637 | "Convert SECONDS (a floating point number) to an Emacs time structure." | ||
| 638 | (list (floor seconds 65536) | ||
| 639 | (floor (mod seconds 65536)) | ||
| 640 | (floor (* (- seconds (ffloor seconds)) 1000000)))) | ||
| 641 | |||
| 642 | (defun timeclock-time-to-date (time) | ||
| 643 | "Convert the TIME value to a textual date string." | ||
| 644 | (format-time-string "%Y/%m/%d" time)) | ||
| 645 | |||
| 646 | (defun timeclock-last-period (&optional moment) | ||
| 647 | "Return the value of the last event period. | ||
| 648 | If the last event was a clock-in, the period will be open ended, and | ||
| 649 | growing every second. Otherwise, it is a fixed amount which has been | ||
| 650 | recorded to disk. If MOMENT is non-nil, use that as the current time. | ||
| 651 | This is only provided for coherency when used by | ||
| 652 | `timeclock-discrepancy'." | ||
| 653 | (if (equal (car timeclock-last-event) "i") | ||
| 654 | (- (timeclock-time-to-seconds (or moment (current-time))) | ||
| 655 | (timeclock-time-to-seconds | ||
| 656 | (cadr timeclock-last-event))) | ||
| 657 | timeclock-last-period)) | ||
| 658 | |||
| 659 | (defun timeclock-find-discrep (&optional today-only) | ||
| 660 | "Find overall discrepancy from `timeclock-workday' (in seconds). | ||
| 661 | If TODAY-ONLY is non-nil, the discrepancy will be not be relative, and | ||
| 662 | will correspond only to the amount of time elapsed today. This is | ||
| 663 | identical to what would be return if `timeclock-relative' were nil." | ||
| 664 | (let* ((now (current-time)) (first t) | ||
| 665 | (todays-date (timeclock-time-to-date now)) | ||
| 666 | accum event beg last-date | ||
| 667 | last-date-limited last-date-seconds avg) | ||
| 668 | (unless timeclock-discrepancy | ||
| 669 | (setq timeclock-project-list nil | ||
| 670 | timeclock-last-project nil | ||
| 671 | timeclock-reason-list nil) | ||
| 672 | (save-excursion | ||
| 673 | (set-buffer (find-file-noselect timeclock-file)) | ||
| 674 | (goto-char (point-min)) | ||
| 675 | (setq accum 0) | ||
| 676 | (setq timeclock-elapsed 0) | ||
| 677 | (while (setq event (timeclock-read-moment)) | ||
| 678 | (cond ((equal (car event) "h") | ||
| 679 | (setq last-date-limited | ||
| 680 | (timeclock-time-to-date (cadr event)) | ||
| 681 | last-date-seconds | ||
| 682 | (string-to-number (nth 2 event)))) | ||
| 683 | ((equal (car event) "i") | ||
| 684 | (when (and (nth 2 event) | ||
| 685 | (> (length (nth 2 event)) 0)) | ||
| 686 | (add-to-list 'timeclock-project-list (nth 2 event)) | ||
| 687 | (setq timeclock-last-project (nth 2 event))) | ||
| 688 | (let ((date (timeclock-time-to-date (cadr event)))) | ||
| 689 | (if (and last-date | ||
| 690 | timeclock-relative | ||
| 691 | (not (equal date last-date))) | ||
| 692 | (setq accum (- accum | ||
| 693 | (if last-date-limited | ||
| 694 | last-date-seconds | ||
| 695 | timeclock-workday))) | ||
| 696 | (unless (or last-date (not first)) | ||
| 697 | (setq first nil | ||
| 698 | accum (- accum | ||
| 699 | (if last-date-limited | ||
| 700 | last-date-seconds | ||
| 701 | timeclock-workday))))) | ||
| 702 | (setq last-date date | ||
| 703 | last-date-limited nil) | ||
| 704 | (if beg | ||
| 705 | (error "Error in format of timelog file!") | ||
| 706 | (setq beg (timeclock-time-to-seconds (cadr event)))))) | ||
| 707 | ((equal (downcase (car event)) "o") | ||
| 708 | (if (and (nth 2 event) | ||
| 709 | (> (length (nth 2 event)) 0)) | ||
| 710 | (add-to-list 'timeclock-reason-list (nth 2 event))) | ||
| 711 | (if (or timeclock-relative | ||
| 712 | (equal last-date todays-date)) | ||
| 713 | (if (not beg) | ||
| 714 | (error "Error in format of timelog file!") | ||
| 715 | (setq timeclock-last-period | ||
| 716 | (- (timeclock-time-to-seconds (cadr event)) | ||
| 717 | beg) | ||
| 718 | accum (+ timeclock-last-period accum) | ||
| 719 | beg nil))) | ||
| 720 | (if (equal last-date todays-date) | ||
| 721 | (setq timeclock-elapsed | ||
| 722 | (+ timeclock-last-period timeclock-elapsed))))) | ||
| 723 | (setq timeclock-last-event event | ||
| 724 | timeclock-last-event-workday | ||
| 725 | (if (equal (timeclock-time-to-date now) | ||
| 726 | last-date-limited) | ||
| 727 | last-date-seconds | ||
| 728 | timeclock-workday)) | ||
| 729 | (forward-line)) | ||
| 730 | (setq timeclock-discrepancy accum))) | ||
| 731 | (setq accum (if today-only | ||
| 732 | timeclock-elapsed | ||
| 733 | timeclock-discrepancy)) | ||
| 734 | (if timeclock-last-event | ||
| 735 | (if (equal (car timeclock-last-event) "i") | ||
| 736 | (setq accum (+ accum (timeclock-last-period now))) | ||
| 737 | (if (not (equal (timeclock-time-to-date | ||
| 738 | (cadr timeclock-last-event)) | ||
| 739 | (timeclock-time-to-date now))) | ||
| 740 | (setq accum (- accum timeclock-last-event-workday))))) | ||
| 741 | (setq accum | ||
| 742 | (- accum | ||
| 743 | (if (and timeclock-last-event | ||
| 744 | (equal (timeclock-time-to-date | ||
| 745 | (cadr timeclock-last-event)) | ||
| 746 | (timeclock-time-to-date now))) | ||
| 747 | timeclock-last-event-workday | ||
| 748 | timeclock-workday))))) | ||
| 749 | |||
| 750 | (provide 'timeclock) | ||
| 751 | |||
| 752 | (run-hooks 'timeclock-load-hook) | ||
| 753 | |||
| 754 | ;; make sure we know the list of reasons, projects, and have computed | ||
| 755 | ;; the last event and current discrepancy. | ||
| 756 | (if (file-readable-p timeclock-file) | ||
| 757 | (timeclock-reread-log)) | ||
| 758 | |||
| 759 | ;;; timeclock.el ends here | ||
diff --git a/src/ChangeLog b/src/ChangeLog index 5d6e8ba61e1..93f8c924f15 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2000-08-14 Gerd Moellmann <gerd@gnu.org> | ||
| 2 | |||
| 3 | * keymap.c (push_key_description): If C without modifiers is < 32, | ||
| 4 | make sure to print `C-' before `M-', like in the manual. | ||
| 5 | |||
| 1 | 2000-08-11 Gerd Moellmann <gerd@gnu.org> | 6 | 2000-08-11 Gerd Moellmann <gerd@gnu.org> |
| 2 | 7 | ||
| 3 | * fns.c (hashfn_eq, hashfn_eql): Don't handle strings specially | 8 | * fns.c (hashfn_eq, hashfn_eql): Don't handle strings specially |