emacs worklogging

emacs/worklog.el

@@ -0,0 +1,172 @@
+(setq worklog-dir "~/Documents/journal/")
+(setq worklog-weeklies "~/Documents/journal/weeklies/")
+
+(setq worklog-seconds-in-a-day (* 24 60 60))
+(setq worklog-seconds-in-a-week (* 7 worklog-seconds-in-a-day))
+
+  
+(defun filename-for-day (given-day)
+  "Return filename for today's buffer."
+  (concat worklog-dir
+          (downcase (format-time-string "%a%m%d%y" given-day))
+          ".org"))
+
+(defun filename-for-weekly (given-day)
+  "Return filename for week's buffer."
+  (concat worklog-weeklies
+          (buffername-for-weekly given-day)))
+
+(defun buffername-for-weekly (given-day)
+  (concat
+   (downcase (format-time-string "week%U-%y" (find-day-in-week given-day 5)))
+   ".org"))
+
+(defun filename-for-today ()
+  (filename-for-day (current-time)))
+
+;; unused!
+(defun filename-for-this-weekly ()
+  (filename-for-weekly (current-time)))
+
+(defun filename-for-days-away-entry (days-away)
+  "Return filename of a daily with int days-away offset."
+  (concat worklog-dir
+          (downcase
+           (format-time-string
+            "%a%m%d%y"
+            (encode-time (decoded-time-add
+                          (decode-time nil nil t)
+                          (make-decoded-time :day days-away)))))
+          ".org"))
+
+(defun yesterdays-daily ()
+  "Open yesterday's news"
+  (interactive)
+  (find-file (filename-for-days-away-entry (- 1))))
+
+;; unused!
+(defun read-last-week ()
+  "Read the last seven day's entries into the current buffer."
+  (interactive)
+  (defun insert-filename-and-contents (fname)
+    (goto-char (point-max))
+    (newline)
+    (insert "* ⋱ " (file-name-base fname))
+    (newline)
+    (insert-file-contents fname)
+    (replace-regexp "[*]+ [^⋱].+" "*\\&"))
+  (defun days-iter (current-day goal-day)
+    (let ((todays-file (filename-for-days-away-entry current-day)))
+      (if (> current-day goal-day)
+          nil
+        (progn (if (file-exists-p todays-file)
+                   (insert-filename-and-contents todays-file))
+               (days-iter (+ current-day 1) goal-day)))))
+  (days-iter (- 7) 0))
+
+(defun read-week-around-day (given-day)
+  (defun insert-filename-and-contents (fname)
+    (goto-char (point-max))
+    (newline)
+    (insert "* ⋱ " (file-name-base fname))
+    (newline)
+    (insert-file-contents fname)
+    (replace-regexp "[*]+ [^⋱].+" "*\\&"))
+  (defun insert-header-categories ()
+    (goto-char (point-min))
+    (insert "* TICKETS")
+    (newline)
+    (insert "* MEETINGS")
+    (newline)
+    (insert "* EXTRA CURRICULAR")
+    (newline))
+  (defun days-iter (weekday weekday-end)
+    (let ((days-file (filename-for-day (find-day-in-week given-day weekday))))
+      (cond ((> weekday weekday-end) nil)
+            (t
+             (progn
+               (if (file-exists-p days-file)
+                   (insert-filename-and-contents days-file))
+               (days-iter (+ weekday 1) weekday-end))))))
+  (days-iter 1 5)
+  (insert-header-categories))
+
+(defun worklog-load-notes-for-week (given-day)
+  (find-file (filename-for-weekly given-day))
+  (set-buffer (buffername-for-weekly given-day))
+  (read-week-around-day given-day))
+
+(defun worklog-this-weeks-entry ()
+  "Gather the notes from this week (to do on friday)."
+  (interactive)
+  (worklog-load-notes-for-week (current-time)))
+
+(defun a-week-ago-from-day (given-day)
+  (time-add given-day (- worklog-seconds-in-a-week)))
+
+(defun worklog-last-weeks-entry ()
+  "Gather the notes from last week (if u forgot to do it on friday)."
+  (interactive)
+  (worklog-load-notes-for-week  (a-week-ago-from-day (current-time))))
+
+(defun worklog-todays-entry ()
+  "Open the worklog buffer for today's date."
+  (interactive)
+  (find-file (filename-for-today)))
+
+(defun worklog-yesterdays-entry ()
+  (interactive)
+  (find-file (filename-for-days-away-entry (- 1))))
+
+(defun worklog-days-ago-entry (days-ago)
+  (interactive "P")
+  (find-file (filename-for-days-away-entry
+              (- (prefix-numeric-value days-ago)))))
+
+(defun find-day-in-week (given-day day-of-week)
+  "Return datetime that is 1,2,3,4,5:M,T,W,T,F in the same week as given-day."
+  (let ((day (decode-time given-day)))
+    (cond ((= (decoded-time-weekday day) day-of-week)
+           given-day)
+          ((< (decoded-time-weekday day) day-of-week)
+           (find-day-in-week (time-add given-day worklog-seconds-in-a-day) day-of-week))
+          ((> (decoded-time-weekday day) day-of-week)
+           (find-day-in-week (time-add given-day (- worklog-seconds-in-a-day)) day-of-week)))))
+
+;; unused!
+(defun this-weeks-friday ()
+  (find-day-in-week (current-time) 5))
+
+;;unused!
+(defun this-weeks-monday ()
+  (find-day-in-week (current-time) 1))
+
+(defun worklog-parse-my-buffername (buffername)
+  (let ((day-of-week (substring buffername 0 3))
+        (month       (string-to-number (substring buffername 3 5)))
+        (day         (string-to-number (substring buffername 5 7)))
+        (year        (string-to-number (substring buffername 7 9))))
+    (encode-time (make-decoded-time :second 0 :minute 0 :hour 0
+                                    :month month :day day :year year))))
+(defun worklog-date-for-current-buffer ()
+  (worklog-parse-my-buffername (buffer-name)))
+
+(defun worklog-previous-daily ()
+  (defun daily-exists-p (date)
+    (file-exists-p (filename-for-day date)))
+  (defun daily-iter (days-back current-daily-date)
+    (let ((daily-date (time-add current-daily-date
+                                (- (* days-back worklog-seconds-in-a-day)))))
+      (if (daily-exists-p daily-date)
+          (find-file (filename-for-day daily-date))
+        (daily-iter (1+ days-back) current-daily-date))))
+  (interactive)
+  (daily-iter 1 (worklog-date-for-current-buffer)))
+
+(defvar worklog-map (make-sparse-keymap)
+  "Worklog bindings.")
+(global-set-key (kbd "C-c w") worklog-map)
+(define-key worklog-map (kbd "d") 'worklog-todays-entry)
+(define-key worklog-map (kbd "w") 'worklog-this-weeks-entry)
+(define-key worklog-map (kbd "p") 'worklog-previous-daily)
+(define-key worklog-map (kbd "y") 'worklog-yesterdays-entry)