about summary refs log tree commit diff
path: root/users/aspen/emacs.d/org-alerts.el
diff options
context:
space:
mode:
Diffstat (limited to 'users/aspen/emacs.d/org-alerts.el')
-rw-r--r--users/aspen/emacs.d/org-alerts.el188
1 files changed, 188 insertions, 0 deletions
diff --git a/users/aspen/emacs.d/org-alerts.el b/users/aspen/emacs.d/org-alerts.el
new file mode 100644
index 0000000000..8e6c3e0417
--- /dev/null
+++ b/users/aspen/emacs.d/org-alerts.el
@@ -0,0 +1,188 @@
+;;; -*- 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