Change: Define predicates with macro, generate docs

README.org

@@ -1,8 +1,10 @@
+#+TITLE: org-ql
 
+~org-ql~ is a lispy query language for Org files.  It allows you to find Org entries matching certain criteria and perform actions on them, such as collecting their parsed representation with ~org-element~ (the default action).
 
-* org-ql
+* Examples
 
-~org-ql~ is a lispy query language for Org files.  It allows you to find Org entries matching certain criteria and perform actions on them, such as collecting their parsed representation with ~org-element~ (the default action).  Some examples:
+More examples are available in [[examples.org]].
 
 #+BEGIN_SRC elisp
   ;; Return a list of Org entry elements in the file "~/org/main.org" which have the SOMEDAY
@@ -34,7 +36,11 @@
          (not (property "key"))))
 #+END_SRC
 
-** org-ql-search
+* Usage
+
+** Commands
+
+*** org-ql-search
 
 The command =org-ql-search= prompts for a query, a list of buffers or files, and how to group and sort results.  Without prefix, it searches the current buffer instead of prompting.  Then it presents the results in an agenda-like view.
 
@@ -44,7 +50,7 @@ Here's an example of using it to generate an agenda-like view for certain files
 
 [[images/org-ql-search-snippet.png]]
 
-** org-ql-agenda
+*** org-ql-agenda
 
 Also included is ~org-ql-agenda~, which uses ~org-ql~ queries to select entries and present them in an Agenda-like view.  It's compatible with [[https://github.com/alphapapa/org-super-agenda][org-super-agenda]], which provides grouping.  For example:
 
@@ -101,6 +107,28 @@ Here are some other examples:
              (closed = today))))
 #+END_SRC
 
+** Predicates
+
+Arguments are listed next to predicate names, when applicable.
+
++  ~category (categories)~ :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
++  ~closed (&optional comparator target-date)~ :: Return non-nil if entry's closed date compares with ~TARGET-DATE~ using ~COMPARATOR~.  ~TARGET-DATE~ should be a string parseable by ~date-to-day~.  ~COMPARATOR~ should be a function (like ~<=~).
++  ~date (&optional comparator target-date)~ :: Return non-nil if Org entry at point has date of ~TYPE~ that compares with ~TARGET-DATE~ using ~COMPARATOR~.  Checks all Org-formatted timestamp strings in entry.  ~TYPE~ may be ~active~, ~inactive~, or ~all~, to control whether active, inactive, or all timestamps are checked.  Ranges of each type are also checked.  ~TARGET-DATE~ should be a string parseable by ~date-to-day~.  ~COMPARATOR~ should be a function (like ~<=~).
++  ~deadline (&optional comparator target-date)~ :: Return non-nil if entry's deadline compares with ~TARGET-DATE~ using ~COMPARATOR~.  ~TARGET-DATE~ should be a string parseable by ~date-to-day~.  ~COMPARATOR~ should be a function (like ~<=~).
++  ~done~ :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
++  ~habit~ :: Return non-nil if entry is a habit.
++  ~heading (regexp)~ :: Return non-nil if current entry's heading matches ~REGEXP~ (a regexp string).
++  ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches ~LEVEL~ with ~COMPARATOR~.  If ~LEVEL~ is nil, ~LEVEL-OR-COMPARATOR~ should be an integer level, which will be tested for equality to the heading's outline level.  If ~LEVEL~ is non-nil, ~LEVEL-OR-COMPARATOR~ should be a comparator function (like ~<=~).
++  ~planning (&optional comparator target-date)~ :: Return non-nil if entry's planning date (deadline or scheduled) compares with ~TARGET-DATE~ using ~COMPARATOR~.  ~TARGET-DATE~ should be a string parseable by ~date-to-day~.  ~COMPARATOR~ should be a function (like ~<=~).
++  ~priority (&optional comparator-or-priority priority)~ :: Return non-nil if current heading has a certain priority.  ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator).  If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string.
++  ~property (property &optional value)~ :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string).
++  ~regexp (regexp)~ :: Return non-nil if current entry matches ~REGEXP~ (a regexp string).
++  ~scheduled (&optional comparator target-date)~ :: Return non-nil if entry's scheduled date compares with ~TARGET-DATE~ using ~COMPARATOR~.  ~TARGET-DATE~ should be a string parseable by ~date-to-day~.  ~COMPARATOR~ should be a function (like ~<=~).
++  ~tags (tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings).
++  ~todo (keywords)~ :: Return non-nil if current heading is a ~TODO~ item.  With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings).
+
+* Notes
+
 ** Comparison with Org Agenda searches
 
 Of course, queries like these can already be written with Org Agenda searches, but the syntax can be complex.  For example, this query would be difficult to write in a standard Org Agenda search, because it matches against a to-do keyword /and/ a plain-text search.  As described in the [[https://orgmode.org/worg/org-tutorials/advanced-searching.html#combining-metadata-and-full-text-queries][advanced searching tutorial]], it would require using ~org-search-view~ with a query with specific regular expression syntax, like this:
@@ -117,14 +145,60 @@ But with ~org-ql-agenda~, you would write:
          (todo "TO-READ")))
 #+END_SRC
 
