planner-timeclock-summary.el: report timeclock information

I spend most of my day before the screen and I use
planner-timeclock.el to clock in and clock out my planner tasks. And I
scratched this planner-timeclock-summary.el to generate a report about
how my time was killed. I have a screen shot at
http://www.smth.edu.cn/bbscon.php?bid=573&id=17157&ap=706 
Basicly it will report how much of my time was spend on each project
on a given day.

It models planner-accomplishments.el and thank you, Sacha :)

This is my first lisp so welcome any comments and suggestions.

In fact I have a problem here: in the "experimental code" at the end
of the file, I tried to use table.el to make a nicer table but
failed. The table messed up if there's a long annotation in the task
description. The wired thing is, if I call
planner-timeclock-summary-show-2 with edebug, it works fine. I guess
this depends on if the target buffer is visible so has something to do
with the time planner buffer get rendered.

Anyway planner-timeclock-summary-show and
planner-timeclock-summary-update works fine. At least for me :)

Here's the code:
----------------------------------------------------------------------
;;; planner-timeclock-summary.el --- timeclock summary for the Emacs planner
;;

;; Keywords: emacs planner timeclock report summary
;; Author: Dryice Liu <dryice AT liu DOT com DOT cn>
;; Time-stamp: <2004-11-19 09:03:51 Dryice Liu>
;; Description: Summary timeclock of a day

;; This file is not part of GNU Emacs.

;; Copyright (C) 2004 Dryice Dong Liu . All rights reserved.

;; This 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.
;;
;; This is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
;; for more details.
;;
;; 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.

;;; Commentary:
;;
;; planner-timeclock-summary.el produces timeclock reports for planner
;; files. 
;;
;; There are two ways you can use it:
;;
;; 1. Display a temporary buffer
;;
;; Call `planner-timeclock-summary-show' and Emacs will ask you which
;; day's summary do you want. Choose the date as anywhere else of
;; Emacs planner, and a tempory buffer will be displayed with the
;; timeclock summary of that day.
;;
;; 2. Rewrit sections of your planner
;;
;; Choose this approach if you want timeclock summary to be in their
;; own section and you would like them to be readable in your plain
;; text files even outside Emacs. Caveat: The timeclock summary
;; section should already exist in your template and will be rewritten
;; when updated. Tip: Add `planner-timeclock-summary-section'
;; (default: "Timeclock") to your `planner-day-page-template'.
;;
;; To use, call `planner-timeclock-summary-update' in the planner day
;; page to update the section. If you want rewriting to be
;; automatically performed, call `planner-timeclock-summary-insinuate'
;; in your .emacs file

;;; REQUIRE
;; to make a nice text table, you need align.el from
;; http://www.newartisans.com/johnw/Emacs/align.el

;;; TODO
;; - report for a period of time
;; - support plan pages. Currently only day pages are supported.
;; - sort?

;;; CODE

(require 'planner-timeclock)
(require 'align)
(require 'cl)

;;; User variables

(defgroup planner-timeclock-summary nil
  "Timeclock reports for planner.el."
  :prefix "planner-timeclock-summary"
  :group 'planner)

(defcustom planner-timeclock-summary-section "Timeclock"
  "Header for the timeclock summary section in a plan page."
  :type 'string
  :group 'planner-timeclock-summary)

(defcustom planner-timeclock-summary-buffer "*Planner Timeclock Summary*"
  "Buffer name for timeclock reports from
`planner-timeclock-summary-show'."
  :type 'string
  :group 'planner-timeclock-summary)

