[elpa] externals/taxy 34f2136 2/2: Examples: Update taxy-org-ql-view

[ELPA Syncer]

branch: externals/taxy
commit 34f2136b737e3ee9a560fd37d5c865bddcef52f6
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Examples: Update taxy-org-ql-view
---
 examples/taxy-org-ql-view.el | 93 +++++++++++++++++++++++++++++++-------------
 1 file changed, 65 insertions(+), 28 deletions(-)

diff --git a/examples/taxy-org-ql-view.el b/examples/taxy-org-ql-view.el
index 69a6aff..c5bf431 100644
--- a/examples/taxy-org-ql-view.el
+++ b/examples/taxy-org-ql-view.el
@@ -45,33 +45,57 @@
 
 (defvar taxy-org-ql-view-keys nil)
 
-(defmacro taxy-org-ql-view-define-key (name &rest body)
-  "Define a `taxy-org-ql-view' key function by NAME having BODY.
+(defmacro taxy-org-ql-view-define-key (name args &rest body)
+  "Define a `taxy-org-ql-view' key function by NAME having BODY taking ARGS.
 Within BODY, `element' is bound to the `org-element' element
 being tested.
 
 Defines a function named `taxy-org-ql--predicate-NAME', and adds
 an entry to `taxy-org-ql-view-keys' mapping NAME to the new
 function symbol."
-  (declare (indent defun))
-  (let ((fn-symbol (intern (format "taxy-org-ql--predicate-%s" name)))
-       (fn `(lambda (element)
-              ,@body)))
+  (declare (indent defun)
+          (debug (&define symbolp listp &rest def-form)))
+  (let* ((fn-symbol (intern (format "taxy-org-ql--predicate-%s" name)))
+        (fn `(lambda (element ,@args)
+               ,@body)))
     `(progn
        (fset ',fn-symbol ,fn)
        (setf (map-elt taxy-org-ql-view-keys ',name) ',fn-symbol))))
 
-(taxy-org-ql-view-define-key todo
-  "Return the to-do keyword for ELEMENT."
-  (org-element-property :todo-keyword element))
-
-(taxy-org-ql-view-define-key priority
-  "Return ELEMENT's priority as a string."
-  (when-let ((priority-number (org-element-property :priority element)))
-    ;; FIXME: Priority numbers may be wildly larger, right?
-    (char-to-string priority-number)))
-
-(taxy-org-ql-view-define-key planning-month
+(taxy-org-ql-view-define-key heading (&rest strings)
+  "Return STRINGS that ELEMENT's heading matches."
+  (when-let ((matches (cl-loop with heading = (org-element-property :raw-value 
element)
+                              for string in strings
+                              when (string-match (regexp-quote string) heading)
+                              collect string)))
+    (format "Heading: %s" (string-join matches ", "))))
+
+(taxy-org-ql-view-define-key todo (&optional keyword)
+  "Return the to-do keyword for ELEMENT.
+If KEYWORD, return whether it matches that."
+  (when-let ((element-keyword (org-element-property :todo-keyword element)))
+    (cl-flet ((format-keyword
+              (keyword) (format "To-do: %s" keyword)))
+      (pcase keyword
+       ('nil (format-keyword element-keyword))
+       (_ (pcase element-keyword
+            ((pred (equal keyword))
+             (format-keyword element-keyword))))))))
+
+(taxy-org-ql-view-define-key priority (&optional priority)
+  "Return ELEMENT's priority as a string.
+If PRIORITY, return it if it matches ELEMENT's priority."
+  (cl-flet ((format-priority
+            (num) (format "Priority: %s" num)))
+    (when-let ((priority-number (org-element-property :priority element)))
+      ;; FIXME: Priority numbers may be wildly larger, right?
+      (pcase priority
+       ('nil (format-priority (char-to-string number)))
+       (_ (pcase (char-to-string priority-number)
+            ((and (pred (equal priority)) string)
+             (format-priority string))))))))
+
+(taxy-org-ql-view-define-key planning-month ()
   "Return ELEMENT's planning-date month, or nil.
 Returns in format \"%Y-%m (%B)\"."
   (when-let ((planning-element (or (org-element-property :deadline element)
@@ -79,7 +103,7 @@ Returns in format \"%Y-%m (%B)\"."
                                   (org-element-property :closed element))))
     (ts-format "%Y-%m (%B)" (ts-parse-org-element planning-element))))
 
-(taxy-org-ql-view-define-key planning-year
+(taxy-org-ql-view-define-key planning-year ()
   "Return ELEMENT's planning-date year, or nil.
 Returns in format \"%Y\"."
   (when-let ((planning-element (or (org-element-property :deadline element)
@@ -87,7 +111,7 @@ Returns in format \"%Y\"."
                                   (org-element-property :closed element))))
     (ts-format "%Y" (ts-parse-org-element planning-element))))
 
-(taxy-org-ql-view-define-key planning-date
+(taxy-org-ql-view-define-key planning-date ()
   "Return ELEMENT's planning date, or nil.
 Returns in format \"%Y-%m-%d\"."
   (when-let ((planning-element (or (org-element-property :deadline element)
@@ -100,17 +124,30 @@ Returns in format \"%Y-%m-%d\"."
 Each of KEYS should be a function alias defined in
 `taxy-org-ql-view-keys', or a list of such KEY-FNS (recursively,
 ad infinitum, approximately)."
-  (cl-labels ((quote-fn
-              (fn) (cl-typecase fn
-                     (symbol fn)
-                     (list (cons 'list (mapcar #'quote-fn fn))))))
-    (setf keys (mapcar #'quote-fn keys)))
   (let ((macrolets (cl-loop for (name . fn) in taxy-org-ql-view-keys
                            collect `(,name ',fn))))
-    ;; Is using (cadr (macroexpand-all ...)) really better than `eval'?
-    (cadr (macroexpand-all `(cl-symbol-macrolet (,@macrolets)
-                             (lambda (item taxy)
-                               (taxy-take-keyed (list ,@keys) item taxy)))))))
+    (cl-labels ((expand-form
+                ;; Is using (cadr (macroexpand-all ...)) really better than 
`eval'?
+                (form) (cadr
+                        (macroexpand-all
+                         `(cl-symbol-macrolet (,@macrolets)
+                            ,form))))
+               (quote-fn
+                (fn) (pcase fn
+                       ((pred symbolp) fn)
+                       (`(,(and (pred symbolp) fn)
+                          . ,(and args (guard (and args
+                                                   (atom (car args))
+                                                   (cl-notany #'symbolp 
args)))))
+                        ;; Key with args: replace with a lambda that
+                        ;; calls that key's function with given args.
+                        `(lambda (element)
+                           (,(expand-form fn) element ,@args)))
+                       ((pred listp) (cons 'list (mapcar #'quote-fn fn))))))
+      (setf keys (mapcar #'quote-fn keys))
+      (expand-form
+       `(lambda (item taxy)
+         (taxy-take-keyed (list ,@keys) item taxy))))))
 
 (defun taxy-org-ql-view-make-taxy (name keys)
   "Return a dynamic `taxy-org-ql-view-section' taxy named NAME having KEYS.