git-subtree-dir: users/glittershark/emacs.d git-subtree-mainline:2edb963b97git-subtree-split:69ee53bffa
		
			
				
	
	
		
			188 lines
		
	
	
	
		
			5.2 KiB
		
	
	
	
		
			EmacsLisp
		
	
	
	
	
	
			
		
		
	
	
			188 lines
		
	
	
	
		
			5.2 KiB
		
	
	
	
		
			EmacsLisp
		
	
	
	
	
	
;;; ~/.doom.d/org-alerts.el -*- 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
 |