From 6bbf74279c1e4f8c246bedb737318f02ddde75bd Mon Sep 17 00:00:00 2001
From: SqrtMinusOne <thexcloud@gmail.com>
Date: Sat, 18 Feb 2023 17:33:11 +0300
Subject: [PATCH] feat(emacs): org-mode alerts

---
 .emacs.d/init.el |  93 +++++++++++++++++++++++++++++++++++-
 Emacs.org        | 120 ++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 211 insertions(+), 2 deletions(-)

diff --git a/.emacs.d/init.el b/.emacs.d/init.el
index 2b6b179..98c31e4 100644
--- a/.emacs.d/init.el
+++ b/.emacs.d/init.el
@@ -2172,6 +2172,7 @@ Returns (<buffer> . <workspace-index>) or nil."
   :after (lsp)
   :init
   (setq lsp-ltex-version "15.2.0")
+  :config
   (setq lsp-ltex-check-frequency "save"))
 
 (defun my/ltex-lang ()
@@ -2188,6 +2189,7 @@ Returns (<buffer> . <workspace-index>) or nil."
      ((string-match-p (rx "/home/pavel/" (+ alnum) ".org" eos) file-name) nil)
      ((string-match-p (rx (literal org-directory) "/" (or "roam" "inbox-notes" "literature-notes" "journal")) file-name) t)
      ((string-match-p (rx (literal org-directory)) file-name) nil)
+     ((string-match-p (rx (literal (expand-file-name user-emacs-directory))) file-name) nil)
      (t t))))
 
 (defun my/text-mode-lsp-maybe ()
@@ -3057,7 +3059,12 @@ Returns (<buffer> . <workspace-index>) or nil."
   :if (not my/remote-server)
   :straight (:fetcher github
                       :repo "alphapapa/org-ql"
-                      :files (:defaults (:exclude "helm-org-ql.el"))))
+                      :files (:defaults (:exclude "helm-org-ql.el")))
+  :init
+  ;; See https://github.com/alphapapa/org-ql/pull/237
+  (setq org-ql-regexp-part-ts-time
+        (rx " " (repeat 1 2 digit) ":" (repeat 2 digit)
+            (optional "-" (repeat 1 2 digit) ":" (repeat 2 digit)))))
 
 (use-package org-habit-stats
   :straight (:host github :repo "ml729/org-habit-stats")
@@ -3125,6 +3132,90 @@ skip exactly those headlines that do not match."
                       (org-agenda-prefix-format " %i %-12:c")
                       (org-agenda-hide-tags-regexp ".")))))))
 
