[elpa] master 1bb1fed 08/13: Added timestamp sorting to relatives finder

[Ian Dunn]

branch: master
commit 1bb1fed0f914bea8fe27435fd832723fddd2795e
Author: Ian Dunn <address@hidden>
Commit: Ian Dunn <address@hidden>

    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