From: tfheen <tfheen@8da78d58-1cd3-0310-bee5-d77bd1b3e8bf>
Date: Thu, 4 Jun 2009 18:08:20 +0000 (+0000)
Subject: Add org-dblock-write:gtimelog function
X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a15b32f450318df85d2d154579c19af3b14a44ad;p=dotfiles

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 5270fa0..f38d29f 100644
--- 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))))))
+