-** More examples
-
-More examples are available in [[examples.org]].
-
 ** org-sidebar
 
 This package is used by [[https://github.com/alphapapa/org-sidebar][org-sidebar]], which presents a customizable agenda-like view in a sidebar window.
 
-** License
+* License
 
 GPLv3
+
+* Code                                                             :noexport:
+
+Code used to update this document.
+
+** Predicates
+
+Generates the predicate subtree.
+
+#+BEGIN_SRC elisp
+  (defun org-ql--readme-predicate-list ()
+    "Return an Org list string documenting predicates."
+    (concat "Arguments are listed next to predicate names, when applicable.\n\n"
+            (s-join "\n" (->> org-ql-predicates
+                              (--sort (string< (symbol-name (plist-get it :name))
+                                               (symbol-name (plist-get other :name))))
+                              (--map (-let* (((&plist :name name :docstring docstring :fn fn) it)
+                                             (args (->> (help-function-arglist fn)
+                                                        (--remove (or (eq it '&rest)
+                                                                      ;; Comparing the symbol itself doesn't work for some reason.
+                                                                      (string= (symbol-name it) "--cl-rest--"))))))
+                                       (if docstring
+                                           (progn
+                                             (setq docstring (s-replace "\n" "  " docstring))
+                                             (format "+  ~%s%s~ :: %s" name
+                                                     (if args
+                                                         (format " %s" args)
+                                                       "")
+                                                     (unpackaged/docstring-to-org docstring)))
+                                         (warn "No docstring for: %s" name)
+                                         nil)))
+                              -non-nil))))
+
+  (defun org-ql--readme-replace-node (outline-path string)
+    "Replace contents of node at OUTLINE-PATH with STRING."
+    (org-with-wide-buffer
+     (-let* ((subtree-marker (org-find-olp outline-path t))
+             ((_headline element) (progn
+                                    (goto-char subtree-marker)
+                                    (org-element-headline-parser (point-max))))
+             ((&plist :contents-begin beg :contents-end end) element))
+       (goto-char beg)
+       (delete-region (point) (1- end))
+       (insert string "\n"))))
+
+  (defun org-ql--readme-update-predicates ()
+    "Update predicate subtree in current document."
+    (interactive)
+    (org-ql--readme-replace-node '("Usage" "Predicates") (org-ql--readme-predicate-list)))
+#+END_SRC

org-ql.el

@@ -35,8 +35,23 @@ Each value is a list of the buffer's modified tick and another
 hash table, keyed by arguments passed to
 `org-ql--select-cached'.")
 
+(defvar org-ql-predicates
+  (list (list :name 'org-back-to-heading :fn (symbol-function 'org-back-to-heading)))
+  "Plist of predicates, their corresponding functions, and their docstrings.
+This list should not contain any duplicates.")
+
 ;;;; Macros
 
+(cl-defmacro org-ql--defpredicate (name args docstring &rest body)
+  "FIXME: docstring"
+  (declare (debug (symbolp listp stringp body))
+           (indent defun))
+  (let ((fn-name (intern (concat "org-ql--predicate-" (symbol-name name))))
+        (pred-name (intern (symbol-name name))))
+    `(progn
+       (push (list :name ',pred-name :fn ',fn-name :docstring ,docstring) org-ql-predicates)
+       (cl-defun ,fn-name ,args ,docstring ,@body))))
+
 (cl-defmacro org-ql (buffers-or-files pred-body &key sort narrow markers
                                       (action '(org-element-headline-parser (line-end-position))))
   "Find entries in BUFFERS-OR-FILES that match PRED-BODY, and return the results of running ACTION-FN on each matching entry.
@@ -178,22 +193,18 @@ a list of defined `org-ql' sorting methods: `date', `deadline',
 (cl-defun org-ql--select (&key predicate action narrow)
   "Return results of mapping function ACTION across entries in current buffer matching function PREDICATE.
 If NARROW is non-nil, buffer will not be widened."
-  (org-ql--flet ((category #'org-ql--category-p)
+  ;; Since the mappings are done at runtime, macros like `flet' can't be used, so we do it manually.
-                 (planning #'org-ql--planning-p)
+  (let (orig-fns)
-                 (deadline #'org-ql--deadline-p)
+    (--each org-ql-predicates
-                 (scheduled #'org-ql--scheduled-p)
+      ;; Save original function mappings.
-                 (date #'org-ql--date-p)
+      (let ((name (plist-get it :name)))
-                 (closed #'org-ql--closed-p)
+        (push (list :name name :fn (symbol-function name)) orig-fns)))
-                 (habit #'org-ql--habit-p)
+    (unwind-protect
-                 (priority #'org-ql--priority-p)
+        (progn
-                 (todo #'org-ql--todo-p)
+          (--each org-ql-predicates
-                 (done #'org-ql--done-p)
+            ;; Set predicate functions.
-                 (tags #'org-ql--tags-p)
+            (fset (plist-get it :name) (plist-get it :fn)))
-                 (property #'org-ql--property-p)
+          ;; Run query.
-                 (regexp #'org-ql--regexp-p)
-                 (heading #'org-ql--heading-p)
-                 (level #'org-ql--level-p)
-                 (org-back-to-heading #'outline-back-to-heading))
           (save-excursion
             (save-restriction
               (unless narrow
@@ -203,7 +214,10 @@ If NARROW is non-nil, buffer will not be widened."
                 (outline-next-heading))
               (cl-loop when (funcall predicate)
                        collect (funcall action)
-                 while (outline-next-heading))))))
+                       while (outline-next-heading)))))
+      (--each orig-fns
+        ;; Restore original function mappings.
+        (fset (plist-get it :name) (plist-get it :fn))))))
 
 ;;;;; Helpers
 
@@ -242,16 +256,16 @@ Or, when possible, fix the problem."
 
 ;;;;; Predicates
 
-(defun org-ql--category-p (&rest categories)
+(org-ql--defpredicate category (&rest categories)
-  "Return non-nil if current heading is in one or more of CATEGORIES."
+  "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)."
   (when-let ((category (org-get-category (point))))
     (cl-typecase categories
       (null t)
       (otherwise (member category categories)))))
 
-(defun org-ql--todo-p (&rest keywords)
+(org-ql--defpredicate todo (&rest keywords)
   "Return non-nil if current heading is a TODO item.
-With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
+With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strings)."
   (when-let ((state (org-get-todo-state)))
     (cl-typecase keywords
       (null t)
@@ -259,11 +273,13 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
       (symbol (member state (symbol-value keywords)))
       (otherwise (user-error "Invalid todo keywords: %s" keywords)))))
 
-(defsubst org-ql--done-p ()
+(org-ql--defpredicate done ()
+  "Return non-nil if entry's TODO keyword is in `org-done-keywords'."
+  ;; NOTE: This was a defsubst before being defined with the macro.  Might be good to make it a defsubst again.
   (or (apply #'org-ql--todo-p org-done-keywords)))
 
-(defun org-ql--tags-p (&rest tags)
+(org-ql--defpredicate tags (&rest tags)
-  "Return non-nil if current heading has one or more of TAGS."
+  "Return non-nil if current heading has one or more of TAGS (a list of strings)."
   ;; TODO: Try to use `org-make-tags-matcher' to improve performance.  It would be nice to not have
   ;; to run `org-get-tags-at' for every heading, especially with inheritance.
   (when-let ((tags-at (org-get-tags-at (point) (not org-use-tag-inheritance))))
@@ -271,15 +287,13 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
       (null t)
       (otherwise (seq-intersection tags tags-at)))))
 
-(defun org-ql--level-p (level-or-comparator &optional level)
+(org-ql--defpredicate level (level-or-comparator &optional level)
   "Return non-nil if current heading's outline level matches LEVEL with COMPARATOR.
 
-If LEVEL is nil, LEVEL-OR-COMPARATOR should be a level, which
+If LEVEL is nil, LEVEL-OR-COMPARATOR should be an integer level,
-will be tested for equality to the heading's outline level.  If
+which will be tested for equality to the heading's outline level.
-LEVEL is non-nil, LEVEL-OR-COMPARATOR should be a comparator
+If LEVEL is non-nil, LEVEL-OR-COMPARATOR should be a comparator
-function.
+function (like `<=')."
-
-Outline levels should be integers."
   ;; NOTE: It might be necessary to take into account `org-odd-levels'; see docstring for
   ;; `org-outline-level'.
   (when-let ((outline-level (org-outline-level)))
@@ -289,11 +303,11 @@ Outline levels should be integers."
       ;; Check with comparator
       (_ (funcall level-or-comparator outline-level level)))))
 
-(defun org-ql--priority-p (&optional comparator-or-priority priority)
+(org-ql--defpredicate priority (&optional comparator-or-priority priority)
   "Return non-nil if current heading has a certain priority.
 COMPARATOR-OR-PRIORITY should be either a comparator function,
-like `<=', or a priority string, like \"A\" (in which case (\` =)
+like `<=', or a priority string, like \"A\" (in which case (`='
-'will be the comparator).  If COMPARATOR-OR-PRIORITY is a
+will be the comparator).  If COMPARATOR-OR-PRIORITY is a
 comparator, PRIORITY should be a priority string."
   (let* (comparator)
     (cond ((null priority)
@@ -326,11 +340,12 @@ comparator, PRIORITY should be a priority string."
                                     (org-get-priority (match-string 0)))))))
       (funcall comparator priority item-priority))))
 
-(defun org-ql--habit-p ()
+(org-ql--defpredicate habit ()
+  "Return non-nil if entry is a habit."
   (org-is-habit-p))
 
-(defun org-ql--regexp-p (regexp)
+(org-ql--defpredicate regexp (regexp)
-  "Return non-nil if current entry matches REGEXP."
+  "Return non-nil if current entry matches REGEXP (a regexp string)."
   (let ((end (or (save-excursion
                    (outline-next-heading))
                  (point-max))))
@@ -338,12 +353,12 @@ comparator, PRIORITY should be a priority string."
       (goto-char (line-beginning-position))
       (re-search-forward regexp end t))))
 
-(defun org-ql--heading-p (regexp)
+(org-ql--defpredicate heading (regexp)
-  "Return non-nil if current entry's heading matches REGEXP."
+  "Return non-nil if current entry's heading matches REGEXP (a regexp string)."
   (string-match regexp (org-get-heading 'no-tags 'no-todo)))
 
-(defun org-ql--property-p (property &optional value)
+(org-ql--defpredicate property (property &optional value)
-  "Return non-nil if current entry has PROPERTY, and optionally VALUE."
+  "Return non-nil if current entry has PROPERTY (a string), and optionally VALUE (a string)."
   (pcase property
     ('nil (user-error "Property matcher requires a PROPERTY argument."))
     (_ (pcase value
@@ -386,8 +401,7 @@ like one returned by `date-to-day'."
       ((pred functionp)
        (let ((target-day-number (cl-typecase target-date
                                   (null (+ (org-get-wdays timestamp) (org-today)))
-                                  ;; Append time to target-date
+                                  ;; Append time to target-date because `date-to-day' requires it.
-                                  ;; because `date-to-day' requires it
                                   (string (date-to-day (concat target-date " 00:00")))
                                   (integer target-date))))
          (pcase (org-element-property :type date-element)
@@ -400,11 +414,19 @@ like one returned by `date-to-day'."
       (_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer"
                      comparator target-date)))))
 
-(defsubst org-ql--planning-p (&optional comparator target-date)
+(org-ql--defpredicate planning (&optional comparator target-date)
+  "Return non-nil if entry's planning date (deadline or scheduled) compares with TARGET-DATE using COMPARATOR.
+TARGET-DATE should be a string parseable by `date-to-day'.
+COMPARATOR should be a function (like `<=')."
+  ;; NOTE: This was a defsubst before being defined with the macro.  Might be good to make it a defsubst again.
   ;; FIXME: I think :date selects either :deadline, :scheduled, or :closed, but I'm not sure.
   (org-ql--date-type-p :date comparator target-date))
 
-(defsubst org-ql--deadline-p (&optional comparator target-date)
+(org-ql--defpredicate deadline (&optional comparator target-date)
+  "Return non-nil if entry's deadline compares with TARGET-DATE using COMPARATOR.
+TARGET-DATE should be a string parseable by `date-to-day'.
+COMPARATOR should be a function (like `<=')."
+  ;; NOTE: This was a defsubst before being defined with the macro.  Might be good to make it a defsubst again.
   ;; FIXME: This is slightly confusing.  Using plain (deadline) does, and should, select entries
   ;; that have any deadline.  But the common case of wanting to select entries whose deadline is
   ;; within the warning days (either the global setting or that entry's setting) requires the user
@@ -414,18 +436,27 @@ like one returned by `date-to-day'."
   ;; selectors, which would also be unintuitive.
   (org-ql--date-type-p :deadline comparator target-date))
 
-(defsubst org-ql--scheduled-p (&optional comparator target-date)
+(org-ql--defpredicate scheduled (&optional comparator target-date)
+  "Return non-nil if entry's scheduled date compares with TARGET-DATE using COMPARATOR.
+TARGET-DATE should be a string parseable by `date-to-day'.
+COMPARATOR should be a function (like `<=')."
+  ;; NOTE: This was a defsubst before being defined with the macro.  Might be good to make it a defsubst again.
   (org-ql--date-type-p :scheduled comparator target-date))
 
-(defsubst org-ql--closed-p (&optional comparator target-date)
+(org-ql--defpredicate closed (&optional comparator target-date)
+  "Return non-nil if entry's closed date compares with TARGET-DATE using COMPARATOR.
+TARGET-DATE should be a string parseable by `date-to-day'.
+COMPARATOR should be a function (like `<=')."
+  ;; NOTE: This was a defsubst before being defined with the macro.  Might be good to make it a defsubst again.
   (org-ql--date-type-p :closed comparator target-date))
 
-(cl-defun org-ql--date-p (&optional comparator target-date (type 'active))
+(org-ql--defpredicate date (&optional comparator target-date (type 'active))
   "Return non-nil if Org entry at point has date of TYPE that compares with TARGET-DATE using COMPARATOR.
 Checks all Org-formatted timestamp strings in entry.  TYPE may be
 `active', `inactive', or `all', to control whether active,
 inactive, or all timestamps are checked.  Ranges of each type are
-also checked."
+also checked.  TARGET-DATE should be a string parseable by
+`date-to-day'.  COMPARATOR should be a function (like `<=')."
   ;; MAYBE: This duplicates some code in --date-p, maybe it could be refactored DRYer.
   (let* ((entry-timestamps (save-excursion
                              ;; NOTE: It's important to `save-excursion', otherwise the point will be moved, which will