;; timeclock-visualize.el --- Visualize timeclocks on the web.

;;; Copyright (C) 2001 Nix <nix@esperi.org.uk>.

;; Author: Nix <nix@esperi.org.uk>
;; Created: 2001-06-15
;; Keywords: lisp

;; This file is not part of Emacs.

;; This library 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 2, or (at your option)
;; any later version.

;;; Commentary:

;; This file allows you to generate timesheets on the web.

;; To use it to update a running index of timesheets and the timesheets linked
;; to them, call `timeclock-update-timesheets' from the `timeclock-event-hook';
;; alternatively, you can call `timeclock-generate-timesheet' to generate a
;; single timesheet for some date, or `timeclock-generate-timesheet-page' to
;; generate a timesheet suitable for embedding in some other page.

;; If you are one of those strange life-forms who think the week begins on a day
;; other than Monday, you might also want to set the `timeclock-week-begins-on'
;; variable appropriately.

;; This requires Bill Perry's `url' library, and my `auto-edit-substitute'
;; library.

;;; Requirements:

(require 'url)                          ; Used by `timeclock-url-append-element'
(require 'auto-edit-substitute)         ; Used by `timeclock-update-timesheets'
(require 'timeclock)                    ; Obvious, really

;;; User-customizable variables:

(defvar timeclock-week-begins-on 1
  "Day on which the week begins. Sunday is 0.")

;;; Utility functions:

(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)))))

;;; User-callable functions:

(defun timeclock-generate-timesheet-page (&optional time)
  "Generate an HTML tabular timesheet for the week containing TIME."
  (interactive)
  ;; Work out when to start working from, and when to stop.
  (let* ((date (or time (current-time)))
         (start (timeclock-time-to-seconds (timeclock-week-base date)))
         (end (+ start (* 7 24 60 60)))
         ;; Get the timesheet data for the period of interest.
         ;; This comes back in format (DEBT (TASK ...)), one element per day,
         ;; where DEBT is a time in seconds (which we do not care about) and
         ;; TASK is a list of the form (START STOP START-REASON STOP-REASON
         ;; TASK-FINISHED) where unused terminal elements are omitted.
         (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)))))
         ;; This list holds the names of the days, and abbreviations for them,
         ;; rotated to fit the starting point of the days (and thus the starting
         ;; day of our timesheet slice).
         (day-names
          (rotate-list '(("Sunday" . "Sun") ("Monday" . "Mon") ("Tuesday" . "Tue")
                         ("Wednesday" . "Wed") ("Thursday" . "Thu")
                         ("Friday" . "Fri") ("Saturday" . "Sat"))
                       timeclock-week-begins-on))
         ;; This vector holds the total time consumed per day.
         (daily-totals (make-vector 8 0.0))
         ;; This list holds the names of the tasks, in the order in which they
         ;; will be placed in the timesheet, yanked straight out of the timesheet
         ;; structure.
         (task-names
          (delete-duplicates
           (mapcar
            #'(lambda (entry)
                (nth 2 entry))
            timesheet)
           :test 'equal :from-end t))
         ;; The body of the table, the time-per-day-per-task values, are
         ;; accumulated in here and printed out all at once. (We cannot print out
         ;; the results incrementally without missing out zero values.) 
         ;; The tail of each vector in this list-of-vectors is the total
         ;; time for this task.
         (time-per-day))

    (if (null timesheet)                ; Do nothing for an empty timesheet
        nil
      ;; Collect the data, and fill out the time-per-day data.
      ;; Also sum each task's time-worked and fill out its hours-worked
      ;; for each day.
      (mapc
       #'(lambda (task)
           (let ((time-per-task (make-vector 8 0)))
             ;; Set the total number of hours worked on this task this week.
             (aset time-per-task 7
                   ;; Sum all the days worked...
                   (apply '+
                          (mapcar
                           #'(lambda (this-task)
                               ;; ... for this task.
                               (if (not (equal (caddr this-task) task))
                                   0
                                 ;; Compute this task's time entry for this day; update the daily totals
                                 ;; appropriately, and return the time today so that the taskly totals
                                 ;; can be maintained.
                                 (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)))
           ;; Update the totals, and the grand total.
           (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)

    ;; Now emit the HTML.
    ;; TODO: Generalize this and neaten it up; the footers and task bodies,
    ;; at least, should be emitted by the same code.
    (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")

      ;; Spit out the table headers; the days of the week, in customized order.
      (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")

      ;; Spit out the table footer; the contents of the `daily-totals' vector.
      (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 the row contents.
      (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."
  ; Work out the latest date to process, in Unix time format.
  (let ((backup-inhibited t)
        (latest-date (timeclock-time-to-seconds
                      (timeclock-week-base (current-time))))
        (earliest-date))
    ;; Work out the earliest date to process, also in Unix time format.
    (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))))

    ;; Construct the name of the index file, and visit it.
    (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)))
            ;; Work through all timesheets from the latest to the earliest, a
            ;; week at a time, updating the reference to that week in the index,
            ;; and (if the week's entry did not exist, or is the latest week)
            ;; update the linked timesheet too. (The latest week's timesheet has
            ;; a special name, so when the latest week becomes the latest-but-one
            ;; week, it will be as if it did not exist and will be regenerated
            ;; appropriately.)
            ;; Assumptions: The list is sorted in descending date order. (This
            ;; code maintains that invariant.) Nothing will break too badly if
            ;; this invariant is not maintained, but you may find duplicate
            ;; entries and unnecessary page regenerations taking place.
            (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 @@ -->"
                ;; Update the timesheets by date.
                (lambda ()
                  (goto-char (point-min))
                  (let* ((latest-timesheet t)
                         (timesheet-date latest-date)
                         (current-gmt-offset))
                    ;; For each week...
                    (while (>= timesheet-date earliest-date)
                      ;; ... work out the URL of the timesheet...
                      (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")))))
                        ;; Find the element pointing at this timesheet's URL. If
                        ;; there isn't one, we must add an entry, and we know
                        ;; that we must later update the HTML page it points to.
                        (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))
                          ;; Otherwise, skip over this line; it is right, so we do
                          ;; not want to consider it again.
                          (forward-line))
                        ;; If we must update the timesheet page, do that now.
                        (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)))

                        ;; It is no longer the latest timesheet; it is now a
                        ;; week earlier. Factor out the difference between GMT offsets
                        ;; (damned DST!).
                        (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)