branch: master
commit 94edf1470ecb6e09434d3b82ebb6d81944d3a656
Author: Ian Dunn <du...@gnu.org>
Commit: Ian Dunn <du...@gnu.org>
Added timestamp sorting to relatives finder
* org-edna.el (org-edna--get-timestamp-time): New helper function.
(org-edna-finder/relatives): Use it for timestamp-up and timestamp-down
forms.
* org-edna-tests.el (org-edna-relatives/sort-timestamp): New test.
(org-edna-action-deadline/wkdy):
(org-edna-action-deadline/cp):
(org-edna-action-deadline/inc):
(org-edna-action-deadline/landing):
(org-edna-action-deadline/landing-no-hour):
(org-edna-action-deadline/float): New tests for deadline.
---
org-edna-tests.el | 208 +++++++++++++++++++++++++++++++++++++++++++++++++++++
org-edna-tests.org | 15 +++-
org-edna.el | 35 ++++++++-
org-edna.org | 10 +++
4 files changed, 262 insertions(+), 6 deletions(-)
diff --git a/org-edna-tests.el b/org-edna-tests.el
index 5b0b1e0..6f5fa5e 100644
--- a/org-edna-tests.el
+++ b/org-edna-tests.el
@@ -1102,6 +1102,28 @@ This avoids org-id digging into its internal database."
(org-with-point-at current
(org-edna-finder/relatives arg 'deadline-down size))))))
+(ert-deftest org-edna-relatives/sort-timestamp ()
+ (let* ((start-marker org-edna-test-relative-parent-one)
+ (target-list `(,org-edna-test-relative-child-with-todo
+ ,org-edna-test-relative-child-with-done
+ ,org-edna-test-relative-commented-child
+ ,org-edna-test-relative-child-with-children
+ ,org-edna-test-relative-standard-child
+ ,org-edna-test-relative-archived-child))
+ (arg 'step-down)
+ (size (length target-list))
+ (org-agenda-files `(,org-edna-test-file))
+ (current (org-edna-find-test-heading start-marker))
+ (siblings (mapcar
+ (lambda (uuid) (org-edna-find-test-heading uuid))
+ target-list)))
+ (should (equal siblings
+ (org-with-point-at current
+ (org-edna-finder/relatives arg 'timestamp-up size))))
+ (should (equal (nreverse siblings)
+ (org-with-point-at current
+ (org-edna-finder/relatives arg 'timestamp-down size))))))
+
(ert-deftest org-edna-cache/no-entry ()
(let* ((org-edna-finder-use-cache t)
(org-edna--finder-cache (make-hash-table :test 'equal)))
@@ -1175,6 +1197,8 @@ This avoids org-id digging into its internal database."
(should (string-equal (org-entry-get nil "TODO") "TODO")))
(org-edna-test-restore-test-file))))
+;; Scheduled
+
(ert-deftest org-edna-action-scheduled/wkdy ()
;; Override `current-time' so we can get a deterministic value
(cl-letf* (((symbol-function 'current-time) (lambda () org-edna-test-time))
@@ -1358,6 +1382,189 @@ This avoids org-id digging into its internal database."
"<2000-01-15 Sat 00:00>")))
(org-edna-test-restore-test-file))))
+(ert-deftest org-edna-action-deadline/wkdy ()
+ ;; Override `current-time' so we can get a deterministic value
+ (cl-letf* (((symbol-function 'current-time) (lambda () org-edna-test-time))
+ (org-agenda-files `(,org-edna-test-file))
+ (target (org-edna-find-test-heading
"0d491588-7da3-43c5-b51a-87fbd34f79f7")))
+ (unwind-protect
+ (org-with-point-at target
+ (org-edna-action/deadline! nil "Mon")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-17 Mon>"))
+ (org-edna-action/deadline! nil 'rm)
+ (should (not (org-entry-get nil "DEADLINE")))
+ (org-edna-action/deadline! nil "Mon 9:00")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-17 Mon 09:00>"))
+ (org-edna-action/deadline! nil 'rm)
+ (should (not (org-entry-get nil "DEADLINE"))))
+ (org-edna-test-restore-test-file))))
+
+(ert-deftest org-edna-action-deadline/cp ()
+ (let* ((org-agenda-files `(,org-edna-test-file))
+ (target (org-edna-find-test-heading
"0d491588-7da3-43c5-b51a-87fbd34f79f7"))
+ (source (org-edna-find-test-heading
"97e6b0f0-40c4-464f-b760-6e5ca9744eb5"))
+ (pairs '((cp . rm) (copy . remove) ("cp" . "rm") ("copy" .
"remove"))))
+ (unwind-protect
+ (org-with-point-at target
+ (dolist (pair pairs)
+ (org-edna-action/deadline! source (car pair))
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>"))
+ (org-edna-action/deadline! source (cdr pair))
+ (should (not (org-entry-get nil "DEADLINE")))))
+ (org-edna-test-restore-test-file))))
+
+(ert-deftest org-edna-action-deadline/inc ()
+ ;; Override `current-time' so we can get a deterministic value
+ (cl-letf* (((symbol-function 'current-time) (lambda () org-edna-test-time))
+ (org-agenda-files `(,org-edna-test-file))
+ (target (org-edna-find-test-heading
"97e6b0f0-40c4-464f-b760-6e5ca9744eb5")))
+ (unwind-protect
+ (org-with-point-at target
+ ;; Time starts at Jan 15, 2000
+ (org-edna-action/deadline! nil "2000-01-15 Sat 00:00")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>"))
+ ;; Increment 1 minute
+ (org-edna-action/deadline! nil "+1M")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:01>"))
+ ;; Decrement 1 minute
+ (org-edna-action/deadline! nil "-1M")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>"))
+ ;; +1 day
+ (org-edna-action/deadline! nil "+1d")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-16 Sun 00:00>"))
+ ;; +1 hour from current time
+ (org-edna-action/deadline! nil "++1h")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 01:00>"))
+ ;; Back to Saturday
+ (org-edna-action/deadline! nil "2000-01-15 Sat 00:00")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>"))
+ ;; -1 day to Friday
+ (org-edna-action/deadline! nil "-1d")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-14 Fri 00:00>"))
+ ;; Increment two days to the next weekday
+ (org-edna-action/deadline! nil "+2wkdy")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-17 Mon 00:00>"))
+ ;; Increment one day, expected to land on a weekday
+ (org-edna-action/deadline! nil "+1wkdy")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-18 Tue 00:00>"))
+ ;; Move forward 8 days, then backward until we find a weekend
+ (org-edna-action/deadline! nil "+8d -wknd")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-23 Sun 00:00>"))
+ ;; Move forward one week, then forward until we find a weekday
+ ;; (org-edna-action/deadline! nil "+1w +wkdy")
+ ;; (should (string-equal (org-entry-get nil "DEADLINE")
+ ;; "<2000-01-31 Mon 00:00>"))
+ ;; Back to Saturday for other tests
+ (org-edna-action/deadline! nil "2000-01-15 Sat 00:00")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>")))
+ (org-edna-test-restore-test-file))))
+
+(ert-deftest org-edna-action-deadline/landing ()
+ "Test landing arguments to deadline increment."
+ ;; Override `current-time' so we can get a deterministic value
+ (cl-letf* (((symbol-function 'current-time) (lambda () org-edna-test-time))
+ (org-agenda-files `(,org-edna-test-file))
+ (target (org-edna-find-test-heading
"97e6b0f0-40c4-464f-b760-6e5ca9744eb5")))
+ (unwind-protect
+ (org-with-point-at target
+ ;; Time starts at Jan 15, 2000
+ (org-edna-action/deadline! nil "2000-01-15 Sat 00:00")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>"))
+ ;; Move forward 10 days, then backward until we find a weekend
+ (org-edna-action/deadline! nil "+10d -wknd")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-23 Sun 00:00>"))
+ ;; Move forward one week, then forward until we find a weekday
+ (org-edna-action/deadline! nil "+1w +wkdy")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-31 Mon 00:00>"))
+ ;; Back to Saturday for other tests
+ (org-edna-action/deadline! nil "2000-01-15 Sat 00:00")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>")))
+ (org-edna-test-restore-test-file))))
+
+(ert-deftest org-edna-action-deadline/landing-no-hour ()
+ "Test landing arguments to deadline increment, without hour."
+ ;; Override `current-time' so we can get a deterministic value
+ (cl-letf* (((symbol-function 'current-time) (lambda () org-edna-test-time))
+ (org-agenda-files `(,org-edna-test-file))
+ (target (org-edna-find-test-heading
"caf27724-0887-4565-9765-ed2f1edcfb16")))
+ (unwind-protect
+ (org-with-point-at target
+ ;; Time starts at Jan 1, 2017
+ (org-edna-action/deadline! nil "2017-01-01 Sun")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2017-01-01 Sun>"))
+ ;; Move forward 10 days, then backward until we find a weekend
+ (org-edna-action/deadline! nil "+10d -wknd")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2017-01-08 Sun>"))
+ ;; Move forward one week, then forward until we find a weekday
+ (org-edna-action/deadline! nil "+1w +wkdy")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2017-01-16 Mon>"))
+ ;; Back to Saturday for other tests
+ (org-edna-action/deadline! nil "2017-01-01 Sun")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2017-01-01 Sun>")))
+ (org-edna-test-restore-test-file))))
+
+(ert-deftest org-edna-action-deadline/float ()
+ (cl-letf* (((symbol-function 'current-time) (lambda () org-edna-test-time))
+ (org-agenda-files `(,org-edna-test-file))
+ (target (org-edna-find-test-heading
"97e6b0f0-40c4-464f-b760-6e5ca9744eb5")))
+ (unwind-protect
+ (org-with-point-at target
+ ;; Time starts at Jan 15, 2000
+ (org-edna-action/deadline! nil "2000-01-15 Sat 00:00")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>"))
+ ;; The third Tuesday of next month (Feb 15th)
+ (org-edna-action/deadline! nil "float 3 Tue")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-02-15 Tue 00:00>"))
+ ;; The second Friday of the following May (May 12th)
+ (org-edna-action/deadline! nil "float 2 5 May")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-05-12 Fri 00:00>"))
+ ;; Move forward to the second Wednesday of the next month (June 14th)
+ (org-edna-action/deadline! nil "float 2 Wednesday")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-06-14 Wed 00:00>"))
+ ;; Move forward to the first Thursday in the following Jan (Jan 4th,
2001)
+ (org-edna-action/deadline! nil "float 1 4 Jan")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2001-01-04 Thu 00:00>"))
+ ;; The fourth Monday in Feb, 2000 (Feb 28th)
+ (org-edna-action/deadline! nil "float ++4 monday")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-02-28 Mon 00:00>"))
+ ;; The second Monday after Mar 12th, 2000 (Mar 20th)
+ (org-edna-action/deadline! nil "float 2 monday Mar 12")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-03-20 Mon 00:00>"))
+ ;; Back to Saturday for other tests
+ (org-edna-action/deadline! nil "2000-01-15 Sat 00:00")
+ (should (string-equal (org-entry-get nil "DEADLINE")
+ "<2000-01-15 Sat 00:00>")))
+ (org-edna-test-restore-test-file))))
+
(ert-deftest org-edna-action-tag ()
(let ((pom (org-edna-find-test-heading org-edna-test-id-heading-one)))
(unwind-protect
@@ -2039,6 +2246,7 @@ the relative finders all still work while cache is
enabled."
(should (string-equal (org-entry-get shower-pom "COUNT") "0")))
;; Change the test file back to its original state.
(org-edna-test-restore-test-file))))))
+
(provide 'org-edna-tests)
;;; org-edna-tests.el ends here
diff --git a/org-edna-tests.org b/org-edna-tests.org
index 9eb8756..4d9aa9d 100644
--- a/org-edna-tests.org
+++ b/org-edna-tests.org
@@ -34,25 +34,28 @@ along with this program. If not, see
<http://www.gnu.org/licenses/>.
:LOGGING: nil
:END:
** TODO ID Heading 3
-SCHEDULED: <2000-01-15 Sat 00:00>
+DEADLINE: <2000-01-15 Sat 00:00> SCHEDULED: <2000-01-15 Sat 00:00>
:PROPERTIES:
:ID: 97e6b0f0-40c4-464f-b760-6e5ca9744eb5
:END:
+<2000-01-15 Sat 00:00>
** DONE ID Heading 4
:PROPERTIES:
:ID: 7d4d564b-18b2-445c-a0c8-b1b3fb9ad29e
:END:
** Scheduled Headings
*** TODO Scheduled Heading 1
-SCHEDULED: <2017-01-01 Sun>
+DEADLINE: <2017-01-01 Sun> SCHEDULED: <2017-01-01 Sun>
:PROPERTIES:
:ID: caf27724-0887-4565-9765-ed2f1edcfb16
:END:
+<2017-01-01 Sun>
*** TODO Scheduled Heading 2
-SCHEDULED: <2017-01-01 Sun>
+DEADLINE: <2017-01-01 Sun> SCHEDULED: <2017-01-01 Sun>
:PROPERTIES:
:ID: 5594d4f1-b1bb-400f-9f3d-e2f9b43e82c3
:END:
+<2017-01-01 Sun>
** Sibling Headings
:PROPERTIES:
:ID: 21b8f1f5-14e8-4677-873d-69e0389fdc9e
@@ -96,12 +99,14 @@ DEADLINE: <2017-01-07 Sat> SCHEDULED: <2017-01-02 Mon>
:ID: 7c542695-8165-4c8b-b44d-4c12fa009548
:Effort: 0:01
:END:
+<2017-01-02 Mon>
*** [#B] Child Heading with Children
DEADLINE: <2017-01-03 Tue> SCHEDULED: <2017-01-03 Tue>
:PROPERTIES:
:ID: c7a986df-8d89-4509-b086-6db429b5607b
:Effort: 0:03
:END:
+<2017-01-03 Tue>
**** Child Heading One
:PROPERTIES:
:ID: 588bbd29-2e07-437f-b74d-f72459b545a1
@@ -116,24 +121,28 @@ DEADLINE: <2017-01-01 Sun> SCHEDULED: <2017-01-06 Fri>
:ID: 8c0b31a1-af49-473c-92ea-a5c1c3bace33
:Effort: 0:02
:END:
+<2017-01-06 Fri>
*** [#B] COMMENT Commented Child Heading
DEADLINE: <2017-01-08 Sun> SCHEDULED: <2017-01-04 Wed>
:PROPERTIES:
:ID: 0a1b9508-17ce-49c5-8ff3-28a0076374f5
:Effort: 0:06
:END:
+<2017-01-04 Wed>
*** [#A] Archived Child Heading :ARCHIVE:
DEADLINE: <2017-01-02 Mon> SCHEDULED: <2017-01-01 Sun>
:PROPERTIES:
:ID: a4b6131e-0560-4201-86d5-f32b36363431
:Effort: 0:05
:END:
+<2017-01-01 Sun>
*** DONE [#C] Child Heading with DONE
DEADLINE: <2017-01-05 Thu> SCHEDULED: <2017-01-05 Thu>
:PROPERTIES:
:ID: 4a1d74a2-b032-47da-a823-b32f5cab0aae
:Effort: 0:08
:END:
+<2017-01-05 Thu>
** Parent Sub Heading #2
:PROPERTIES:
:ID: 4fe67f03-2b35-4708-8c38-54d2c4dfab81
diff --git a/org-edna.el b/org-edna.el
index 102dd06..36f3afa 100644
--- a/org-edna.el
+++ b/org-edna.el
@@ -810,6 +810,14 @@ Return a list of markers for the descendants."
(when-let* ((entry-tags (org-get-tags-at)))
(seq-intersection tags entry-tags)))
+(defun org-edna--get-timestamp-time (pom &optional inherit)
+ "Get the timestamp time as a time tuple, of a format suitable
+for calling org-schedule with, or if there is no timestamp,
+returns nil."
+ (let ((time (org-entry-get pom "TIMESTAMP" inherit)))
+ (when time
+ (apply 'encode-time (org-parse-time-string time)))))
+
(defun org-edna-finder/relatives (&rest options)
"Find some relative of the current heading.
@@ -875,7 +883,9 @@ All arguments are symbols, unless noted otherwise.
- scheduled-up: Scheduled time, farthest first
- scheduled-down: Scheduled time, closest first
- deadline-up: Deadline time, farthest first
-- deadline-down: Deadline time, closest first"
+- deadline-down: Deadline time, closest first
+- timestamp-up: Timestamp time, farthest first
+- timestamp-down: Timestamp time, closest first"
(let (targets
sortfun
reverse-sort
@@ -1028,6 +1038,18 @@ All arguments are symbols, unless noted otherwise.
(lambda (lhs rhs)
(let ((time-lhs (org-get-deadline-time lhs))
(time-rhs (org-get-deadline-time rhs)))
+ (time-less-p time-lhs time-rhs)))))
+ ('timestamp-up
+ (setq sortfun
+ (lambda (lhs rhs)
+ (let ((time-lhs (org-edna--get-timestamp-time lhs))
+ (time-rhs (org-edna--get-timestamp-time rhs)))
+ (not (time-less-p time-lhs time-rhs))))))
+ ('timestamp-down
+ (setq sortfun
+ (lambda (lhs rhs)
+ (let ((time-lhs (org-edna--get-timestamp-time lhs))
+ (time-rhs (org-edna--get-timestamp-time rhs)))
(time-less-p time-lhs time-rhs)))))))
(setq filterfuns (nreverse filterfuns))
(when (and targets sortfun)
@@ -1285,11 +1307,18 @@ N is an integer. WHAT can be `day', `month', `year',
`minute',
(org-timestamp-change n what)
(buffer-string)))
+(defun org-edna--property-for-planning-type (type)
+ (pcase type
+ ('scheduled "SCHEDULED")
+ ('deadline "DEADLINE")
+ ('timestamp "TIMESTAMP")
+ (_ "")))
+
(defun org-edna--get-planning-info (what)
"Get the planning info for WHAT.
-WHAT is either 'scheduled or 'deadline."
- (org-entry-get nil (if (eq what 'scheduled) "SCHEDULED" "DEADLINE")))
+WHAT is one of 'scheduled, 'deadline, or 'timestamp."
+ (org-entry-get nil (org-edna--property-for-planning-type what)))
;; Silence the byte-compiler
(defvar parse-time-weekdays)
diff --git a/org-edna.org b/org-edna.org
index d18828e..38fe539 100644
--- a/org-edna.org
+++ b/org-edna.org
@@ -526,6 +526,8 @@ All arguments are symbols, unless noted otherwise.
- scheduled-down: Scheduled time, closest first
- deadline-up: Deadline time, farthest first
- deadline-down: Deadline time, closest first
+- timestamp-up: Timestamp time, farthest first
+- timestamp-down: Timestamp time, closest first
Many of the other finders are shorthand for argument combinations of relative:
@@ -1503,6 +1505,14 @@ making any changes:
:PROPERTIES:
:DESCRIPTION: List of changes by version
:END:
+** 1.0
+
+- Various bugs fixes
+ - Fixed parsing of consideration
+ - Limited cache to just the finders that don't depend on current position
+- Added "buffer" option for match finder
+- Added timestamp sorting to relatives finder
+
** 1.0beta8
Quick fix for beta7.
** 1.0beta7
