[elpa] scratch/org-edna f05cf5e 23/72: Created finders for compatibility with org-depend

[Ian Dunn]

branch: scratch/org-edna
commit f05cf5e080d23015cc5c6ffb891cec0da5ca6e27
Author: Ian D <address@hidden>
Commit: Ian D <address@hidden>

    Created finders for compatibility with org-depend
    
    * org-edna.el (org-edna-finder/siblings-wrap):
      (org-edna-finder/rest-of-siblings): New functions
      (org-edna-finder/chain-find): Finder for org-depend's chain-find-next
---
 org-edna.el | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)

diff --git a/org-edna.el b/org-edna.el
index 720db92..0c00145 100644
--- a/org-edna.el
+++ b/org-edna.el
@@ -237,6 +237,32 @@ IDS are all UUIDs as understood by `org-id-find'."
          (push (point-marker) markers)))
      (nreverse markers))))
 
+(defun org-edna-finder/siblings-wrap ()
+  (org-with-wide-buffer
+   (let ((self (and (ignore-errors (org-back-to-heading t)) (point)))
+         (markers))
+     ;; Go from this heading to the end
+     (while (org-get-next-sibling)
+       (unless (equal (point) self)
+         (push (point-marker) markers)))
+     ;; Go to the first heading
+     (org-up-heading-safe)
+     (org-goto-first-child)
+     (while (not (equal (point) self))
+       (push (point-marker) markers)
+       (org-get-next-sibling))
+     (nreverse markers))))
+
+(defun org-edna-finder/rest-of-siblings ()
+  (org-with-wide-buffer
+   (let ((self (and (ignore-errors (org-back-to-heading t)) (point)))
+         (markers))
+     ;; Go from this heading to the end
+     (while (org-get-next-sibling)
+       (unless (equal (point) self)
+         (push (point-marker) markers)))
+     (nreverse markers))))
+
 (defun org-edna-finder/next-sibling ()
   (org-with-wide-buffer
    (and (org-get-next-sibling)
@@ -295,6 +321,60 @@ IDS are all UUIDs as understood by `org-id-find'."
   (with-current-buffer (find-file-noselect (expand-file-name file 
org-directory))
     (list (point-min-marker))))
 
+(defun org-edna-finder/chain-find (&rest options)
+  ;; sortfun - function to use to sort elements
+  ;; filterufn - Function to use to filter elements
+  ;; Both should handle positioning point
+  (let (targets sortfun filterfun)
+    (dolist (opt options)
+      (pcase (intern opt)
+        ('from-top
+         (setq targets (org-edna-finder/siblings)))
+        ('from-bottom
+         (setq targets (seq-reverse (org-edna-finder/siblings))))
+        ('from-current
+         (setq targets (org-edna-finder/siblings-wrap)))
+        ('no-wrap
+         (setq targets (org-edna-finder/rest-of-siblings)))
+        ('todo-only
+         (setq filterfun
+               (lambda (target)
+                 (org-entry-get target "TODO"))))
+        ('todo-and-done-only
+         (setq filterfun
+               (lambda (target)
+                 (member (org-entry-get target "TODO") org-done-keywords))))
+        ('priority-up
+         (setq sortfun
+               (lambda (lhs rhs)
+                 (let ((priority-lhs (org-entry-get lhs "PRIORITY"))
+                       (priority-rhs (org-entry-get rhs "PRIORITY")))
+                   (not (string-lessp priority-lhs priority-rhs))))))
+        ('priority-down
+         (setq sortfun
+               (lambda (lhs rhs)
+                 (let ((priority-lhs (org-entry-get lhs "PRIORITY"))
+                       (priority-rhs (org-entry-get rhs "PRIORITY")))
+                   (string-lessp priority-lhs priority-rhs)))))
+        ('effort-up
+         (setq sortfun
+               (lambda (lhs rhs)
+                 (let ((effort-lhs (org-duration-to-minutes (org-entry-get lhs 
"EFFORT")))
+                       (effort-rhs (org-duration-to-minutes (org-entry-get rhs 
"EFFORT"))))
+                   (not (< effort-lhs effort-rhs))))))
+        ('effort-down
+         (setq sortfun
+               (lambda (lhs rhs)
+                 (let ((effort-lhs (org-duration-to-minutes (org-entry-get lhs 
"EFFORT")))
+                       (effort-rhs (org-duration-to-minutes (org-entry-get rhs 
"EFFORT"))))
+                   (< effort-lhs effort-rhs)))))))
+    (when (and targets sortfun)
+      (setq targets (seq-sort sortfun targets)))
+    (when (and targets filterfun)
+      (setq targets (seq-filter filterfun targets)))
+    (when targets
+      (seq-elt 0 targets))))
+
 
 
 ;; Set TODO state