Download
(eval-when-compile (require 'timezone) (require 'cl))
(defgroup worklog nil
"Keep track of what you do.")
(defcustom worklog-file "~/.worklog"
"Where worklog info should be put."
:type 'file
:group 'worklog)
(defcustom worklog-fill-prefix " "
"Fill prefix to use for worklog mode."
:type 'string
:group 'worklog)
(defcustom worklog-automatic-login t
"Insert an 'login' task automagically if you are not logged in.
While you use `worklog-do-task' to insert a new task worklog will
enter the 'login' task for you.
Because worklog will need to parse your tasks when doing this it will
make task insertion slower. Set to nil by default for backward compatibility"
:type 'boolean
:group 'worklog)
(defcustom worklog-mode-hook nil
"Standard mode hook."
:type 'hook
:group 'worklog)
(defcustom worklog-use-minutes t
"Set to `nil' to express minutes as percentages of hours."
:type 'boolean
:group 'worklog)
(defcustom worklog-summarize-show-totals nil
"Set to `t' to show daily totals in the summary."
:type 'boolean
:group 'worklog)
(defcustom worklog-summarize-show-overall-total t
"Set to `t' to show the total time spent working in the summary."
:type 'boolean
:group 'worklog)
(defcustom worklog-reuse-summary-buffer nil
"Set to t to have worklog just re-use the same buffer for generating
summaries. `nil' (the default) will create a new buffer each time
`worklog-summarize-tasks' is invoked."
:type 'boolean
:group 'worklog)
(defcustom worklog-summarize-tasks-hook nil
"Hook run at the end of `worklog-summarize-tasks'.
The output buffer is current when called."
:type 'hook
:group 'worklog)
(defvar worklog-version "2.4.1"
"Worklog version")
(defvar worklog-mode-map
(let ((m (copy-keymap text-mode-map)))
(define-key m "\C-c\C-c" 'worklog-finish)
(define-key m "\C-c\C-a" 'worklog-add-entry)
(define-key m "\C-c\C-d" 'worklog-kill-entry)
(define-key m "\C-c\C-k" 'worklog-kill-entry)
(define-key m "\C-c\C-s" 'worklog-summarize-tasks-between-dates)
(define-key m "\C-c\C-l\C-i" 'worklog-add-entry-login)
(define-key m "\C-c\C-l\C-o" 'worklog-add-entry-logout)
(define-key m "\C-c\C-l\C-b" 'worklog-task-begin)
(define-key m "\C-c\C-l\C-s" 'worklog-task-stop)
(define-key m "\C-c\C-n" 'worklog-forward-entry)
(define-key m "\C-c\C-p" 'worklog-backward-entry)
(define-key m "\M-n" 'worklog-forward-entry)
(define-key m "\M-p" 'worklog-backward-entry)
m)
"Keymap for worklog mode.")
(defvar worklog-font-lock-keywords
(list "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9] [0-9][0-9]:[0-9][0-9]"
"stop"
"done"
"login"
"logout")
"Font lock keywords for worklog mode.")
(defvar worklog-font-lock-defaults
(list 'worklog-font-lock-keywords nil nil nil nil)
"Font lock defaults for worklog mode.")
(defvar worklog-target-column 17
"Where the text of an entry starts.")
(defvar worklog-task-history nil
"History of tasks.")
(defvar worklog-logged-in nil
"Determines if we are currently logged in or not.")
(defvar worklog-mode-popup-menu
'("Worklog"
["Begin" worklog-task-begin]
["Stop" worklog-task-stop]
"---"
["Add entry" worklog-add-entry]
["Kill entry" worklog-kill-entry]
["Login" worklog-add-entry-login]
["Logout" worklog-add-entry-logout]
"---"
["Summarize" worklog-summarize-tasks-between-dates]
["Finish" worklog-finish]
))
(defun worklog ()
"Enter worklog file, add a new entry."
(interactive)
(find-file worklog-file)
(worklog-mode)
(worklog-add-entry))
(defun worklog-show ()
"Enter worklog file."
(interactive)
(find-file worklog-file)
(worklog-mode))
(defun worklog-mode ()
"Mode for editing worklog sheets.
\\{worklog-mode-map}"
(interactive)
(kill-all-local-variables)
(setq major-mode 'worklog-mode)
(setq mode-name "WorkLog")
(use-local-map worklog-mode-map)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults worklog-font-lock-defaults)
(setq fill-prefix worklog-fill-prefix)
(make-local-variable 'paragraph-start)
(setq paragraph-start (concat paragraph-separate "\\|[0-9][0-9][0-9][0-9]"))
(turn-on-auto-fill)
(setq mode-popup-menu (symbol-value 'worklog-mode-popup-menu))
(run-hooks 'text-mode-hook)
(run-hooks 'worklog-mode-hook))
(defun worklog-xmas-read-char (&optional prompt)
"Get the next event."
(when prompt
(message "%s" prompt))
(let ((event (next-command-event)))
(sit-for 0)
(while (not (or (key-press-event-p event)
(button-press-event-p event)))
(dispatch-event event)
(setq event (next-command-event)))
(and (key-press-event-p event)
(event-to-character event))))
(if (featurep 'xemacs)
(defalias 'worklog-read-char 'worklog-xmas-read-char)
(defalias 'worklog-read-char 'read-char))
(defun timezone-parse-date (date)
"Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
Two-digit dates are `windowed'. Those <69 have 2000 added; otherwise 1900
is added. Three-digit dates have 1900 added.
TIMEZONE is nil for DATEs without a zone field.
Understands the following styles:
(1) 14 Apr 89 03:20[:12] [GMT]
(2) Fri, 17 Mar 89 4:01[:33] [GMT]
(3) Mon Jan 16 16:12[:37] [GMT] 1989
(4) 6 May 1992 1641-JST (Wednesday)
(5) 22-AUG-1993 10:59:12.82
(6) Thu, 11 Apr 16:17:12 91 [MET]
(7) Mon, 6 Jul 16:47:20 T 1992 [MET]
(8) 1996-06-24 21:13:12 [GMT]
(9) 1996-06-24 21:13-ZONE"
(and (stringp date)
(or (text-properties-at 0 date)
(next-property-change 0 date))
(setq date (copy-sequence date))
(set-text-properties 0 (length date) nil date))
(let ((date (or date ""))
(year nil)
(month nil)
(day nil)
(time nil)
(zone nil))
(cond ((string-match
"\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
(setq year 3 month 2 day 1 time 4 zone 5))
((string-match
"\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
(setq year 3 month 2 day 1 time 4 zone nil))
((string-match
"\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
(setq year 6 month 3 day 2 time 4 zone nil))
((string-match
"\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
(setq year 6 month 3 day 2 time 4 zone 7))
((string-match
"\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date)
(setq year 4 month 1 day 2 time 3 zone nil))
((string-match
"\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
(setq year 5 month 1 day 2 time 3 zone 4))
((string-match
"\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
(setq year 3 month 2 day 1 time 4 zone 5))
((string-match
"\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
(setq year 3 month 2 day 1 time 4 zone 6))
((string-match
"\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?" date)
(setq year 3 month 2 day 1 time 4 zone nil))
((string-match
"\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)" date)
(setq year 1 month 2 day 3 time 4 zone 5))
((string-match
"\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+\\)[ \t]+\\([-+a-zA-Z0-9:]+\\)" date)
(setq year 1 month 2 day 3 time 4 zone 5))
((string-match
"\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)" date)
(setq year 1 month 2 day 3 time 4 zone nil))
)
(when year
(setq year (match-string year date))
(if (< (length year) 4)
(let ((y (string-to-int year)))
(if (< y 69)
(setq y (+ y 100)))
(setq year (int-to-string (+ 1900 y)))))
(setq month
(if (= (aref date (+ (match-beginning month) 2)) ?-)
(substring date
(match-beginning month)
(+ (match-beginning month) 2))
(let* ((string (substring date
(match-beginning month)
(+ (match-beginning month) 3)))
(monthnum
(cdr (assoc (upcase string) timezone-months-assoc))))
(if monthnum
(int-to-string monthnum)))))
(setq day (match-string day date))
(setq time (match-string time date)))
(if zone (setq zone (match-string zone date)))
(if (and year month)
(vector year month day time zone)
(vector "0" "0" "0" "0" nil))))
(defun worklog-do-task (task &optional autostop)
"Append TASK to the worklog.
If there is an ongoing task, you are given the option to declare it done or
stopped, or to cancel the operation.
`worklog-do-task' allows you to insert tasks into your worklog without
the need to interactively call it.
If autostop is set to non-nil, any running task will automatically be stopped.
"
(worklog-show)
(if worklog-automatic-login
(worklog-grok-region (point-min) (point-max)))
(if (not worklog-task-history)
(worklog-grok-region (point-min) (point-max)))
(goto-char (point-max))
(forward-word -1)
(if (and (not worklog-logged-in) worklog-automatic-login)
(worklog-add-entry-login))
(worklog-add-entry)
(insert task "\n"))
(defun worklog-task-begin (task)
"Convenience function for `worklog-do-task'.
Does the same as calling`worklog-do-task' with a string parameter."
(interactive (progn
(unless worklog-task-history
(worklog-show)
(worklog-grok-region (point-min) (point-max)))
(let (c)
(list (read-string "What are you doing now? " nil
'worklog-task-history c)))))
(worklog-do-task task))
(defun worklog-task-stop ()
"Append a \"stop\" entry to the worklog."
(interactive)
(worklog-show)
(worklog-add-entry) (insert "stop\n"))
(defun worklog-task-done ()
"Append a \"done\" entry to the worklog."
(interactive)
(worklog-show)
(worklog-add-entry) (insert "done\n"))
(defun worklog-date-between-dates (date-test date-from date-to)
"Checks to see if the date (DAY YEAR) is between date-from and date-to.
If date-from is nil, then all dates before date-to are considered between.
If date-to is null, then all dates after date-from are considered between.
"
(interactive)
(if (eq date-from nil)
(setq date-from (cons 0 "0000")))
(if (eq date-to nil)
(setq date-to (cons 999 "9999")))
(if (or
(and
(= (string-to-number (cdr date-from)) (string-to-number (cdr date-test)))
(>= (car date-test) (car date-from)))
(and
(= (string-to-number (cdr date-to)) (string-to-number (cdr date-test)))
(<= (car date-test) (car date-to)))
(and
(> (string-to-number (cdr date-test)) (string-to-number (cdr date-from)))
(< (string-to-number (cdr date-test)) (string-to-number (cdr date-to)))
)
)
t
nil)
)
(defun worklog-do-summarize-tasks-between-dates (date-from date-to)
"Displays a summary of the worklog in two sections.
The first section is a reverse-chronological list of tasks and their durations,
and the second is an unsorted compendium of all tasks and total durations.
Durations are measured in hours. If invoked non-interactively (i.e., \"emacs
--batch\"), the display buffer is sent to `message'.
The summary is limited to all events between date-from to date-to.
If date-from is nil, the earliest possible date is displayed. If date-to is
nil, the latest possible date is displayed."
(let* ((buf (and worklog-reuse-summary-buffer
(get-buffer "*worklog summary*")))
(grokked (save-current-buffer
(worklog-show)
(worklog-grok-region (point-min) (point-max))))
(tasks (car grokked))
(by-date (cadr grokked))
(cur-date nil)
(cur-day-of-year nil)
(source-day-of-year nil)
(target-day-of-year nil)
(daily-total 0)
(overall-total 0)
(done-tasks (make-hash-table :test 'equal))
(finished nil))
(unless buf
(setq buf (generate-new-buffer "*worklog summary*")))
(switch-to-buffer buf)
(erase-buffer)
(insert "Generated by Worklog " worklog-version "\n\n")
(insert (format-time-string "Generated on %Y-%m-%d at %H:%M\n"))
(insert "Reporting on " date-from " to " date-to "\n")
(insert "\nBy date\n-------\n")
(if (stringp date-from)
(setq source-day-of-year (worklog-calculate-day-of-year date-from)))
(if (stringp date-to)
(setq target-day-of-year (worklog-calculate-day-of-year date-to)))
(catch 'done-processing
(dolist (day by-date)
(setq cur-day-of-year (worklog-calculate-day-of-year (car day)))
(catch 'too_early
(let ()
(if (not (worklog-date-between-dates cur-day-of-year source-day-of-year target-day-of-year))
(throw 'too_early t)
(unless (string= cur-date (car day))
(insert (car day) "\n")
(setq cur-date (car day)))
(setq daily-total 0)
(maphash (lambda (task durations)
(let ((so-far (gethash task done-tasks))
(total (apply #'+ durations)))
(setf (gethash task done-tasks) (append so-far durations))
(insert (format " %s\t%s\n"
(worklog-sum-to-hours-1 total)
task))
(setq daily-total (+ daily-total total))
(setq overall-total (+ overall-total total))
))
(cdr day))
(if worklog-summarize-show-totals
(insert (format " %s\tTotal\n"
(worklog-sum-to-hours-1 daily-total))))
)))
))
(if worklog-summarize-show-overall-total
(insert (format "\n %s\tTotal time spent working\n"
(worklog-sum-to-hours-1 overall-total))))
(insert "\nTasks\n-----\n")
(maphash (lambda (task durations)
(insert (format "%s\t%s\n"
(worklog-sum-to-hours durations)
task)))
done-tasks)
(run-hooks 'worklog-summarize-tasks-hook)
(when noninteractive
(message (buffer-string)))))
(defun worklog-summarize-tasks ()
"Display a summary of the worklog in two sections.
The first section is a reverse-chronological list of tasks and their durations,
and the second is an unsorted compendium of all tasks and total durations.
Durations are measured in hours. If invoked non-interactively (i.e., \"emacs
--batch\"), the display buffer is sent to `message'.
This summary is displayed over the entire worklog file, it is an convenience
function for `worklog-do-summarize-tasks-between-dates'"
(interactive)
(let* ((by-date (cadr (save-current-buffer
(worklog-show)
(worklog-grok-region (point-min) (point-max)))))
(last-date (nth 0 by-date))
(first-date (nth (1- (length by-date)) by-date))
)
(worklog-do-summarize-tasks-between-dates (car first-date) (car last-date))
))
(defun worklog-summarize-tasks-between-dates (from to)
"Display a summary of the worklog in two sections.
The first section is a reverse-chronological list of tasks and their durations,
and the second is an unsorted compendium of all tasks and total durations.
Durations are measured in hours. If invoked non-interactively (i.e., \"emacs
--batch\"), the display buffer is sent to `message'.
This summary is displayed over a section of the worklog file, it is an convenience
function for `worklog-summarize-tasks-between-dates'"
(interactive "sDate from (YYYY-MM-DD): \nsFrom %s to (YYYY-MM-DD): ")
(worklog-do-summarize-tasks-between-dates from to)
)
(defun worklog-finish ()
"Save and bury worklog buffer."
(interactive)
(save-buffer)
(bury-buffer))
(defun worklog-add-entry ()
"Insert the timestamp and trailing space that come before an task name."
(interactive)
(end-of-buffer)
(unless (bolp)
(newline))
(insert (worklog-make-date-time) " "))
(defun worklog-add-entry-login ()
"Adds a login entry"
(interactive)
(worklog-add-entry)
(insert "login\n"))
(defun worklog-add-entry-logout ()
"Inserts a 'logout' entry"
(interactive)
(worklog-add-entry)
(insert "logout\n"))
(defun worklog-kill-entry (n)
"Kills the task entry at point"
(interactive "p")
(kill-region (progn (backward-paragraph 1) (point))
(progn (forward-paragraph n) (point))))
(defun worklog-backward-entry (n)
"Move backward one (or N if prefix arg) entries."
(interactive "p")
(worklog-forward-entry (- n)))
(defun worklog-forward-entry (n)
"Move forward one (or N if prefix arg) entries."
(interactive "p")
(when (< n 0) (backward-paragraph 1))
(forward-paragraph n)
(move-to-column worklog-target-column))
(defun worklog-make-date-time (&optional time)
"Makes the worklog timestamp"
(format-time-string "%Y-%m-%d %H:%M" time))
(defun worklog-time-diff (a b)
"Return the difference between two times. This function requires
the second argument to be earlier in time than the first argument."
(cond ((= (nth 0 a) (nth 0 b)) (list 0 (- (nth 1 a) (nth 1 b))))
((> (nth 1 b) (nth 1 a)) (list (- (nth 0 a) (nth 0 b) 1)
(- (+ 65536 (nth 1 a)) (nth 1 b))))
(t (list (- (nth 0 a) (nth 0 b))
(- (nth 1 a) (nth 1 b))))))
(defun worklog-parse-date/time (date/time)
"Parses the date/time format"
(let ((v (timezone-fix-time date/time nil (current-time-zone))))
(encode-time 0 (aref v 4) (aref v 3) (aref v 2) (aref v 1) (aref v 0))))
(defun worklog-grok-region (b e)
"Parse a region for worklog syntax (YYYY-MM-DD HH:MM TASK)"
(setq worklog-task-history nil)
(let ((worklog-line-re (or (get 'worklog-grok-region 'line-re)
(put 'worklog-grok-region
'line-re
(let ((d "[0-9]"))
(concat "^\\(\\(" d d d d "-" d d "-" d d
"\\) " d d ":" d d
"\\) \\(.+\\)$")))))
(cur-date nil)
(cur-task nil)
(cur-start nil)
(tasks (make-hash-table :test 'equal))
(days-tasks nil)
(by-date nil))
(goto-char b)
(while (re-search-forward worklog-line-re e t)
(let ((task (match-string 3))
(date (match-string 2))
(task-time (worklog-parse-date/time
(concat (match-string 1) ":00"))))
(cond ((string= "login" task)
(setq cur-date date
days-tasks (make-hash-table :test 'equal)
worklog-logged-in t))
((string= "logout" task)
(if (stringp cur-task)
(worklog-handle-stopped-task cur-task task-time cur-start tasks days-tasks))
(push (cons cur-date days-tasks) by-date)
(setq cur-date nil
days-tasks nil
worklog-logged-in nil)
(if (stringp cur-task)
(setq cur-task nil)))
((or (string= "stop" task)
(string= "done" task))
(worklog-handle-stopped-task cur-task task-time cur-start tasks days-tasks)
(setq cur-task nil))
((and (stringp cur-task) (not (string= task cur-task)))
(worklog-handle-stopped-task cur-task task-time cur-start tasks days-tasks)
(setq cur-task task)
(setq cur-start task-time)
(push task worklog-task-history))
(t (setq cur-task task
cur-start task-time)
(push task worklog-task-history)))))
(when cur-date
(push (cons cur-date days-tasks) by-date))
(list tasks by-date)))
(defun worklog-sum-to-hours-1 (seconds)
"Take a list of seconds worked on a task and calculate the ammount
of hours and minutes worked."
(let ((total (format "%2.2f" (/ seconds 60.0 60.0))))
(if (not worklog-use-minutes)
total
(let* ((index (string-match "\\." total))
(percent (substring total (1+ index)))
(hours (substring total 0 index))
(minutes 0))
(setq minutes (format "%02.0f" (* 0.6 (string-to-number percent))))
(concat hours "." minutes)
))))
(defun worklog-sum-to-hours (seconds-list)
"Take a list of seconds worked on a task and calculate the ammount
of hours and minutes worked."
(worklog-sum-to-hours-1 (apply #'+ seconds-list)))
(defun worklog-handle-stopped-task (cur-task task-time cur-start tasks days-tasks)
"Retrieves the time spent so-far on a task from tasks, the time spent on that task in
days-tasks and calculates the duration by worklog-time-diff task-time and cur-start.
Both hashes are subsequently updated with new lists of durations."
(let ((so-far (gethash cur-task tasks))
(so-far-today (gethash cur-task days-tasks))
(dur (cadr (worklog-time-diff task-time cur-start))))
(setf (gethash cur-task tasks) (cons dur so-far))
(setf (gethash cur-task days-tasks) (cons dur so-far-today))))
(defun worklog-calculate-day-of-year (cur-date)
"Calculates the day of the year for cur-date. Returns a list (DAY YEAR)."
(let ((current-date (timezone-parse-date
(concat cur-date " 00:00:00"))))
(setq day-of-year (timezone-day-number
(string-to-number (elt current-date 1))
(string-to-number (elt current-date 2))
(string-to-number (elt current-date 0))))
(cons day-of-year (elt current-date 0))
))
(provide 'worklog)