diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml new file mode 100644 index 0000000..bf4beeb --- /dev/null +++ b/.github/workflows/test.yml @@ -0,0 +1,33 @@ +# copied from +# https://github.com/magnars/s.el/blob/dda84d38fffdaf0c9b12837b504b402af910d01d/.github/workflows/test.yml +name: CI + +on: + push: + branches: + - master + pull_request: + +jobs: + test: + timeout-minutes: 5 + runs-on: ubuntu-latest + strategy: + matrix: + emacs_version: + - 29.1 + - 29.2 + - 29.3 + - 29.4 + - snapshot + fail-fast: false + steps: + - uses: actions/checkout@v3 + - name: Set up Emacs + uses: purcell/setup-emacs@v4.0 + with: + version: ${{ matrix.emacs_version }} + + - name: Test + run: | + ./ci.sh diff --git a/ci.sh b/ci.sh new file mode 100755 index 0000000..cefc17d --- /dev/null +++ b/ci.sh @@ -0,0 +1,9 @@ +#!/bin/bash + +set -xe + +emacs -batch -f package-initialize \ + --eval '(add-to-list (quote package-archives) (quote ("melpa" . "http://melpa.org/packages/")))' \ + --eval '(use-package alert :ensure t)' + +cd test && make test diff --git a/org-alert.el b/org-alert.el index 269095b..30ac443 100644 --- a/org-alert.el +++ b/org-alert.el @@ -101,13 +101,13 @@ to allow differentiation from other uses of alert" (skip-chars-forward " \t\r\n") (save-match-data (save-excursion (outline-end-of-heading) - (setq folded (org-invisible-p))) + (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]*$"))) + (looking-at-p (concat (org-inlinetask-outline-regexp) + "END[ \t]*$"))) (end-of-line)) (setq end (point)) (goto-char beg0) @@ -128,16 +128,16 @@ return the stripped copy" "Return the current org subtree as a string with the text-properties stripped, along with the cutoff to apply" (let* ((subtree (org-alert--read-subtree)) - (props (org-entry-properties)) - (prop (alist-get org-alert-cutoff-prop props org-alert-notify-cutoff nil #'string-equal)) - (prop (if (stringp prop) - (string-to-number prop) - prop)) - (text (org-alert--strip-text-properties subtree))) + (props (org-entry-properties)) + (prop (alist-get org-alert-cutoff-prop props org-alert-notify-cutoff nil #'string-equal)) + (prop (if (stringp prop) + (string-to-number prop) + prop)) + (text (org-alert--strip-text-properties subtree))) (list (apply #'concat - (cl-remove-if #'(lambda (s) (string= s "")) - (cdr (split-string text "\n")))) + (cl-remove-if #'(lambda (s) (string= s "")) + (cdr (split-string text "\n")))) prop))) (defun org-alert--to-minute (hour minute) @@ -149,15 +149,15 @@ text-properties stripped, along with the cutoff to apply" `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))) + (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 cutoff) - ;; negative time-until past events - (> time-until (- org-alert-notify-after-event-cutoff))) + (and + (<= time-until cutoff) + ;; negative time-until past events + (> time-until (- org-alert-notify-after-event-cutoff))) (<= time-until cutoff)))) (defun org-alert--parse-entry () @@ -166,27 +166,30 @@ heading, the scheduled/deadline time, and the cutoff to apply" (let ((head (org-alert--strip-text-properties (org-get-heading t t t t)))) (cl-destructuring-bind (body cutoff) (org-alert--grab-subtree) (if (string-match org-alert-time-match-string body) - (list head (match-string 1 body) cutoff) - nil)))) + (list head (match-string 1 body) cutoff) + nil)))) (defun org-alert--dispatch () (let ((entry (org-alert--parse-entry))) (when entry (cl-destructuring-bind (head time cutoff) entry - (if time - (when (org-alert--check-time time cutoff) - (alert (concat time ": " head) + (if time + (when (org-alert--check-time time cutoff) + (alert (concat time ": " head) :title org-alert-notification-title :category org-alert-notification-category)) - (alert head :title org-alert-notification-title + (alert head :title org-alert-notification-title :category org-alert-notification-category)))))) +(defun org-alert--map-entries (func) + (org-map-entries func org-alert-match-string 'agenda + '(org-agenda-skip-entry-if 'todo + org-done-keywords-for-agenda))) + (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)) + (org-alert--map-entries 'org-alert--dispatch) t) (defun org-alert-enable () @@ -200,7 +203,7 @@ heading, the scheduled/deadline time, and the cutoff to apply" (interactive) (dolist (timer timer-list) (if (eq (elt timer 5) 'org-alert-check) - (cancel-timer timer)))) + (cancel-timer timer)))) (provide 'org-alert) ;;; org-alert.el ends here diff --git a/test/Makefile b/test/Makefile new file mode 100644 index 0000000..afd3519 --- /dev/null +++ b/test/Makefile @@ -0,0 +1,7 @@ +test: + emacs -batch -f package-initialize \ + -l ert \ + -l alert \ + -l ../org-alert.el \ + -l test.el \ + -f ert-run-tests-batch-and-exit diff --git a/test/plain.org b/test/plain.org new file mode 100644 index 0000000..a510064 --- /dev/null +++ b/test/plain.org @@ -0,0 +1,2 @@ +* TODO regular test + SCHEDULED: <2023-05-20 Sat 09:55> diff --git a/test/test.el b/test/test.el index da949ae..29554aa 100644 --- a/test/test.el +++ b/test/test.el @@ -1,23 +1,96 @@ ;; -*- lexical-binding: t; -*- +(defvar test-alert-notifications nil + "The notifications received so far") + +(defun test-alert-notify (info) + (push info test-alert-notifications)) + +(defun test-alert-reset () + (setq test-alert-notifications nil)) + +(alert-define-style 'test-alert :notifier #'test-alert-notify) + +(cl-defmacro with-test-org (agenda-file &rest body) + (declare (indent defun)) + (let ((agenda-file (or agenda-file "test.org"))) + `(let ((org-directory ".") + (org-agenda-files (list ,agenda-file)) + (alert-default-style 'test-alert) + ;; TODO the fact that I have to include this from my own config is a + ;; really bad sign for the default value in the package + (org-alert-match-string + "SCHEDULED<\"\"+SCHEDULED<\"\"")) + (with-environment-variables (("TZ" "UTC4")) + (unwind-protect + (progn ,@body) + (test-alert-reset)))))) + +(defmacro with-current-time (time &rest body) + "Override `current-time` to return `Sat May 20 09:40:01 2023`, 15 minutes +before the scheduled event in `test.org`." + ;; (current-time-string '(25704 52657 0 0)) + (declare (indent defun)) + (let ((time (or time '(25704 52657 0 0)))) + `(cl-letf (((symbol-function 'current-time) + (lambda () ',time))) + ,@body))) + (ert-deftest org-alert-custom-cutoff () "checks that we can extract the correct cutoff from the PROPERTIES of a subtree" - (let ((org-directory ".") - (org-agenda-files (list "test.org"))) + (with-test-org nil (should (equal - '(("remindern test" "09:55" 15)) - (org-map-entries 'org-alert--parse-entry org-alert-match-string 'agenda - '(org-agenda-skip-entry-if 'todo - org-done-keywords-for-agenda)))))) + '(("remindern test" "09:55" 15)) + (org-alert--map-entries 'org-alert--parse-entry))))) + +(ert-deftest check-alert-default () + "Check that `org-alert-check` sends an alert from `test.org`. + +This works because the default `org-alert-notify-after-event-cutoff` is +nil, so any time in the past will be alerted." + (with-test-org nil + (org-alert-check) + (should (= (length test-alert-notifications) 1)))) + +(ert-deftest check-alert-none-cutoff () + "Check that `org-alert-check` does not send an alert from `test.org` with +a post-event cutoff set." + (with-test-org nil + (let ((org-alert-notify-after-event-cutoff 60)) + (org-alert-check) + (should (= (length test-alert-notifications) 0))))) -;; TODO idea here is generate an org file with a timestamp in the near future to -;; check if the notification actually works +(ert-deftest check-alert-some-remindern () + "Check that `org-alert-check` sends an alert from `test.org` with +a post-event cutoff set but the current time set appropriately." + (with-test-org nil + (with-current-time (25704 52667 0 0) ; 9:40:11 + (let ((org-alert-notify-after-event-cutoff 60)) + (should (= (length test-alert-notifications) 0)) + (org-alert-check) + (should (= (length test-alert-notifications) 1)))))) -;; (let ((org-directory ".") -;; (org-agenda-files (list "test.org"))) -;; (org-alert-check)) +(ert-deftest check-alert-none-remindern () + "Check that `org-alert-check` does not send an alert from `test.org` with +a post-event cutoff set but the current time set appropriately." + (with-test-org nil + ;; (current-time-string '(25704 52655 0 0)) => "Sat May 20 09:39:59 2023" or + ;; just before the notification should trigger + (with-current-time (25704 52655 0 0) + (let ((org-alert-notify-after-event-cutoff 60)) + (org-alert-check) + (should (= (length test-alert-notifications) 0)))))) -;; (org-time-stamp '(16) nil) -;; <2023-05-20 Sat 10:22> +(ert-deftest check-alert-some () + (with-test-org "plain.org" + (with-current-time (25704 52957 0 0) ; 9:45:01 + (org-alert-check) + (should (= (length test-alert-notifications) 1))))) +(ert-deftest check-alert-none () + (with-test-org "plain.org" + (with-current-time (25704 52945 0 0) ; 9:44:49 + (should (= (length test-alert-notifications) 0)) + (org-alert-check) + (should (= (length test-alert-notifications) 0)))))