feat(emacs): org-mode alerts

This commit is contained in:
Pavel Korytov 2023-02-18 17:33:11 +03:00
parent bd718b254d
commit 6bbf74279c
2 changed files with 211 additions and 2 deletions

View file

@ -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")

120
Emacs.org
View file

@ -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