(require 'url) (require 'auto-edit-substitute) (require 'timeclock)
(defvar timeclock-week-begins-on 1
"Day on which the week begins. Sunday is 0.")
(defun timeclock-week-base (&optional time)
"Given a time within a week, return 0:0:0 at the start of that week."
(let* ((time (or time (current-time)))
(distance-backwards
(+ (- (timeclock-time-to-seconds time)
(timeclock-time-to-seconds (timeclock-day-base time)))
(* (mod (- (nth 6 (decode-time time))
timeclock-week-begins-on) 7) 24 60 60))))
(timeclock-seconds-to-time
(- (timeclock-time-to-seconds (or time (current-time)))
distance-backwards))))
(defun timeclock-url-append-element (url element)
"Append a path ELEMENT to the file part of an URL."
(let ((parsed-url (url-generic-parse-url url)))
(aset parsed-url 5
(paths-construct-path
(list (aref parsed-url 5) element)))
(url-recreate-url parsed-url)))
(defun rotate-list (list &optional n)
"Rotate the LIST N places to the left."
(setq n (or n 1))
(if (not (integerp n))
(cerror 'wrong-type-argument 'integerp n))
(if (eq n 0)
list
(if (not (natnump n))
(rotate-list list (- (length list) (abs n)))
(let ((list-tail (copy-list list)))
(setcdr (nthcdr (1- n) list-tail) nil)
(append (nthcdr n list) list-tail)))))
(defun timeclock-generate-timesheet-page (&optional time)
"Generate an HTML tabular timesheet for the week containing TIME."
(interactive)
(let* ((date (or time (current-time)))
(start (timeclock-time-to-seconds (timeclock-week-base date)))
(end (+ start (* 7 24 60 60)))
(timesheet
(mapcan
#'(lambda (day)
(let ((task-time (timeclock-time-to-seconds (car day))))
(and (<= start task-time)
(>= end task-time)
(list day))))
(mapcan
#'(lambda (entry)
(cdr entry))
(timeclock-day-list (timeclock-log-data)))))
(day-names
(rotate-list '(("Sunday" . "Sun") ("Monday" . "Mon") ("Tuesday" . "Tue")
("Wednesday" . "Wed") ("Thursday" . "Thu")
("Friday" . "Fri") ("Saturday" . "Sat"))
timeclock-week-begins-on))
(daily-totals (make-vector 8 0.0))
(task-names
(delete-duplicates
(mapcar
#'(lambda (entry)
(nth 2 entry))
timesheet)
:test 'equal :from-end t))
(time-per-day))
(if (null timesheet) nil
(mapc
#'(lambda (task)
(let ((time-per-task (make-vector 8 0)))
(aset time-per-task 7
(apply '+
(mapcar
#'(lambda (this-task)
(if (not (equal (caddr this-task) task))
0
(let ((time-today (abs (- (timeclock-time-to-seconds (car this-task))
(timeclock-time-to-seconds (cadr this-task)))))
(day-today (mod (- (nth 6 (decode-time (car this-task)))
timeclock-week-begins-on) 7)))
(aset time-per-task day-today
(+ (aref time-per-task day-today) time-today))
(aset daily-totals day-today
(+ (aref daily-totals day-today) time-today))
time-today)))
timesheet)))
(setq time-per-day (append time-per-day (list time-per-task)))
(aset daily-totals 7 (+ (aref daily-totals 7) (aref time-per-task 7)))))
task-names)
(let ((header-caption (concat "Timesheet for " (timeclock-time-to-date
(timeclock-seconds-to-time start)))))
(insert " <p><table class='timesheet' frame='hsides' rules='groups'\n"
" summary='" header-caption "'>\n"
" <caption>" header-caption "</caption>\n"
" <colgroup span=1 class='column-headings'></colgroup>\n"
" <colgroup span=7 class='column-content' width='1*'></colgroup>\n"
" <colgroup span=1 class='column-totals' width='1*'></colgroup>\n"
" <thead class='row-headings'>\n"
" <tr><th></th>\n")
(mapc #'(lambda (day-of-week)
(insert " <th scope='col' abbr='" (cdr day-of-week) "'>"
(car day-of-week) "</th>\n"))
(append day-names '(("Total" . "Tot."))))
(insert " </thead>\n")
(insert " <tfoot class='row-totals'>\n"
" <tr><th scope='row' abbr='Tot.'>Totals</th>\n"))
(mapc #'(lambda (item)
(insert (format " <td>%.1f</td>\n" (/ item 60 60))))
daily-totals)
(insert " </tr>\n"
" </tfoot>\n"))
(insert " <tbody class='row-content'>\n")
(mapcar* #'(lambda (task time-for-task)
(insert " <tr><th scope='row'>" task "</th>\n")
(mapc #'(lambda (item)
(insert (format " <td>%.1f</td>\n" (/ item 60 60))))
time-for-task)
(insert " </tr>\n"))
task-names time-per-day)
(insert " </tbody>\n"
" </table>\n")))
(defun timeclock-generate-timesheet (file &optional html-index-url stylesheet-url
time)
"Generate and save in FILE an HTML timesheet for the week containing TIME.
If TIME is nil, the current week is assumed.
HTML-INDEX-URL, if not nil, is the relative URL from the FILE to an index page
to be reverse LINKed to; STYLESHEET-URL is the relative URL from the FILE to
a stylesheet to use to display its contents. (Look at the generated HTML to
see what that stylesheet could contain.)
FILE's existing contents, if any, are removed."
(if (not (stringp file))
(cerror 'wrong-type-argument 'stringp file))
(let ((time (or time (current-time)))
(start (timeclock-week-base time))
(tempo-interactive nil))
(with-temp-buffer
(tempo-template-html-skeleton)
(insert "Timesheet for " (timeclock-time-to-date start))
(end-of-line)
(and (not (null html-index-url))
(insert "\n <link rev='Prev' href='" html-index-url "'>"))
(and (not (null stylesheet-url))
(insert "\n <link href='" stylesheet-url "' rel='stylesheet' "
"type='text/css'>"))
(search-forward "<body>\n")
(forward-line)
(beginning-of-line)
(delete-region (point) (save-excursion (end-of-line 2) (point)))
(timeclock-generate-timesheet-page time)
(write-file file))))
(defun timeclock-update-timesheets (directory url &optional archival-directory
archival-url stylesheet-url index)
"Update the index of timesheets in DIRECTORY.
Also update all timesheets linked to it. URL must point to the same place as
DIRECTORY, but in HTTP syntax.
The index file is called `timesheet-index.html', unless another INDEX name is
given; this file must already exist, and should contain the textual markers
`<!-- @@ TIMECLOCK-VERSION-START @@-->', `<!-- @@ TIMECLOCK-VERSION-END @@-->',
`<!-- @@ TIMECLOCK-INDEX-START @@-->' and `<!-- @@ TIMECLOCK-INDEX-END @@-->'
surrounding the regions where the updates should take place.
The latest timesheet is called `timesheet-latest.html' in the DIRECTORY;
the others are named after their date, in the ARCHIVAL-DIRECTORY (URL-referenced
as ARCHIVAL-URL), or in DIRECTORY if ARCHIVAL-DIRECTORY is nil.
The STYLESHEET-URL is the URL of the stylesheet used by the linked timesheets."
(let ((backup-inhibited t)
(latest-date (timeclock-time-to-seconds
(timeclock-week-base (current-time))))
(earliest-date))
(mapc
#'(lambda (day)
(let* ((task-emacs-time (car day))
(task-time (timeclock-time-to-seconds task-emacs-time)))
(if (or (null earliest-date)
(and (<= task-time earliest-date)))
(setq earliest-date (timeclock-time-to-seconds
(timeclock-week-base task-emacs-time))))))
(mapcan
#'(lambda (entry)
(cdr entry))
(timeclock-day-list (timeclock-log-data))))
(save-current-buffer
(condition-case unused
(let ((index-filename
(paths-construct-path (list directory
(or index "timesheet-index.html"))))
(index-url
(timeclock-url-append-element url
(or index "timesheet-index.html")))
(archival-directory (or archival-directory directory))
(archival-url (or archival-url url)))
(set-buffer (find-file-noselect index-filename))
(auto-edit-substitute
`(("<!-- @@ TIMECLOCK-VERSION-START @@ -->\n" "<!-- @@ TIMECLOCK-VERSION-END @@ -->"
,(int-to-string timeclock-version))
("<!-- @@ TIMECLOCK-INDEX-START @@ -->\n" "<!-- @@ TIMECLOCK-INDEX-END @@ -->"
(lambda ()
(goto-char (point-min))
(let* ((latest-timesheet t)
(timesheet-date latest-date)
(current-gmt-offset))
(while (>= timesheet-date earliest-date)
(let* ((must-update-timesheet-page nil)
(timesheet-date-as-string
(replace-in-string (timeclock-time-to-date
(timeclock-seconds-to-time
timesheet-date))
"/" "-"))
(timesheet-url
(if latest-timesheet
(timeclock-url-append-element
url "timesheet-latest.html")
(timeclock-url-append-element
archival-url (concat timesheet-date-as-string ".html")))))
(if (not (search-forward (concat "<a href='"
timesheet-url "'>")
(point-max) t))
(progn
(insert " <p><a href='" timesheet-url "'>"
(if latest-timesheet
"This week's timesheet."
(concat "Timesheet for " timesheet-date-as-string "."))
"</a></p>\n")
(setq must-update-timesheet-page t))
(forward-line))
(if (or latest-timesheet must-update-timesheet-page)
(timeclock-generate-timesheet
(paths-construct-path
(if latest-timesheet
(list directory "timesheet-latest.html")
(list archival-directory
(concat timesheet-date-as-string ".html"))))
index-url stylesheet-url
(timeclock-seconds-to-time timesheet-date)))
(let* ((last-week-date (- timesheet-date (* 7 24 60 60)))
(last-week-gmt-offset (nth 8 (decode-time (timeclock-seconds-to-time last-week-date)))))
(setq latest-timesheet nil
current-gmt-offset (nth 8 (decode-time (timeclock-seconds-to-time timesheet-date)))
timesheet-date (- last-week-date
(- last-week-gmt-offset current-gmt-offset)))))))))))
(save-buffer)
(kill-buffer (current-buffer)))
(file-error nil)))))
(provide 'timeclock-visualize)