diff --git a/worktimer.scm b/worktimer.scm
index c94eca3..1abee0d 100755
--- a/worktimer.scm
+++ b/worktimer.scm
@@ -21,19 +21,24 @@
 ;; THE SOFTWARE.
 
 (import (rnrs io ports (6))
+        (srfi srfi-1)
         (srfi srfi-19)
         (srfi srfi-11))
 
 ;;; Use srfi-48 in other scheme implementation
 (use-modules (ice-9 format))
 
+(use-modules (ice-9 pretty-print))
+
 ;;; Record format:
-;;; PROJECT/PATH: [START_TIME] - [STOP_TIME] - DURATION
+;;; PROJECT/TASK/SUBTASK/ETC: [START_TIME] - [STOP_TIME] - DURATION
+
+(define date-format "~Y-~m-~d ~H:~M:~S")
 
 ;;; Find substring separated by ch-start and ch-end.
-;; (substring/find str ch-start ch-end [begin end]) 
-;; If ch-start is #f, select substring from beginning of string.
-;; If ch-end is #f, select substring from ch-start to end string.
+;;; (substring/find str ch-start ch-end [begin end]) 
+;;; If ch-start is #f, select substring from beginning of string.
+;;; If ch-end is #f, select substring from ch-start to end string.
 (define (substring/find str ch-start ch-end . args)
   (let ((start (if (null? args) 0 (car args)))
         (end (if (< (length args) 2) (string-length str) (cadr args))))
@@ -45,6 +50,7 @@
               (if (not cs) (reverse strings)
                   (loop (cons (substring str (1+ cs) ce) strings) (1+ ce)))))))))
 
+;;; Convert time-difference to string "hh:mm:ss"
 (define (time-difference->h:m:s td)
   (let ((sec (time-second td)))
     (let* ((h (quotient sec 3600))
@@ -55,6 +61,7 @@
        (format #f "~2,'0d" m) ":"
        (format #f "~2,'0d" s)))))
 
+;;; Convert path to string
 (define (path->string path)
   (let loop ((path path)
              (str ""))
@@ -65,7 +72,9 @@
                (car path)
                (if (null? (cdr path)) "" "/"))))))
 
-(define (parse-path str . args)
+;;; Split path to separate elements
+;;; (path-split str [start end])
+(define (path-split str . args)
   (let ((start (if (null? args) 0 (car args)))
         (end (if (or (null? args) (null? (cdr args))) (string-length str) (cadr args))))
     (let loop ((path '()) (path-start start))
@@ -75,11 +84,13 @@
             (loop
              (cons (substring str path-start item-end) path) (1+ item-end)))))))
 
+;;; Parse task string and return list:
+;;; '((list of path elements) start-date stop-date duration)
 (define (parse-task-string str)
   (let ((path
          (let ((path-end (string-index str #\:)))
            (if (not path-end) '()
-               (parse-path str 0 path-end))))
+               (path-split str 0 path-end))))
         (dates (substring/find str #\[ #\])))
     (if (null? dates) '()
         (let ((date-start (string->date (car dates) "~Y-~m-~d ~H:~M:~S")))
@@ -93,94 +104,157 @@
                               (values date-end duration)))))
             (list path date-start date-end duration))))))
 
+;;; Parse timesheet file and return list of tasks
 (define (parse-timesheet filename)
   (call-with-input-file filename
     (lambda (port)
       (let loop ((recs '()))
         (let ((line (get-line port)))
           (if (eof-object? line)
-              recs
-              (loop (parse-task-string line))))))))
+              (reverse recs)
+              (loop (cons (parse-task-string line) recs))))))))
 
-(define (timesheet-get-last filename)
-  (let ((last-line
-         (call-with-input-file filename
-           (lambda (port)
-             (let loop ((last-line ""))
-               (let ((line (get-line port)))
-                 (if (eof-object? line) last-line
-                     (loop line))))))))
-    (parse-task-string last-line)))
+;;; Return difference of two dates
+(define (date-difference d1 d2)
+  (time-difference
+   (date->time-utc d1)
+   (date->time-utc d2)))
 
