Add journal

1 files changed, 141 insertions, 0 deletions

diff --git a/config/org.el b/config/org.el
index cebc916..e058def 100644
--- a/config/org.el
+++ b/config/org.el
@@ -80,6 +80,147 @@
 		org-caldav-files '("~/Notes/tasks.org")))
 
 ;; =====================================
+;; Org Journal
+;; =====================================
+
+(use-package org-journal
+  :after org
+  :bind
+  ("C-c j" . org-journal-new-entry)
+  ("C-c r" . org-journal-rate-day)
+  ("C-c R" . org-journal-ratings-view)
+  :config
+  (setq org-journal-dir "~/Notes/journal/"
+	org-journal-file-type 'daily
+	org-journal-date-format "%A, %B %d %Y"
+	org-journal-file-format "%Y-%m-%d.org"
+	org-journal-carryover-items "TODO=\"TODO\"")
+
+  (defun org-journal-rate-day (arg)
+    "Rate a journal entry from 1-10. With prefix ARG, prompt for date."
+    (interactive "P")
+    (let* ((date (if arg
+		     (org-read-date nil nil nil "Rate which day? ")
+		   (format-time-string "%Y-%m-%d")))
+	   (journal-file (expand-file-name (concat date ".org")
+					   org-journal-dir)))
+      (if (not (file-exists-p journal-file))
+	  (user-error "No journal entry for %s" date)
+	(let ((rating (read-number (format "Rate %s (1-10): " date))))
+	  (setq rating (max 1 (min 10 rating)))
+	  (with-current-buffer (find-file-noselect journal-file)
+	    (goto-char (point-min))
+	    (if (re-search-forward "^#\\+RATING:" nil t)
+		(progn
+		  (beginning-of-line)
+		  (kill-whole-line)
+		  (insert (format "#+RATING: %d\n" rating)))
+	      (goto-char (point-min))
+	      (insert (format "#+RATING: %d\n" rating)))
+	    (save-buffer)
+	    (message "Rated %s %d/10" date rating))))))
+
+  (defun org-journal--rating-color (rating)
+    "Return a color for RATING (1-10)."
+    (pcase rating
+      (1  "#4a0000") (2  "#6b1010") (3  "#8b3a3a")
+      (4  "#8b6508") (5  "#8b8b00") (6  "#6b8e23")
+      (7  "#3a8b3a") (8  "#228b22") (9  "#1a9a1a") (10 "#00cc00")
+      (_  "#333333")))
+
+  (defun org-journal--read-ratings (year month)
+    "Read all ratings for YEAR-MONTH. Returns alist of (day . rating)."
+    (let ((ratings nil)
+	  (pattern (format "%04d-%02d-" year month)))
+      (dolist (file (directory-files (expand-file-name org-journal-dir) t
+				    (concat pattern ".*\\.org$")))
+	(let ((day (string-to-number
+		    (substring (file-name-base file) 8 10))))
+	  (with-temp-buffer
+	    (insert-file-contents file)
+	    (goto-char (point-min))
+	    (when (re-search-forward "^#\\+RATING:\\s-*\\([0-9]+\\)" nil t)
+	      (push (cons day (string-to-number (match-string 1))) ratings)))))
+      ratings))
+
+  (defun org-journal-ratings-view (&optional year month)
+    "Display a calendar heatmap of daily ratings."
+    (interactive)
+    (let* ((now (decode-time))
+	   (year (or year (nth 5 now)))
+	   (month (or month (nth 4 now)))
+	   (buf (get-buffer-create "*Daily Ratings*")))
+      (with-current-buffer buf
+	(let ((inhibit-read-only t))
+	  (erase-buffer)
+	  (org-journal--render-ratings year month)
+	  (goto-char (point-min)))
+	(special-mode)
+	(local-set-key (kbd "p") #'org-journal-ratings-prev-month)
+	(local-set-key (kbd "n") #'org-journal-ratings-next-month)
+	(local-set-key (kbd "q") #'quit-window)
+	(setq-local org-journal-ratings--year year)
+	(setq-local org-journal-ratings--month month))
+      (switch-to-buffer buf)))
+
+  (defun org-journal--render-ratings (year month)
+    "Render the ratings grid for YEAR-MONTH into current buffer."
+    (let* ((ratings (org-journal--read-ratings year month))
+	   (days-in-month (calendar-last-day-of-month month year))
+	   (first-dow (mod (calendar-day-of-week (list month 1 year)) 7))
+	   (month-name (calendar-month-name month))
+	   (header (format " %s %d " month-name year))
+	   (avg (if ratings
+		    (/ (apply #'+ (mapcar #'cdr ratings))
+		       (float (length ratings)))
+		  0.0)))
+      (insert (propertize header 'face '(:weight bold :height 1.3)) "\n")
+      (insert (propertize " [p]rev  [n]ext  [q]uit" 'face 'shadow) "\n\n")
+      (insert " Su  Mo  Tu  We  Th  Fr  Sa\n")
+      (insert " ")
+      (dotimes (_ first-dow) (insert "    "))
+      (dotimes (i days-in-month)
+	(let* ((day (1+ i))
+	       (rating (cdr (assq day ratings)))
+	       (cell (if rating
+			 (propertize "██"
+				     'face `(:foreground ,(org-journal--rating-color rating)))
+		       (propertize "░░" 'face '(:foreground "#555555"))))
+	       (tip (if rating (format "%2d" rating) "  ")))
+	  (insert cell tip)
+	  (when (= (mod (+ first-dow day) 7) 0)
+	    (insert "\n "))))
+      (insert "\n\n")
+      (insert " Legend: ")
+      (dotimes (i 10)
+	(let ((r (1+ i)))
+	  (insert (propertize "██"
+			      'face `(:foreground ,(org-journal--rating-color r)))
+		  (format "%d " r))))
+      (insert "\n")
+      (when ratings
+	(insert (format "\n Avg: %.1f/10  |  %d/%d days rated\n"
+			avg (length ratings) days-in-month)))))
+
+  (defun org-journal-ratings-prev-month ()
+    "Show previous month's ratings."
+    (interactive)
+    (let* ((y org-journal-ratings--year)
+	   (m org-journal-ratings--month)
+	   (new-month (if (= m 1) 12 (1- m)))
+	   (new-year (if (= m 1) (1- y) y)))
+      (org-journal-ratings-view new-year new-month)))
+
+  (defun org-journal-ratings-next-month ()
+    "Show next month's ratings."
+    (interactive)
+    (let* ((y org-journal-ratings--year)
+	   (m org-journal-ratings--month)
+	   (new-month (if (= m 12) 1 (1+ m)))
+	   (new-year (if (= m 12) (1+ y) y)))
+      (org-journal-ratings-view new-year new-month))))
+
+;; =====================================
 ;; Calendar Framework (calfw)
 ;; =====================================