+(setq my/org-alert-notify-times '(600 60))
+
+(setq my/org-alert--alerts (make-hash-table :test #'equal))
+
+(defun my/org-alert--is-scheduled (label time)
+  "Check if LABEL is scheduled to be shown an TIME."
+  (gethash (cons label time)
+           my/org-alert--alerts nil))
+
+(defun my/org-alert--schedule (label time)
+  "Schedule LABEL to be shown at TIME, unless it's already scheduled."
+  (unless (my/org-alert--is-scheduled label time)
+    (puthash (cons label time)
+             (run-at-time time
+                          nil
+                          (lambda ()
+                            (alert label
+                                   :title "PROXIMITY ALERT")))
+             my/org-alert--alerts)))
+
+(defun my/org-alert-cleanup (&optional keys)
+  "Unschedule items that do not appear in KEYS.
+
+KEYS is a list of cons cells like (<label> . <time>)."
+  (let ((existing-hash (make-hash-table :test #'equal)))
+    (cl-loop for key in keys
+             do (puthash key t existing-hash))
+    (cl-loop for key being the hash-keys of my/org-alert--alerts
+             unless (gethash key existing-hash)
+             do (progn
+                  (cancel-timer (gethash key my/org-alert--alerts))
+                  (remhash key my/org-alert--alerts)))))
+
+(defun my/org-alert--update-today-alerts ()
+  (let ((items
+         (org-ql-query
+           :select 'element
+           :from (org-agenda-files)
+           :where `(and
+                    (todo "FUTURE")
+                    (ts-active :from ,(format-time-string "%Y-%m-%d %H:%M")
+                               :to ,(format-time-string
+                                     "%Y-%m-%d"
+                                     (time-add
+                                      (current-time)
+                                      (* 60 60 24)))
+                               :with-time t))
+           :order-by 'date))
+        scheduled-keys)
+    (cl-loop
+     for item in items
+     for scheduled = (org-timestamp-to-time (org-element-property :scheduled item))
+     do (cl-loop
+         for before-time in my/org-alert-notify-times
+         for label = (format "%s at %s [%s min. remaining]"
+                             (org-element-property :raw-value item)
+                             (format-time-string "%H:%M" scheduled)
+                             (number-to-string (/ before-time 60)))
+         for time = (time-convert
+                     (+ (time-convert scheduled 'integer) (- before-time)))
+         do (progn
+              (my/org-alert--schedule label time)
+              (push (cons label time) scheduled-keys))))
+    (my/org-alert-cleanup scheduled-keys)))
+
+(setq my/org-alert--timer nil)
+
+(define-minor-mode my/org-alert-mode ()
+  :global t
+  :after-hook
+  (if my/org-alert-mode
+      (progn
+        (my/org-alert--update-today-alerts)
+        (when (timerp my/org-alert--timer)
+          (cancel-timer my/org-alert--timer))
+        (setq my/org-alert--timer
+              (run-at-time 600 t #'my/org-alert--update-today-alerts)))
+    (when (timerp my/org-alert--timer)
+      (cancel-timer my/org-alert--timer))
+    (my/org-alert-cleanup)))
+
+(with-eval-after-load 'org
+  (my/org-alert-mode))
+
 (my-leader-def
   :infix "o"
   "" '(:which-key "org-mode")
diff --git a/Emacs.org b/Emacs.org
index 04c2504..8ba7ee4 100644
--- a/Emacs.org
+++ b/Emacs.org
@@ -2952,6 +2952,7 @@ It shouldn't be too hard to package that for guix, but I've installed the nix ve
   :after (lsp)
   :init
   (setq lsp-ltex-version "15.2.0")
+  :config
   (setq lsp-ltex-check-frequency "save"))
 #+end_src
 
@@ -2974,6 +2975,7 @@ Check whether it's necessary to run LTeX:
      ((string-match-p (rx "/home/pavel/" (+ alnum) ".org" eos) file-name) nil)
      ((string-match-p (rx (literal org-directory) "/" (or "roam" "inbox-notes" "literature-notes" "journal")) file-name) t)
      ((string-match-p (rx (literal org-directory)) file-name) nil)
+     ((string-match-p (rx (literal (expand-file-name user-emacs-directory))) file-name) nil)
      (t t))))
 #+end_src
 
@@ -4291,8 +4293,14 @@ None of that worked out, but I'll keep the package here in case I have some more
   :if (not my/remote-server)
   :straight (:fetcher github
                       :repo "alphapapa/org-ql"
-                      :files (:defaults (:exclude "helm-org-ql.el"))))
+                      :files (:defaults (:exclude "helm-org-ql.el")))
+  :init
+  ;; See https://github.com/alphapapa/org-ql/pull/237
+  (setq org-ql-regexp-part-ts-time
+        (rx " " (repeat 1 2 digit) ":" (repeat 2 digit)
+            (optional "-" (repeat 1 2 digit) ":" (repeat 2 digit)))))
 #+end_src
+
 **** Tracking habits
 Let's see how this goes.
 
@@ -4376,6 +4384,116 @@ And the agendas themselves:
                       (org-agenda-prefix-format " %i %-12:c")
                       (org-agenda-hide-tags-regexp ".")))))))
 #+end_src
+**** Alerts
+- Me at 10:00: /Open Org Agenga/ oh, there's a meeting at 15:00
+- Me at 14:00: /Open Org Agenda/ oh, there's a meeting at 15:00
+- Me at 14:45: Gotta remember to join in 15 minutes
+- Me at 14:55: Gotta remember to join in 5 minutes
+- Me at 15:05: Sh*t
+
+Okay, I will set up +org-alert+ some custom alert system.
+
+I want to have multiple warnings, let it be 10 minutes in advance and 1 minute in advance for now.
+#+begin_src emacs-lisp
+(setq my/org-alert-notify-times '(600 60))
+#+end_src
+
+And IDK if that makes much sense, but I'll try to avoid re-creating timers. So, here are functions to schedule showing some label at some time and to check whether the label is scheduled:
+#+begin_src emacs-lisp
+(setq my/org-alert--alerts (make-hash-table :test #'equal))
+
+(defun my/org-alert--is-scheduled (label time)
+  "Check if LABEL is scheduled to be shown an TIME."
+  (gethash (cons label time)
+           my/org-alert--alerts nil))
+
+(defun my/org-alert--schedule (label time)
+  "Schedule LABEL to be shown at TIME, unless it's already scheduled."
+  (unless (my/org-alert--is-scheduled label time)
+    (puthash (cons label time)
+             (run-at-time time
+                          nil
+                          (lambda ()
+                            (alert label
+                                   :title "PROXIMITY ALERT")))
+             my/org-alert--alerts)))
+#+end_src
+
+And unschedule items that need to be unscheduled:
+#+begin_src emacs-lisp
+(defun my/org-alert-cleanup (&optional keys)
+  "Unschedule items that do not appear in KEYS.
+
+KEYS is a list of cons cells like (<label> . <time>)."
+  (let ((existing-hash (make-hash-table :test #'equal)))
+    (cl-loop for key in keys
+             do (puthash key t existing-hash))
+    (cl-loop for key being the hash-keys of my/org-alert--alerts
+             unless (gethash key existing-hash)
+             do (progn
+                  (cancel-timer (gethash key my/org-alert--alerts))
+                  (remhash key my/org-alert--alerts)))))
+#+end_src
+
+And a function to extract the required items with =org-ql-query= and schedule them:
+#+begin_src emacs-lisp
+(defun my/org-alert--update-today-alerts ()
+  (let ((items
+         (org-ql-query
+           :select 'element
+           :from (org-agenda-files)
+           :where `(and
+                    (todo "FUTURE")
+                    (ts-active :from ,(format-time-string "%Y-%m-%d %H:%M")
+                               :to ,(format-time-string
+                                     "%Y-%m-%d"
+                                     (time-add
+                                      (current-time)
+                                      (* 60 60 24)))
+                               :with-time t))
+           :order-by 'date))
+        scheduled-keys)
+    (cl-loop
+     for item in items
+     for scheduled = (org-timestamp-to-time (org-element-property :scheduled item))
+     do (cl-loop
+         for before-time in my/org-alert-notify-times
+         for label = (format "%s at %s [%s min. remaining]"
+                             (org-element-property :raw-value item)
+                             (format-time-string "%H:%M" scheduled)
+                             (number-to-string (/ before-time 60)))
+         for time = (time-convert
+                     (+ (time-convert scheduled 'integer) (- before-time)))
+         do (progn
+              (my/org-alert--schedule label time)
+              (push (cons label time) scheduled-keys))))
+    (my/org-alert-cleanup scheduled-keys)))
+#+end_src
+
+Let's wrap it into a minor mode:
+#+begin_src emacs-lisp
+(setq my/org-alert--timer nil)
+
+(define-minor-mode my/org-alert-mode ()
+  :global t
+  :after-hook
+  (if my/org-alert-mode
+      (progn
+        (my/org-alert--update-today-alerts)
+        (when (timerp my/org-alert--timer)
+          (cancel-timer my/org-alert--timer))
+        (setq my/org-alert--timer
+              (run-at-time 600 t #'my/org-alert--update-today-alerts)))
+    (when (timerp my/org-alert--timer)
+      (cancel-timer my/org-alert--timer))
+    (my/org-alert-cleanup)))
+#+end_src
+
+#+begin_src emacs-lisp
+(with-eval-after-load 'org
+  (my/org-alert-mode))
+#+end_src
+
 **** Other settings
 Hotkeys
 #+begin_src emacs-lisp