-(define (call-with-append-file filename thunk)
-  (let ((port (open-file filename
-                         (if (file-exists? filename) "a" "w"))))
-    (thunk port)
-    (close-port port)))
+;;; Print timesheet
+(define (print-timesheet timesheet)
+  (for-each
+   (lambda (task)
+     (let ((path (car task))
+           (sdate (cadr task))
+           (edate (caddr task))
+           (duration (cadddr task)))
+       (format #t "~a: [~a]"
+               (path->string path)
+               (date->string sdate date-format))
+       (if edate
+           (format #t " - [~a] - ~a\n"
+                   (date->string edate date-format)
+                   (time-difference->h:m:s duration))
+           (newline))))
+   timesheet))
 
-(define (write-stop-and-duration port start-date stop-date)
-  (format port " - [~a] - ~a\n"
-          (date->string stop-date "~Y-~m-~d ~H:~M:~S")
-          (time-difference->h:m:s
-           (time-difference
-            (date->time-utc stop-date)
-            (date->time-utc start-date)))))
+;;; Report is a tree of projects items.
+;;; Root of the tree is super-project with name "ROOT":
+;;; ("ROOT" d
+;;;  ("PROJ1" d
+;;;   ("P1-TASK1" d
+;;;    ("P1-T1-SUBTASK1" d)
+;;;    ("P1-T1-SUBTASK2" d))
+;;;   ("P1-TASK2" d)))
+(define (make-report timesheet)
+  ;; Add task duration to project branch
+  (define (tree-add-duration project-tree path duration)
+    (let tree-walk ((tree project-tree)
+                    (path path))
+      ;; Add task duration to tree leaf
+      (set-car! (cdr tree) (add-duration (cadr tree) duration))
+
+      ;; Search next leaf corresponding with path item
+      (if (null? path)
+          project-tree
+          (let ((item (find
+                       (lambda (i) (string= (car i) (car path)))
+                       (cddr tree))))
+            (if item
+                (tree-walk item (cdr path))
+
+                ;; Add new branch (or leaf) to tree
+                (let ((add-items
+                       (let add-item-loop ((add-items '())
+                                           (path (reverse path)))
+                         (if (null? path)
+                             add-items
+                             (add-item-loop
+                              (if (null? add-items)
+                                  (list (car path) duration)
+                                  (list (car path) duration add-items))
+                              (cdr path))))))
+                  (set-cdr! (cdr tree) (cons add-items (cddr tree)))
+                  project-tree))))))
+  ;; END tree-add-duration
+  
+  (let loop ((projects (list "Overall" (make-time 'time-duration 0 0)))
+             (timesheet timesheet))
+    (if (null? timesheet)
+        projects                        ; TODO Sort projects by path
+        (let* ((task (car timesheet))
+               (path (car task))
+               (duration (cadddr task)))
+          (loop (if duration
+                    (tree-add-duration projects path duration)
+                    projects)
+                (cdr timesheet))))))
+
+(define (print-report report)
+  (let walk ((tree report)
+             (level 0))
+    (when (not (null? tree))
+      (format #t "~v_~a: ~a\n" level (car tree)
+              (time-difference->h:m:s (cadr tree)))
+      (for-each (lambda (l) (walk l (+ level 2))) (cddr tree)))))
 
 ;; MAIN
 
 (define ts-file "/home/np/timesheet.txt")
 
-(let* ((cmdl (command-line))
-       (params (cdr cmdl)))
-  (if (null? params) 
-      ;; No command. Show last record and duration if running
-      (let ((last (timesheet-get-last ts-file)))
-        (if (null? last)
-            (format #t "Not any tasks\n")
-            (let ((path (car last))
-                  (start-date (cadr last))
-                  (stop-date (caddr last))
-                  (duration (cadddr last))
-                  (now (current-date)))
-              (format #t "~a: [~a] - [~a] - ~a\n"
-                      (path->string path)
-                      (date->string start-date "~Y-~m-~d ~H:~M:~S")
-                      (if (not stop-date) "NOW"
-                          (date->string stop-date "~Y-~m-~d ~H:~M:~S"))
-                      (time-difference->h:m:s
-                       (if duration duration
-                           (time-difference
-                            (date->time-utc (if stop-date stop-date now))
-                            (date->time-utc start-date))))))))
+;; (let* ((cmdl (command-line))
+;;        (params (cdr cmdl)))
+;;   (if (null? params) 
+;;       ;; No command. Show last record and duration if running
+;;       (let ((last (timesheet-get-last ts-file)))
+;;         (if (null? last)
+;;             (format #t "Not any tasks\n")
+;;             (let ((path (car last))
+;;                   (start-date (cadr last))
+;;                   (stop-date (caddr last))
+;;                   (duration (cadddr last))
+;;                   (now (current-date)))
+;;               (format #t "~a: [~a] - [~a] - ~a\n"
+;;                       (path->string path)
+;;                       (date->string start-date "~Y-~m-~d ~H:~M:~S")
+;;                       (if (not stop-date) "NOW"
+;;                           (date->string stop-date "~Y-~m-~d ~H:~M:~S"))
+;;                       (time-difference->h:m:s
+;;                        (if duration duration
+;;                            (time-difference
+;;                             (date->time-utc (if stop-date stop-date now))
+;;                             (date->time-utc start-date))))))))
 
-      ;; Commands
-      (let ((command (car params))
-            (date (current-date)))
-        (cond
+;;       ;; Commands
+;;       (let ((command (car params))
+;;             (date (current-date)))
+;;         (cond
 
-         ((equal? command "start")
-          ;; ----------------------- Start timer ------------------------- ;;
-          (call-with-append-file
-           ts-file
-           (lambda (port)
-             (let* ((last (timesheet-get-last ts-file))
-                    (path
-                     (if (null? (cdr params))
-                         (if (null? last) '() (car last))
-                         (parse-path (cadr params)))))
-               (if (null? path)
-                   (format #t "ERROR: Not specified the task path\n")
-                   (begin
-                     (when (and (not (null? last)) (not (caddr last)))
-                       (write-stop-and-duration port (cadr last) date))
-                     (format port "~a: [~a]" (path->string path) (date->string date "~Y-~m-~d ~H:~M:~S"))))))))
+;;          ((equal? command "start")
+;;           ;; ----------------------- Start timer ------------------------- ;;
+;;           (call-with-append-file
+;;            ts-file
+;;            (lambda (port)
+;;              (let* ((last (timesheet-get-last ts-file))
+;;                     (path
+;;                      (if (null? (cdr params))
+;;                          (if (null? last) '() (car last))
+;;                          (path-split (cadr params)))))
+;;                (if (null? path)
+;;                    (format #t "ERROR: Not specified the task path\n")
+;;                    (begin
+;;                      (when (and (not (null? last)) (not (caddr last)))
+;;                        (write-stop-and-duration port (cadr last) date))
+;;                      (format port "~a: [~a]" (path->string path) (date->string date "~Y-~m-~d ~H:~M:~S"))))))))
 
-         ((equal? command "stop")
-          ;; ----------------------- Stop timer ------------------------- ;;
-          (call-with-append-file
-           ts-file
-           (lambda (port)
-             (let ((last (timesheet-get-last ts-file)))
-               (if (or (null? last) (caddr last))
-                   (format #t "WARNING: Not running any tasks\n")
-                   (write-stop-and-duration port (cadr last) date))))))))))
+;;          ((equal? command "stop")
+;;           ;; ----------------------- Stop timer ------------------------- ;;
+;;           (call-with-append-file
+;;            ts-file
+;;            (lambda (port)
+;;              (let ((last (timesheet-get-last ts-file)))
+;;                (if (or (null? last) (caddr last))
+;;                    (format #t "WARNING: Not running any tasks\n")
+;;                    (write-stop-and-duration port (cadr last) date))))))))))
+
+(print-report (make-report (parse-timesheet ts-file)))