emacs/org/elpa/org-alert-20220721.1721/org-alert.el

170 lines
6.1 KiB
EmacsLisp

;;; org-alert.el --- Notify org deadlines via notify-send
;; Copyright (C) 2015 Stephen Pegoraro
;; Author: Stephen Pegoraro <spegoraro@tutive.com>
;; Version: 0.2.0
;; Package-Version: 20220721.1721
;; Package-Commit: f1801e061722843329b95409957c7dbd5cc223e9
;; Package-Requires: ((org "9.0") (alert "1.2"))
;; Keywords: org, org-mode, notify, notifications, calendar
;; URL: https://github.com/spegoraro/org-alert
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides functions to display system notifications for
;; any org-mode deadlines that are due in your agenda. To perform a
;; one-shot check call (org-alert-deadlines). To enable repeated
;; checking call (org-alert-enable) and to disable call
;; (org-alert-disable). You can set the checking interval by changing
;; the org-alert-interval variable to the number of seconds you'd
;; like.
;;; Code:
(require 'cl-lib)
(require 'alert)
(require 'org-agenda)
(defvar org-alert-interval 300
"Interval in seconds to recheck and display deadlines.")
;; TODO look for a property of the agenda entry as suggested in
;; https://github.com/spegoraro/org-alert/issues/20
(defvar org-alert-notify-cutoff 10
"Time in minutes before a deadline a notification should be sent.")
(defvar org-alert-notify-after-event-cutoff nil
"Time in minutes after a deadline to stop sending notifications.
If nil, never stop sending notifications.")
(defvar org-alert-notification-title "*org*"
"Title to be sent with notify-send.")
(defvar org-alert-match-string
"SCHEDULED>=\"<today>\"+SCHEDULED<\"<tomorrow>\"|DEADLINE>=\"<today>\"+DEADLINE<\"<tomorrow>\""
"property/todo/tags match string to be passed to `org-map-entries'.")
(defvar org-alert-time-match-string
"\\(?:SCHEDULED\\|DEADLINE\\):.*<.*\\([0-9]\\{2\\}:[0-9]\\{2\\}\\).*>"
"regex to find times in an org subtree. The first capture group
is used to extract the time")
(defun org-alert--read-subtree ()
"Return the current subtree as a string. Adapted from
`org-copy-subtree` from org-mode."
(org-preserve-local-variables
(let (beg end folded (beg0 (point)))
(org-back-to-heading t)
(setq beg (point))
(skip-chars-forward " \t\r\n")
(save-match-data
(save-excursion (outline-end-of-heading)
(setq folded (org-invisible-p)))
(ignore-errors (org-forward-heading-same-level (1- n) t))
(org-end-of-subtree t t))
;; Include the end of an inlinetask
(when (and (featurep 'org-inlinetask)
(looking-at-p (concat (org-inlinetask-outline-regexp)
"END[ \t]*$")))
(end-of-line))
(setq end (point))
(goto-char beg0)
(when (> end beg)
(setq org-subtree-clip-folded folded)
(buffer-substring-no-properties beg end)))))
;; I think this is unnecessary now that we're using read-subtree
;; instead of copy-subtree
(defun org-alert--strip-text-properties (text)
"Strip all of the text properties from a copy of TEXT and
return the stripped copy"
(let ((text (substring text)))
(set-text-properties 0 (length text) nil text)
text))
(defun org-alert--grab-subtree ()
"Return the current org subtree as a string with the
text-properties stripped"
(let* ((subtree (org-alert--read-subtree))
(text (org-alert--strip-text-properties subtree)))
(apply #'concat
(cl-remove-if #'(lambda (s) (string= s ""))
(cdr (split-string text "\n"))))))
(defun org-alert--to-minute (hour minute)
"Convert HOUR and MINUTE to minutes"
(+ (* 60 hour) minute))
(defun org-alert--check-time (time &optional now)
"Check if TIME is less than `org-alert-notify-cutoff` from NOW. If
`org-alert-notify-after-event-cutoff` is set, also check that NOW
is less than `org-alert-notify-after-event-cutoff` past TIME."
(let* ((time (mapcar #'string-to-number (split-string time ":")))
(now (or now (decode-time (current-time))))
(now (org-alert--to-minute (decoded-time-hour now) (decoded-time-minute now)))
(then (org-alert--to-minute (car time) (cadr time)))
(time-until (- then now)))
(if org-alert-notify-after-event-cutoff
(and
(<= time-until org-alert-notify-cutoff)
;; negative time-until past events
(> time-until (- org-alert-notify-after-event-cutoff)))
(<= time-until org-alert-notify-cutoff))))
(defun org-alert--parse-entry ()
"Parse an entry from the org agenda and return a list of the
heading and the scheduled/deadline time"
(let ((head (org-alert--strip-text-properties (org-get-heading t t t t)))
(body (org-alert--grab-subtree)))
(string-match org-alert-time-match-string body)
(list head (match-string 1 body))))
(defun org-alert--dispatch ()
(let* ((entry (org-alert--parse-entry))
(head (car entry))
(time (cadr entry)))
(if time
(when (org-alert--check-time time)
(alert (concat time ": " head) :title org-alert-notification-title))
(alert head :title org-alert-notification-title))))
(defun org-alert-check ()
"Check for active, due deadlines and initiate notifications."
(interactive)
(org-map-entries 'org-alert--dispatch org-alert-match-string 'agenda
'(org-agenda-skip-entry-if 'todo
org-done-keywords-for-agenda))
t)
(defun org-alert-enable ()
"Enable the notification timer. Cancels existing timer if running."
(interactive)
(org-alert-disable)
(run-at-time 0 org-alert-interval 'org-alert-check))
(defun org-alert-disable ()
"Cancel the running notification timer."
(interactive)
(dolist (timer timer-list)
(if (eq (elt timer 5) 'org-alert-check)
(cancel-timer timer))))
(provide 'org-alert)
;;; org-alert.el ends here