From 4eee6a6943a44bc57e3e7e24cac38cf08355953a Mon Sep 17 00:00:00 2001 From: Daniele Pizzolli Date: Fri, 15 Oct 2021 16:46:31 +0200 Subject: [PATCH] Relative dates in deadlines and scheluded for before and after Backward compatible improvement, org-read-date support a super-set of the previous function org-time-string-to-absolute. The tests are working, but hugly hacks to force org-read-date to compute a relative date to a fixed date. --- README.org | 4 +- org-super-agenda.el | 14 +++-- org-super-agenda.info | 4 +- test/results.el | 124 ++++++++++++++++++++++++++++++++++++++++++ test/test.el | 56 +++++++++++++++++++ test/test.org | 7 +++ 6 files changed, 199 insertions(+), 10 deletions(-) diff --git a/README.org b/README.org index a36be47..e6fd528 100644 --- a/README.org +++ b/README.org @@ -192,7 +192,7 @@ These selectors take one argument alone, or multiple arguments in a list. + =:category= :: Group items that match any of the given categories. Argument may be a string or list of strings. + =:children= :: Select any item that has child entries. Argument may be ~t~ to match if it has any children, ~nil~ to match if it has no children, ~todo~ to match if it has children with any to-do keywords, or a string to match if it has children with certain to-do keywords. You might use this to select items that are project top-level headings. Be aware that this may be very slow in non-daily/weekly agenda views because of its recursive nature. + =:date= :: Group items that have a date associated. Argument can be =t= to match items with any date, =nil= to match items without a date, or =today= to match items with today’s date. The =ts-date= text-property is matched against. -+ =:deadline= :: Group items that have a deadline. Argument can be ~t~ (to match items with any deadline), ~nil~ (to match items that have no deadline), ~past~ (to match items with a deadline in the past), ~today~ (to match items whose deadline is today), or ~future~ (to match items with a deadline in the future). Argument may also be given like ~before DATE~ or ~after DATE~ where DATE is a date string that ~org-time-string-to-absolute~ can process. ++ =:deadline= :: Group items that have a deadline. Argument can be ~t~ (to match items with any deadline), ~nil~ (to match items that have no deadline), ~past~ (to match items with a deadline in the past), ~today~ (to match items whose deadline is today), or ~future~ (to match items with a deadline in the future). Argument may also be given like ~before DATE~ or ~after DATE~ where DATE is a date string that ~org-read-date~ can process. + =:effort<= :: Group items that are less than (or equal to) the given effort. Argument is a time-duration string, like ~5~ or ~0:05~ for 5 minutes. + =:effort>= :: Group items that are higher than (or equal to) the given effort. Argument is a time-duration string, like ~5~ or ~0:05~ for 5 minutes. + ~:file-path~ :: Group items whose buffers' filename paths match any of the given regular expressions. @@ -207,7 +207,7 @@ These selectors take one argument alone, or multiple arguments in a list. + =:priority<== :: Group items that are lower than or equal to the given priority, e.g. ~B~. + =:property= :: Group items with a property, optionally matching a value. Argument may be a property name string, or a list of property name string and either value string or predicate with which to test the value. + =:regexp= :: Group items that match any of the given regular expressions. -+ =:scheduled= :: Group items that are scheduled. Argument can be ~t~ (to match items scheduled for any date), ~nil~ (to match items that are not schedule), ~past~ (to match items scheduled for the past), ~today~ (to match items scheduled for today), or ~future~ (to match items scheduled for the future). Argument may also be given like ~before DATE~ or ~after DATE~ where DATE is a date string that ~org-time-string-to-absolute~ can process. ++ =:scheduled= :: Group items that are scheduled. Argument can be ~t~ (to match items scheduled for any date), ~nil~ (to match items that are not schedule), ~past~ (to match items scheduled for the past), ~today~ (to match items scheduled for today), or ~future~ (to match items scheduled for the future). Argument may also be given like ~before DATE~ or ~after DATE~ where DATE is a date string that ~org-read-date~ can process. + =:tag= :: Group items that match any of the given tags. Argument may be a string or list of strings. + =:time-grid= :: Group items that appear on the time grid. + =:todo= :: Group items that match any of the given TODO keywords. Argument may be a string or list of strings, or ~t~ to match any keyword, or ~nil~ to match only non-todo items. diff --git a/org-super-agenda.el b/org-super-agenda.el index 163bc2b..f215387 100644 --- a/org-super-agenda.el +++ b/org-super-agenda.el @@ -465,8 +465,9 @@ match items that have no deadline), `past` (to match items with a deadline in the past), `today' (to match items whose deadline is today), or `future' (to match items with a deadline in the future). Argument may also be given like `before DATE' or `after -DATE', where DATE is a date string that -`org-time-string-to-absolute' can process." +DATE', where DATE is a date string that `org-read-date' can +process. Note that relative dates are supported, e.g. `before +\"+3d\"' means in the next two days." :section-name (pcase (car args) ('t "Deadline items") ('nil "Items without deadlines") @@ -481,7 +482,7 @@ DATE', where DATE is a date string that (org-today)))) (target-date (pcase (car args) ((or 'before 'on 'after) - (org-time-string-to-absolute (cadr args)))))) + (org-time-string-to-absolute (org-read-date nil nil (cadr args))))))) :test (org-super-agenda--when-with-marker-buffer (org-super-agenda--get-marker item) (let ((entry-time (org-entry-get (point) "DEADLINE"))) (pcase (car args) @@ -502,8 +503,9 @@ Argument can be `t' (to match items scheduled for any date), items scheduled for the past), `today' (to match items scheduled for today), or `future' (to match items scheduled for the future). Argument may also be given like `before DATE' or `after -DATE', where DATE is a date string that -`org-time-string-to-absolute' can process." +DATE', where DATE is a date string that `org-read-date' can +process. Note that relative dates are supported, e.g. `before +\"+3d\"' means in the next two days." :section-name (pcase (car args) ('t "Scheduled items") ('nil "Unscheduled items ") @@ -518,7 +520,7 @@ DATE', where DATE is a date string that (org-today)))) (target-date (pcase (car args) ((or 'before 'on 'after) - (org-time-string-to-absolute (cadr args)))))) + (org-time-string-to-absolute (org-read-date nil nil (cadr args))))))) :test (org-super-agenda--when-with-marker-buffer (org-super-agenda--get-marker item) (let ((entry-time (org-entry-get (point) "SCHEDULED"))) (pcase (car args) diff --git a/org-super-agenda.info b/org-super-agenda.info index a570734..7223bd3 100644 --- a/org-super-agenda.info +++ b/org-super-agenda.info @@ -421,7 +421,7 @@ list. ‘today’ (to match items whose deadline is today), or ‘future’ (to match items with a deadline in the future). Argument may also be given like ‘before DATE’ or ‘after DATE’ where DATE is a date - string that ‘org-time-string-to-absolute’ can process. + string that ‘org-read-date’ can process. ‘:effort<’ Group items that are less than (or equal to) the given effort. Argument is a time-duration string, like ‘5’ or ‘0:05’ for 5 @@ -478,7 +478,7 @@ list. (to match items scheduled for today), or ‘future’ (to match items scheduled for the future). Argument may also be given like ‘before DATE’ or ‘after DATE’ where DATE is a date string that - ‘org-time-string-to-absolute’ can process. + ‘org-read-date’ can process. ‘:tag’ Group items that match any of the given tags. Argument may be a string or list of strings. diff --git a/test/results.el b/test/results.el index de4d9c7..60e3463 100644 --- a/test/results.el +++ b/test/results.el @@ -2199,4 +2199,128 @@ Wednesday 5 July 2017 ambition: In 77 d.: TODO Visit Mars :universe:ambition::space:travel:planet: test: Scheduled: TODO [#C] Get haircut :personal:@town: ambition: TODO Practice leaping tall ! :universe:ambition::personal: +" "97d7f990a88637673184f908f779b5bd" "Day-agenda (W27): +Wednesday 5 July 2017 + + Due before +5d + ambition: In 2 d.: TODO [#A] Take over the world :universe:ambition::world: + test: Deadline: CHECK /r/emacs :website:Emacs: + + Other items + test: 7:02...... Sunrise (12:04 of daylight) + 8:00...... ---------------- + 10:00...... ---------------- + 12:00...... now - - - - - - - - - - - - - - - - - - - - - - - - - + 12:00...... ---------------- + 14:00...... ---------------- + 16:00...... ---------------- + test: 18:00...... Scheduled: TODO Order a pizza :food:dinner: + 18:00...... ---------------- + test: 19:07...... Sunset + 20:00...... ---------------- + ambition: Sched. 1x: TODO [#A] Skype with president of Antarctica :universe:ambition:world::meetings: + ambition: In 10 d.: TODO [#A] Take over the universe :universe:ambition: + test: In 27 d.: TODO [#A] Spaceship lease :bills:spaceship: + test: Scheduled: TODO [#B] Fix flux capacitor :spaceship:shopping:@computer: + test: Scheduled: TODO Shop for groceries :food:shopping:@town: + ideas: Scheduled: SOMEDAY Rewrite Emacs in Common Lisp :Emacs:elisp:computers:software:programming: + ambition: In 5 d.: TODO [#B] Renew membership in supervillain club :universe:ambition:: + test: In 16 d.: TODO [#B] Internet :bills: + ambition: In 53 d.: WAITING Visit the moon :universe:ambition::space:travel: + ambition: In 77 d.: TODO Visit Mars :universe:ambition::space:travel:planet: + test: Scheduled: TODO [#C] Get haircut :personal:@town: + ambition: TODO Practice leaping tall ! :universe:ambition::personal: +" "9157548a5d1e109f50f36e8936e58577" "Day-agenda (W27): +Wednesday 5 July 2017 + + Due after +5d + ambition: In 10 d.: TODO [#A] Take over the universe :universe:ambition: + test: In 27 d.: TODO [#A] Spaceship lease :bills:spaceship: + test: In 16 d.: TODO [#B] Internet :bills: + ambition: In 53 d.: WAITING Visit the moon :universe:ambition::space:travel: + ambition: In 77 d.: TODO Visit Mars :universe:ambition::space:travel:planet: + + Other items + test: 7:02...... Sunrise (12:04 of daylight) + 8:00...... ---------------- + 10:00...... ---------------- + 12:00...... now - - - - - - - - - - - - - - - - - - - - - - - - - + 12:00...... ---------------- + 14:00...... ---------------- + 16:00...... ---------------- + test: 18:00...... Scheduled: TODO Order a pizza :food:dinner: + 18:00...... ---------------- + test: 19:07...... Sunset + 20:00...... ---------------- + ambition: Sched. 1x: TODO [#A] Skype with president of Antarctica :universe:ambition:world::meetings: + ambition: In 2 d.: TODO [#A] Take over the world :universe:ambition::world: + test: Scheduled: TODO [#B] Fix flux capacitor :spaceship:shopping:@computer: + test: Scheduled: TODO Shop for groceries :food:shopping:@town: + ideas: Scheduled: SOMEDAY Rewrite Emacs in Common Lisp :Emacs:elisp:computers:software:programming: + test: Deadline: CHECK /r/emacs :website:Emacs: + ambition: In 5 d.: TODO [#B] Renew membership in supervillain club :universe:ambition:: + test: Scheduled: TODO [#C] Get haircut :personal:@town: + ambition: TODO Practice leaping tall ! :universe:ambition::personal: +" "e9bc8ca80596355bd3332b2db03ae553" "Day-agenda (W27): +Wednesday 5 July 2017 + + Scheduled before -0d + ambition: Sched. 1x: TODO [#A] Skype with president of Antarctica :universe:ambition:world::meetings: + + Other items + test: 7:02...... Sunrise (12:04 of daylight) + 8:00...... ---------------- + 10:00...... ---------------- + 12:00...... now - - - - - - - - - - - - - - - - - - - - - - - - - + 12:00...... ---------------- + 14:00...... ---------------- + 16:00...... ---------------- + test: 18:00...... Scheduled: TODO Order a pizza :food:dinner: + 18:00...... ---------------- + test: 19:07...... Sunset + 20:00...... ---------------- + ambition: In 2 d.: TODO [#A] Take over the world :universe:ambition::world: + ambition: In 10 d.: TODO [#A] Take over the universe :universe:ambition: + test: In 27 d.: TODO [#A] Spaceship lease :bills:spaceship: + test: Scheduled: TODO [#B] Fix flux capacitor :spaceship:shopping:@computer: + test: Scheduled: TODO Shop for groceries :food:shopping:@town: + ideas: Scheduled: SOMEDAY Rewrite Emacs in Common Lisp :Emacs:elisp:computers:software:programming: + test: Deadline: CHECK /r/emacs :website:Emacs: + ambition: In 5 d.: TODO [#B] Renew membership in supervillain club :universe:ambition:: + test: In 16 d.: TODO [#B] Internet :bills: + ambition: In 53 d.: WAITING Visit the moon :universe:ambition::space:travel: + ambition: In 77 d.: TODO Visit Mars :universe:ambition::space:travel:planet: + test: Scheduled: TODO [#C] Get haircut :personal:@town: + ambition: TODO Practice leaping tall ! :universe:ambition::personal: +" "4b7dd608c770d16f0937273124cdf793" "Day-agenda (W27): +Wednesday 5 July 2017 + + Scheduled after -1d + test: 18:00...... Scheduled: TODO Order a pizza :food:dinner: + test: Scheduled: TODO [#B] Fix flux capacitor :spaceship:shopping:@computer: + test: Scheduled: TODO Shop for groceries :food:shopping:@town: + ideas: Scheduled: SOMEDAY Rewrite Emacs in Common Lisp :Emacs:elisp:computers:software:programming: + test: Scheduled: TODO [#C] Get haircut :personal:@town: + ambition: TODO Practice leaping tall ! :universe:ambition::personal: + + Other items + test: 7:02...... Sunrise (12:04 of daylight) + 8:00...... ---------------- + 10:00...... ---------------- + 12:00...... now - - - - - - - - - - - - - - - - - - - - - - - - - + 12:00...... ---------------- + 14:00...... ---------------- + 16:00...... ---------------- + 18:00...... ---------------- + test: 19:07...... Sunset + 20:00...... ---------------- + ambition: Sched. 1x: TODO [#A] Skype with president of Antarctica :universe:ambition:world::meetings: + ambition: In 2 d.: TODO [#A] Take over the world :universe:ambition::world: + ambition: In 10 d.: TODO [#A] Take over the universe :universe:ambition: + test: In 27 d.: TODO [#A] Spaceship lease :bills:spaceship: + test: Deadline: CHECK /r/emacs :website:Emacs: + ambition: In 5 d.: TODO [#B] Renew membership in supervillain club :universe:ambition:: + test: In 16 d.: TODO [#B] Internet :bills: + ambition: In 53 d.: WAITING Visit the moon :universe:ambition::space:travel: + ambition: In 77 d.: TODO Visit Mars :universe:ambition::space:travel:planet: ")) \ No newline at end of file diff --git a/test/test.el b/test/test.el index 7158fec..99d0932 100644 --- a/test/test.el +++ b/test/test.el @@ -18,6 +18,7 @@ ;;;; Variables (defconst org-super-agenda-test-date "2017-07-05 12:00") +(defconst org-super-agenda-test-date-internal (org-read-date t t org-super-agenda-test-date)) (defvar org-super-agenda-test-results (ht-create)) (defvar org-super-agenda-test-save-results nil) (defvar org-super-agenda-test-show-results nil) @@ -58,6 +59,31 @@ (defun org-super-agenda-test--diary-sunset () (cl-second (org-super-agenda-test--diary-sunrise-sunset-split))) + +;;;; Relative dates + +(defun org-read-date-around (orig-fun &optional with-time to-time from-string + prompt default-time default-input inactive) + "Workaround for allowing the check of relative date to and +arbitrary fixed date: ~org-super-agenda-test-date-internal~" + ;;; not very lispy... I known I do not kwnow + (when (string-prefix-p "+" from-string) + (setq from-string (concat "+" from-string) + default-time org-super-agenda-test-date-internal) + (message "org-read-date-around: Active workaround for relative date check for +")) + (when (string-prefix-p "-" from-string) + (setq from-string (concat "-" from-string) + default-time org-super-agenda-test-date-internal) + (message "org-read-date-around: Active workaround for relative date check for -")) + (apply orig-fun with-time to-time from-string + prompt default-time default-input inactive)) + +;;; FIXME the advice is enabled globally because +;;; org-super-agenda-test--run-this-test execute only part of the the ert test +;;; definition and we use all the test definition for unwind-protect, anyway due +;;; to the conditional it will not break anything in current tests +(advice-add 'org-read-date :around #'org-read-date-around) + ;;;; Commands (cl-defun org-super-agenda-test--update-all () @@ -525,10 +551,26 @@ already loaded." ;; DONE: Works. (should (org-super-agenda-test--run :groups '((:deadline (before "2017-07-10")))))) +(ert-deftest org-super-agenda-test--:deadline-before-relative () + ;; DONE: Works. + ;;; not very lispy... I known I do not kwnow probably it should be + ;;; refactored as a macro + (unwind-protect + (progn (advice-add 'org-read-date :around #'org-read-date-around) + (should (org-super-agenda-test--run + :groups '((:deadline (before "+5d")))))) + (advice-remove 'org-read-date #'org-read-date-around))) (ert-deftest org-super-agenda-test--:deadline-after () ;; DONE: Works. (should (org-super-agenda-test--run :groups '((:deadline (after "2017-07-10")))))) +(ert-deftest org-super-agenda-test--:deadline-after-relative () + ;; DONE: Works. + (unwind-protect + (progn (advice-add 'org-read-date :around #'org-read-date-around) + (should (org-super-agenda-test--run + :groups '((:deadline (after "+5d")))))) + (advice-remove 'org-read-date #'org-read-date-around))) (ert-deftest org-super-agenda-test--:effort< () ;; DONE: Works. @@ -646,10 +688,24 @@ already loaded." ;; DONE: Works. (should (org-super-agenda-test--run :groups '((:scheduled (before "2017-07-05")))))) +(ert-deftest org-super-agenda-test--:scheduled-before-relative () + ;; DONE: Works. + (unwind-protect + (progn (advice-add 'org-read-date :around #'org-read-date-around) + (should (org-super-agenda-test--run + :groups '((:scheduled (before "-0d")))))) + (advice-remove 'org-read-date #'org-read-date-around))) (ert-deftest org-super-agenda-test--:scheduled-after () ;; DONE: Works. (should (org-super-agenda-test--run :groups '((:scheduled (after "2017-07-04")))))) +(ert-deftest org-super-agenda-test--:scheduled-after-relative () + ;; DONE: Works. + (unwind-protect + (progn (advice-add 'org-read-date :around #'org-read-date-around) + (should (org-super-agenda-test--run + :groups '((:scheduled (after "-1d"))))))) + (advice-remove 'org-read-date #'org-read-date-around)) (ert-deftest org-super-agenda-test--:tag () ;; DONE: Works. diff --git a/test/test.org b/test/test.org index 249d869..1c9cd96 100644 --- a/test/test.org +++ b/test/test.org @@ -282,6 +282,13 @@ I don't know when I'll get to this, so it's undated. (org-super-agenda-groups '((:scheduled (before "2017-07-06"))))) (org-agenda nil "a"))) + + (with-org-today-date "2017-07-05 00:00" + (let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org")) + (org-agenda-span 'day) + (org-super-agenda-groups + '((:scheduled (before "+2d"))))) + (org-agenda nil "a"))) #+END_SRC #+BEGIN_SRC elisp