tvl-depot/users/aspen/emacs.d/org-alerts.el
Aspen Smith 82ecd61f5c chore(users): grfn -> aspen
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9
Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809
Autosubmit: aspen <root@gws.fyi>
Reviewed-by: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Reviewed-by: lukegb <lukegb@tvl.fyi>
2024-02-14 19:37:41 +00:00

188 lines
5.1 KiB
EmacsLisp

;;; -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:
(require 's)
(require 'dash)
(require 'alert)
(require 'org-agenda)
(defvar grfn/org-alert-interval 300
"Interval in seconds to recheck and display deadlines.")
(defvar grfn/org-alert-notification-title "*org*"
"Title to be sent with notify-send.")
(defvar grfn/org-alert-headline-regexp "\\(Sched.+:.+\\|Deadline:.+\\)"
"Regexp for headlines to search in agenda buffer.")
(defun grfn/org-alert--strip-prefix (headline)
"Remove the scheduled/deadline prefix from HEADLINE."
(replace-regexp-in-string ".*:\s+" "" headline))
(defun grfn/org-alert--unique-headlines (regexp agenda)
"Return unique headlines from the results of REGEXP in AGENDA."
(let ((matches (-distinct (-flatten (s-match-strings-all regexp agenda)))))
(--map (grfn/org-alert--strip-prefix it) matches)))
(defun grfn/org-alert--get-headlines ()
"Return the current org agenda as text only."
(with-temp-buffer
(let ((org-agenda-sticky nil)
(org-agenda-buffer-tmp-name (buffer-name)))
(ignore-errors (org-agenda-list nil "TODAY" 1))
(grfn/org-alert--unique-headlines
grfn/org-alert-headline-regexp
(buffer-substring-no-properties (point-min) (point-max))))))
(defun grfn/parse-range-string (str)
(when
(string-match (rx (group (repeat 2 (any digit))
":"
(repeat 2 (any digit)))
(optional
(and
"-"
(group (repeat 2 (any digit))
":"
(repeat 2 (any digit))))))
str)
(list
(org-read-date nil t
(match-string 1 str))
(when-let ((et (match-string 2 str))) (org-read-date nil t et)))))
(defun grfn/start-time-from-range-string (str)
(pcase-let ((`(,start-time . _) (grfn/parse-range-string str)))
start-time))
(comment
(org-agenda-list nil "TODAY" 1)
(grfn/org-alert--get-headlines)
(setq --src
(with-temp-buffer
(let ((org-agenda-sticky nil)
(org-agenda-buffer-tmp-name (buffer-name)))
(ignore-errors (org-agenda-list nil "TODAY" 1))
(buffer-substring-no-properties (point-min) (point-max)))))
(setq --entries
(with-temp-buffer
(let ((inhibit-redisplay t)
(org-agenda-sticky nil)
(org-agenda-buffer-tmp-name (buffer-name))
(org-agenda-buffer-name (buffer-name))
(org-agenda-buffer (current-buffer)))
(org-agenda-get-day-entries
(cadr (org-agenda-files nil 'ifmode))
(calendar-gregorian-from-absolute
(time-to-days (org-read-date nil t "TODAY")))))))
(loop for k in (text-properties-at 0 (car --entries))
by #'cddr
collect k)
(--map (substring-no-properties (get-text-property 0 'txt it)) --entries)
(--map (get-text-property 0 'time it) --entries)
(current-time)
(format-time-string "%R" (org-read-date nil t "10:00-11:00"))
(grfn/start-time-from-range-string "10:00")
(current-time-string (org-read-date nil t "10:00-11:00"))
(todo-state
org-habit-p
priority
warntime
ts-date
date
type
org-hd-marker
org-marker
face
undone-face
help-echo
mouse-face
done-face
org-complex-heading-regexp
org-todo-regexp
org-not-done-regexp
dotime
format
extra
time
level
txt
breadcrumbs
duration
time-of-day
org-lowest-priority
org-highest-priority
tags
org-category)
(propertize)
--src
)
(defun grfn/org-alert--headline-complete? (headline)
"Return whether HEADLINE has been completed."
(--any? (s-starts-with? it headline) org-done-keywords-for-agenda))
(defun grfn/org-alert--filter-active (deadlines)
"Remove any completed headings from the provided DEADLINES."
(-remove 'grfn/org-alert--headline-complete? deadlines))
(defun grfn/org-alert--strip-states (deadlines)
"Remove the todo states from DEADLINES."
(--map (s-trim (s-chop-prefixes org-todo-keywords-for-agenda it)) deadlines))
(defun grfn/org-alert-check ()
"Check for active, due deadlines and initiate notifications."
(interactive)
;; avoid interrupting current command.
(unless (minibufferp)
(save-window-excursion
(save-excursion
(save-restriction
(let ((active (grfn/org-alert--filter-active (grfn/org-alert--get-headlines))))
(dolist (dl (grfn/org-alert--strip-states active))
(alert dl :title grfn/org-alert-notification-title))))))
(when (get-buffer org-agenda-buffer-name)
(ignore-errors
(with-current-buffer org-agenda-buffer-name
(org-agenda-redo t))))))
(defun grfn/org-alert-enable ()
"Enable the notification timer. Cancels existing timer if running."
(interactive)
(grfn/org-alert-disable)
(run-at-time 0 grfn/org-alert-interval 'grfn/org-alert-check))
(defun grfn/org-alert-disable ()
"Cancel the running notification timer."
(interactive)
(dolist (timer timer-list)
(if (eq (elt timer 5) 'grfn/org-alert-check)
(cancel-timer timer))))
(provide 'grfn/org-alert)
;;; grfn/org-alert.el ends here