Add org-dblock-write:gtimelog function

git-svn-id: file:///svn/tfheen/trunk/dotfiles@1364 8da78d58-1cd3-0310-bee5-d77bd1b3e8bf

diff --git a/emacs b/emacs
index 5270fa0cc3e25c27e15b13726b58c14e69ba5c2d..f38d29f7c5dcfb1fe3ec2d91fd8042421174f4b1 100644 (file)
--- a/emacs
+++ b/emacs
@@ -393,3 +393,63 @@
  (define-key global-map (read-kbd-macro "C-+") 'font-zoom-increase-font-size)
  (define-key global-map (read-kbd-macro "C-=") 'font-zoom-reset-font-size)
  (font-zoom-reset-font-size))
+
+(defun org-dblock-write:gtimelog (params)
+  "Display day-by-day time reports in gtimelog format."
+  (let* ((ts (plist-get params :tstart))
+         (te (plist-get params :tend))
+        (ins (make-marker))
+         (maxlevel (plist-get params :maxlevel))
+         (start (time-to-seconds
+                 (apply 'encode-time (org-parse-time-string ts))))
+         (end (time-to-seconds
+               (apply 'encode-time (org-parse-time-string te))))
+        tbl day-numbers)
+    (setq params (plist-put params :tstart nil))
+    (setq params (plist-put params :end nil))
+    (move-marker ins (point))
+    (while (<= start end)
+      (save-excursion
+       (org-clock-sum start (+ start 86400))
+       (goto-char (point-min))
+       (setq st t)
+       (while (or (and (bobp) (prog1 st (setq st nil))
+                       (get-text-property (point) :org-clock-minutes)
+                       (setq p (point-min)))
+                  (setq p (next-single-property-change (point) :org-clock-minutes)))
+         (goto-char p)
+         (when (setq time (get-text-property p :org-clock-minutes))
+           (save-excursion
+             (beginning-of-line 1)
+             (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$"))
+                        (setq level (org-reduced-level
+                                     (- (match-end 1) (match-beginning 1))))
+                        (<= level maxlevel))
+               (push (list
+                      start
+                      (match-string 2)
+                      time) tbl))))))
+      (setq start (+ 86400 start)))
+    (setq tbl (nreverse tbl))
+    (goto-char ins)
+    (setq ts 0)
+    (while tbl
+      (let ((line (car tbl)))
+       (if (< ts (car line))
+           ; New day
+           (progn
+             (insert-before-markers
+              (format-time-string "%Y-%m-%d %H:%M %z"
+                                  (seconds-to-time (first line)))
+              ": Arrive\n")
+             (setq ts (first line))))
+
+       (insert-before-markers
+        (format-time-string "%Y-%m-%d %H:%M %z"
+                            (seconds-to-time (+ ts (* 60 (third line)))))
+        ": "
+        (format "%s" (second line))
+        "\n")
+       (setq ts (+ ts (* 60 (third line))))
+       (setq tbl (cdr tbl))))))
+