dotfiles/emacs/worklog.el

(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)