(defcustom planner-timeclock-summary-not-planned-string "Not Planned"
  "Project name for the manually `timeclock-in' tasks that without a
project name."
  :type 'string
  :group 'planner-timeclock-summary)

(defcustom planner-timeclock-summary-summary-string 
           "\n\nDay begined: %B, Day ended: %E\nTime elapsed: %S, \
Time clocked: %C\nTime clocked ratio: %R\n"
  "The string below the report table.

%B the first time checked in the day
%L the last time checked in the day
%E the last time checked in the day, or the current time if it's today
%s span, the difference between %B and %L
%S span, the difference between %B and %E
%C the total time clocked
%r clocked/%s
%R clocked/%S"
  :type 'string
  :group 'planner-timeclock-summary)

;;;; User variables stop here

(defvar planner-timeclock-summary-empty-cell-string "====="
  "Internal use, don't touch")

(defvar planner-timeclock-summary-total-cell-string "======="
  "Internal use, don't touch")

;;;###autoload
(defun planner-timeclock-summary-insinuate ()
  "Automatically call `planner-timeclock-summary-update'. when the day
plan page is saved."
  (add-hook 'planner-mode-hook
            (lambda ()
              (add-hook
               (cond
                ((boundp 'write-file-functions) 'write-file-functions)
                ((boundp 'local-write-file-hooks) 'local-write-file-hooks)
                ((boundp 'write-file-hooks) 'write-file-hooks))
               'planner-timeclock-summary-update nil t))))

;;;###autoload
(defun planner-timeclock-summary-update ()
  "Update `planner-timeclock-summary-section'. in the current day plan
page. (If the section exists)"
  (interactive)
  (save-excursion
    (save-restriction
      (when (planner-narrow-to-section planner-timeclock-summary-section)
        (if (string-match planner-date-regexp (planner-page-name))
            (progn
              (delete-region (point-min) (point-max))
              (insert "* " planner-timeclock-summary-section "\n\n"
                      (planner-timeclock-summary-make-text-table-day
                       (replace-in-string (planner-page-name) "\\." "/" t))
                      " \n")
              nil)
          (message "Timeclock summary in plan pages are not supported yet, \
welcome your patches!")
          )))))

;;;###autoload
(defun planner-timeclock-summary-show (&optional date)
  "Display a buffer with the given day's timeclock summary.

date is a string in the form YYYY.MM.DD. It will be asked if not
given."
  (interactive)
  (if (not date)
      (setq date (planner-read-date)))
  (switch-to-buffer (get-buffer-create planner-timeclock-summary-buffer))
  (erase-buffer)
  (let ((emacs-wiki-project planner-project))
    (insert "Timeclock summary report for " date "\n\n"
            (planner-timeclock-summary-make-text-table-day
             (replace-in-string date "\\." "/" t)))
    (planner-mode))
  (goto-char (point-min))
  )


(defun planner-timeclock-summary-extract-data-day (date)
  "Make the alist that will fit into a summary for one day.
Read `timeclock-file' and give out an alist. The list will be:
  (TotalTime
   (((Project1Name Project1Time Project1Ratio) (p1t1time p1t1ratio p1t1name)
                                            (p1t2time p1t2ratio p1t2name)
                                            ...)
   ((p2name p2time p2ratio) ...)))"
  (let ((data-list (planner-timeclock-one-day-alist date))
        (target-data))
    (while data-list
      (setq entry (pop data-list))
      (setq task-data (planner-timeclock-summary-extract-task-data entry))
      (let ((entry-project-name (car task-data))
            (entry-task-name (cadr task-data))
            (entry-task-length (caddr task-data)))
        ;; total time
        (if target-data
            (setcar target-data (+ (car target-data) entry-task-length))
          (setq target-data (list entry-task-length)))
        ;; updating project
        (let ((projects (cdr target-data))
              (project-found nil))
          (while projects
            (setq project (car projects))
            (let ((project-name (caar project))
                  (project-time (cadar project)))
              (if (and project-name 
                       (string-equal project-name entry-project-name))
                  ;; the same project has been recorded, updating tasks
                  (let ((tasks (cdr project))
                        (task-found nil))
                    (while tasks
                      (setq task (car tasks))
                      (let ((task-name (caddr task)))
                        (if (and task-name
                                 (string-equal task-name
                                               entry-task-name))
                            ;; the same task has been recorded, add
                            ;; time
                            (progn
                              (setcar task (+ (car task)
                                              entry-task-length))
                              (setq tasks nil)
                              (setq task-found t))
                          (setq tasks (cdr tasks)))))
                    ;; make a new task record
                    (if (not task-found)
                        (setcar projects
                        (add-to-list 'project (list entry-task-length
                                                    0
                                                    entry-task-name) t)))
                    ;; update project time
                    (setcar (cdar project) (+ project-time
                                              entry-task-length))
                    (setq projects nil)
                    (setq project-found t))
                (setq projects (cdr projects)))))
          ;; make a new project record
          (if (not project-found)
              (add-to-list 'target-data (list (list entry-project-name
                                                    entry-task-length
                                                    0)
                                              (list entry-task-length
                                                    0
                                                    entry-task-name)) t))
        )))
    target-data))

(defun planner-timeclock-summary-calculate-ratio-day (date)
  "calculate ratio."
  (setq target-data (planner-timeclock-summary-extract-data-day date))
  (let ((total (car target-data))
        (projects (cdr target-data)))
    (while projects
      (let ((project (car projects))
            (tasks (cdar projects)))
        (setcar (cddar project) (/ (cadar project) total))
        (while tasks
          (let ((task (car tasks)))
            (setcar (cdr task) (/ (car task) total))
            (setq tasks (cdr tasks))))
        (setq projects (cdr projects)))))
  target-data)

(defun planner-timeclock-summary-make-text-table-day (date)
  "make summary table with plain text"
  (setq source-list (planner-timeclock-summary-calculate-ratio-day
                     date))
  (let ((projects (cdr source-list))
        (total (car source-list)))
    (if total
        (with-temp-buffer
          (erase-buffer)
          (insert (format "%s|%9s|%6s| %s\n" "Project" "Time" "Ratio" "Task"))
          (while projects
            (let ((project-data (caar projects))
                  (tasks (cdar projects)))
              (insert (format "%s|" (car project-data)))
              (setq task (car tasks))
              (insert (format "%9s|%5s%%| %s\n"
                              (timeclock-seconds-to-string (car task) t)
                              (format "%2.1f" (* 100 (cadr task)))
                              (caddr task)))
              (setq tasks (cdr tasks))
              (while tasks
                (let ((task (car tasks)))
                  (insert (format "%s|%9s|%5s%%| %s\n"
                                  planner-timeclock-summary-empty-cell-string
                                  (timeclock-seconds-to-string (car task) t)
                                  (format "%2.1f" (* 100 (cadr task)))
                                  (caddr task)))
                  (setq tasks (cdr tasks))))
              (insert (format "%s|%9s|%5s%%| %s\n"
                              planner-timeclock-summary-total-cell-string
                              (timeclock-seconds-to-string (cadr project-data) 
t)
                              (format "%2.1f" (* 100 (nth 2 project-data)))
                              planner-timeclock-summary-empty-cell-string))
              (setq projects (cdr projects))))
          (align-regexp (point-min) (point-max) "\\(\\s-*\\)|" 1 0 nil)
          (untabify (point-min) (point-max))
          (goto-char (point-min))
          (let ((total-regexp (format "%s\\s-*|"
                                      
planner-timeclock-summary-total-cell-string)))
            (while (search-forward-regexp total-regexp nil t)
              (let ((string-len (- (match-end 0) (match-beginning 0))))
                (setq new-string (format "%sTotal: |" 
                                         (make-string (- string-len 8)
                                                      (aref " " 0))))
                (replace-match new-string t))))
          (goto-char (point-min))
          (while (search-forward
                  planner-timeclock-summary-empty-cell-string nil t)
            (replace-match (make-string 
                            (length planner-timeclock-summary-empty-cell-string)
                            (aref " " 0))))
          (goto-char (point-max))
          (insert (planner-timeclock-summary-make-summary-string date total))
          (buffer-string))
      "")))

(defun planner-timeclock-summary-make-summary-string (date total)
  "make the summary according to
  `planner-timeclock-summary-summary-string'
date is in format YYYY/MM/DD
total is the total time clocked today in second"
  (let ((target-string planner-timeclock-summary-summary-string)
        (data (planner-timeclock-one-day-entry-no-date date))
        begin end last Span span)
    (setq begin (timeclock-day-begin data))
    (setq end (timeclock-day-end data))
    (if (string-equal date (format-time-string "%Y/%m/%d"))
        (setq last (current-time))
      (setq last end))
    (setq span (timeclock-time-to-seconds (time-subtract last begin)))
    (setq Span (timeclock-time-to-seconds (time-subtract end begin)))
    (setq target-string (replace-in-string target-string "%B" 
                                           (format-time-string "%H:%M:%S" 
begin) t))
    (setq target-string (replace-in-string target-string "%E"
                                           (format-time-string "%H:%M:%S" end) 
t))
    (setq target-string (replace-in-string target-string "%L"
                                           (format-time-string "%H:%M:%S" last) 
t))
    (setq target-string (replace-in-string target-string "%s"
                                           (timeclock-seconds-to-string span t) 
t))
    (setq target-string (replace-in-string target-string "%S"
                                           (timeclock-seconds-to-string Span t) 
t))
    (setq target-string (replace-in-string target-string "%C"
                                           (timeclock-seconds-to-string total 
t) t))
    (setq target-string (replace-in-string target-string "%r"
                                           (format "%2.1f%%" (* 100 (/ total 
span))) t))
    (setq target-string (replace-in-string target-string "%R"
                                           (format "%2.1f%%" (* 100 (/ total 
Span))) t))))
    
(defun planner-timeclock-summary-extract-task-data (entry)
  "Given a TIME-ENTRY (see `timeclock-log-data'), return a list of
  (project task length). 
note the PROJECT there is 'project: task' here"
  (let ((task-fullname (timeclock-entry-project entry))
        (task-length (timeclock-entry-length entry))
        project-name task-name)
    ;; in case some manually clocked in tasks
    ;; without ": "
    (if (string-match ": .*$" task-fullname)
        (progn
          (setq project-name (replace-match "" t t
                                            task-fullname))
          (if (string-match " " project-name)
              ;; there's " " in project-name, this is not a really wiki name
              (progn
                (setq project-name planner-timeclock-summary-not-planned-string)
                (setq task-name task-fullname))
            (setq task-name (replace-in-string
                             task-fullname "^.*?: " "" t))))
      ;; no ": " found, not planned task
      (progn 
        (setq project-name planner-timeclock-summary-not-planned-string)
        (setq task-name task-fullname))
      )
    (list project-name task-name task-length)
    ))

(defun planner-timeclock-one-day-entry (date)
  "the data of a given day. The data is an ENTRY as in
timeclock.el. Arg date in format YYYY/MM/DD."
  (let ((day-list (timeclock-day-alist))
        entry-list)
    (while day-list
      (let ((theday (pop day-list)))
        (if (string-match date (car theday))
            (progn
              (setq entry-list theday)
              (setq day-list nil))
          )))
    entry-list))

(defun planner-timeclock-one-day-entry-no-date (date)
  (let ((entry-list (planner-timeclock-one-day-entry date)))
    (cdr entry-list))
  )

(defun planner-timeclock-one-day-alist (date)
  "the data of a given day. Arg date in format YYYY/MM/DD."
  (let ((entry-list (planner-timeclock-one-day-entry date)))
    (cddr entry-list))
  )

;; XEmacs has `replace-in-string', Gnu Emacs has
;; `replace-regexp-in-string'
(unless (fboundp 'replace-in-string)
  (defsubst replace-in-string (string regexp newtext &optional literal)
    "Replace all matches in STRING for REGEXP with NEWTEXT."
    (replace-regexp-in-string regexp newtext string 'fixedcase literal)))

(provide 'planner-timeclock-summary)
;;; planner-timeclock-summary.el ends here

;;; experimental code

(defcustom planner-timeclock-summary-task-project-summary-string
  "*Project Summary*"
  "Task name for project summary."
  :type 'string
  :group 'planner-timeclock-summary)

(defcustom planner-timeclock-summary-project-column-min-width 22
  "Min width of the project column in the report table"
  :type 'integer
  :group 'planner-timeclock-summary)

(defcustom planner-timeclock-summary-time-column-min-width 8
  "Min width of the time column in the report table"
  :type 'integer
  :group 'planner-timeclock-summary)

(defcustom planner-timeclock-summary-ratio-column-min-width 5
  "Min width of the ratio column in the report table"
  :type 'integer
  :group 'planner-timeclock-summary)

(defcustom planner-timeclock-summary-task-column-min-width 40
  "Min width of the task column in the report table"
  :type 'integer
  :group 'planner-timeclock-summary)

;; (defun planner-timeclock-summary-make-table-list-day (date)
;;   "make the output of `planner-timeclock-summary-calculate-ratio-day'
;; usable by `planner-timeclock-summary-table-insert-list'. The CAR of
;; the return value is the row number of the table, and the CDR is what
;; `planner-timeclock-summary-table-insert-list' want."
;;   (setq source-list (planner-timeclock-summary-calculate-ratio-day
;;                   date))
;;   (let ((projects (cdr source-list))
;;      (dest-list (list "Project" "Time" "Ratio" "Task"))
;;      (row-count 0))
;;     (while projects
;;       (let ((project-data (caar projects))
;;          (tasks (cdar projects)))
;;      (add-to-list 'dest-list 
;;                   (format "%s \n Total: %s, %2.1f%%"
;;                           (car project-data)
;;                           (timeclock-seconds-to-string 
;;                            (cadr project-data) t)
;;                           (* 100 (caddr project-data))) t)
;;      (setq row-count (1+ row-count))
;;      (setq task (car tasks))
;;      (add-to-list 'dest-list 
;;                   (format "%s" (timeclock-seconds-to-string 
;;                                 (car task) t) )t)
;;      (add-to-list 'dest-list
;;                   (format "%2.1f%%" (* 100 (cadr task))) t)
;;      (add-to-list 'dest-list
;;                   (format "%s" (caddr task)) t)
;;      (setq row-count (1+ row-count))
;;      (setq tasks (cdr tasks))
;;      (while tasks
;;        (let ((task (car tasks)))
;;          (add-to-list 'dest-list
;; ;;                    'planner-timeclock-summary-table-span-cell-above
;;                       "0"
;;                       t)
;;          (add-to-list 'dest-list 
;;                       (format "%s" (timeclock-seconds-to-string 
;;                                     (car task) t) )t)
;;          (add-to-list 'dest-list
;;                       (format "%2.1f%%" (* 100 (cadr task))) t)
;;          (add-to-list 'dest-list
;;                       (format "%s" (caddr task)) t)
;;          (setq row-count (1+ row-count))
;;          (setq tasks (cdr tasks))
;;          ))
;;      (setq projects (cdr projects))))
;;     (cons row-count dest-list)))

;; (defun planner-timeclock-summary-generate-report-day (date)
;;   "make the report table"
;;   (with-temp-buffer
;;   (let ((data-list (planner-timeclock-summary-make-table-list-day
;;                  date)))
;;     (table-insert 4 (car data-list) 
;;                (list
;;                 planner-timeclock-summary-project-column-min-width
;;                 planner-timeclock-summary-time-column-min-width
;;                 planner-timeclock-summary-ratio-column-min-width
;;                 planner-timeclock-summary-task-column-min-width)
;;                1)
;;     (planner-mode)
;;     (planner-timeclock-summary-table-insert-list (cdr data-list)))
;;   (buffer-string)))

;; this is wired: it works fine in edebug, but when called from
;; -show-2, the table messed up if there is a long annotation in the
;; task string. This should have something to do with the planner page
;; render.
(defun planner-timeclock-summary-make-table-day (date, start-point)
  "manipulate the output of
`planner-timeclock-summary-make-text-table-day' to a real nice table"
;;   (with-temp-buffer
;;     (erase-buffer)
    (insert (planner-timeclock-summary-make-text-table-day date))
;;     (planner-mode)
    (redraw-display)
    (table-capture 42 (point-max) "|" "\n" 'left 
                   (list planner-timeclock-summary-project-column-min-width
                         planner-timeclock-summary-time-column-min-width
                         planner-timeclock-summary-ratio-column-min-width
                         planner-timeclock-summary-task-column-min-width)
                   )
    ;; make "=====" cell empty and span above
;;     (goto-char (point-min))
;;     (while (search-forward
;;          planner-timeclock-summary-empty-cell-string)
;;       (beginning-of-line)
;;       (kill-line)
;;       (table-span-cell 'above))
;;     (buffer-string))
)

(defun planner-timeclock-summary-show-2 (&optional date)
  "Display a buffer with the given day's timeclock summary.

date is a string in the form YYYY.MM.DD. It will be asked if not
given."
  (interactive)
  (if (not date)
      (setq date (planner-read-date)))
  (switch-to-buffer (get-buffer-create planner-timeclock-summary-buffer))
  (erase-buffer)
  (let ((emacs-wiki-project planner-project))
    (insert "Timeclock summary report for " date "\n\n")
    (planner-mode)
    (planner-timeclock-summary-make-table-day
             (replace-in-string date "\\." "/" t) (point))
    )
  (goto-char (point-min))
  )

;; (defun planner-timeclock-summary-table-insert-list (list)
;;   ""
;;   (save-excursion
;;     (while list
;;       (let ((info (pop list)))
;;      (if (functionp info)
;;          (funcall info)
;;        (table-with-cache-buffer
;; ;;       (goto-char (point-min))
;;          (erase-buffer)
;;          (emacs-wiki-mode)
;;          (insert info)
;;          (table--fill-region (point-min) (point) nil 'left))
;;        )
;;      (table-forward-cell)
;;      ))))

(defun planner-timeclock-summary-table-span-cell-left ()
  "merge the current cell with the left one"
  (table-span-cell 'left)
)

(defun planner-timeclock-summary-table-span-cell-above ()
  "merge the current cell with the left one"
  (table-span-cell 'above)
)


;;; obsolate

(defun planner-timeclock-summary-generate-report (date)
  "Generate the timeclock summary table of the given date. This is the
function do the real work."
  (with-temp-buffer
    (insert (format "%s | %s | %s\n" "Project" "time" "task"))
    (let ((day-list (timeclock-day-alist)))
      (while day-list
        (let ((theday (pop day-list)))
          (if (string-match date (car theday))
              (let ((projects-name-theday (timeclock-day-projects
                                           theday))
                    )
                (while projects-name-theday
                  (let ((project-name-theday (pop
                                              projects-name-theday))
                        (projects-data-theday (cddr theday))
                        (time 0))
                    (if project-name-theday
                        (progn
                          (while projects-data-theday
                            (let ((project-data-theday (pop
                                                        projects-data-theday)))
                              ;;                              (if (string-match 
project-name-theday (nth 2
                              (if (string-equal project-name-theday (nth 2
                                                                         
project-data-theday))
                                  (incf time  (-
                                               (timeclock-time-to-seconds (nth 
1 project-data-theday))
                                               (timeclock-time-to-seconds (nth
                                                                           0
                                                                           
project-data-theday)))))))
                          ;; in case some manually clocked in tasks
                          ;; without ": "
                          (if (string-match ": .*$" project-name-theday)
                              (setq project-name (replace-match "" t t
                                                                
project-name-theday))
                            (setq project-name "Not Planned"))
                          (setq task-name (replace-in-string
                                           project-name-theday "^.*: " "" t))
                          (insert (format "%s | %s | %s\n"
                                          project-name 
                                          (timeclock-seconds-to-string time t)
                                          task-name))

                          ))
                    )))))))
      (when (fboundp 'align-regexp)
        (align-regexp (point-min) (point-max) "\\(\\s-*\\)|" 1 0 t))
    (buffer-string)
    ))
----------------------------------------------------------------------


-- 
Cheers,
Dryice

http://dryice.3322.org