WIP

Very useful now.  Still a lot of potential UI work to make it easier
to use, and plugging it into links and bookmarks, etc.

.github/ISSUE_TEMPLATE/bug_report.yml

@@ -1,78 +0,0 @@
-name: Bug Report
-description: File a bug report
-# labels: ["bug"]
-# assignees:
-#   - alphapapa
-body:
-  - type: markdown
-    attributes:
-      value: |
-        Thanks for taking the time to fill out this bug report!
-  - type: input
-    id: os-platform
-    attributes:
-      label: OS/platform
-      description: What operating system or platform are you running Emacs on?
-    validations:
-      required: true
-  - type: textarea
-    id: emacs-provenance
-    attributes:
-      label: Emacs version and provenance
-      description: What version of Emacs are you using, where did you acquire it, and how did you install it?
-    validations:
-      required: true
-  - type: input
-    id: emacs-command
-    attributes:
-      label: Emacs command
-      description: By what method did you run Emacs?  (i.e. what command did you run?)
-    validations:
-      required: true
-  - type: textarea
-    id: org-provenance
-    attributes:
-      label: Org version and provenance
-      description: What version of Org are you using, where did you acquire it, and how did you install it?
-    validations:
-      required: true
-  - type: input
-    id: package-provenance
-    attributes:
-      label: org-ql package version and provenance
-      description: What version of org-ql are you using, where did you acquire it, and how did you install it?
-    validations:
-      required: true
-  - type: textarea
-    id: actions
-    attributes:
-      label: Actions taken
-      description: What actions did you take, step-by-step, in order, before the problem was noticed?
-    validations:
-      required: true
-  - type: textarea
-    id: results
-    attributes:
-      label: Observed results
-      description: What behavior did you observe that seemed wrong?
-    validations:
-      required: true
-  - type: textarea
-    id: expected
-    attributes:
-      label: Expected results
-      description: What behavior did you expect to observe?
-    validations:
-      required: true
-  - type: textarea
-    id: backtrace
-    attributes:
-      label: Backtrace
-      description: If an error was signaled, please use `M-x toggle-debug-on-error RET` and cause the error to happen again, then paste the contents of the `*Backtrace*` buffer here.
-      render: elisp
-  - type: textarea
-    id: etc
-    attributes:
-      label: Etc.
-      description: Any other information that seems relevant
-

.github/ISSUE_TEMPLATE/config.yml

@@ -1,5 +0,0 @@
-blank_issues_enabled: true
-contact_links:
-  - name: Support questions
-    url: https://github.com/alphapapa/org-ql/discussions
-    about: Please ask and answer support questions here.

.github/ISSUE_TEMPLATE/feature_request.yml

@@ -1,45 +0,0 @@
-name: Feature Request
-description: File a feature request
-labels: ["enhancement"]
-body:
-  - type: input
-    id: os-platform
-    attributes:
-      label: OS/platform
-      description: What operating system or platform are you running Emacs on?
-    validations:
-      required: true
-  - type: textarea
-    id: emacs-provenance
-    attributes:
-      label: Emacs version and provenance
-      description: What version of Emacs are you using, where did you acquire it, and how did you install it?
-    validations:
-      required: true
-  - type: textarea
-    id: org-provenance
-    attributes:
-      label: Org version and provenance
-      description: What version of Org are you using, where did you acquire it, and how did you install it?
-    validations:
-      required: true
-  - type: input
-    id: package-provenance
-    attributes:
-      label: org-ql package version and provenance
-      description: What version of org-ql are you using, where did you acquire it, and how did you install it?
-    validations:
-      required: true
-  - type: textarea
-    id: description
-    attributes:
-      label: Description
-      description: Describe your request.
-    validations:
-      required: true
-  - type: textarea
-    id: etc
-    attributes:
-      label: Etc.
-      description: Any other information that seems relevant
-

.github/workflows/test.yml

@@ -41,14 +41,11 @@ jobs:
       fail-fast: false
       matrix:
         emacs_version:
+          - 26.3
           - 27.1
           - 27.2
           - 28.1
           - 28.2
-          - 29.1
-          - 29.2
-          - 29.3
-          - 29.4
           - snapshot
     steps:
     - uses: purcell/setup-emacs@master

README.org

@@ -1,6 +1,7 @@
 #+TITLE: org-ql
 
 # NOTE: Using =BEGIN_HTML= for this causes TeX/info export to fail, but this HTML block works.
+# #+HTML: <a href=https://alphapapa.github.io/dont-tread-on-emacs/><img src="images/dont-tread-on-emacs-150.png" align="right"></a>
 #+HTML: <img src="images/dog.png" align="right">
 
 # NOTE: To avoid having this in the info manual, we use HTML rather than Org syntax; it still appears with the GitHub renderer.
@@ -19,7 +20,6 @@ It includes three libraries: The =org-ql= library is flexible and may be used as
 - [[#installation][Installation]]
 - [[#usage][Usage]]
 - [[#changelog][Changelog]]
-- [[#development][Development]]
 :END:
 
 
@@ -112,20 +112,11 @@ Lisp code examples are in [[examples.org]].
 These commands jump to a heading selected using Emacs's built-in completion facilities with an Org QL query:
 
 - ~org-ql-find~ searches in the current buffer.
-- ~org-ql-find-path~ searches outline paths in the current buffer.
 - ~org-ql-find-in-agenda~ searches in ~(org-agenda-files)~.
 - ~org-ql-find-in-org-directory~ searches in ~org-directory~.
 
-Note that these commands are compatible with [[https://github.com/oantolin/embark][Embark]]: the ~embark-act~ command can be called on a completion candidate (i.e. a search result) to act on it immediately, without having to visit the entry in its source Org buffer, and ~embark-export~ may be called to show the results in an ~org-ql-view~ buffer.
-
 [[images/org-ql-find.png]]
 
-*** org-ql-open-link
-
-This command finds links in entries matching the input query and offers them for selection; the selected link is then opened with ~org-open-at-point~.
-
-The input is matched using the default predicate, which means it searches both entry content and outline paths.  This is helpful when a collection of links are kept in Org files: rather than having to first visit the entry containing the desired link, then locate it within the entry, and then open it, the user can simply select the link and open it directly.  For example, if an entry with the heading =Emacs= contained a link named =mailing list=, one could search for =Emacs list= and open the link to the mailing list directly.
-
 *** org-ql-refile
 
 This command refiles the current Org entry to one selected by searching with Org QL completion.  It searches files listed in ~org-refile-targets~ as well as the current buffer.
@@ -156,8 +147,6 @@ Read ~QUERY~ and search with ~org-ql~.  Interactively, prompt for these variable
 
 *Note:* The view buffer is currently put in ~org-agenda-mode~, which means that /some/ Org Agenda commands work, such as jumping to entries and changing item priorities (without necessarily updating the view).  This feature is experimental and not guaranteed to work correctly with all commands.  (It works to the extent it does because the appropriate text properties are placed on each item, imitating an Agenda buffer.)
 
-*Note:* Also, this buffer is compatible with [[https://github.com/oantolin/embark][Embark]]: the ~embark-act~ command can be called on an entry to act on it immediately, without having to visit the entry in its source Org buffer.
-
 *** helm-org-ql
 
 /Note: This command uses [[#non-sexp-query-syntax][non-sexp queries]].  It is available separately in the package =helm-org-ql=./
@@ -233,7 +222,7 @@ Note that the =effort=, =level=, and =priority= predicates do not support compar
 Arguments are listed next to predicate names, where applicable.
 
 +  =blocked= :: Return non-nil if current heading is blocked.  Calls ~org-entry-blocked-p~, which see.
-+  =category (&rest categories)= :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
++  =category (&optional categories)= :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
 +  =done= :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
 +  =effort (&optional effort-or-comparator effort)= :: Return non-nil if current heading's effort property matches arguments.  The following forms are accepted: ~(effort DURATION)~: Matches if effort is ~DURATION~.  ~(effort DURATION DURATION)~: Matches if effort is between DURATIONs, inclusive.  ~(effort COMPARATOR DURATION)~: Matches if effort compares to ~DURATION~ with ~COMPARATOR~.  ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~.  ~DURATION~ should be an Org effort string, like =5= or =0:05=.
 +  =habit= :: Return non-nil if entry is a habit.
@@ -249,23 +238,23 @@ Arguments are listed next to predicate names, where applicable.
      -  Aliases: ~olps~.
 +  =path (&rest regexps)= :: Return non-nil if current heading's buffer's filename path matches any of ~REGEXPS~ (regexp strings).  Without arguments, return non-nil if buffer is file-backed.
 +  =priority (&rest args)= :: Return non-nil if current heading has a certain priority.  ~ARGS~ may be either a list of one or more priority letters as strings, or a comparator function symbol followed by a priority letter string.  For example:  ~(priority "A") (priority "A" "B") (priority '>= "B")~ Note that items without a priority cookie never match this predicate (while Org itself considers items without a cookie to have the default priority, which, by default, is equal to priority ~B~).
-+  =property (property &optional value &key inherit)= :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string).  If ~INHERIT~ is nil, only match entries with ~PROPERTY~ set on the entry; if t, also match entries with inheritance.  If ~INHERIT~ is not specified, use the value of ~org-use-property-inheritance~, which see.
++  =property (property &optional value &key inherit)= :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string).  If ~INHERIT~ is nil, only match entries with ~PROPERTY~ set on the entry; if t, also match entries with inheritance.  If ~INHERIT~ is not specified, use the Boolean value of ~org-use-property-inheritance~, which see (i.e. it is only interpreted as nil or non-nil).
 +  =regexp (&rest regexps)= :: Return non-nil if current entry matches all of ~REGEXPS~ (regexp strings).  Matches against entire entry, from beginning of its heading to the next heading.
      -  Aliases: =r=.
 +  =rifle (&rest strings)= :: Return non-nil if each string is found in either the entry or its outline path.  Works like =org-rifle=.  This is probably the most useful, intuitive, general-purpose predicate.
      - Aliases: ~smart~.
      - *Note:* By default, this is the default predicate used for plain-string query tokens (i.e. given without a specified predicate).  This can be customized with the option ~org-ql-default-predicate~.
 +  ~src (&key lang regexps)~ :: Return non-nil if current entry contains an Org Babel source block.  If ~LANG~ is non-nil, match blocks of that language.  If ~REGEXPS~ is non-nil, require that block's contents match all regexps.  Matching is done case-insensitively.
-+  =tags (&rest tags)= :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings).  Tests both inherited and local tags.
-+  =tags-inherited (&rest tags)= :: Return non-nil if current heading's inherited tags include one or more of ~TAGS~ (a list of strings).  If ~TAGS~ is nil, return non-nil if heading has any inherited tags.
++  =tags (&optional tags)= :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings).  Tests both inherited and local tags.
++  =tags-inherited (&optional tags)= :: Return non-nil if current heading's inherited tags include one or more of ~TAGS~ (a list of strings).  If ~TAGS~ is nil, return non-nil if heading has any inherited tags.
      -  Aliases: ~inherited-tags~, ~tags-i~, ~itags~.
-+  =tags-local (&rest tags)= :: Return non-nil if current heading's local tags include one or more of ~TAGS~ (a list of strings).  If ~TAGS~ is nil, return non-nil if heading has any local tags.
++  =tags-local (&optional tags)= :: Return non-nil if current heading's local tags include one or more of ~TAGS~ (a list of strings).  If ~TAGS~ is nil, return non-nil if heading has any local tags.
      -  Aliases: ~local-tags~, ~tags-l~, ~ltags~.
-+  =tags-all (&rest tags)= :: Return non-nil if current heading includes all of ~TAGS~.  Tests both inherited and local tags.
++  =tags-all (tags)= :: Return non-nil if current heading includes all of ~TAGS~.  Tests both inherited and local tags.
      -  Aliases: ~tags&~.
 +  =tags-regexp (&rest regexps)= :: Return non-nil if current heading has tags matching one or more of ~REGEXPS~.  Tests both inherited and local tags.
      -  Aliases: ~tags*~.
-+  =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~ (a list of strings).  When called without arguments, only matches non-done tasks (i.e. does not match keywords in ~org-done-keywords~).
++  =todo (&optional 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).  When called without arguments, only matches non-done tasks (i.e. does not match keywords in ~org-done-keywords~).
 
 *** Ancestor/descendant predicates
 
@@ -554,146 +543,15 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
 
 /Note:/ Breaking changes may be made before version 1.0, but in the event of major changes, attempts at backward compatibility will be made with obsolescence declarations, translation of arguments, etc.  Users who need stability guarantees before 1.0 may choose to use tagged stable releases.
 
-** 0.9-pre
-
-*Additions*
-+ Face ~org-ql-view-query~, applied to view queries in header line.
-+ Face ~org-ql-view-title~, applied to view titles in header line.
-+ Option ~org-ql-view-relative-deadline-prefix~.
-
-*Changes*
-+ Command ~org-ql-find~ respects narrowing of the current buffer by default, allowing searching within the narrowed region.  (Using one ~C-u~ argument widens the current buffer, and using two ~C-u~ arguments prompts for the buffers to search.)
-+ Function ~org-ql-completing-read~ accepts a new ~NARROWP~ argument, which is passed to ~org-ql-select~.
-
-*Fixes*
-+ Customization group for face ~org-ql-view-due-date~.
-+ Apply Org syntax font-locking to items in ~org-ql-view~ buffers.
-
-*** helm-org-ql
-
-Tagged v0.6.2, fixing a compilation warning.
-
-** 0.8.10
-
-*Fixes*
-+ Command ~org-ql-refile~ uses the base buffer when refiling to an indirect buffer.  ([[https://github.com/alphapapa/org-ql/issues/466][#466]].)
-+ Predicate ~link~ could signal an error when searching text that is mistakenly recognized as an Org link (e.g. Bash double-bracket constructs in a source block).  (Thanks to [[https://github.com/jwiegley][John Wiegley]] for reporting.)
-
-** 0.8.9
-
-*Fixes*
-+ Predicate ~property~ when called with argument form ~(property "PROPERTY-NAME" :inherit t)~.  ([[https://github.com/alphapapa/org-ql/issues/460][#460]].  Thanks to [[https://github.com/Stewmath][Stewmath]] for reporting.)
-+ Predicate ~level~'s preamble optimizer allows expressions in place of the numeric argument.  (See [[https://github.com/alphapapa/org-ql/issues/460][#460]].  Thanks to [[https://github.com/Stewmath][Stewmath]] for reporting.)
-+ Reading of view settings from Org links in upcoming Emacs version.  ([[https://github.com/alphapapa/org-ql/issues/461][#461]].  Thanks to [[https://github.com/snogge][Ola Nilsson]] for help debugging, and for maintaining [[https://github.com/jorgenschaefer/emacs-buttercup][Buttercup]].)
-
-*Compatibility*
-+ Fix compilation error on Emacs 30.  ([[https://github.com/alphapapa/org-ql/issues/433][#433]].  Thanks to [[https://github.com/akirak][Akira Komamura]] and [[https://github.com/monnier][Stefan Monnier]].)
-
-** 0.8.8
-
-*Fixes*
-+ Remove text properties from to-do keywords before displaying them in an ~org-ql-view~ buffer.  (Such text properties could cause them to, e.g. display with extra leading spaces, depending on which other modes might be enabled in the source Org buffer.)
-+ Binding of ~completion-styles-alist~ in ~org-ql-completing-read~.  (This fixes compatibility with Helm's ~helm~ completion style, as well as default Emacs completion in recursive minibuffers.  [[https://github.com/alphapapa/org-ql/issues/337][#337]].  Thanks to [[https://github.com/progfolio][Nicholas Vollmer]], [[https://github.com/9viz][viz]], and [[https://github.com/karthink][Karthik Chikmagalur]] for reporting and suggesting fixes.)
-+ Use of the context snippet function for ~org-ql-completing-read~.  ([[https://github.com/alphapapa/org-ql/issues/419][#419]].  Thanks to [[https://github.com/tpeacock19][tpeacock19]] for reporting.)
-
-** 0.8.7
-
-*Fixes*
-+ Timestamps with internal time ranges (e.g. ~<2024-06-26 10:00-11:00>~) are matched for simple queries.  (This support is not yet comprehensive, e.g. a query that depends on the specific inner time range may not behave as expected.  Previously such timestamps were not matched at all.  See [[https://github.com/alphapapa/org-ql/pull/237][#237]] and [[https://github.com/alphapapa/org-ql/issues/371][#371]].  Thanks to [[https://github.com/yantar92][Ihor Radchenko]].)
-+ Timestamps with day-of-the-week abbreviations are matched more flexibly (allowing, e.g. a period in French locales).  (See [[https://github.com/alphapapa/org-ql/discussions/429][#429]], [[https://github.com/alphapapa/org-ql/issues/432][#432]].  Thanks to [[https://github.com/neurolit][Florian D.]] for reporting.)  
-+ Command ~org-ql-search~ did not narrow properly when called interactively.
-
-*Compatibility*
-+ Dynamic blocks work with Org 9.7.  ([[https://github.com/alphapapa/org-ql/issues/431][#431]].  Thanks to [[https://github.com/jezcope][Jez Cope]] for reporting.)
-
-** 0.8.6
-
-*Fixes*
-+ Bookmarking ~org-ql-view~ buffers when the ~buffers-files~ argument is a symbol (like ~org-agenda-files~).
-
-** 0.8.5
-
-*Fixes*
-+ Predicate ~heading~ incorrectly matched strings as regular expressions, sometimes returning incorrect results.  (See [[https://github.com/alphapapa/org-ql/discussions/410][discussion]].  Thanks to [[https://github.com/al3xandru][Alex Popescu]] for reporting.)
-+ Predicates ~ancestor~ and ~parent~ did not normalize their sub-queries, sometimes returning incorrect results.  ([[https://github.com/alphapapa/org-ql/issues/365][#365]].  Thanks to [[https://github.com/kofm][Gabriele Mongiano]] for reporting.)
-
-** 0.8.4
-
-*Fixes*
-
-+ Command ~org-ql-find~ goes to the selected entry in the base buffer (rather than potentially an indirect buffer, whose narrowing could leave the selected entry hidden.  The nuances around going to entries in buffers that may be indirect and/or narrowed are surprisingly complicated.  Hopefully this is the last fix).
-
-** 0.8.3
-
-*Fixes*
-
-+ Command ~org-ql-find~ incorrectly moved point.  (See [[https://github.com/alphapapa/org-ql/issues/380#issuecomment-1881913025][#380]].  Thanks to [[https://github.com/oantolin][Omar Antolín Camarena]] for reporting.)
-
-** 0.8.2
-
-*Fixes*
-
-+ Command ~org-ql-find~ incorrectly restored the buffer after jumping when not using indirect buffers.  (See [[https://github.com/alphapapa/org-ql/issues/380#issuecomment-1881913025][#380]].  Thanks to [[https://github.com/bram85][Bram Schoenmakers]] for reporting.)
-
-** 0.8.1
-
-*Fixes*
-
-+ Command ~org-ql-find~ widens the buffer before going to the selected entry.
-+ In ~org-ql-view~ buffers, links in headings remain clickable links.  (Fixes [[https://github.com/alphapapa/org-ql/issues/282][#282]].  Thanks to [[https://github.com/jakebox][Jacob Boxerman]] for reporting.)
-
-** 0.8
-
-*Additions*
-
-+ Function ~org-ql-completing-read~, used by command ~org-ql-find~, now specifies the completion category as ~org-heading~, providing compatibility with [[https://github.com/oantolin/embark][Embark]].  (This is a powerful feature, as it means any ~org-ql-find~ result can be acted on from inside the search results with Embark, which provides common actions from Org Agenda and Org speed keys bindings.)  ([[https://github.com/alphapapa/org-ql/issues/299][#299]].  Thanks to [[https://github.com/oantolin][Omar Antolín Camarena]], [[https://github.com/minad][Daniel Mendler]], and [[https://github.com/akirak][Akira Komamura]].)
-  - Command ~org-ql-completing-read-export~, bound to ~C-c C-e~ or ~embark-export~ while in an ~org-ql-completing-read~ session, exits and shows an ~org-ql-view~ buffer for the current search.
-+ Command ~org-ql-find~ may be called in an ~org-agenda~ or ~org-ql-view~ buffer to search the buffers which contributed to the agenda/view buffer.
-+ Command ~org-ql-find-path~, which searches outline paths in the current buffer.
-+ Command ~org-ql-open-link~, which finds links in entries matching the given query, and opens the selected one with ~org-open-at-point~.  (This is helpful when a collection of links are kept in Org files: rather than having to first visit the entry containing the desired link, then locate it within the entry, and then open it, the user can simply select the link and open it directly.)
-+ Items in ~org-ql-view~ buffers now include the ~org-category~ text property, like Org Agenda buffers, which allows grouping with ~org-super-agenda~'s category-related selectors.  ([[https://github.com/alphapapa/org-ql/issues/363][#363]].  Thanks to [[https://github.com/kofm][Gabriele Mongiano]] for reporting.)
-
-*Fixes*
-
-+ Predicate ~property~ correctly uses the value of ~org-use-property-inheritance~ when not specified.  ([[https://github.com/alphapapa/org-ql/pull/346][#346]], [[https://github.com/alphapapa/org-ql/issues/356][#356]].  Thanks to [[https://github.com/bram85][Bram Schoenmakers]].)
-
-*Compatibility*
-
-+ Emacs 27.1 or later is now required.
-+ Org v9.7's ~org-element~ API changes required some adjustments.  ([[https://github.com/alphapapa/org-ql/issues/364][#364]].  Thanks to several users for reporting, and to [[https://github.com/yantar92][Ihor Radchenko]] for his feedback.)
-
-** 0.7.4
-
-*Fixes*
-+ Ignore empty quoted strings in plain-string queries ([[https://github.com/alphapapa/org-ql/issues/383][#383]]).
-
-** 0.7.3
-
-*Fixes*
-+ Disable ~case-fold-search~ when collecting headings in outline paths.  (Headings that started with a word that is also a to-do keyword but with different capitalization would be matched incorrectly.)
-+ Saving of ~org-ql-view~ views.  ([[https://github.com/alphapapa/org-ql/issues/378][#378]].  Thanks to [[https://github.com/Pentaquark1][Pentaquark1]] for reporting.)
-+ Command ~org-ql-find~ didn't move point to the selected entry.  ([[https://github.com/alphapapa/org-ql/issues/380][#380]].  Thanks to [[https://github.com/oantolin][Omar Antolín Camarena]] for reporting.)
-
-** 0.7.2
-
-*Fixes*
-+ Timestamp predicates are more tolerant of partial input (e.g. preventing errors while the user is typing a query into ~org-ql-find~).
-+ Query parser ignores leading whitespace (e.g. preventing errors while the user is typing a query into ~org-ql-find~).
-+ Use of ~org-ql-find~ with ~:query-prefix~ argument prevented selection of results.  ([[https://github.com/alphapapa/org-ql/issues/351][#351]].  Thanks to [[https://github.com/danielfleischer][Daniel Fleischer]] for reporting.)
-+ Handle narrowed buffers correctly in ~org-ql-find~.
-+ Warn about empty headings in ~org-ql-completing-read~ (the Org format allows a heading line to have no text, but it's useless for this purpose, and usually indicates unnoticed corruption).
-
-** 0.7.1
+** 0.7.1-pre
 
 *Fixes*
 + Function ~org-ql-completing-read~ is more compatible with default Emacs completion.  (See [[https://github.com/alphapapa/org-ql/issues/338][#338]].  Thanks to [[https://github.com/arozbiz][arozbiz]] for reporting.)
-+ Function ~org-ql-completing-read~ would sometimes stop updating with changes in input.  (See [[https://github.com/alphapapa/org-ql/issues/350][#350]].  Thanks to [[https://github.com/anpandey][Ankit Raj Pandey]] for reporting and fixing, and to [[https://github.com/minad][Daniel Mendler]] for advising.)
-+ In ~org-ql-completing-read~, format links for display, and use ~org-entry-get~ internally rather than ~org-get-heading~.
 
 ** 0.7
 
 *Added*
-+  Command ~org-ql-find~, which jumps to entries selected using Emacs's built-in completion facilities and Org QL queries (like ~helm-org-ql~, but doesn't require Helm.).
++  Commands ~org-ql-find~, ~org-ql-find-heading~, and ~org-ql-find-path~, which jump to entries selected using Emacs's built-in completion facilities and Org QL queries (like ~helm-org-ql~, but doesn't require Helm.).
 +  Command ~org-ql-refile~, which refiles the entry at point to one selected using Org QL completion.
 +  Predicate ~rifle~, which matches an entry if each of the given arguments is found in either the entry's contents or its outline path.  This provides very intuitive results, mimicing the behavior of [[https://github.com/alphapapa/org-rifle][=org-rifle=]].  In fact, the results are so useful that it's now the default predicate for plain-string query tokens.  (It is also aliased to ~smart~, since it's so "smart," and not all users have used =org-rifle=.)
 +  Option ~org-ql-default-predicate~, applied to plain-string query tokens (before, the ~regexp~ predicate was always used, but now it may be customized).
@@ -1003,14 +861,6 @@ Tagged v0.6.2, fixing a compilation warning.
 
 First tagged release.
 
-* Development
-
-Bug reports, feature requests, and suggestions are welcome.  For patches, see below.
-
-** Copyright assignment
-
-While Org QL is currently distributed in MELPA, it's [[https://github.com/alphapapa/org-ql/issues/409][intended]] to merge Org QL into Org mode.  When that happens, it will become a part of Emacs and Org, and therefore cumulative contributions of more than 15 lines of code will require that the author assign copyright of such contributions to the FSF.  Authors who are interested in doing so may contact [[mailto:assign@gnu.org][assign@gnu.org]] to request the appropriate form.
-
 * Notes
 :PROPERTIES:
 :TOC:      :ignore this

helm-org-ql.el

@@ -2,8 +2,8 @@
 
 ;; Author: Adam Porter <adam@alphapapa.net>
 ;; URL: https://github.com/alphapapa/org-ql
-;; Version: 0.6.2
-;; Package-Requires: ((emacs "26.1") (compat "29.1.4.5") (dash "2.18.1") (s "1.12.0") (helm-org "1.0") (org-ql "0.6-pre"))
+;; Version: 0.6.1
+;; Package-Requires: ((emacs "26.1") (dash "2.18.1") (s "1.12.0") (helm-org "1.0") (org-ql "0.6-pre"))
 
 ;;; Commentary:
 
@@ -35,7 +35,6 @@
 (require 'cl-lib)
 (require 'org)
 
-(require 'compat)
 (require 'dash)
 (require 's)
 
@@ -45,15 +44,6 @@
 (require 'org-ql)
 (require 'org-ql-search)
 
-(declare-function org-ql--normalize-query "org-ql" t t)
-
-;;;; Compatibility
-
-(defalias 'helm-org-ql--show-entry
-  (if (version< org-version "9.6")
-      'org-show-entry
-    'org-fold-show-entry))
-
 ;;;; Variables
 
 (defvar helm-org-ql-map
@@ -112,7 +102,7 @@ NAME is passed to `helm-org-ql-source', which see.
 
 NOTE: Atoms in the query are turned into strings where
 appropriate, which makes it unnecessary to type quotation marks
-around words that are intended to be searched for as independent
+around words that are intended to be searched for as indepenent
 strings.
 
 All query tokens are wrapped in the operator BOOLEAN (default
@@ -161,7 +151,7 @@ Is transformed into this query:
   ;; it to go to the previous heading.  I don't know why it does that.
   (switch-to-buffer (marker-buffer marker))
   (goto-char marker)
-  (helm-org-ql--show-entry))
+  (org-show-entry))
 
 (defun helm-org-ql-show-marker-indirect (marker)
   "Show heading at MARKER with `org-tree-to-indirect-buffer'."
@@ -187,7 +177,7 @@ Is transformed into this query:
 
 ;;;###autoload
 (cl-defun helm-org-ql-source (buffers-files &key (name "helm-org-ql"))
-  "Return Helm source named NAME to search BUFFERS-FILES with `helm-org-ql'."
+  "Return Helm source named NAME that searches BUFFERS-FILES with `helm-org-ql'."
   ;; Expansion of `helm-build-sync-source' macro.
   (helm-make-source name 'helm-source-sync
     :candidates (lambda ()
@@ -211,7 +201,7 @@ Is transformed into this query:
 (defun helm-org-ql--heading (window-width)
   "Return string for Helm for heading at point.
 WINDOW-WIDTH should be the width of the Helm window."
-  (font-lock-ensure (pos-bol) (pos-eol))
+  (font-lock-ensure (point-at-bol) (point-at-eol))
   ;; TODO: It would be better to avoid calculating the prefix and width
   ;; at each heading, but there's no easy way to do that once in each
   ;; buffer, unless we manually called `org-ql' in each buffer, which

makem.sh

@@ -3,7 +3,7 @@
 # * makem.sh --- Script to aid building and testing Emacs Lisp packages
 
 # URL: https://github.com/alphapapa/makem.sh
-# Version: 0.7.1
+# Version: 0.6-pre
 
 # * Commentary:
 
@@ -112,12 +112,6 @@ Source files are automatically discovered from git, or may be
 specified with options.  Package dependencies are discovered from
 "Package-Requires" headers in source files, from -pkg.el files, and
 from a Cask file.
-
-Checkdoc's spell checker may not recognize some words, causing the
-`lint-checkdoc' rule to fail.  Custom words can be added in file-local
-or directory-local variables using the variable
-`ispell-buffer-session-localwords', which should be set to a list of
-strings.
 EOF
 }
 
@@ -183,7 +177,6 @@ function elisp-checkdoc-file {
               (setq makem-checkdoc-errors-p t)
               ;; Return nil because we *are* generating a buffered list of errors.
               nil))))
-    (put 'ispell-buffer-session-localwords 'safe-local-variable #'list-of-strings-p)
     (mapcar #'checkdoc-file files)
     (when makem-checkdoc-errors-p
       (kill-emacs 1))))
@@ -307,6 +300,7 @@ function elisp-package-initialize-file {
 (setq package-archives (list (cons "gnu" "https://elpa.gnu.org/packages/")
                              (cons "melpa" "https://melpa.org/packages/")
                              (cons "melpa-stable" "https://stable.melpa.org/packages/")))
+$elisp_org_package_archive
 (package-initialize)
 EOF
     echo $file
@@ -385,36 +379,6 @@ function byte-compile-file {
 
 # ** Files
 
-function submodules {
-    # Echo a list of submodules's paths relative to the repo root.
-    # TODO: Parse with bash regexp instead of cut.
-    git submodule status | awk '{print $2}'
-}
-
-function project-root {
-    # Echo the root of the project (or superproject, if running from
-    # within a submodule).
-    root_dir=$(git rev-parse --show-superproject-working-tree)
-    [[ $root_dir ]] || root_dir=$(git rev-parse --show-toplevel)
-    [[ $root_dir ]] || error "Can't find repo root."
-
-    echo "$root_dir"
-}
-
-function files-project {
-    # Echo a list of files in project; or with $1, files in it
-    # matching that pattern with "git ls-files".  Excludes submodules.
-    [[ $1 ]] && pattern="/$1" || pattern="."
-
-    local excludes
-    for submodule in $(submodules)
-    do
-        excludes+=(":!:$submodule")
-    done
-
-    git ls-files -- "$pattern" "${excludes[@]}"
-}
-
 function dirs-project {
     # Echo list of directories to be used in load path.
     files-project-feature | dirnames
@@ -423,7 +387,7 @@ function dirs-project {
 
 function files-project-elisp {
     # Echo list of Elisp files in project.
-    files-project 2>/dev/null \
+    git ls-files 2>/dev/null \
         | egrep "\.el$" \
         | filter-files-exclude-default \
         | filter-files-exclude-args
@@ -432,13 +396,13 @@ function files-project-elisp {
 function files-project-feature {
     # Echo list of Elisp files that are not tests and provide a feature.
     files-project-elisp \
-        | grep -E -v "$test_files_regexp" \
+        | egrep -v "$test_files_regexp" \
         | filter-files-feature
 }
 
 function files-project-test {
     # Echo list of Elisp test files.
-    files-project-elisp | grep -E "$test_files_regexp"
+    files-project-elisp | egrep "$test_files_regexp"
 }
 
 function dirnames {
@@ -451,7 +415,7 @@ function dirnames {
 
 function filter-files-exclude-default {
     # Filter out paths (STDIN) which should be excluded by default.
-    grep -E -v "(/\.cask/|-autoloads\.el|\.dir-locals)"
+    egrep -v "(/\.cask/|-autoloads.el|.dir-locals)"
 }
 
 function filter-files-exclude-args {
@@ -477,7 +441,7 @@ function filter-files-feature {
     # Read paths on STDIN and echo ones that (provide 'a-feature).
     while read path
     do
-        grep -E "^\\(provide '" "$path" &>/dev/null \
+        egrep "^\\(provide '" "$path" &>/dev/null \
             && echo "$path"
     done
 }
@@ -525,7 +489,7 @@ function ert-tests-p {
 
 function package-main-file {
     # Echo the package's main file.
-    file_pkg=$(files-project "*-pkg.el" 2>/dev/null)
+    file_pkg=$(git ls-files ./*-pkg.el 2>/dev/null)
 
     if [[ $file_pkg ]]
     then
@@ -548,23 +512,23 @@ function dependencies {
 
     # Search package headers.  Use -a so grep won't think that an Elisp file containing
     # control characters (rare, but sometimes necessary) is binary and refuse to search it.
-    grep -E -a -i '^;; Package-Requires: ' $(files-project-feature) $(files-project-test) \
-        | grep -E -o '\([^([:space:]][^)]*\)' \
-        | grep -E -o '^[^[:space:])]+' \
+    egrep -a -i '^;; Package-Requires: ' $(files-project-feature) $(files-project-test) \
+        | egrep -o '\([^([:space:]][^)]*\)' \
+        | egrep -o '^[^[:space:])]+' \
         | sed -r 's/\(//g' \
-        | grep -E -v '^emacs$'  # Ignore Emacs version requirement.
+        | egrep -v '^emacs$'  # Ignore Emacs version requirement.
 
     # Search Cask file.
     if [[ -r Cask ]]
     then
-        grep -E '\(depends-on "[^"]+"' Cask \
+        egrep '\(depends-on "[^"]+"' Cask \
             | sed -r -e 's/\(depends-on "([^"]+)".*/\1/g'
     fi
 
     # Search -pkg.el file.
-    if [[ $(files-project "*-pkg.el" 2>/dev/null) ]]
+    if [[ $(git ls-files ./*-pkg.el 2>/dev/null) ]]
     then
-        sed -nr 's/.*\(([-[:alnum:]]+)[[:blank:]]+"[.[:digit:]]+"\).*/\1/p' $(files-project- -- -pkg.el 2>/dev/null)
+        sed -nr 's/.*\(([-[:alnum:]]+)[[:blank:]]+"[.[:digit:]]+"\).*/\1/p' $(git ls-files ./*-pkg.el 2>/dev/null)
     fi
 }
 
@@ -617,9 +581,6 @@ function sandbox {
         local deps=($(dependencies))
         debug "Installing dependencies: ${deps[@]}"
 
-        # Ensure built-in packages get upgraded to newer versions from ELPA.
-        args_sandbox_package_install+=(--eval "(setq package-install-upgrade-built-in t)")
-
         for package in "${deps[@]}"
         do
             args_sandbox_package_install+=(--eval "(package-install '$package)")
@@ -1123,15 +1084,21 @@ args_package_archives=(
     --eval "(add-to-list 'package-archives '(\"melpa\" . \"https://melpa.org/packages/\") t)"
 )
 
+args_org_package_archives=(
+    --eval "(add-to-list 'package-archives '(\"org\" . \"https://orgmode.org/elpa/\") t)"
+)
+
 args_package_init=(
     --eval "(package-initialize)"
 )
 
+elisp_org_package_archive="(add-to-list 'package-archives '(\"org\" . \"https://orgmode.org/elpa/\") t)"
+
 # * Args
 
 args=$(getopt -n "$0" \
-              -o dhce:E:i:s::vf:C \
-              -l compile-batch,exclude:,emacs:,install-deps,install-linters,debug,debug-load-path,help,install:,verbose,file:,no-color,no-compile,sandbox:: \
+              -o dhce:E:i:s::vf:CO \
+              -l compile-batch,exclude:,emacs:,install-deps,install-linters,debug,debug-load-path,help,install:,verbose,file:,no-color,no-compile,no-org-repo,sandbox:: \
               -- "$@") \
     || { usage; exit 1; }
 eval set -- "$args"
@@ -1195,6 +1162,9 @@ do
             shift
             args_files+=("$1")
             ;;
+        -O|--no-org-repo)
+            unset elisp_org_package_archive
+            ;;
         --no-color)
             unset color
             ;;
@@ -1223,9 +1193,6 @@ paths_temp+=("$package_initialize_file")
 
 trap cleanup EXIT INT TERM
 
-# Change to project root directory first.
-cd "$(project-root)"
-
 # Discover project files.
 files_project_feature=($(files-project-feature))
 files_project_test=($(files-project-test))

org-ql-completing-read.el

@@ -1,6 +1,6 @@
 ;;; org-ql-completing-read.el --- Completing read of Org entries using org-ql  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2022-2023  Adam Porter
+;; Copyright (C) 2022  Adam Porter
 
 ;; Author: Adam Porter <adam@alphapapa.net>
 
@@ -26,19 +26,6 @@
 
 (require 'org-ql)
 
-(declare-function org-ql-search "org-ql-search")
-(declare-function org-ql--normalize-query "org-ql" t t)
-
-;;;; Variables
-
-(defvar-keymap org-ql-completing-read-map
-  :doc "Active during `org-ql-completing-read' sessions."
-  "C-c C-e" #'org-ql-completing-read-export)
-
-;; `embark-collect' doesn't work for `org-ql-completing-read', so remap
-;; it to `embark-export' (which `keymap-set', et al doesn't allow).
-(define-key org-ql-completing-read-map [remap embark-collect] 'embark-export)
-
 ;;;; Customization
 
 (defgroup org-ql-completing-read nil
@@ -50,10 +37,12 @@
   :type 'boolean)
 
 (defcustom org-ql-completing-read-snippet-function #'org-ql-completing-read--snippet-simple
-  ;; TODO(v0.9): Performance of completion annotations seems to be
-  ;; much improved now (whether due to changes in Emacs, Vertico, or
-  ;; both, I don't know).  It may be reasonable to make the context
-  ;; snippet the default now.
+  ;; TODO: I'd like to make the -regexp one the default, but with
+  ;; default Emacs completion affixation, it can sometimes be a bit
+  ;; slow, and I don't want that to be a user's first impression.  It
+  ;; may be possible to further optimize the -regexp one so that it
+  ;; can be used by default.  In the meantime, the -simple one seems
+  ;; fast enough for general use.
   "Function used to annotate results in `org-ql-completing-read'.
 Function is called at entry beginning.  (When set to
 `org-ql-completing-read--snippet-regexp', it is called with a
@@ -84,69 +73,16 @@ For an experience like `org-rifle', use a newline."
 (defface org-ql-completing-read-snippet '((t (:inherit font-lock-comment-face)))
   "Snippets.")
 
-(defvar org-ql-completing-read-input-regexp nil
-  "Current regexp for `org-ql-completing-read' input.
-To be used in, e.g. annotation functions.")
-
 ;;;; Functions
 
-(defun org-ql-completing-read-action ()
-  "Default action for `org-ql-completing-read'.
-Returns (STRING . MARKER) cons for entry at point."
-  (font-lock-ensure (pos-bol) (pos-eol))
-  (cons (org-link-display-format (org-entry-get nil "ITEM")) (point-marker)))
-
-(defun org-ql-completing-read-snippet (marker)
-  "Return snippet for entry at MARKER.
-Returns value returned by function
-`org-ql-completing-read-snippet-function' or
-`org-ql-completing-read--snippet-simple', whichever returns a
-value, or nil."
-  (pcase (while-no-input
-           ;; Using `while-no-input' here doesn't make it as
-           ;; responsive as, e.g. Helm while typing, but it seems to
-           ;; help a little when using the org-rifle-style snippets.
-           (org-with-point-at marker
-             (or (funcall org-ql-completing-read-snippet-function
-                          org-ql-completing-read-input-regexp)
-                 (org-ql-completing-read--snippet-simple))))
-    (`t  ;; Interrupted: return nil (which can be concatted).
-     nil)
-    (else (propertize (concat " " else)
-                      'face 'org-ql-completing-read-snippet))))
-
-(defun org-ql-completing-read-path (marker)
-  "Return formatted outline path for entry at MARKER."
-  (org-with-point-at marker
-    (let ((path (thread-first (org-get-outline-path nil t)
-                              (org-format-outline-path (window-width) nil "")
-                              (org-split-string ""))))
-      (if org-ql-completing-read-reverse-paths
-          (concat "\\" (string-join (reverse path) "\\"))
-        (concat "/" (string-join path "/"))))))
-
 ;;;;; Completing read
 
-(defun org-ql-completing-read-export ()
-  "Show `org-ql-view' buffer for current `org-ql-completing-read'-based search."
-  (interactive)
-  (user-error "Not in an `org-ql-completing-read' session"))
-
 ;;;###autoload
-(cl-defun org-ql-completing-read
-    (buffers-files &key query-prefix query-filter narrowp
-                   (action #'org-ql-completing-read-action)
-                   ;; FIXME: Unused argument.
-                   ;; (annotate #'org-ql-completing-read-snippet)
-                   (snippet #'org-ql-completing-read-snippet)
-                   (path #'org-ql-completing-read-path)
-                   (action-filter #'list)
-                   (prompt "Find entry: "))
-  "Return marker at entry in BUFFERS-FILES selected with `org-ql'.
+(cl-defun org-ql-completing-read (buffers-files &key query-prefix query-filter
+                                                (prompt "Find entry: "))
+  "Return marker at Org entry in BUFFERS-FILES selected with `org-ql'.
 PROMPT is shown to the user.
 
-NARROWP is passed to `org-ql-select', which see.
-
 QUERY-PREFIX may be a string to prepend to the query entered by
 the user (e.g. use \"heading:\" to only search headings, easily
 creating a custom command that saves the user from having to type
@@ -171,157 +107,148 @@ single predicate)."
   (let ((table (make-hash-table :test #'equal))
         (disambiguations (make-hash-table :test #'equal))
         (window-width (window-width))
-        last-input org-outline-path-cache query-tokens)
+        last-input org-outline-path-cache query-tokens snippet-regexp)
     (cl-labels (;; (debug-message
                 ;;  (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args))
-                (action ()
-                  (font-lock-ensure (pos-bol) (pos-eol))
-                  ;; This function needs to handle multiple candidates per
-                  ;; call, so we loop over a list of values by default.
-                  (pcase-dolist (`(,string . ,marker) (funcall action-filter (funcall action)))
-                    (when string
-                      (if (string-empty-p string)
-                          ;; A heading's string can be empty, but we can't use one because it
-                          ;; wouldn't be useful to the user; and if one is found, it's very
-                          ;; likely to indicate an unnoticed mistake or corruption in the
-                          ;; file: so display a warning and don't record it as a candidate.
-                          (display-warning 'org-ql-completing-read (format-message "Empty heading at %S" marker))
-                        (when (gethash string table)
-                          ;; Disambiguate string (even adding the path isn't enough, because that could
-                          ;; also be duplicated).
-                          (if-let ((suffix (gethash string disambiguations)))
-                              (setf string (format "%s <%s>" string (cl-incf suffix)))
-                            (setf string (format "%s <%s>" string (puthash string 2 disambiguations)))))
-                        (puthash (propertize string 'org-marker marker) marker table)))))
+                (action
+                 () (font-lock-ensure (point-at-bol) (point-at-eol))
+                 ;; FIXME: We want the fontified heading, and `org-heading-components' returns it
+                 ;; without properties, so we have to use `org-get-heading', which added additional
+                 ;; optional arguments in a certain Org version, so in those versions, it will
+                 ;; return priority cookies and comment strings.
+                 (let ((heading (org-get-heading t t)))
+                   (when (gethash heading table)
+                     ;; Disambiguate heading (even adding the path isn't enough, because that could
+                     ;; also be duplicated).
+                     (if-let ((suffix (gethash heading disambiguations)))
+                         (setf heading (format "%s <%s>" heading (cl-incf suffix)))
+                       (setf heading (format "%s <%s>" heading (puthash heading 2 disambiguations)))))
+                   (puthash heading (point-marker) table)))
                 (path (marker)
-                  (org-with-point-at marker
-                    (let* ((path (thread-first (org-get-outline-path nil t)
-                                               (org-format-outline-path window-width nil "")
-                                               (org-split-string "")))
-                           (formatted-path (if org-ql-completing-read-reverse-paths
-                                               (concat "\\" (string-join (reverse path) "\\"))
-                                             (concat "/" (string-join path "/")))))
-                      formatted-path)))
-                (todo (marker)
-                  (if-let (it (org-entry-get marker "TODO"))
-                      (concat (propertize it 'face (org-get-todo-face it)) " ")
-                    ""))
+                      (org-with-point-at marker
+                        (let* ((path (thread-first (org-get-outline-path nil t)
+                                                   (org-format-outline-path window-width nil "")
+                                                   (org-split-string "")))
+                               (formatted-path (if org-ql-completing-read-reverse-paths
+                                                   (concat "\\" (string-join (reverse path) "\\"))
+                                                 (concat "/" (string-join path "/")))))
+                          formatted-path)))
+                (todo
+                 (marker) (if-let (it (org-entry-get marker "TODO"))
+                              (concat (propertize it 'face (org-get-todo-face it)) " ")
+                            ""))
                 (affix (completions)
-                  ;; (debug-message "AFFIX:%S" completions)
-                  (cl-loop for completion in completions
-                           for marker = (get-text-property 0 'org-marker completion)
-                           for prefix = (todo marker)
-                           for suffix = (concat (funcall path marker) " " (funcall snippet marker))
-                           collect (list completion prefix suffix)))
+                       ;; (debug-message "AFFIX:%S" completions)
+                       (cl-loop for completion in completions
+                                for marker = (gethash completion table)
+                                for prefix = (todo marker)
+                                for suffix = (concat (path marker) " " (snippet marker))
+                                collect (list completion prefix suffix)))
                 (annotate (candidate)
-                  ;; (debug-message "ANNOTATE:%S" candidate)
-                  (while-no-input
-                    ;; Using `while-no-input' here doesn't make it as responsive as,
-                    ;; e.g. Helm while typing, but it seems to help a little when using the
-                    ;; org-rifle-style snippets.
-                    (or (funcall snippet (get-text-property 0 'org-marker candidate)) "")))
+                          ;; (debug-message "ANNOTATE:%S" candidate)
+                          (while-no-input
+                            ;; Using `while-no-input' here doesn't make it as responsive as,
+                            ;; e.g. Helm while typing, but it seems to help a little when using the
+                            ;; org-rifle-style snippets.
+                            (or (snippet (gethash candidate table)) "")))
+                (snippet
+                 (marker) (when-let
+                              ((snippet
+                                (org-with-point-at marker
+                                  (or (funcall org-ql-completing-read-snippet-function snippet-regexp)
+                                      (org-ql-completing-read--snippet-simple)))))
+                            (propertize (concat " " snippet)
+                                        'face 'org-ql-completing-read-snippet)))
                 (group (candidate transform)
-                  (pcase transform
-                    (`nil (buffer-name (marker-buffer (get-text-property 0 'org-marker candidate))))
-                    (_ candidate)))
+                       (pcase transform
+                         (`nil (buffer-name (marker-buffer (gethash candidate table))))
+                         (_ candidate)))
                 (try (string _collection _pred point &optional _metadata)
-                  ;; (debug-message "TRY: STRING:%S" string)
-                  (cons string point))
+                     ;; (debug-message "TRY: STRING:%S" string)
+                     (cons string point))
                 (all (string table pred _point)
-                  ;; (debug-message "all: STRING:%S" string)
-                  ;; (debug-message "all-completions RETURNS: %S" (all-completions string table pred))
-                  (all-completions string table pred))
+                     ;; (debug-message "all: STRING:%S" string)
+                     ;; (debug-message "all-completions RETURNS: %S" (all-completions string table pred))
+                     (all-completions string table pred))
                 (collection (input _pred flag)
-                  (pcase flag
-                    ('metadata (list 'metadata
-                                     (cons 'category 'org-heading)
-                                     (cons 'group-function #'group)
-                                     (cons 'affixation-function #'affix)
-                                     (cons 'annotation-function #'annotate)
-                                     (cons 'display-sort-function
-                                           (lambda (strings)
-                                             (let ((quoted-tokens (mapcar #'regexp-quote query-tokens)))
-                                               (sort strings
-                                                     (lambda (a b)
-                                                       (cl-labels ((matches
-                                                                     (s) (cl-loop for token in quoted-tokens
-                                                                                  count (string-match-p token s))))
-                                                         (> (matches a) (matches b))))))))))
-                    (`t
-                     ;; (debug-message "COLLECTION:t INPUT:%S KEYS:%S"
-                     ;;                input (hash-table-keys table))
-                     ;; It's not ideal to call `run-query' unconditionally here, but due to
-                     ;; the complexity of the "Programmed Completion" API, it's basically
-                     ;; necessary, and org-ql's caching should make it nearly free.
-                     (run-query input)
-                     (hash-table-keys table))
-                    ('lambda
-                      ;; (debug-message "COLLECTION:lambda INPUT:%S KEYS:%S"
-                      ;;                input (hash-table-keys table))
-                      (if (not (hash-table-empty-p table))
-                          (when (gethash input table)
-                            t)
-                        (run-query input)
-                        (when (gethash input table)
-                          ;; (debug-message "COLLECTION:lambda INPUT:%S FOUND" input)
-                          t)))
-                    (`nil
-                     ;; (debug-message "COLLECTION:nil INPUT:%S" input)
-                     (if (not (hash-table-empty-p table))
-                         (when (gethash input table)
-                           t)
-                       (run-query input)
-                       ;; (debug-message "COLLECTION:nil INPUT:%S KEYS:%S"
-                       ;;                input (hash-table-keys table))
-                       (cond ((hash-table-empty-p table)
-                              nil)
-                             ((gethash input table)
-                              t)
-                             (t
-                              ;; FIXME: "it should return the longest common prefix
-                              ;; substring of all matches otherwise"...but there's no
-                              ;; function to compute that?  At least returning an empty
-                              ;; string doesn't seem to break anything.
-                              input))))
-                    (`(boundaries . ,suffix)
-                     ;; (debug-message "COLLECTION:boundaries INPUT:%S SUFFIX:%S KEYS:%S"
-                     ;;                input suffix (hash-table-keys table))
-                     ;; FIXME: This is unlikely to be correct, but I'm not even sure if it
-                     ;; can be correct in this case since the input (e.g. "todo: foo")
-                     ;; usually won't match a completion candidate directly.
-                     `(boundaries 0 . ,(length suffix)))))
+                            (when query-prefix
+                              (setf input (concat query-prefix input)))
+                            (pcase flag
+                              ('metadata (list 'metadata
+                                               (cons 'group-function #'group)
+                                               (cons 'affixation-function #'affix)
+                                               (cons 'annotation-function #'annotate)))
+                              (`t
+                               ;; (debug-message "COLLECTION:t INPUT:%S KEYS:%S"
+                               ;;                input (hash-table-keys table))
+                               ;; It's not ideal to call `run-query' unconditionally here, but due to
+                               ;; the complexity of the "Programmed Completion" API, it's basically
+                               ;; necessary, and org-ql's caching should make it nearly free.
+                               (run-query input)
+                               (hash-table-keys table))
+                              ('lambda
+                                ;; (debug-message "COLLECTION:lambda INPUT:%S KEYS:%S"
+                                ;;                input (hash-table-keys table))
+                                (if (not (hash-table-empty-p table))
+                                    (when (gethash input table)
+                                      t)
+                                  (run-query input)
+                                  (when (gethash input table)
+                                    ;; (debug-message "COLLECTION:lambda INPUT:%S FOUND" input)
+                                    t)))
+                              (`nil
+                               ;; (debug-message "COLLECTION:nil INPUT:%S" input)
+                               (if (not (hash-table-empty-p table))
+                                   (when (gethash input table)
+                                     t)
+                                 (run-query input)
+                                 ;; (debug-message "COLLECTION:nil INPUT:%S KEYS:%S"
+                                 ;;                input (hash-table-keys table))
+                                 (cond ((hash-table-empty-p table)
+                                        nil)
+                                       ((gethash input table)
+                                        t)
+                                       (t
+                                        ;; FIXME: "it should return the longest common prefix
+                                        ;; substring of all matches otherwise"...but there's no
+                                        ;; function to compute that?  At least returning an empty
+                                        ;; string doesn't seem to break anything.
+                                        input))))
+                              (`(boundaries . ,suffix)
+                               ;; (debug-message "COLLECTION:boundaries INPUT:%S SUFFIX:%S KEYS:%S"
+                               ;;                input suffix (hash-table-keys table))
+                               ;; FIXME: This is unlikely to be correct, but I'm not even sure if it
+                               ;; can be correct in this case since the input (e.g. "todo: foo")
+                               ;; usually won't match a completion candidate directly.
+                               `(boundaries 0 . ,(length suffix)))))
                 (run-query (input)
-                  ;; (debug-message "RUN-QUERY:%S" input)
-                  (when query-prefix
-                    (setf input (concat query-prefix input)))
-                  (unless (or (string-empty-p input)
-                              (equal last-input input))
-                    ;; (debug-message "RUN-QUERY:%S  RUNNING" input)
-                    (setf last-input input)
-                    ;; Clear hash table each time the user changes the input.
-                    (clrhash table)
-                    (clrhash disambiguations)
-                    (when query-filter
-                      (setf input (funcall query-filter input)))
-                    (setf query-tokens
-                          ;; Remove any tokens that specify predicates or are too short.
-                          (--select (not (or (string-match-p (rx bos (1+ (not (any ":"))) ":") it)
-                                             (< (length it) org-ql-completing-read-snippet-minimum-token-length)))
-                                    (split-string input nil t (rx blank)))
-                          org-ql-completing-read-input-regexp
-                          (when query-tokens
-                            ;; Limiting each context word to 15 characters prevents
-                            ;; excessively long, non-word strings from ending up in
-                            ;; snippets, which can adversely affect performance.
-                            (rx-to-string `(seq (optional (repeat 1 3 (repeat 1 15 (not space)) (0+ space)))
-                                                bow (or ,@query-tokens) (0+ (not space))
-                                                (optional (repeat 1 3 (0+ space) (repeat 1 15 (not space))))))))
-                    (org-ql-select buffers-files (org-ql--query-string-to-sexp input)
-                      :narrow narrowp
-                      :action #'action))))
-      (unless (listp buffers-files)
-        ;; Since we map across this argument, we ensure it's a list.
-        (setf buffers-files (list buffers-files)))
+                           ;; (debug-message "RUN-QUERY:%S" input)
+                           (unless (or (string-empty-p input)
+                                       (equal last-input input))
+                             ;; (debug-message "RUN-QUERY:%S  RUNNING" input)
+                             (setf last-input input)
+                             ;; Clear hash table each time the user changes the input.
+                             (clrhash table)
+                             (clrhash disambiguations)
+                             (when query-filter
+                               (setf input (funcall query-filter input)))
+                             (pcase org-ql-completing-read-snippet-function
+                               ('org-ql-completing-read--snippet-regexp
+                                (setf query-tokens
+                                      ;; Remove any tokens that specify predicates or are too short.
+                                      (--select (not (or (string-match-p (rx bos (1+ (not (any ":"))) ":") it)
+                                                         (< (length it) org-ql-completing-read-snippet-minimum-token-length)))
+                                                (split-string input nil t (rx space)))
+                                      snippet-regexp
+                                      (when query-tokens
+                                        ;; Limiting each context word to 15 characters prevents
+                                        ;; excessively long, non-word strings from ending up in
+                                        ;; snippets, which can adversely affect performance.
+                                        (rx-to-string `(seq (optional (repeat 1 3 (repeat 1 15 (not space)) (0+ space)))
+                                                            bow (or ,@query-tokens) (0+ (not space))
+                                                            (optional (repeat 1 3 (0+ space) (repeat 1 15 (not space))))))))))
+                             (org-ql-select buffers-files (org-ql--query-string-to-sexp input)
+                               :action #'action))))
       ;; NOTE: It seems that the `completing-read' machinery can call, abort, and re-call the
       ;; collection function while the user is typing, which can interrupt the machinery Org uses to
       ;; prepare an Org buffer when an Org file is loaded.  This results in, e.g. the buffer being
@@ -331,27 +258,13 @@ single predicate)."
       ;; `completing-read' machinery, which interrupts it, so we must work around this problem by
       ;; ensuring all of the BUFFERS-FILES are loaded and initialized before calling
       ;; `completing-read'.
+      (unless (listp buffers-files)
+        ;; Since we map across this argument, we ensure it's a list.
+        (setf buffers-files (list buffers-files)))
       (mapc #'org-ql--ensure-buffer buffers-files)
       (let* ((completion-styles '(org-ql-completing-read))
-             (completion-styles-alist (cons (list 'org-ql-completing-read #'try #'all "Org QL Find")
-                                            completion-styles-alist))
-             (selected
-              (minibuffer-with-setup-hook
-                  (lambda ()
-                    (use-local-map (make-composed-keymap org-ql-completing-read-map (current-local-map))))
-                (cl-letf* (((symbol-function 'org-ql-completing-read-export)
-                            (lambda ()
-                              (interactive)
-                              (run-at-time 0 nil
-                                           #'org-ql-search
-                                           buffers-files
-                                           (minibuffer-contents-no-properties))
-                              (if (fboundp 'minibuffer-quit-recursive-edit)
-                                  (minibuffer-quit-recursive-edit)
-                                (abort-recursive-edit))))
-                           ((symbol-function 'embark-export)
-                            (symbol-function 'org-ql-completing-read-export)))
-                  (completing-read prompt #'collection nil t)))))
+             (completion-styles-alist (list (list 'org-ql-completing-read #'try #'all "Org QL Find")))
+             (selected (completing-read prompt #'collection nil t)))
         ;; (debug-message "SELECTED:%S  KEYS:%S" selected (hash-table-keys table))
         (or (gethash selected table)
             ;; If there are completions in the table, but none of them exactly match the user input
@@ -366,7 +279,7 @@ single predicate)."
             (car (hash-table-values table))
             (user-error "No results for input"))))))
 
-(defun org-ql-completing-read--snippet-simple (&optional _input-regexp)
+(defun org-ql-completing-read--snippet-simple (&optional _regexp)
   "Return a snippet of the current entry.
 Returns up to `org-ql-completing-read-snippet-length' characters."
   (save-excursion
@@ -380,15 +293,15 @@ Returns up to `org-ql-completing-read-snippet-length' characters."
                                            t t)
                  50 nil nil t))))))
 
-(defun org-ql-completing-read--snippet-regexp (&optional input-regexp)
-  "Return a snippet of the current entry's matches for INPUT-REGEXP."
+(defun org-ql-completing-read--snippet-regexp (regexp)
+  "Return a snippet of the current entry's matches for REGEXP."
   ;; REGEXP may be nil if there are no qualifying tokens in the query.
-  (when input-regexp
+  (when regexp
     (save-excursion
       (org-end-of-meta-data t)
       (unless (org-at-heading-p)
         (let* ((end (org-entry-end-position))
-               (snippets (cl-loop while (re-search-forward input-regexp end t)
+               (snippets (cl-loop while (re-search-forward regexp end t)
                                   concat (match-string 0) concat "…"
                                   do (goto-char (match-end 0)))))
           (unless (string-empty-p snippets)

org-ql-find.el

@@ -1,6 +1,6 @@
 ;;; org-ql-find.el --- Find headings with completion using org-ql  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2022-2023  Adam Porter
+;; Copyright (C) 2022  Adam Porter
 
 ;; Author: Adam Porter <adam@alphapapa.net>
 
@@ -33,8 +33,6 @@
 (require 'org-ql-search)
 (require 'org-ql-completing-read)
 
-(declare-function org-ql--normalize-query "org-ql" t t)
-
 ;;;; Customization
 
 (defgroup org-ql-find nil
@@ -43,7 +41,6 @@
 
 (defcustom org-ql-find-goto-hook '(org-show-entry org-reveal)
   "Functions called when selecting an entry."
-  ;; TODO: Add common choices, including `org-tree-to-indirect-buffer'.
   :type 'hook)
 
 (defcustom org-ql-find-display-buffer-action '(display-buffer-same-window)
@@ -51,21 +48,14 @@
 See function `display-buffer'."
   :type 'sexp)
 
-;;;; Commands
+;;;; Functions
 
 ;;;###autoload
-(cl-defun org-ql-find (buffers-files &key query-prefix query-filter widen
+(cl-defun org-ql-find (buffers-files &key query-prefix query-filter
                                      (prompt "Find entry: "))
   "Go to an Org entry in BUFFERS-FILES selected by searching entries with `org-ql'.
-Interactively, search the buffers and files relevant to the
-current buffer (i.e. in `org-agenda-mode', the value of
-`org-ql-view-buffers-files' or `org-agenda-contributing-files';
-in `org-mode', that buffer).
-
-With one or more universal prefix arguments, WIDEN buffers before
-searching (otherwise, respect any narrowing).  With two universal
-prefix arguments, select multiple buffers to search with
-completion and PROMPT.
+Interactively, with universal prefix, select multiple buffers to
+search with completion and PROMPT.
 
 QUERY-PREFIX may be a string to prepend to the query (e.g. use
 \"heading:\" to only search headings, easily creating a custom
@@ -76,35 +66,28 @@ types is filtered before execution (e.g. it could replace spaces
 with commas to turn multiple tokens, which would normally be
 treated as multiple predicates, into multiple arguments to a
 single predicate)."
-  (interactive (list (org-ql-find--buffers
-                      :read-buffer-p (equal '(16) current-prefix-arg))
-                     :widen current-prefix-arg))
-  (let ((marker (save-restriction
-                  (when (and widen (equal (current-buffer) buffers-files))
-                    (widen))
-                  (org-ql-completing-read buffers-files
-                    :narrowp (not widen)
-                    :query-prefix query-prefix
-                    :query-filter query-filter
-                    :prompt prompt))))
-    (set-buffer (or (buffer-base-buffer (marker-buffer marker))
-                    (marker-buffer marker)))
-    (pop-to-buffer (current-buffer) org-ql-find-display-buffer-action)
-    (without-restriction
+  (interactive
+   (list (if current-prefix-arg
+             (mapcar #'get-buffer
+                     (completing-read-multiple
+                      "Buffers: "
+                      (cl-loop for buffer in (buffer-list)
+                               when (eq 'org-mode (buffer-local-value 'major-mode buffer))
+                               collect (buffer-name buffer))
+                      nil t))
+           (progn
+             (unless (eq major-mode 'org-mode)
+               (user-error "This is not an Org buffer: %S" (current-buffer)))
+             (current-buffer)))))
+  (let ((marker (org-ql-completing-read buffers-files
+                  :query-prefix query-prefix
+                  :query-filter query-filter
+                  :prompt prompt)))
+    (with-current-buffer (marker-buffer marker)
       (goto-char marker)
-      (run-hook-with-args 'org-ql-find-goto-hook))
-    (when (equal (current-buffer) (marker-buffer marker))
-      ;; Ensure point is still within visible portion of buffer.  (If
-      ;; `org-tree-to-indirect-buffer' is used in `org-ql-find-goto-hook',
-      ;; the buffer will have been changed and it won't matter; otherwise,
-      ;; the buffer could have been narrowed to a region excluding the
-      ;; selected entry.)
-      (let ((end-of-subtree (org-with-point-at marker
-                              (org-end-of-subtree 'invisible-ok))))
-        (unless (and (<= (point-min) marker)
-                     (>= (point-max) end-of-subtree))
-          (widen)
-          (goto-char marker))))))
+      (display-buffer (current-buffer) org-ql-find-display-buffer-action)
+      (select-window (get-buffer-window (current-buffer)))
+      (run-hook-with-args 'org-ql-find-goto-hook))))
 
 ;;;###autoload
 (defun org-ql-refile (marker)
@@ -122,20 +105,18 @@ which see (but only the files are used)."
                                                                        ((and (pred listp) files) files)))
                                                              (list files-spec)))))))
                  (list (org-ql-completing-read buffers-files :prompt "Refile to: "))))
-  (let ((buffer (or (buffer-base-buffer (marker-buffer marker))
-                    (marker-buffer marker))))
-    (org-refile nil nil
-                ;; The RFLOC argument:
-                (list
-                 ;; Name
-                 (org-with-point-at marker
-                   (nth 4 (org-heading-components)))
-                 ;; File
-                 (buffer-file-name buffer)
-                 ;; nil
-                 nil
-                 ;; Position
-                 marker))))
+  (org-refile nil nil
+              ;; The RFLOC argument:
+              (list
+               ;; Name
+               (org-with-point-at marker
+                 (nth 4 (org-heading-components)))
+               ;; File
+               (buffer-file-name (marker-buffer marker))
+               ;; nil
+               nil
+               ;; Position
+               marker)))
 
 ;;;###autoload
 (defun org-ql-find-in-agenda ()
@@ -149,85 +130,6 @@ which see (but only the files are used)."
   (interactive)
   (org-ql-find (org-ql-search-directories-files)))
 
-;;;###autoload
-(defun org-ql-find-path (buffers-files)
-  "Call `org-ql-find' to search outline paths in BUFFERS-FILES.
-Interactively, search the buffers and files relevant to the
-current buffer (i.e. in `org-agenda-mode', the value of
-`org-ql-view-buffers-files' or `org-agenda-contributing-files';
-in `org-mode', that buffer).  With universal prefix, select
-multiple buffers to search with completion and PROMPT."
-  (interactive (list (org-ql-find--buffers)))
-  (let ((org-ql-default-predicate 'outline-path))
-    (org-ql-find buffers-files)))
-
-;;;###autoload
-(cl-defun org-ql-open-link (buffers-files &key query-prefix query-filter
-                                          (prompt "Open link: "))
-  "Open a link selected with `org-ql-completing-read'.
-Links found in entries matching the input query are offered as
-candidates, and the selected one is opened with
-`org-open-at-point'.  Arguments BUFFERS-FILES, QUERY-FILTER,
-QUERY-PREFIX, and PROMPT are passed to `org-ql-completing-read',
-which see.
-
-Interactively, search the buffers and files relevant to the
-current buffer (i.e. in `org-agenda-mode', the value of
-`org-ql-view-buffers-files' or `org-agenda-contributing-files';
-in `org-mode', that buffer).  With universal prefix, select
-multiple buffers to search with completion and PROMPT."
-  (interactive (list (org-ql-find--buffers)))
-  (let* ((marker (org-ql-completing-read buffers-files
-                   :query-prefix query-prefix
-                   :query-filter query-filter
-                   :prompt prompt
-                   :action-filter #'identity
-                   :action (lambda ()
-                             (save-excursion
-                               (cl-loop with limit = (org-entry-end-position)
-                                        while (re-search-forward org-link-any-re limit t)
-                                        for link = (string-trim (match-string 0))
-                                        do (progn
-                                             (set-text-properties 0 (length link) '(face org-link) link)
-                                             (setf link (org-link-display-format link)))
-                                        collect (cons link (copy-marker (match-beginning 0))))))
-                   :snippet (lambda (&rest _)
-                              "")
-                   :path (lambda (marker)
-                           (org-with-point-at marker
-                             (let* ((path (thread-first (org-get-outline-path t t)
-                                                        (org-format-outline-path (window-width) nil "")
-                                                        (org-split-string "")))
-                                    (formatted-path (if org-ql-completing-read-reverse-paths
-                                                        (concat "\\" (string-join (reverse path) "\\"))
-                                                      (concat "/" (string-join path "/")))))
-                               formatted-path))))))
-    (org-with-point-at marker
-      (org-open-at-point))))
-
-;;;; Functions
-
-(cl-defun org-ql-find--buffers (&key read-buffer-p)
-  "Return buffer or list of buffers to search in.
-In a mode derived from `org-agenda-mode', return the value of
-`org-ql-view-buffers-files' or `org-agenda-contributing-files'.
-In a mode derived from `org-mode', return the current buffer.  If
-READ-BUFFER-P, read a list of buffers in `org-mode' with
-completion.  To be used in `org-ql-find' commands' interactive
-forms."
-  (if read-buffer-p
-      (mapcar #'get-buffer
-              (completing-read-multiple
-               "Buffers: "
-               (cl-loop for buffer in (buffer-list)
-                        when (eq 'org-mode (buffer-local-value 'major-mode buffer))
-                        collect (buffer-name buffer))
-               nil t))
-    (cond ((derived-mode-p 'org-agenda-mode) (or org-ql-view-buffers-files
-                                                 org-agenda-contributing-files))
-          ((derived-mode-p 'org-mode) (current-buffer))
-          (t (user-error "This is not an Org-related buffer: %S" (current-buffer))))))
-
 (provide 'org-ql-find)
 
 ;;; org-ql-find.el ends here

org-ql-search.el

@@ -1,7 +1,5 @@
 ;;; org-ql-search.el --- Search commands for org-ql  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2019-2023  Adam Porter
-
 ;; Author: Adam Porter <adam@alphapapa.net>
 ;; Url: https://github.com/alphapapa/org-ql
 
@@ -40,8 +38,6 @@
 (require 'org-ql)
 (require 'org-ql-view)
 
-(declare-function org-ql--normalize-query "org-ql" t t)
-
 ;;;; Compatibility
 
 (defalias 'org-ql-search--link-heading-search-string
@@ -60,16 +56,6 @@
         ((fboundp 'org-store-link-props) #'org-store-link-props)
         (t (error "org-ql: Unable to define alias `org-ql-search--org-link-store-props'.  Please report this as a bug"))))
 
-(defalias 'org-ql--org-hide-archived-subtrees
-  (if (version<= "9.6" org-version)
-      'org-fold-hide-archived-subtrees
-    'org-hide-archived-subtrees))
-
-(defalias 'org-ql--org-show-context
-  (if (version<= "9.6" org-version)
-      'org-fold-show-context
-    'org-show-context))
-
 ;;;; Variables
 
 (defvar org-ql-block-header nil
@@ -138,10 +124,10 @@ Runs `org-occur-hook' after making the sparse tree."
                     query))))
       (org-ql-select buffer query
         :action (lambda ()
-                  (org-ql--org-show-context 'occur-tree)
+                  (org-show-context 'occur-tree)
                   (cl-incf num-results)))
       (unless org-sparse-tree-open-archived-trees
-        (org-ql--org-hide-archived-subtrees (point-min) (point-max)))
+        (org-hide-archived-subtrees (point-min) (point-max)))
       (run-hooks 'org-occur-hook)
       (unless (get-buffer-window buffer)
         (pop-to-buffer buffer))
@@ -186,7 +172,7 @@ necessary."
   (interactive (list (org-ql-view--complete-buffers-files)
                      (read-string "Query: " (when org-ql-view-query
                                               (format "%S" org-ql-view-query)))
-                     :narrow (or org-ql-view-narrow (equal current-prefix-arg '(4)))
+                     :narrow (or org-ql-view-narrow (eq current-prefix-arg '(4)))
                      :super-groups (org-ql-view--complete-super-groups)
                      :sort (org-ql-view--complete-sort)))
   ;; NOTE: Using `with-temp-buffer' is a hack to work around the fact that `make-local-variable'
@@ -222,28 +208,23 @@ necessary."
                                          (symbol (symbol-value super-groups))
                                          (list super-groups))))
           (setf strings (org-super-agenda--group-items strings))))
-      (org-ql-view--display :buffer buffer :header header :strings strings))))
+      (org-ql-view--display :buffer buffer :header header
+        :string (s-join "\n" strings)))))
 
 ;;;###autoload
-(defun org-ql-search-block (args)
-  "Insert items for ARGS into current buffer.
-Intended to be used as a user-defined function in
-`org-agenda-custom-commands'.  ARGS corresponds to the `match'
-item in the custom command form.  It should be a list of
-arguments which may be applied to `org-ql-select', which see, but
-not including its BUFFERS-FILES argument (which is supplied
-through the Agenda).  An additional `:header' keyword argument
-may be supplied as a string, like that supplied to
-`org-ql-view--display'.
+(defun org-ql-search-block (query)
+  "Insert items for QUERY into current buffer.
+QUERY should be an `org-ql' query form.  Intended to be used as a
+user-defined function in `org-agenda-custom-commands'.  QUERY
+corresponds to the `match' item in the custom command form.
 
 Like other agenda block commands, it searches files returned by
 function `org-agenda-files'.  Inserts a newline after the block.
 
 If `org-ql-block-header' is non-nil, it is used as the header
-string for the block, otherwise the header is formed
+string for the block, otherwise a the header is formed
 automatically from the query."
-  (pcase-let ((`(,query . ,(map :header :sort)) args)
-              (narrow-p) (old-beg) (old-end))
+  (let (narrow-p old-beg old-end)
     (when-let* ((from (pcase org-agenda-restrict
                         ('nil (org-agenda-files nil 'ifmode))
                         (_ (prog1 org-agenda-restrict
@@ -254,7 +235,7 @@ automatically from the query."
 			       (narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end))))))
                 (items (org-ql-select from query
                          :action 'element-with-markers
-                         :narrow narrow-p :sort sort)))
+                         :narrow narrow-p)))
       (when narrow-p
         ;; Restore buffer's previous restrictions.
         (with-current-buffer from
@@ -264,25 +245,16 @@ automatically from the query."
       ;; FIXME: `org-agenda--insert-overriding-header' is from an Org version newer than
       ;; I'm using.  Should probably declare it as a minimum Org version after upgrading.
       ;;  (org-agenda--insert-overriding-header (or org-ql-block-header (org-ql-agenda--header-line-format from query)))
-      ;; FIXME: Should we really use `org-ql-block-header' AND `header', or just one of them?
-      (insert (org-add-props (or org-ql-block-header header
-                                 (org-ql-view--header-line-format
-                                  :buffers-files from :query query))
+      (insert (org-add-props (or org-ql-block-header (org-ql-view--header-line-format
+                                                      :buffers-files from :query query))
                   nil 'face 'org-agenda-structure) "\n")
       ;; Calling `org-agenda-finalize' should be unnecessary, because in a "series" agenda,
       ;; `org-agenda-multi' is bound non-nil, in which case `org-agenda-finalize' does nothing.
       ;; But we do call `org-agenda-finalize-entries', which allows `org-super-agenda' to work.
-      ;; However, `org-agenda-finalize-entries' sorts entries with `org-entries-lessp', which
-      ;; overrides the sorting `org-ql' has already done, so we rebind `org-entries-lessp' to
-      ;; prevent it from affecting sort order.  (Ideally we would let `org-entries-lessp'
-      ;; handle sorting, but that's not possible, because we can't add the `type' text property
-      ;; it uses to sort entries, because the design of org-ql and org-agenda is fundamentally
-      ;; different.  So we have to do the sorting ourselves.)
-      (cl-letf (((symbol-function 'org-entries-lessp) #'ignore))
-        (->> items
-             (-map #'org-ql-view--format-element)
-             org-agenda-finalize-entries
-             insert))
+      (->> items
+           (-map #'org-ql-view--format-element)
+           org-agenda-finalize-entries
+           insert)
       (insert "\n"))))
 
 ;;;###autoload
@@ -363,24 +335,23 @@ this (must be a single line in the Org buffer):
                                    (org-element-property (intern (concat ":" (upcase property))) element)))))
           (elements (org-ql-query :from (current-buffer)
                                   :where query
-                                  :select '(org-ql-view--resolve-element-properties
-                                            (org-element-headline-parser (line-end-position)))
+                                  :select '(org-element-headline-parser (line-end-position))
                                   :order-by sort)))
     (when take
       (setf elements (cl-etypecase take
                        ((and integer (satisfies cl-minusp)) (-take-last (abs take) elements))
                        (integer (-take take elements)))))
-    (cl-labels ((format-element (element)
-                  (string-join (cl-loop for column in columns
-                                        collect (or (pcase-exhaustive column
-                                                      ((pred symbolp)
-                                                       (funcall (alist-get column format-fns) element))
-                                                      (`((,column . ,args) ,_header)
-                                                       (apply (alist-get column format-fns) element args))
-                                                      (`(,column ,_header)
-                                                       (funcall (alist-get column format-fns) element)))
-                                                    ""))
-                               " | ")))
+    (cl-labels ((format-element
+                 (element) (string-join (cl-loop for column in columns
+                                                 collect (or (pcase-exhaustive column
+                                                               ((pred symbolp)
+                                                                (funcall (alist-get column format-fns) element))
+                                                               (`((,column . ,args) ,_header)
+                                                                (apply (alist-get column format-fns) element args))
+                                                               (`(,column ,_header)
+                                                                (funcall (alist-get column format-fns) element)))
+                                                             ""))
+                                        " | ")))
       ;; Table header
       (insert "| " (string-join (--map (pcase it
                                          ((pred symbolp) (capitalize (symbol-name it)))

org-ql-view.el

@@ -1,7 +1,5 @@
 ;;; org-ql-view.el --- Agenda-like view based on org-ql  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2019-2023  Adam Porter
-
 ;; Author: Adam Porter <adam@alphapapa.net>
 ;; Url: https://github.com/alphapapa/org-ql
 
@@ -44,7 +42,6 @@
 
 (declare-function org-ql-search "org-ql-search" t)
 (declare-function org-ql-search--org-link-store-props "org-ql-search" t)
-(declare-function org-ql--normalize-query "org-ql" t t)
 
 (require 'dash)
 (require 's)
@@ -57,18 +54,7 @@
 (defface org-ql-view-due-date
   '((t (:slant italic :weight bold)))
   "Face for due dates in `org-ql-view' views."
-  :group 'org-ql-view)
-
-(defface org-ql-view-query nil
-  "View query in header line.
-This face is added to the formatted query after font-lock faces
-are applied to it.  It may be used, e.g. to reduce the height so
-more of it is visible."
-  :group 'org-ql-view)
-
-(defface org-ql-view-title '((t :weight bold))
-  "View title in header line."
-  :group 'org-ql-view)
+  :group 'org-ql)
 
 ;;;; Variables
 
@@ -249,12 +235,6 @@ See info node `(elisp)Cyclic Window Ordering'."
                                       (sexp :tag "org-super-agenda grouping expression")
                                       (variable :tag "Variable holding org-super-agenda  grouping expression"))))))))
 
-(defcustom org-ql-view-relative-deadline-prefix "due "
-  ;; TODO(v0.9): Add one for scheduled, too.
-  "Prefix for relative deadlines.
-Relative deadlines are, e.g. \"in 5d\", \"5d ago\"."
-  :type 'string)
-
 ;;;; Commands
 
 ;;;###autoload
@@ -322,10 +302,10 @@ SLOT is passed to `display-buffer-in-side-window', which see."
 (defun org-ql-view-switch ()
   "Switch to view at point."
   (interactive)
-  (let ((key (buffer-substring-no-properties (pos-bol) (pos-eol))))
+  (let ((key (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
     (unless (string-empty-p key)
       (ov-clear :org-ql-view-selected)
-      (ov (pos-bol) (1+ (pos-eol)) :org-ql-view-selected t
+      (ov (point-at-bol) (1+ (point-at-eol)) :org-ql-view-selected t
           'face '(:weight bold :inherit highlight))
       (org-ql-view key))))
 
@@ -372,8 +352,7 @@ update search arguments."
               (yes-or-no-p (format "Overwrite view \"%s\"?" name)))
       (setf (map-elt org-ql-views name nil #'equal) plist)
       (customize-set-variable 'org-ql-views org-ql-views)
-      (customize-mark-to-save 'org-ql-views)
-      (custom-save-all))))
+      (customize-mark-to-save 'org-ql-views))))
 
 (defun org-ql-view-delete ()
   "Delete current view (with confirmation)."
@@ -383,13 +362,12 @@ update search arguments."
           (--remove (equal (car it) org-ql-view-title)
                     org-ql-views))
     (customize-set-variable 'org-ql-views org-ql-views)
-    (customize-mark-to-save 'org-ql-views)
-    (custom-save-all)))
+    (customize-mark-to-save 'org-ql-views)))
 
 (defun org-ql-view-customize ()
   "Customize view at point in `org-ql-view-sidebar' buffer."
   (interactive)
-  (let ((key (buffer-substring-no-properties (pos-bol) (pos-eol))))
+  (let ((key (buffer-substring-no-properties (point-at-bol) (point-at-eol))))
     (customize-option 'org-ql-views)
     (search-forward (concat "Name: " key))))
 
@@ -426,7 +404,7 @@ update search arguments."
 
 (defvar bookmark-make-record-function)
 
-(cl-defun org-ql-view--display (&key (buffer org-ql-view-buffer) header strings)
+(cl-defun org-ql-view--display (&key (buffer org-ql-view-buffer) header string)
   "Display STRING in `org-ql-view' BUFFER.
 
 BUFFER may be a buffer, or a string naming a buffer, which is
@@ -464,9 +442,7 @@ subsequent refreshing of the buffer: `org-ql-view-buffers-files',
       ;; Clear buffer, insert entries, etc.
       (let ((inhibit-read-only t))
         (erase-buffer)
-        (dolist (string strings)
-          (insert string "\n"))
-        (insert "\n")
+        (insert string "\n")
         (pop-to-buffer (current-buffer) org-ql-view-display-buffer-action)
         (org-agenda-finalize)
         (goto-char (point-min))))))
@@ -476,8 +452,7 @@ subsequent refreshing of the buffer: `org-ql-view-buffers-files',
 If TITLE, prepend it to the header."
   (let* ((title (if title
                     (concat (propertize "View:" 'face 'transient-argument)
-                            (propertize title 'face 'org-ql-view-title)
-                            " ")
+                            title " ")
                   ""))
          (query-formatted (when query
                             (org-ql-view--format-query query)))
@@ -496,7 +471,6 @@ If TITLE, prepend it to the header."
                                                      (org-ql-view--font-lock-string 'emacs-lisp-mode)
                                                      (s-truncate available-width))
                                                 'help-echo buffers-files-formatted))))
-    (add-face-text-property 0 (length query-propertized) 'org-ql-view-query 'append query-propertized)
     (concat title
             (when query (propertize "Query:" 'face 'transient-argument))
             (when query query-propertized)
@@ -511,11 +485,11 @@ If TITLE, prepend it to the header."
 Makes QUERY more readable, e.g. timestamp objects are replaced
 with human-readable strings."
   (cl-labels ((rec (form)
-                (cl-typecase form
-                  (ts (ts-format form))
-                  (cons (cons (rec (car form))
-                              (rec (cdr form))))
-                  (otherwise form))))
+                   (cl-typecase form
+                     (ts (ts-format form))
+                     (cons (cons (rec (car form))
+                                 (rec (cdr form))))
+                     (otherwise form))))
     (format "%S" (rec query))))
 
 (defun org-ql-view--font-lock-string (mode s)
@@ -528,22 +502,6 @@ with human-readable strings."
       (font-lock-ensure)
       (buffer-string))))
 
-(defun org-ql-view--font-lock-as-org (s)
-  "Return string S font-locked as in `org-mode'."
-  ;; This works like `org-fontify-like-in-org-mode', but uses a single
-  ;; buffer instead of a new one every time.
-  ;; TODO(C): Submit these improvements upstream.
-  (let ((buffer (or (get-buffer " *org-ql-view--font-lock-as-org*")
-                    (with-current-buffer (get-buffer-create " *org-ql-view--font-lock-as-org*")
-                      (buffer-disable-undo)
-                      (org-mode)
-                      (current-buffer)))))
-    (with-current-buffer buffer
-      (insert s)
-      (font-lock-ensure)
-      (prog1 (buffer-string)
-        (erase-buffer)))))
-
 (defun org-ql-view--buffer (&optional name)
   "Return `org-ql-view' buffer, creating it if necessary.
 If NAME is non-nil, return buffer by that name instead of using
@@ -573,20 +531,19 @@ dates in the past, and negative for dates in the future."
 
 (defun org-ql-view-bookmark-make-record ()
   "Return a bookmark record for the current Org QL View buffer."
-  (cl-labels ((file-nameize (b-f)
-                (abbreviate-file-name
-                 (cl-typecase b-f
-                   (string b-f)
-                   (buffer (or (buffer-file-name b-f)
-                               (when (buffer-base-buffer b-f)
-                                 (buffer-file-name (buffer-base-buffer b-f)))))
-                   (t (user-error "Only file-backed buffers can be bookmarked by Org QL View: %s" b-f))))))
+  (cl-labels ((file-nameize
+               (b-f) (abbreviate-file-name
+                      (cl-typecase b-f
+                        (string b-f)
+                        (buffer (or (buffer-file-name b-f)
+                                    (when (buffer-base-buffer b-f)
+                                      (buffer-file-name (buffer-base-buffer b-f)))))
+                        (t (user-error "Only file-backed buffers can be bookmarked by Org QL View: %s" b-f))))))
     (-let* ((plist (org-ql-view--plist (current-buffer)))
             ((&plist :buffers-files) plist))
       ;; Replace buffers with their filenames, and signal error if any are not file-backed.
       (setf plist (plist-put plist :buffers-files
                              (cl-etypecase buffers-files
-                               (symbol buffers-files)
                                (string buffers-files)
                                (buffer (file-nameize buffers-files))
                                (list (mapcar #'file-nameize buffers-files)))))
@@ -646,7 +603,6 @@ The optional, second argument is temporarily _IGNORED for
 purposes of compatibility with changes in Org 9.4."
   (require 'url-parse)
   (require 'url-util)
-  (declare-function url-path-and-query "url-parse")
   (when (version<= "9.3" (org-version))
     ;; Org 9.3+ makes a backward-incompatible change to link escaping.
     ;; I don't think it would be a good idea to try to guess whether
@@ -661,7 +617,7 @@ purposes of compatibility with changes in Org 9.4."
                (query (url-unhex-string query))
                (params (when params (url-parse-query-string params)))
                ;; `url-parse-query-string' returns "improper" alists, which makes this awkward.
-               (sort (when-let* ((stored-string (car (alist-get "sort" params nil nil #'string=)))
+               (sort (when-let* ((stored-string (alist-get "sort" params nil nil #'string=))
                                  (read-value (read stored-string)))
                        ;; Ensure the value is either a symbol or list of symbols (which excludes lambdas).
                        (unless (or (symbolp read-value) (cl-every #'symbolp read-value))
@@ -669,19 +625,17 @@ purposes of compatibility with changes in Org 9.4."
                                 read-value))
                        read-value))
                (org-super-agenda-allow-unsafe-groups nil) ; Disallow unsafe group selectors.
-               (groups (--when-let (car (alist-get "super-groups" params nil nil #'string=))
+               (groups (--when-let (alist-get "super-groups" params nil nil #'string=)
                          (read it)))
-               (title (--when-let (car (alist-get "title" params nil nil #'string=))
+               (title (--when-let (alist-get "title" params nil nil #'string=)
                         (read it)))
-               (buffers-files (--if-let (car (alist-get "buffers-files" params nil nil #'string=))
+               (buffers-files (--if-let (alist-get "buffers-files" params nil nil #'string=)
                                   (org-ql-view--expand-buffers-files (read it))
                                 (current-buffer))))
     (unless (or (bufferp buffers-files)
                 (stringp buffers-files)
                 (cl-every #'stringp buffers-files))
       (error "CAUTION: Link not opened because unsafe buffers-files parameter detected: %s" buffers-files))
-    (unless (or (stringp title) (null title))
-      (error "CAUTION: Link not opened because unsafe title parameter detected: %S" title))
     (when (or (listp query)
               (string-match (rx bol (0+ space) "(") query))
       ;; SAFETY: Query is in sexp form: ask for confirmation, because it could contain arbitrary code.
@@ -699,25 +653,23 @@ When opened, the link searches the buffer it's opened from."
   (when org-ql-view-query
     ;; Only Org QL View buffers should have `org-ql-view-query' set.
     (cl-labels ((prompt-for (buffers-files)
-                  (pcase-exhaustive
-                      (completing-read (format "Make link that searches: ")
-                                       '("file link is in" "files currently searched")
-                                       nil t nil nil "file link is in")
-                    ("file link is in" nil)
-                    ("files currently searched" buffers-files)))
-                (strings-or-file-buffers-p (thing)
-                  (cl-etypecase thing
-                    (list (cl-every #'strings-or-file-buffers-p thing))
-                    (string thing)
-                    (buffer (or (buffer-file-name thing)
-                                ;; TODO: Should indirect buffers be allowed?  Maybe not, since their
-                                ;; narrowing isn't preserved.  On the other hand, it's possible to
-                                ;; accidentally make a search view for an indirect buffer that's
-                                ;; since been widened, and forcing the user to manually change that
-                                ;; would be awkward, and trying to communicate the problem would be
-                                ;; difficult, so maybe it's okay to allow it.
-                                (when (buffer-base-buffer thing)
-                                  (buffer-file-name (buffer-base-buffer thing))))))))
+                            (pcase-exhaustive
+                                (completing-read (format "Make link that searches: ")
+                                                 '("file link is in" "files currently searched")
+                                                 nil t nil nil "file link is in")
+                              ("file link is in" nil)
+                              ("files currently searched" buffers-files)))
+                (strings-or-file-buffers-p
+                 (thing) (cl-etypecase thing
+                           (list (cl-every #'strings-or-file-buffers-p thing))
+                           (string thing)
+                           (buffer (or (buffer-file-name thing)
+                                       ;; TODO: Should indirect buffers be allowed?  Maybe not, since their narrowing isn't preserved.
+                                       ;; On the other hand, it's possible to accidentally make a search view for an indirect buffer
+                                       ;; that's since been widened, and forcing the user to manually change that would be awkward,
+                                       ;; and trying to communicate the problem would be difficult, so maybe it's okay to allow it.
+                                       (when (buffer-base-buffer thing)
+                                         (buffer-file-name (buffer-base-buffer thing))))))))
       (unless (strings-or-file-buffers-p org-ql-view-buffers-files)
         (user-error "%s" "Views that search non-file-backed buffers can't be linked to"))
       (let* ((query-string (--if-let (org-ql--query-sexp-to-string org-ql-view-query)
@@ -750,8 +702,6 @@ When opened, the link searches the buffer it's opened from."
 ;; Transient manual is written very well, not everything is covered in
 ;; it, so I'm having to try to imitate examples from `magit-transient'.
 
-(require 'eieio-core)
-
 (require 'transient)
 
 (defclass org-ql-view--variable (transient-variable)
@@ -868,20 +818,6 @@ When opened, the link searches the buffer it's opened from."
 
 ;;;; Faces/properties
 
-(defalias 'org-ql-view--resolve-element-properties
-  ;; It would be preferable to define this as an inline function, but
-  ;; that would mean that users would have to recompile org-ql when
-  ;; upgrading to Org 9.7 or else get weird errors.
-  ;; TODO(someday): Define `org-ql-view--resolve-element-properties' as inline.
-  (if (version<= "9.7" org-version)
-      (lambda (node)
-        "Resolve NODE's properties using `org-element-properties-resolve'."
-        ;; Silence warnings about `org-element-properties-resolve'
-        ;; being unresolved on earlier Org versions.
-        (with-no-warnings
-          (org-element-properties-resolve node 'force-undefer)))
-    #'identity))
-
 (defun org-ql-view--format-element (element)
   ;; This essentially needs to do what `org-agenda-format-item' does,
   ;; which is a lot.  We are a long way from that, but it's a start.
@@ -891,7 +827,6 @@ returned by `org-element-parse-buffer'.  If ELEMENT is nil,
 return an empty string."
   (if (not element)
       ""
-    (setf element (org-ql-view--resolve-element-properties element))
     (let* ((properties (cadr element))
            ;; Remove the :parent property, which so bloats the size of
            ;; the properties list that it makes it essentially
@@ -913,15 +848,10 @@ return an empty string."
            ;; Adding the relative due date property should probably be done explicitly and separately
            ;; (which would also make it easier to do it independently of faces, etc).
            (title (--> (org-ql-view--add-faces element)
-                       (org-element-property :raw-value it)))
-           ;; TODO(B): Needs refactoring.  A function like `org-ql-view--add-faces'
-           ;; should return a list of faces to be added.
-           (title-faces (get-text-property 0 'face title))
-           (title (org-ql-view--font-lock-as-org title))
-           (_ (add-face-text-property 0 (length title) title-faces t title))
+                       (org-element-property :raw-value it)
+                       (org-link-display-format it)))
            (todo-keyword (-some--> (org-element-property :todo-keyword element)
-                           (org-ql-view--add-todo-face
-                            (substring-no-properties it))))
+                           (org-ql-view--add-todo-face it)))
            (tag-list (if org-use-tag-inheritance
                          ;; MAYBE: Use our own variable instead of `org-use-tag-inheritance'.
                          (if-let ((marker (or (org-element-property :org-hd-marker element)
@@ -942,21 +872,12 @@ return an empty string."
                               (s-join ":" it)
                               (s-wrap it ":")
                               (org-add-props it nil 'face 'org-tag))))
-           (category (or (org-element-property :CATEGORY element)
-                         (when-let ((marker (or (org-element-property :org-hd-marker element)
-                                                (org-element-property :org-marker element))))
-                           (org-with-point-at marker
-                             (or (org-get-category)
-                                 (when buffer-file-name
-			           (file-name-sans-extension
-			            (file-name-nondirectory buffer-file-name))))))
-                         ""))
+           ;;  (category (org-element-property :category element))
            (priority-string (-some->> (org-element-property :priority element)
                               (char-to-string)
                               (format "[#%s]")
                               (org-ql-view--add-priority-face)))
-           (habit-property (org-with-point-at (or (org-element-property :org-hd-marker element)
-                                                  (org-element-property :org-marker element))
+           (habit-property (org-with-point-at (org-element-property :begin element)
                              (when (org-is-habit-p)
                                (org-habit-parse-todo))))
            (due-string (pcase (org-element-property :relative-due-date element)
@@ -970,7 +891,6 @@ return an empty string."
            (concat "  " it)
            (org-add-props it properties
              'org-agenda-type 'search
-             'org-category category
              'todo-state todo-keyword
              'tags tag-list
              'org-habit-p habit-property)))))
@@ -1056,9 +976,7 @@ property."
              (deadline-day-number (org-time-string-to-absolute
                                    (org-element-timestamp-interpreter deadline-date 'ignore)))
              (difference-days (- today-day-number deadline-day-number))
-             (relative-due-date (org-add-props
-                                    (concat org-ql-view-relative-deadline-prefix
-                                            (org-ql-view--format-relative-date difference-days)) nil
+             (relative-due-date (org-add-props (org-ql-view--format-relative-date difference-days) nil
                                   'help-echo (org-element-property :raw-value deadline-date)))
              ;; FIXME: Unused for now: (todo-keyword (org-element-property :todo-keyword element))
              ;; FIXME: Unused for now: (done-p (member todo-keyword org-done-keywords))
@@ -1103,11 +1021,11 @@ the variable), \"org-directory\" if it matches the value of
 current buffer.  Otherwise BUFFERS-FILES is returned unchanged."
   ;; Used in `org-ql-view--complete-buffers-files' and
   ;; `org-ql-view--header-line-format'.
-  (cl-labels ((expand-files (list)
-                (--map (cl-typecase it
-                         (string (expand-file-name it))
-                         (otherwise it))
-                       list)))
+  (cl-labels ((expand-files
+               (list) (--map (cl-typecase it
+                               (string (expand-file-name it))
+                               (otherwise it))
+                             list)))
     ;; TODO: Test this more exhaustively.
     (pcase buffers-files
       ((pred listp)
@@ -1129,10 +1047,10 @@ current buffer.  Otherwise BUFFERS-FILES is returned unchanged."
 
 (defun org-ql-view--complete-buffers-files ()
   "Return value for `org-ql-view-buffers-files' using completion."
-  (cl-labels ((initial-input ()
-                (when org-ql-view-buffers-files
-                  (org-ql-view--contract-buffers-files
-                   org-ql-view-buffers-files))))
+  (cl-labels ((initial-input
+               () (when org-ql-view-buffers-files
+                    (org-ql-view--contract-buffers-files
+                     org-ql-view-buffers-files))))
     (if (and org-ql-view-buffers-files
              (bufferp org-ql-view-buffers-files))
         ;; Buffers can't be input by name, so if the default value is a buffer, just use it.

org-ql.el

@@ -1,11 +1,11 @@
 ;;; org-ql.el --- Org Query Language, search command, and agenda-like view  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2017-2023  Adam Porter
+;; Copyright (C) 2017-2022  Adam Porter
 
 ;; Author: Adam Porter <adam@alphapapa.net>
 ;; Url: https://github.com/alphapapa/org-ql
-;; Version: 0.9-pre
-;; Package-Requires: ((emacs "27.1") (compat "29.1") (dash "2.18.1") (f "0.17.2") (map "2.1") (org "9.0") (org-super-agenda "1.2") (ov "1.0.6") (peg "1.0.1") (s "1.12.0") (transient "0.1") (ts "0.2-pre"))
+;; Version: 0.7.1-pre
+;; Package-Requires: ((emacs "26.1") (dash "2.18.1") (f "0.17.2") (map "2.1") (org "9.0") (org-super-agenda "1.2") (ov "1.0.6") (peg "1.0.1") (s "1.12.0") (transient "0.1") (ts "0.2-pre"))
 ;; Keywords: hypermedia, outlines, Org, agenda
 
 ;;; License:
@@ -43,7 +43,6 @@
 (require 'seq)
 (require 'subr-x)
 
-(require 'compat)
 (require 'dash)
 (require 'map)
 (require 'ts)
@@ -77,7 +76,6 @@ Tags are stored in match group 1.  Match group 2 stores the tags
 without the enclosing colons.")
 
 (defvaralias 'org-ql-link-regexp
-  ;; FIXME: `org-link-bracket-re' is void until `org-link-make-regexps' is called.
   (if (bound-and-true-p org-link-bracket-re)
       'org-link-bracket-re
     'org-bracket-link-regexp)
@@ -96,12 +94,6 @@ Necessary because of backward-incompatible changes in Org
 `org-bracket-link-regexp' was marked as an obsolete alias for it,
 but the match groups were changed, so they are not compatible.")
 
-;;;; Compatibility
-(defalias 'org-ql--org-timestamp-format
-  (if (version<= "9.6" org-version)
-      'org-format-timestamp
-    'org-timestamp-format))
-
 ;;;; Variables
 
 (defvar org-ql--today nil)
@@ -157,9 +149,10 @@ This list should not contain any duplicates."))
 (defvar org-ql-regexp-part-ts-date
   (rx (repeat 4 digit) "-" (repeat 2 digit) "-" (repeat 2 digit)
       ;; Day of week
-      (optional " " (1+ (or alpha punct))))
+      (optional " " (1+ alpha)))
   "Matches the inner, date part of an Org timestamp, both active and inactive.
-Used to build other timestamp regexps.")
+Also matches optional day-of-week.  Used to build other timestamp
+regexps.")
 
 (defvar org-ql-regexp-part-ts-repeaters
   ;; Repeaters (not sure if the colon is necessary, but it's in the org.el one)
@@ -169,8 +162,7 @@ Used to build other timestamp regexps.")
 Includes leading space character.")
 
 (defvar org-ql-regexp-part-ts-time
-  (rx " " (repeat 1 2 digit) ":" (repeat 2 digit)
-      (optional "-" (repeat 1 2 digit) ":" (repeat 2 digit)))
+  (rx " " (repeat 1 2 digit) ":" (repeat 2 digit))
   "Matches the inner, time part of an Org timestamp (i.e. HH:MM).
 Includes leading space character.  Used to build other timestamp
 regexps.")
@@ -292,11 +284,6 @@ Matches with or without time.")
   :link '(custom-manual "(org-ql)Usage")
   :link '(url-link "https://github.com/alphapapa/org-ql"))
 
-(defcustom org-ql-signal-peg-failure nil
-  "Signal an error when parsing a plain-string query fails.
-This should only be enabled while debugging."
-  :type 'boolean)
-
 (defcustom org-ql-ask-unsafe-queries t
   "Ask before running a query that could run arbitrary code.
 Org QL queries in sexp form can contain arbitrary expressions.
@@ -636,10 +623,9 @@ Returns cons (INHERITED-TAGS . LOCAL-TAGS)."
   "Return outline path for heading at point."
   (save-excursion
     (let ((heading (save-match-data
-                     (let (case-fold-search)
-                       (if (looking-at org-complex-heading-regexp)
-                           (or (match-string-no-properties 4) "")
-                         "")))))
+                     (if (looking-at org-complex-heading-regexp)
+                         (or (match-string 4) "")
+                       ""))))
       (if (org-up-heading-safe)
           ;; MAYBE: It seems wrong to call the cache function from
           ;; inside this function, like a violation of separation of
@@ -761,38 +747,38 @@ be coalesced."
   ;; can't be coalesced with it since they don't specify the same
   ;; language.  That could be fixed, but it's probably not worth it.
   (cl-labels ((rec (sexp)
-                (pcase sexp
-                  (`(,(and boolean (or 'or 'not)) . ,sexps)
-                   `(,boolean ,@(mapcar #'rec sexps)))
-                  (`(and . ,sexps)
-                   (anded sexps))
-                  (_ sexp)))
+                   (pcase sexp
+                     (`(,(and boolean (or 'or 'not)) . ,sexps)
+                      `(,boolean ,@(mapcar #'rec sexps)))
+                     (`(and . ,sexps)
+                      (anded sexps))
+                     (_ sexp)))
               (anded (sexps)
-                (let (anded-predicates new-sexp)
-                  (dolist (sexp sexps)
-                    (pcase sexp
-                      (`(,(or 'or 'not) . ,_)
-                       (push (rec sexp) new-sexp))
-                      (`(,predicate . ,args)
-                       (pcase-exhaustive (plist-get (alist-get predicate org-ql-predicates) :coalesce)
-                         (`nil (push sexp new-sexp))
-                         (`t (setf (alist-get predicate anded-predicates)
-                                   (append (alist-get predicate anded-predicates) args)))
-                         ((and fn (pred functionp))
-                          (if-let (new-args (funcall fn (alist-get predicate anded-predicates) args))
-                              (setf (alist-get predicate anded-predicates) new-args)
-                            (push sexp new-sexp)))))))
-                  (delq nil `(and ,@(nreverse new-sexp) ,@(nreverse anded-predicates))))))
+                     (let (anded-predicates new-sexp)
+                       (dolist (sexp sexps)
+                         (pcase sexp
+                           (`(,(or 'or 'not) . ,_)
+                            (push (rec sexp) new-sexp))
+                           (`(,predicate . ,args)
+                            (pcase-exhaustive (plist-get (alist-get predicate org-ql-predicates) :coalesce)
+                              (`nil (push sexp new-sexp))
+                              (`t (setf (alist-get predicate anded-predicates)
+                                        (append (alist-get predicate anded-predicates) args)))
+                              ((and fn (pred functionp))
+                               (if-let (new-args (funcall fn (alist-get predicate anded-predicates) args))
+                                   (setf (alist-get predicate anded-predicates) new-args)
+                                 (push sexp new-sexp)))))))
+                       (delq nil `(and ,@(nreverse new-sexp) ,@(nreverse anded-predicates))))))
     (rec query)))
 
 (defun org-ql--sanity-check-form (form)
   "Signal error if any forms in FORM do not have preconditions met.
 Or, when possible, fix the problem."
   (cl-flet ((check (symbol)
-              (pcase symbol
-                ('done (unless org-done-keywords
-                         ;; NOTE: This check needs to be done from within the Org buffer being checked.
-                         (error "Variable `org-done-keywords' is nil.  Are you running this from an Org buffer?"))))))
+                   (pcase symbol
+                     ('done (unless org-done-keywords
+                              ;; NOTE: This check needs to be done from within the Org buffer being checked.
+                              (error "Variable `org-done-keywords' is nil.  Are you running this from an Org buffer?"))))))
     (cl-loop for elem in form
 	     if (consp elem)
 	     do (progn
@@ -814,27 +800,28 @@ respectively."
 			           (and "\\" (0+ "\\\\") (any "[]"))
 			           (and (1+ "\\") (not (any "[]")))))))
     (cl-labels
-        ((no-desc (match)
-           (rx-to-string `(seq (or bol (1+ blank))
-                               "[[" ,link-target-part (regexp ,match) ,link-target-part
-                               "]]")))
-         (match-both (description target)
-           (rx-to-string `(seq (or bol (1+ blank))
-                               "[[" ,link-target-part (regexp ,target) ,link-target-part
-                               "][" (*? anything) (regexp ,description) (*? anything)
-                               "]]")))
+        ((no-desc
+          (match) (rx-to-string `(seq (or bol (1+ blank))
+                                      "[[" ,link-target-part (regexp ,match) ,link-target-part
+                                      "]]")))
+         (match-both
+          (description target)
+          (rx-to-string `(seq (or bol (1+ blank))
+                              "[[" ,link-target-part (regexp ,target) ,link-target-part
+                              "][" (*? anything) (regexp ,description) (*? anything)
+                              "]]")))
          ;; Note that these actually allow empty descriptions
          ;; or targets, depending on what they are matching.
-         (match-desc (match)
-           (rx-to-string `(seq (or bol (1+ blank))
-                               "[[" ,link-target-part
-                               "][" (*? anything) (regexp ,match) (*? anything)
-                               "]]")))
-         (match-target (match)
-           (rx-to-string `(seq (or bol (1+ blank))
-                               "[[" ,link-target-part (regexp ,match) ,link-target-part
-                               "][" (*? anything)
-                               "]]"))))
+         (match-desc
+          (match) (rx-to-string `(seq (or bol (1+ blank))
+                                      "[[" ,link-target-part
+                                      "][" (*? anything) (regexp ,match) (*? anything)
+                                      "]]")))
+         (match-target
+          (match) (rx-to-string `(seq (or bol (1+ blank))
+                                      "[[" ,link-target-part (regexp ,match) ,link-target-part
+                                      "][" (*? anything)
+                                      "]]"))))
       (cond (description-or-target
              (rx-to-string `(or (regexp ,(no-desc description-or-target))
                                 (regexp ,(match-desc description-or-target))
@@ -889,48 +876,48 @@ Arguments STRING, POS, FILL, and LEVEL are according to
         ;; NOTE: The pcases check for both t/nil symbols and strings, because the
         ;; string queries always return keyword arguments' values as strings.
         (cl-macrolet ((clocked (&key from to on)
-                        `(org-ql--predicate-clocked :from ,from :to ,to))
+                               `(org-ql--predicate-clocked :from ,from :to ,to))
                       (closed (&key from to on (with-time 'not-found))
-                        `(org-ql--predicate-closed :from ,from :to ,to))
+                              `(org-ql--predicate-closed :from ,from :to ,to))
                       (deadline (&key from to on (with-time 'not-found))
-                        `(org-ql--predicate-deadline
-                          :from ,from :to ,to :with-time ',with-time
-                          :regexp ,(pcase-exhaustive with-time
-                                     ((or 't "t") org-ql-regexp-deadline-with-time)
-                                     ((or 'nil "nil") org-ql-regexp-deadline-without-time)
-                                     ('not-found org-ql-regexp-deadline))))
+                                `(org-ql--predicate-deadline
+                                  :from ,from :to ,to :with-time ',with-time
+                                  :regexp ,(pcase-exhaustive with-time
+                                             ((or 't "t") org-ql-regexp-deadline-with-time)
+                                             ((or 'nil "nil") org-ql-regexp-deadline-without-time)
+                                             ('not-found org-ql-regexp-deadline))))
                       (planning (&key from to on (with-time 'not-found))
-                        `(org-ql--predicate-planning
-                          :from ,from :to ,to :with-time ',with-time
-                          :regexp ,(pcase-exhaustive with-time
-                                     ((or 't "t") org-ql-regexp-planning-with-time)
-                                     ((or 'nil "nil") org-ql-regexp-planning-without-time)
-                                     ('not-found org-ql-regexp-planning))))
+                                `(org-ql--predicate-planning
+                                  :from ,from :to ,to :with-time ',with-time
+                                  :regexp ,(pcase-exhaustive with-time
+                                             ((or 't "t") org-ql-regexp-planning-with-time)
+                                             ((or 'nil "nil") org-ql-regexp-planning-without-time)
+                                             ('not-found org-ql-regexp-planning))))
                       (scheduled (&key from to on (with-time 'not-found))
-                        `(org-ql--predicate-scheduled
-                          :from ,from :to ,to :with-time ',with-time
-                          :regexp ,(pcase-exhaustive with-time
-                                     ((or 't "t") org-ql-regexp-scheduled-with-time)
-                                     ((or 'nil "nil") org-ql-regexp-scheduled-without-time)
-                                     ('not-found org-ql-regexp-scheduled))))
+                                 `(org-ql--predicate-scheduled
+                                   :from ,from :to ,to :with-time ',with-time
+                                   :regexp ,(pcase-exhaustive with-time
+                                              ((or 't "t") org-ql-regexp-scheduled-with-time)
+                                              ((or 'nil "nil") org-ql-regexp-scheduled-without-time)
+                                              ('not-found org-ql-regexp-scheduled))))
                       (ts (&key from to on (type 'both) (with-time 'not-found))
-                        ;; NOTE: The TYPE argument is elided from the arguments actually passed to the predicate, being converted to the REGEXP argument.
-                        ;; MAYBE: Move the :regexp handling out of this macrolet and into the normalizer.
-                        `(org-ql--predicate-ts
-                          :from ,from :to ,to :with-time ',with-time
-                          :regexp ,(pcase type
-                                     ((or 'nil 'both) (pcase-exhaustive with-time
-                                                        ((or 't "t") org-ql-regexp-ts-both-with-time)
-                                                        ((or 'nil "nil") org-ql-regexp-ts-both-without-time)
-                                                        ('not-found org-ql-regexp-ts-both)))
-                                     ('active (pcase-exhaustive with-time
-                                                ((or 't "t") org-ql-regexp-ts-active-with-time)
-                                                ((or 'nil "nil") org-ql-regexp-ts-active-without-time)
-                                                ('not-found org-ql-regexp-ts-active)))
-                                     ('inactive (pcase-exhaustive with-time
-                                                  ((or 't "t") org-ql-regexp-ts-inactive-with-time)
-                                                  ((or 'nil "nil") org-ql-regexp-ts-inactive-without-time)
-                                                  ('not-found org-ql-regexp-ts-inactive)))))))
+                          ;; NOTE: The TYPE argument is elided from the arguments actually passed to the predicate, being converted to the REGEXP argument.
+                          ;; MAYBE: Move the :regexp handling out of this macrolet and into the normalizer.
+                          `(org-ql--predicate-ts
+                            :from ,from :to ,to :with-time ',with-time
+                            :regexp ,(pcase type
+                                       ((or 'nil 'both) (pcase-exhaustive with-time
+                                                          ((or 't "t") org-ql-regexp-ts-both-with-time)
+                                                          ((or 'nil "nil") org-ql-regexp-ts-both-without-time)
+                                                          ('not-found org-ql-regexp-ts-both)))
+                                       ('active (pcase-exhaustive with-time
+                                                  ((or 't "t") org-ql-regexp-ts-active-with-time)
+                                                  ((or 'nil "nil") org-ql-regexp-ts-active-without-time)
+                                                  ('not-found org-ql-regexp-ts-active)))
+                                       ('inactive (pcase-exhaustive with-time
+                                                    ((or 't "t") org-ql-regexp-ts-inactive-with-time)
+                                                    ((or 'nil "nil") org-ql-regexp-ts-inactive-without-time)
+                                                    ('not-found org-ql-regexp-ts-inactive)))))))
           ,query)))))
 
 ;;;;; String query parsing
@@ -957,11 +944,11 @@ value of `org-ql-predicates')."
                                ;; obscure bug in `peg': when one keyword is a substring of another,
                                ;; and the shorter one is listed first, the shorter one fails to match.
                                (-sort (-on #'> #'length))))
-         (pexs `((query (and (* [blank]) (+ (and term (* [blank])))))
+         (pexs `((query (+ (and term (* [blank]))))
                  (term (or (and negation (list positive-term)
                                 ;; This is a bit confusing, but it seems to work.  There's probably a better way.
                                 `(pred -- (list 'not (car pred))))
-                           positive-term empty-quote))
+                           positive-term))
                  (positive-term (or (and predicate-with-args `(pred args -- (cons (intern pred) args)))
                                     (and predicate-without-args `(pred -- (list (intern pred))))
                                     (and plain-string `(s -- (list org-ql-default-predicate s)))))
@@ -974,12 +961,6 @@ value of `org-ql-predicates')."
                  (keyword (substring (+ (not (or separator "=" "\"" (syntax-class whitespace))) (any))))
                  (quoted-arg "\"" (substring (+ (not (or separator "\"")) (any))) "\"")
                  (unquoted-arg (substring (+ (not (or separator "\"" (syntax-class whitespace))) (any))))
-                 (empty-quote
-                  ;; This avoids aborting parsing or signaling an
-                  ;; error if the user types in two successive
-                  ;; quotation marks while typing a query (e.g. when
-                  ;; using electric-pair-mode).
-                  "\"\"")
                  (negation "!")
                  (separator "," )))
          (closure (lambda (input &optional boolean)
@@ -1000,10 +981,7 @@ value of `org-ql-predicates')."
                                 ;; have to borrow some code.  It ends up that we only have to
                                 ;; borrow this `with-peg-rules' call, which isn't too bad.
                                 (eval `(with-peg-rules ,pexs
-                                         (peg-run (peg ,(caar pexs))
-                                                  (lambda (failures)
-                                                    (when org-ql-signal-peg-failure
-                                                      (peg-signal-failure failures)))))))))
+                                         (peg-run (peg ,(caar pexs)) #'peg-signal-failure))))))
                         (pcase parsed-sexp
                           (`(,one-predicate) one-predicate)
                           (`(,_ . ,_) (cons boolean (reverse parsed-sexp)))
@@ -1047,21 +1025,21 @@ This function is defined by calling
 `org-ql--define-normalize-query-fn', which uses normalizer forms
 defined in `org-ql-predicates' by calling `org-ql-defpred'."
               (cl-labels ((rec (element)
-                            (pcase element
-                              (`(or . ,clauses) `(or ,@(mapcar #'rec clauses)))
-                              (`(and . ,clauses) `(and ,@(mapcar #'rec clauses)))
-                              (`(not . ,clauses) `(not ,@(mapcar #'rec clauses)))
-                              (`(when ,condition . ,clauses) `(when ,(rec condition)
-                                                                ,@(mapcar #'rec clauses)))
-                              (`(unless ,condition . ,clauses) `(unless ,(rec condition)
-                                                                  ,@(mapcar #'rec clauses)))
-                              ;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND).
-                              ((pred stringp) `(,org-ql-default-predicate ,element))
+                               (pcase element
+                                 (`(or . ,clauses) `(or ,@(mapcar #'rec clauses)))
+                                 (`(and . ,clauses) `(and ,@(mapcar #'rec clauses)))
+                                 (`(not . ,clauses) `(not ,@(mapcar #'rec clauses)))
+                                 (`(when ,condition . ,clauses) `(when ,(rec condition)
+                                                                   ,@(mapcar #'rec clauses)))
+                                 (`(unless ,condition . ,clauses) `(unless ,(rec condition)
+                                                                     ,@(mapcar #'rec clauses)))
+                                 ;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND).
+                                 ((pred stringp) `(,org-ql-default-predicate ,element))
 
-                              ,@normalizer-patterns
+                                 ,@normalizer-patterns
 
-                              ;; Any other form: passed through unchanged.
-                              (_ element))))
+                                 ;; Any other form: passed through unchanged.
+                                 (_ element))))
                 ;; Repeat normalization until result doesn't change (limiting to 10 in case of an infinite-loop bug).
                 (cl-loop with limit = 10 and count = 0
                          for new-query = (rec query)
@@ -1114,21 +1092,18 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'."
                (_ (let ((preamble-case-fold t)
                         org-ql-preamble)
                     (cl-labels ((rec (element)
-                                  (or (when org-ql-preamble
-                                        ;; Only one preamble is allowed
-                                        element)
-                                      (pcase element
-                                        (`(or ,element)
-                                         ;; A predicate with a single name: unwrap the OR.  (Pcase doesn't like
-                                         ;; "one-armed ORs", giving a "Please avoid it" compilation error.)
-                                         element)
+                                     (or (when org-ql-preamble
+                                           ;; Only one preamble is allowed
+                                           element)
+                                         (pcase element
+                                           (`(or _) element)
 
-                                        ,@preamble-patterns
+                                           ,@preamble-patterns
 
-                                        (`(and . ,rest)
-                                         (let ((clauses (mapcar #'rec rest)))
-                                           `(and ,@(-non-nil clauses))))
-                                        (_ element)))))
+                                           (`(and . ,rest)
+                                            (let ((clauses (mapcar #'rec rest)))
+                                              `(and ,@(-non-nil clauses))))
+                                           (_ element)))))
                       (setq query (pcase (mapcar #'rec (list query))
                                     ((or `(nil)
                                          `((nil))
@@ -1144,7 +1119,7 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'."
     (byte-compile 'org-ql--query-preamble)))
 
 (cl-defmacro org-ql-defpred (name args docstring &key body preambles normalizers coalesce)
-  "Define an Org QL selector predicate \\=`org-ql--predicate-NAME'.
+  "Define an `org-ql' selector predicate named `org-ql--predicate-NAME'.
 NAME may be a symbol or a list of symbols: if a list, the first
 is used as NAME and the rest are aliases.  A function is only
 created for NAME, not for aliases, so a normalizer should be used
@@ -1189,7 +1164,7 @@ to variables bound in the pattern:
   :case-fold  Bound to `case-fold-search' around the regexp search.
 
   :query      Expression which should replace the query expression,
-              or \\+`query' if it should not be changed (e.g. if the
+              or `query' if it should not be changed (e.g. if the
               regexp is insufficient to determine whether a
               heading matches, in which case the predicate's body
               needs to be tested on the heading).  If the regexp
@@ -1216,7 +1191,7 @@ e.g. a predicate takes keyword arguments, so arguments to
 multiple calls can't be simply appended.)
 
 For convenience, within the `pcase' patterns, the symbol
-\\+`predicate-names' is a special form which is replaced with a
+`predicate-names' is a special form which is replaced with a
 pattern matching any of the predicate's name and aliases.  For
 example, if NAME were:
 
@@ -1224,13 +1199,13 @@ example, if NAME were:
 
 Then if NORMALIZERS were:
 
-  ((\\=`(,predicate-names . ,args)
-    \\=`(heading ,@args)))
+  ((`(,predicate-names . ,args)
+  `(heading ,@args)))
 
 It would be expanded to:
 
-  ((\\=`(,(or \\='heading \\='h) . ,args)
-    \\=`(heading ,@args)))"
+  ((`(,(or 'heading 'h) . ,args)
+  `(heading ,@args)))"
   ;; FIXME: Update defpred tutorial to include :coalesce.
 
   ;; NOTE: The debug form works, completely!  For example, use `edebug-defun'
@@ -1310,9 +1285,6 @@ result form."
              to on))
      (when from
        (setq from (pcase from
-                    ("-"
-                     ;; Ignore, because it means the user is typing a negative number.
-                     nil)
                     ((or 'today "today") (->> (ts-now)
                                               (ts-apply :hour 0 :minute 0 :second 0)))
                     ((pred numberp) (->> (ts-now)
@@ -1329,9 +1301,6 @@ result form."
                     ((pred ts-p) from))))
      (when to
        (setq to (pcase to
-                  ("-"
-                   ;; Ignore, because it means the user is typing a negative number.
-                   nil)
                   ((or 'today "today") (->> (ts-now)
                                             (ts-apply :hour 23 :minute 59 :second 59)))
                   ((pred numberp) (->> (ts-now)
@@ -1464,16 +1433,40 @@ Org effort string, like \"5\" or \"0:05\"."
                (list :regexp (rx bol (0+ space) ":STYLE:" (1+ space) "habit" (0+ space) eol))))
   :body (org-is-habit-p))
 
-(org-ql-defpred (heading h) (&rest _strings)
+(org-ql-defpred (heading h) (&rest strings)
   "Return non-nil if current entry's heading matches all STRINGS.
 Matching is done case-insensitively."
   :coalesce t
   :normalizers ((`(,predicate-names . ,args)
-                 ;; NOTE: Each string argument must be converted to a regexp
-                 ;; for testing by the body, so we just normalize to the
-                 ;; `heading-regexp' predicate, leaving this predicate as
-                 ;; one that merely regexp-quotes its arguments.
-                 `(heading-regexp ,@(mapcar #'regexp-quote args)))))
+                 ;; "h" alias.
+                 `(heading ,@args)))
+  ;; TODO: Adjust regexp to avoid matching in tag list.
+  :preambles ((`(,predicate-names)
+               ;; This clause protects against the case in which the
+               ;; arguments are nil, which would cause an error in
+               ;; `rx-to-string' in other clauses.  This can happen
+               ;; with `org-ql-completing-read', e.g. when the input
+               ;; is "h:" while the user is typing.
+               (list :regexp (rx bol (1+ "*") (1+ blank) (0+ nonl))
+                     :case-fold t :query query))
+              (`(,predicate-names ,string)
+               ;; Only one string: match with preamble, then let predicate confirm (because
+               ;; the match could be in e.g. the tags rather than the heading text).
+               (list :regexp (rx-to-string `(seq bol (1+ "*") (1+ blank) (0+ nonl)
+                                                 ,string)
+                                           'no-group)
+                     :case-fold t :query query))
+              (`(,predicate-names . ,strings)
+               ;; Multiple strings: use preamble to match against first
+               ;; string, then let the predicate match the rest.
+               (list :regexp (rx-to-string `(seq bol (1+ "*") (1+ blank) (0+ nonl)
+                                                 ,(car strings))
+                                           'no-group)
+                     :case-fold t :query query)))
+  ;; TODO: In Org 9.2+, `org-get-heading' takes 2 more arguments.
+  :body (let ((heading (org-get-heading 'no-tags 'no-todo))
+              (case-fold-search t))
+          (--all? (string-match it heading) strings)))
 
 (org-ql-defpred (heading-regexp h*) (&rest regexps)
   "Return non-nil if current entry's heading matches all REGEXPS (regexp strings).
@@ -1537,8 +1530,7 @@ COMPARATOR may be `<', `<=', `>', or `>='."
                ;; is "h:" while the user is typing.
                (list :regexp (rx bol (1+ "*") " ")
                      :case-fold t))
-              ((and `(,predicate-names ,comparator-or-num ,num)
-                    (guard (numberp num)))
+              (`(,predicate-names ,comparator-or-num ,num)
                (let ((repeat (pcase comparator-or-num
                                ('< `(repeat 1 ,(1- num) "*"))
                                ('<= `(repeat 1 ,num "*"))
@@ -1547,8 +1539,7 @@ COMPARATOR may be `<', `<=', `>', or `>='."
                                ((pred integerp) `(repeat ,comparator-or-num ,num "*")))))
                  (list :regexp (rx-to-string `(seq bol ,repeat " ") t)
                        :case-fold t)))
-              ((and `(,predicate-names ,num)
-                    (guard (numberp num)))
+              (`(,predicate-names ,num)
                (list :regexp (rx-to-string `(seq bol (repeat ,num "*") " ") t)
                      :case-fold t)))
   ;; NOTE: It might be necessary to take into account `org-odd-levels'; see docstring for
@@ -1626,15 +1617,11 @@ any link is found."
                          (or (null description)
                              (string-match-p description (match-string org-ql-link-description-group)))))
               (_ (if (and description target)
-                     (and (and (match-string 1)
-                               (string-match-p target (match-string 1)))
-                          (and (match-string org-ql-link-description-group)
-                               (string-match-p description (match-string org-ql-link-description-group))))
-                   (or (and (match-string 1)
-                            (string-match-p description-or-target (match-string 1)))
-                       (and (match-string org-ql-link-description-group)
-                            (string-match-p description-or-target
-                                            (match-string org-ql-link-description-group))))))))))
+                     (and (string-match-p target (match-string 1))
+                          (string-match-p description (match-string org-ql-link-description-group)))
+                   (or (string-match-p description-or-target (match-string 1))
+                       (string-match-p description-or-target
+                                       (match-string org-ql-link-description-group)))))))))
 
 (org-ql-defpred (rifle smart) (&rest strings)
   "Return non-nil if each of strings is found in the entry or its outline path.
@@ -1808,62 +1795,34 @@ interpreted as nil or non-nil)."
                  ;; predicate test for whether an entry has local
                  ;; properties when no arguments are given.
                  (list 'property ""))
-                (`(,predicate-names ,property)
+                (`(,predicate-names ,property ,value . ,plist)
                  ;; Convert keyword property arguments to strings.  Non-sexp
                  ;; queries result in keyword property arguments (because to do
                  ;; otherwise would require ugly special-casing in the parsing).
                  (when (keywordp property)
                    (setf property (substring (symbol-name property) 1)))
-                 (list 'property property))
-                (`(,predicate-names ,property . ,rest)
-                 (pcase rest
-                   (`(,value)
-                    ;; Convert keyword property arguments to strings.  Non-sexp
-                    ;; queries result in keyword property arguments (because to do
-                    ;; otherwise would require ugly special-casing in the parsing).
-                    (when (keywordp property)
-                      (setf property (substring (symbol-name property) 1)))
-                    (list 'property property value))
-                   ((and `(,value . ,plist)
-                         (guard (not (keywordp value))))
-                    ;; Convert keyword property arguments to strings.  Non-sexp
-                    ;; queries result in keyword property arguments (because to do
-                    ;; otherwise would require ugly special-casing in the parsing).
-                    (when (keywordp property)
-                      (setf property (substring (symbol-name property) 1)))
-                    (list 'property property value
-                          :inherit (cond ((plist-member plist :inherit) (plist-get plist :inherit))
-                                         ((listp org-use-property-inheritance) ''selective)
-                                         (t org-use-property-inheritance))))
-                   ((and plist (guard (keywordp (car rest))))
-                    ;; Convert keyword property arguments to strings.  Non-sexp
-                    ;; queries result in keyword property arguments (because to do
-                    ;; otherwise would require ugly special-casing in the parsing).
-                    (when (keywordp property)
-                      (setf property (substring (symbol-name property) 1)))
-                    (list 'property property nil
-                          :inherit (cond ((plist-member plist :inherit) (plist-get plist :inherit))
-                                         ((listp org-use-property-inheritance) ''selective)
-                                         (t org-use-property-inheritance)))))))
+                 (list 'property property value
+                       :inherit (if (plist-member plist :inherit)
+                                    (plist-get plist :inherit)
+                                  org-use-property-inheritance))))
   ;; MAYBE: Should case folding be disabled for properties?  What about values?
   ;; MAYBE: Support (property) without args.
 
   ;; NOTE: When inheritance is enabled, the preamble can't be used,
   ;; which will make the search slower.
-  :preambles (((and `(,predicate-names ,property ,value)
-                    (guard (atom value)))
+  :preambles ((`(,predicate-names ,property ,value . ,(map :inherit))
                ;; We do NOT return nil, because the predicate still needs to be tested,
                ;; because the regexp could match a string not inside a property drawer.
-               (list :regexp (rx-to-string `(seq bol (0+ space) ":" ,property ":"
-                                                 (1+ space) ,value (0+ space) eol))
+               (list :regexp (unless inherit
+                               (rx-to-string `(seq bol (0+ space) ":" ,property ":"
+                                                   (1+ space) ,value (0+ space) eol)))
                      :query query))
-              ((and `(,predicate-names ,property ,value . ,plist)
-                    (guard (keywordp (car plist))))
-               ;; WE do NOT return nil, because the predicate still needs to be tested,
+              (`(,predicate-names ,property . ,(map :inherit))
+               ;; We do NOT return nil, because the predicate still needs to be tested,
                ;; because the regexp could match a string not inside a property drawer.
                ;; NOTE: The preamble only matches if there appears to be a value.
                ;; A line like ":ID: " without any other text does not match.
-               (list :regexp (unless (plist-get plist :inherit)
+               (list :regexp (unless inherit
                                (rx-to-string `(seq bol (0+ space) ":" ,property ":" (1+ space)
                                                    (minimal-match (1+ not-newline)) eol)))
                      :query query)))
@@ -1875,7 +1834,7 @@ interpreted as nil or non-nil)."
           ;; Check that PROPERTY exists
           (org-ql--value-at
            (point) (lambda ()
-                     (org-entry-get (point) property inherit))))
+                     (org-entry-get (point) property))))
          (_
           ;; Check that PROPERTY has VALUE.
 
@@ -1992,7 +1951,7 @@ language.  Matching is done case-insensitively."
                                                      (point)))
                                      (contents-end (progn
                                                      (goto-char (match-end 0))
-                                                     (pos-bol))))
+                                                     (point-at-bol))))
                                  (cl-loop for re in regexps
                                           do (goto-char contents-beg)
                                           always (re-search-forward re contents-end t))))))))))
@@ -2002,8 +1961,8 @@ language.  Matching is done case-insensitively."
 Tests both inherited and local tags."
   ;; MAYBE: -all versions for inherited and local.
   :body (cl-macrolet ((tags-p (tags)
-                        `(and ,tags
-                              (not (eq 'org-ql-nil ,tags)))))
+                              `(and ,tags
+                                    (not (eq 'org-ql-nil ,tags)))))
           (-let* (((inherited local) (org-ql--tags-at (point))))
             (cl-typecase tags
               (null (or (tags-p inherited)
@@ -2028,8 +1987,8 @@ If TAGS is nil, return non-nil if heading has any inherited tags."
   :normalizers ((`(,predicate-names . ,tags)
                  `(tags-inherited ,@tags)))
   :body (cl-macrolet ((tags-p (tags)
-                        `(and ,tags
-                              (not (eq 'org-ql-nil ,tags)))))
+                              `(and ,tags
+                                    (not (eq 'org-ql-nil ,tags)))))
           (-let* (((inherited _) (org-ql--tags-at (point))))
             (cl-typecase tags
               (null (tags-p inherited))
@@ -2049,8 +2008,8 @@ If TAGS is nil, return non-nil if heading has any local tags."
                                            t)
                      :query t)))
   :body (cl-macrolet ((tags-p (tags)
-                        `(and ,tags
-                              (not (eq 'org-ql-nil ,tags)))))
+                              `(and ,tags
+                                    (not (eq 'org-ql-nil ,tags)))))
           (-let* (((_ local) (org-ql--tags-at (point))))
             (cl-typecase tags
               (null (tags-p local))
@@ -2063,8 +2022,8 @@ Tests both inherited and local tags."
   :normalizers ((`(,predicate-names . ,regexps)
                  `(tags-regexp ,@regexps)))
   :body (cl-macrolet ((tags-p (tags)
-                        `(and ,tags
-                              (not (eq 'org-ql-nil ,tags)))))
+                              `(and ,tags
+                                    (not (eq 'org-ql-nil ,tags)))))
           (-let* (((inherited local) (org-ql--tags-at (point))))
             (cl-typecase regexps
               (null (or (tags-p inherited)
@@ -2114,7 +2073,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
   :normalizers ((`(,predicate-names
                    ;; Avoid infinitely compiling already-compiled functions.
                    ,(and query (guard (not (byte-code-function-p query)))))
-                 `(ancestors ,(org-ql--query-predicate (org-ql--normalize-query query))))
+                 `(ancestors ,(org-ql--query-predicate (rec query))))
                 (`(,predicate-names) '(ancestors (lambda () t))))
   :body
   (org-with-wide-buffer
@@ -2126,7 +2085,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
   :normalizers ((`(,predicate-names
                    ;; Avoid infinitely compiling already-compiled functions.
                    ,(and query (guard (not (byte-code-function-p query)))))
-                 `(parent ,(org-ql--query-predicate (org-ql--normalize-query query))))
+                 `(parent ,(org-ql--query-predicate (rec query))))
                 (`(,predicate-names) '(parent (lambda () t))))
   :body
   (org-with-wide-buffer
@@ -2412,12 +2371,12 @@ any planning prefix); it defaults to 0 (i.e. the whole regexp)."
 
   :body
   (cl-macrolet ((next-timestamp ()
-                  `(when (re-search-forward regexp limit t)
-                     (ts-parse-org (match-string match-group))))
+                                `(when (re-search-forward regexp limit t)
+                                   (ts-parse-org (match-string match-group))))
                 (test-timestamps (pred-form)
-                  `(cl-loop for next-ts = (next-timestamp)
-                            while next-ts
-                            thereis ,pred-form)))
+                                 `(cl-loop for next-ts = (next-timestamp)
+                                           while next-ts
+                                           thereis ,pred-form)))
     (save-excursion
       (cond ((not (or from to)) (re-search-forward regexp limit t))
             ((and from to) (test-timestamps (ts-in from to next-ts)))
@@ -2443,27 +2402,27 @@ PREDICATES is a list of one or more sorting methods, including:
 `deadline', `scheduled', `closed' and `priority'."
   ;; MAYBE: Use macrolet instead of flet.
   (cl-flet* ((sorter (symbol)
-               (pcase symbol
-                 ((or 'deadline 'scheduled 'closed)
-                  (apply-partially #'org-ql--date-type< (intern (concat ":" (symbol-name symbol)))))
-                 ;; TODO: Rename `date' to `planning'.  `date' should be something else.
-                 ('date #'org-ql--date<)
-                 ('priority #'org-ql--priority<)
-                 ('random (lambda (&rest _ignore)
-                            (= 0 (random 2))))
-                 ;; NOTE: reverse and todo are handled below.
-                 ;; TODO: Add more.
-                 (_ (user-error "Invalid sorting predicate: %s" symbol))))
+                     (pcase symbol
+                       ((or 'deadline 'scheduled 'closed)
+                        (apply-partially #'org-ql--date-type< (intern (concat ":" (symbol-name symbol)))))
+                       ;; TODO: Rename `date' to `planning'.  `date' should be something else.
+                       ('date #'org-ql--date<)
+                       ('priority #'org-ql--priority<)
+                       ('random (lambda (&rest _ignore)
+                                  (= 0 (random 2))))
+                       ;; NOTE: reverse and todo are handled below.
+                       ;; TODO: Add more.
+                       (_ (user-error "Invalid sorting predicate: %s" symbol))))
              (sort-by-todo-keyword (items)
-               (let* ((grouped-items (--group-by (when-let (keyword (org-element-property :todo-keyword it))
-                                                   (substring-no-properties keyword))
-                                                 items))
-                      (sorted-groups (cl-sort grouped-items #'<
-                                              :key (lambda (keyword)
-                                                     (or (cl-position (car keyword) org-todo-keywords-1 :test #'string=)
-                                                         ;; Put at end of list if not found
-                                                         (1+ (length org-todo-keywords-1)))))))
-                 (-flatten-n 1 (-map #'cdr sorted-groups)))))
+                                   (let* ((grouped-items (--group-by (when-let (keyword (org-element-property :todo-keyword it))
+                                                                       (substring-no-properties keyword))
+                                                                     items))
+                                          (sorted-groups (cl-sort grouped-items #'<
+                                                                  :key (lambda (keyword)
+                                                                         (or (cl-position (car keyword) org-todo-keywords-1 :test #'string=)
+                                                                             ;; Put at end of list if not found
+                                                                             (1+ (length org-todo-keywords-1)))))))
+                                     (-flatten-n 1 (-map #'cdr sorted-groups)))))
     (dolist (pred predicates)
       (setq items (pcase pred
                     ;; NOTE: Using `reverse' instead of `nreverse' because my gut
@@ -2488,16 +2447,16 @@ A and B are Org headline elements.  TYPE should be a symbol like
   "Return non-nil if A's deadline or scheduled property is earlier than B's.
 Deadline is considered before scheduled."
   (cl-macrolet ((ts (item)
-                  `(or (org-element-property :deadline ,item)
-                       (org-element-property :scheduled ,item))))
+                    `(or (org-element-property :deadline ,item)
+                         (org-element-property :scheduled ,item))))
     (org-ql--org-timestamp-element< (ts a) (ts b))))
 
 (defun org-ql--org-timestamp-element< (a b)
   "Return non-nil if A's date element is earlier than B's.
 A and B are Org timestamp elements."
   (cl-macrolet ((ts (ts)
-                  `(when ,ts
-                     (org-ql--org-timestamp-format ,ts "%s"))))
+                    `(when ,ts
+                       (org-timestamp-format ,ts "%s"))))
     (let* ((a-ts (ts a))
            (b-ts (ts b)))
       (cond ((and a-ts b-ts)
@@ -2509,7 +2468,7 @@ A and B are Org timestamp elements."
   "Return non-nil if A's priority is higher than B's.
 A and B are Org headline elements."
   (cl-macrolet ((priority (item)
-                  `(org-element-property :priority ,item)))
+                          `(org-element-property :priority ,item)))
     ;; NOTE: Priorities are numbers in Org elements.  This might differ from the priority selector logic.
     (let ((a-priority (priority a))
           (b-priority (priority b)))
@@ -2537,66 +2496,66 @@ element should be a regexp string."
 If QUERY can't be converted to a string, return nil."
   ;; This started out pretty simple...but at least it's not just one long function, right?
   (cl-labels ((complex-p (query)
-                (or (contains-p 'or query)
-		    (contains-p 'ancestors query)
-		    (contains-p 'children query)
-		    (contains-p 'descendants query)
-		    (contains-p 'parent query)))
+                         (or (contains-p 'or query)
+			     (contains-p 'ancestors query)
+			     (contains-p 'children query)
+			     (contains-p 'descendants query)
+			     (contains-p 'parent query)))
               (contains-p (symbol list)
-                (cl-loop for element in list
-                         thereis (or (eq symbol element)
-                                     (and (listp element)
-                                          (contains-p symbol element)))))
-              (format-args (args)
-                (let (non-paired paired next-keyword)
-                  (cl-loop for arg in args
-                           do (cond (next-keyword (push (cons next-keyword arg) paired)
-                                                  (setf next-keyword nil))
-                                    ((keywordp arg) (setf next-keyword (substring (symbol-name arg) 1)))
-                                    (t (push arg non-paired))))
-                  (string-join (append (mapcar #'format-atom non-paired)
-                                       (nreverse (--map (format "%s=%s" (car it) (cdr it))
-                                                        paired)))
-                               ",")))
-              (format-atom (atom)
-                (cl-typecase atom
-                  (string (if (string-match (rx space) atom)
-                              (format "%S" atom)
-                            (format "%s" atom)))
-                  (t (format "%s" atom))))
-              (format-form (form)
-                (pcase form
-                  (`(not . (,rest)) (concat "!" (format-form rest)))
-                  (`(priority . ,_) (format-priority form))
-                  ;; FIXME: Convert (src) queries to non-sexp form...someday...
-                  (`(src . ,_) (user-error "Converting (src ...) queries to non-sexp form is not implemented"))
-                  (_ (pcase-let* ((`(,pred . ,args) form)
-                                  (args-string (pcase args
-                                                 ('() "")
-                                                 ((guard (= 1 (length args))) (format "%s" (car args)))
-                                                 (_ (format-args args)))))
-                       (format "%s:%s" pred args-string)))))
-              (format-and (form)
-                (pcase-let* ((`(and . ,rest) form))
-                  (string-join (mapcar #'format-form rest) " ")))
-              (format-priority (form)
-                (pcase-let* ((`(priority . ,rest) form)
-                             (args (pcase rest
-                                     (`(,(and comparator (or '< '<= '> '>= '=)) ,letter)
-                                      (priority-letters comparator letter))
-                                     (_ rest))))
-                  (concat "priority:" (string-join args ","))))
-              (priority-letters (comparator letter)
-                (let* ((char (string-to-char (upcase (symbol-name letter))))
-                       (numeric-priorities '(?A ?B ?C))
-                       ;; NOTE: The comparator inversion is intentional.
-                       (others (pcase comparator
-                                 ('< (--select (> it char) numeric-priorities))
-                                 ('<= (--select (>= it char) numeric-priorities))
-                                 ('> (--select (< it char) numeric-priorities))
-                                 ('>= (--select (<= it char) numeric-priorities))
-                                 ('= (--select (= it char) numeric-priorities)))))
-                  (mapcar #'char-to-string others))))
+                          (cl-loop for element in list
+                                   thereis (or (eq symbol element)
+                                               (and (listp element)
+                                                    (contains-p symbol element)))))
+              (format-args
+               (args) (let (non-paired paired next-keyword)
+                        (cl-loop for arg in args
+                                 do (cond (next-keyword (push (cons next-keyword arg) paired)
+                                                        (setf next-keyword nil))
+                                          ((keywordp arg) (setf next-keyword (substring (symbol-name arg) 1)))
+                                          (t (push arg non-paired))))
+                        (string-join (append (mapcar #'format-atom non-paired)
+                                             (nreverse (--map (format "%s=%s" (car it) (cdr it))
+                                                              paired)))
+                                     ",")))
+              (format-atom
+               (atom) (cl-typecase atom
+                        (string (if (string-match (rx space) atom)
+                                    (format "%S" atom)
+                                  (format "%s" atom)))
+                        (t (format "%s" atom))))
+              (format-form
+               (form) (pcase form
+                        (`(not . (,rest)) (concat "!" (format-form rest)))
+                        (`(priority . ,_) (format-priority form))
+                        ;; FIXME: Convert (src) queries to non-sexp form...someday...
+                        (`(src . ,_) (user-error "Converting (src ...) queries to non-sexp form is not implemented"))
+                        (_ (pcase-let* ((`(,pred . ,args) form)
+                                        (args-string (pcase args
+                                                       ('() "")
+                                                       ((guard (= 1 (length args))) (format "%s" (car args)))
+                                                       (_ (format-args args)))))
+                             (format "%s:%s" pred args-string)))))
+              (format-and
+               (form) (pcase-let* ((`(and . ,rest) form))
+                        (string-join (mapcar #'format-form rest) " ")))
+              (format-priority
+               (form) (pcase-let* ((`(priority . ,rest) form)
+                                   (args (pcase rest
+                                           (`(,(and comparator (or '< '<= '> '>= '=)) ,letter)
+                                            (priority-letters comparator letter))
+                                           (_ rest))))
+                        (concat "priority:" (string-join args ","))))
+              (priority-letters
+               (comparator letter) (let* ((char (string-to-char (upcase (symbol-name letter))))
+                                          (numeric-priorities '(?A ?B ?C))
+                                          ;; NOTE: The comparator inversion is intentional.
+                                          (others (pcase comparator
+                                                    ('< (--select (> it char) numeric-priorities))
+                                                    ('<= (--select (>= it char) numeric-priorities))
+                                                    ('> (--select (< it char) numeric-priorities))
+                                                    ('>= (--select (<= it char) numeric-priorities))
+                                                    ('= (--select (= it char) numeric-priorities)))))
+                                     (mapcar #'char-to-string others))))
     ;; FIXME: Error out for ts structs passed to `ts' predicate (very unlikely to be linked to).
     (unless (complex-p query)
       (pcase query

taxy-org-ql-view.el

@@ -0,0 +1,722 @@
+;;; taxy-org-ql-view.el ---                          -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021  Adam Porter
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'map)
+(require 'seq)
+
+(require 'org-ql-view)
+
+(require 'taxy)
+(require 'taxy-magit-section)
+
+;;;; Structs
+
+;;;; Variables
+
+(defvar-local taxy-org-ql-view-args nil
+  "Arguments passed to `taxy-org-ql-search'.
+Used when updating the view.")
+
+(defvar-local taxy-org-ql-view-queries nil
+  "Queries shown in the current buffer.
+Used when updating the view.")
+
+;;;; Customization
+
+(defgroup org-ql-view-taxy nil
+  "Options for `org-ql-view-taxy'."
+  :group 'org-ql-view)
+
+(defcustom org-ql-view-taxy-blank-between-depth 1
+  "Insert blank lines between groups up to this depth."
+  :type 'integer)
+
+(defcustom org-ql-view-taxy-initial-depth 0
+  "Effective initial depth of first-level groups.
+Sets at which depth groups and items begin to be indented.  For
+example, setting to -1 prevents indentation of the first and
+second levels."
+  :type 'integer)
+
+;;;;; Faces
+
+(defgroup org-ql-view-faces nil
+  "Faces for Org QL View buffers."
+  :group 'org-ql-view-taxy)
+
+(defface org-ql-view-header-line
+  '((t (:inherit header-line :weight bold)))
+  "Header line.")
+
+(defface org-ql-view-query-heading
+  '((t (:inherit header-line :height 1.3)))
+  "Query headings.")
+
+(defface taxy-org-ql-view-header
+  '((t (:inherit header-line :height 1.5 :weight bold :overline t :extend t)))
+  "View top-level section names.")
+
+(defface org-ql-view-heading
+  `((t (:inherit org-agenda-structure ;; magit-section-heading
+                 :weight bold)))
+  "Group headings.
+Inherited by level-specific faces.")
+
+(defface org-ql-view-heading-1
+  `((t (:inherit org-ql-view-heading
+		 :height 1.2 :overline t
+		 :background ,(face-background 'header-line))))
+  "Level-1 group headings.")
+
+(defface org-ql-view-heading-2
+  `((t (:inherit org-ql-view-heading ;; :inverse-video t
+		 :height 1.1 :overline nil
+		 :background ,(face-background 'header-line))))
+  "Level-2 group headings.")
+
+(defface org-ql-view-parent-heading
+  `((t (:inherit font-lock-comment-face)))
+  "Parent headings (shown in \"Heading\\Parent\" column).")
+
+;;;;; Columns
+
+(eval-and-compile
+  (taxy-magit-section-define-column-definer "org-ql-view"))
+
+(org-ql-view-define-column "Category" (:max-width nil :align 'right)
+  (or (org-with-point-at (org-element-property :org-hd-marker item)
+	(org-get-category (point)))
+      ""))
+
+(org-ql-view-define-column "Keyword" (:max-width nil :align 'right)
+  (let ((keyword (or (org-element-property :todo-keyword item) "")))
+    (unless (string-empty-p keyword)
+      ;; NOTE: We use `substring-no-properties' to avoid propagating
+      ;; `wrap-prefix' and `line-prefix' properties that may be
+      ;; present on the source buffer's keyword.
+      (setf keyword (org-ql-view--add-todo-face (substring-no-properties keyword))))
+    keyword))
+
+(org-ql-view-define-column "Heading" (:max-width 60)
+  (propertize (org-link-display-format
+	       (org-element-property
+		:raw-value (org-ql-view--add-faces item)))
+	      :org-hd-marker (org-element-property :org-hd-marker item)))
+
+(org-ql-view-define-column "Heading\\Parent" (:max-width 60)
+  (let* ((marker (org-element-property :org-hd-marker item))
+         (parent-heading (org-with-point-at marker
+                           (if (org-up-heading-safe)
+                               (propertize (concat "\\" (org-link-display-format
+                                                         (nth 4 (org-heading-components))))
+                                           'face 'org-ql-view-parent-heading)
+                             "")))
+         (this-heading (org-link-display-format
+	                (org-element-property
+		         :raw-value (org-ql-view--add-faces item))))
+         (string (concat this-heading parent-heading)))
+    (propertize string :org-hd-marker marker)))
+
+(org-ql-view-define-column "Pri" (:max-width nil)
+  (or (-some->> (org-element-property :priority item)
+        (char-to-string)
+        (format "[#%s]")
+        (org-ql-view--add-priority-face))
+      ""))
+
+(org-ql-view-define-column "Planning" (:max-width nil)
+  (when-let ((planning-element (or (org-element-property :deadline item)
+                                   (org-element-property :scheduled item)
+                                   (org-element-property :closed item))))
+    (org-ql-view--format-relative-date
+     (floor (/ (ts-diff (ts-now) (ts-parse-org-element planning-element))
+               86400)))))
+
+(org-ql-view-define-column "Tags" (:max-width nil)
+  ;; Copied from `org-ql-view--format-element'.
+  (when-let ((tags (if org-use-tag-inheritance
+                       ;; MAYBE: Use our own variable instead of `org-use-tag-inheritance'.
+                       (if-let ((marker (or (org-element-property :org-hd-marker item)
+                                            (org-element-property :org-marker item))))
+                           (with-current-buffer (marker-buffer marker)
+                             (org-with-wide-buffer
+                              (goto-char marker)
+                              (delete-dups
+                               (cl-loop for type in (org-ql--tags-at marker)
+                                        unless (or (eq 'org-ql-nil type)
+                                                   (not type))
+                                        append type))))
+                         ;; No marker found
+                         ;; TODO: Use `display-warning' with `org-ql' as the type.
+                         (warn "No marker found for item: %s" item)
+                         (org-element-property :tags item))
+                     (org-element-property :tags item))))
+    (org-add-props (concat ":" (string-join tags ":") ":")
+        nil 'face 'org-tag)))
+
+(unless org-ql-view-columns
+  (setq-default org-ql-view-columns
+                ;; HACK:
+                (remove "Heading\\Parent" (get 'org-ql-view-columns 'standard-value))))
+
+;;;; Taxy keys
+
+(eval-and-compile
+  (taxy-define-key-definer taxy-org-ql-view-define-key
+    taxy-org-ql-view-keys "taxy-org-ql--key"
+    "Define a `taxy-org-ql-view' key function by NAME having BODY taking ARGS.
+Within BODY, `item' 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."))
+
+(taxy-org-ql-view-define-key heading (&rest strings)
+  "Return STRINGS that ITEM's heading matches."
+  (when-let ((matches (cl-loop with heading = (org-element-property :raw-value item)
+                               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 ITEM.
+If KEYWORD, return whether it matches that."
+  (when-let ((element-keyword (org-element-property :todo-keyword item)))
+    (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 tags (&rest tags)
+  "Return the tags for ITEM.
+If TAGS, return whether it matches them."
+  (cl-flet ((tags-at
+             (pos) (apply #'append (delq 'org-ql-nil (org-ql--tags-at pos)))))
+    (org-with-point-at (org-element-property :org-hd-marker item)
+      (pcase tags
+        ('nil (tags-at (point)))
+        (_ (when-let (common-tags (seq-intersection tags (tags-at (point))
+                                                    #'cl-equalp))
+             (format "Tags: %s" (string-join common-tags ", "))))))))
+
+(taxy-org-ql-view-define-key priority (&optional priority)
+  "Return ITEM's priority as a string.
+If PRIORITY, return it if it matches ITEM's priority."
+  (when-let ((priority-number (org-element-property :priority item)))
+    (cl-flet ((format-priority
+               (num) (format "Priority: %s" num)))
+      ;; FIXME: Priority numbers may be wildly larger, right?
+      (pcase priority
+        ('nil (format-priority (char-to-string priority-number)))
+        (_ (pcase (char-to-string priority-number)
+             ((and (pred (equal priority)) string)
+              (format-priority string))))))))
+
+(taxy-org-ql-view-define-key planning-month ()
+  "Return ITEM's planning-date month, or nil.
+Returns in format \"%Y-%m (%B)\"."
+  (when-let ((planning-element (or (org-element-property :deadline item)
+                                   (org-element-property :scheduled item)
+                                   (org-element-property :closed item))))
+    (ts-format "Planning: %Y-%m (%B)" (ts-parse-org-element planning-element))))
+
+(taxy-org-ql-view-define-key planning-year ()
+  "Return ITEM's planning-date year, or nil.
+Returns in format \"%Y\"."
+  (when-let ((planning-element (or (org-element-property :deadline item)
+                                   (org-element-property :scheduled item)
+                                   (org-element-property :closed item))))
+    (ts-format "Planning: %Y" (ts-parse-org-element planning-element))))
+
+(taxy-org-ql-view-define-key planning-date ()
+  "Return ITEM's planning date, or nil.
+Returns in format \"%Y-%m-%d\"."
+  (when-let ((planning-element (or (org-element-property :deadline item)
+                                   (org-element-property :scheduled item)
+                                   (org-element-property :closed item))))
+    (ts-format "Planning: %Y-%m-%d" (ts-parse-org-element planning-element))))
+
+(taxy-org-ql-view-define-key planning ()
+  "Return \"Planned\" if ITEM has a planning date."
+  (when (or (org-element-property :deadline item)
+            (org-element-property :scheduled item)
+            (org-element-property :closed item))
+    "Planned"))
+
+(taxy-org-ql-view-define-key agenda
+  (&optional (days (pcase org-agenda-span
+		     ('week 7)
+		     ('day 1)
+		     ('month (date-days-in-month (ts-year (ts-now)) (ts-month (ts-now))))
+		     ('year 365)
+		     ((pred numberp) org-agenda-span))))
+  ;; FIXME: This isn't quite how Org Agenda works.
+  "Return ITEM's planning date if it's within DAYS of the current date."
+  (when-let ((planning-element (or (org-element-property :deadline item)
+				   (org-element-property :scheduled item)
+				   (org-element-property :closed item))))
+    (let ((parsed-ts (ts-parse-org-element planning-element)))
+      (when (<= (ts-diff (ts-apply 'hour 0 'minute 0 'second 0 (ts-now)) parsed-ts)
+		(* days 86400))
+	(ts-format "Agenda: %Y-%m-%d" parsed-ts)))))
+
+(taxy-org-ql-view-define-key category ()
+  "Return ITEM's category."
+  (org-with-point-at (org-element-property :org-hd-marker item)
+    (concat "Category: " (org-get-category))))
+
+(defun taxy-org-ql--latest-timestamp-in (regexp element)
+  "Return the latest timestamp matching REGEXP in ELEMENT.
+Searches in ELEMENT's buffer."
+  (org-with-point-at (org-element-property :org-hd-marker element)
+    (let* ((limit (org-entry-end-position))
+           (tss (cl-loop for next-ts =
+                         (when (re-search-forward regexp limit t)
+                           (ts-parse-org (match-string 1)))
+                         while next-ts
+                         collect next-ts)))
+      (when tss
+        (car (sort tss #'ts>))))))
+
+(taxy-org-ql-view-define-key ts-year ()
+  "Return the year of ITEM's latest timestamp."
+  (when-let ((latest-ts (taxy-org-ql--latest-timestamp-in org-element--timestamp-regexp item)))
+    (ts-format "%Y" latest-ts)))
+
+(taxy-org-ql-view-define-key ts-month ()
+  "Return the month of ITEM's latest timestamp."
+  (when-let ((latest-ts (taxy-org-ql--latest-timestamp-in org-element--timestamp-regexp item)))
+    (ts-format "%Y-%m (%B)" latest-ts)))
+
+(taxy-org-ql-view-define-key deadline (&rest args)
+  "Return whether ITEM has a deadline according to ARGS."
+  (when-let ((deadline-element (org-element-property :deadline item)))
+    (pcase args
+      (`(,(or 'nil 't)) "Deadlined")
+      (_ (let ((element-ts (ts-parse-org-element deadline-element)))
+           (pcase args
+             ((and `(:past)
+                   (guard (ts> (ts-now) element-ts)))
+              "Overdue")
+             ((and `(:today)
+                   (guard (equal (ts-day (ts-now)) (ts-day element-ts))))
+              "Due today")
+             ((and `(:future)
+                   (guard (ts< (ts-now) element-ts)))
+              ;; FIXME: Not necessarily soon.
+              "Due soon")
+             ((and `(:before ,target-date)
+                   (guard (ts< element-ts (ts-parse target-date))))
+              (concat "Due before: " target-date))
+             ((and `(:after ,target-date)
+                   (guard (ts> element-ts (ts-parse target-date))))
+              (concat "Due after: " target-date))
+             ((and `(:on ,target-date)
+                   (guard (let ((now (ts-now)))
+                            (and (equal (ts-doy element-ts)
+                                        (ts-doy now))
+                                 (equal (ts-year element-ts)
+                                        (ts-year now))))))
+              (concat "Due on: " target-date))
+             ((and `(:from ,target-ts)
+                   (guard (ts<= (ts-parse target-ts) element-ts)))
+              (concat "Due from: " target-ts))
+             ((and `(:to ,target-ts)
+                   (guard (ts>= (ts-parse target-ts) element-ts)))
+              (concat "Due to: " target-ts))
+             ((and `(:from ,from-ts :to ,to-ts)
+                   (guard (and (ts<= (ts-parse from-ts) element-ts)
+                               (ts>= (ts-parse to-ts) element-ts))))
+              (format "Due from: %s to %s" from-ts to-ts))))))))
+
+(taxy-org-ql-view-define-key planned (&rest args)
+  "Return whether ITEM is planned according to ARGS.
+DEADLINE, SCHEDULED, and CLOSED timestamps are considered, in
+that order."
+  (when-let ((planned-element (or (org-element-property :deadline item)
+                                  (org-element-property :scheduled item)
+                                  (org-element-property :closed item))))
+    ;; TODO: Every key should support a :name like this.
+    (let ((name (cadr (member :name args))))
+      (when name
+        (let ((pos (cl-position :name args)))
+          (setf args (append (cl-subseq args 0 pos)
+                             (cl-subseq args (+ 2 pos))))))
+      (pcase args
+        ((or 'nil 't) (or name "Planned"))
+        (_ (let ((element-ts (ts-parse-org-element planned-element)))
+             (pcase args
+               ((and `(:past)
+                     (guard (ts> (ts-now) element-ts)))
+                (or name "Planned: past"))
+               ((and `(:today)
+                     (guard (equal (ts-day (ts-now)) (ts-day element-ts))))
+                (or name "Planned: today"))
+               ((and `(:future)
+                     (guard (ts< (ts-now) element-ts)))
+                ;; FIXME: Not necessarily soon.
+                (or name "Planned: future"))
+               ((and `(:before ,target-date)
+                     (guard (ts< element-ts (ts-parse target-date))))
+                (or name (concat "Planned before: " target-date)))
+               ((and `(:after ,target-date)
+                     (guard (ts> element-ts (ts-parse target-date))))
+                (or name (concat "Planned after: " target-date)))
+               ((and `(:on ,target-date)
+                     (guard (let ((now (ts-now)))
+                              (and (equal (ts-doy element-ts)
+                                          (ts-doy now))
+                                   (equal (ts-year element-ts)
+                                          (ts-year now))))))
+                (or name (concat "Planned on: " target-date)))
+               ((and `(:from ,target-ts)
+                     (guard (ts<= (ts-parse target-ts) element-ts)))
+                (or name (concat "Planned from: " target-ts)))
+               ((and `(:to ,target-ts)
+                     (guard (ts>= (ts-parse target-ts) element-ts)))
+                (or name (concat "Planned to: " target-ts)))
+               ((and `(:from ,from-ts :to ,to-ts)
+                     (guard (and (ts<= (ts-parse from-ts) element-ts)
+                                 (ts>= (ts-parse to-ts) element-ts))))
+                (or name (format "Planned from: %s to %s" from-ts to-ts))))))))))
+
+(taxy-org-ql-view-define-key file (&key full-path)
+  "Return the name of ITEM's containing file."
+  (let ((filename (org-with-point-at (org-element-property :org-hd-marker item)
+                    (if full-path
+                        (buffer-file-name)
+                      (file-name-nondirectory (buffer-file-name))))))
+    (concat "File: " filename)))
+
+;;;; Mode
+
+(defvar taxy-org-ql-view-mode-map
+  (let* ((org-agenda-mode-map-copy (copy-keymap org-agenda-mode-map))
+	 map)
+    (cl-loop for key in (where-is-internal #'org-agenda-goto org-agenda-mode-map-copy)
+	     do (define-key org-agenda-mode-map-copy key nil))
+    (setf map (make-composed-keymap magit-section-mode-map org-agenda-mode-map-copy))
+    (define-key map "g" #'taxy-org-ql-view-refresh)
+    (define-key map "r" #'taxy-org-ql-view-refresh)
+    (define-key map "q" #'bury-buffer)
+    (define-key map "v" #'org-ql-view-dispatch)
+    (define-key map (kbd "C-x C-s") #'org-ql-view-save)
+    ;; HACK: Undefine Org's extra "<tab>" binding from
+    ;; org-agenda-mode-map, which interferes with the "TAB" binding
+    ;; from magit-section-mode-map.  (This shouldn't be necessary
+    ;; since we're already looping through the bindings earlier, but
+    ;; for some reason, it is.)
+    (define-key map (kbd "<tab>") nil)
+    map))
+
+(define-derived-mode taxy-org-ql-view-mode magit-section-mode "Org QL View"
+  "TODO: Docstring."
+  ;; For compatibility with Org Agenda commands.
+  (setq-local org-agenda-type 'search
+              taxy-org-ql-view-format-table (make-hash-table)))
+
+;;;; Functions
+
+;; FIXME: Each taxy's items are formatted relative to its own items,
+;; so column widths don't account for the width of items in other
+;; taxys.  This should be fixable, but it will require some thoughtful
+;; refactoring, which will probably require a new version of
+;; taxy-magit-section.
+
+(defvar-local taxy-org-ql-view-taxy nil
+  "Root taxy.")
+
+(defvar-local taxy-org-ql-view-format-table nil
+  ;; Setting the default value to a hash table here doesn't work; it
+  ;; must be initialized in each buffer manually.
+  "Format table for all items in view.")
+
+(cl-defun taxy-org-ql-view
+    (&rest rest &key name buffer queries from where group sort append columns narrow)
+  "Show Org QL QUERIES in BUFFER with `taxy-org-ql-view'.
+BUFFER may be a buffer, a name of a buffer, or a name of a buffer
+to make.
+
+QUERIES is a list of plists with the following keys:
+
+  :name  An optional name for the query.
+  :from   One or a list of buffers/files to search.
+  :query  The `org-ql' query expression.
+  :sort   One or a list of sorting predicates.
+  :group  A group definition.
+
+GROUP and SORT, if specified, apply to all QUERIES unless a
+query specifies its own.
+
+If APPEND, add QUERIES to BUFFER; otherwise, replace BUFFER's
+contents."
+  (declare (indent defun))
+  ;; Silence byte-compiler since we use `symbol-value' for these.
+  (ignore from group sort append)
+  (let ((buffer
+         (cl-typecase buffer
+           (buffer buffer)
+           (string (or (get-buffer buffer)
+                       (get-buffer-create (format "*Taxy Org QL View: %s*" buffer))))))
+        (instance-taxy (make-taxy-magit-section :name name))
+        format-cons column-sizes
+        make-fn-group)
+    (cl-labels ((add-props
+                 ;; NOTE: This mutates.  Maybe good, maybe not.
+                 (plist) (dolist (prop '(:name :from :sort :group) plist)
+                           (unless (plist-member plist prop)
+                             (setf plist (plist-put plist prop (plist-get rest prop))))))
+                (format-item (item)
+			     ;; For compatibility with Org Agenda, we
+			     ;; add the marker property to the whole
+			     ;; string (though it only seems to check
+			     ;; at BOL).
+			     (let* ((string (gethash item taxy-org-ql-view-format-table))
+				    (marker (or (get-text-property 0 :org-hd-marker string)
+						(when-let ((pos (next-single-property-change 0 :org-hd-marker string)))
+						  (get-text-property pos :org-hd-marker string)))))
+			       ;; I don't understand why Org sometimes
+			       ;; uses one property and sometimes the
+			       ;; other.
+			       (propertize string
+					   'org-hd-marker marker
+					   'org-marker marker)))
+		(heading-face
+		 (depth) (pcase depth
+			   (-1 'org-ql-view-query-heading)
+			   ;; NOTE: Faces count from 1 (like
+			   ;; `outline-` faces), but depth from 0 (or
+			   ;; -1 for query headings).
+			   (0 'org-ql-view-heading-1)
+			   (1 'org-ql-view-heading-2)
+			   (_ 'org-ql-view-heading)))
+                (make-fn (&rest args)
+                         (apply #'make-taxy-magit-section
+                                :make #'make-fn
+                                ;; FIXME: The binding of `make-fn-group' here is very awkward.  See below.
+                                :take (taxy-make-take-function make-fn-group taxy-org-ql-view-keys)
+                                :format-fn #'format-item
+                                :heading-face-fn #'heading-face
+                                :level-indent org-ql-view-level-indent
+                                :item-indent org-ql-view-item-indent
+                                args)))
+      (with-current-buffer buffer
+        (unless append
+          (taxy-org-ql-view-mode)
+          (setf taxy-org-ql-view-taxy (make-taxy-magit-section
+                                       :name (propertize (buffer-name buffer)
+                                                         'face 'taxy-org-ql-view-header)
+                                       :format-fn #'format-item)))
+        (cl-pushnew rest taxy-org-ql-view-args :test #'equal)
+        (when columns
+          (setq-local org-ql-view-columns columns))
+        (pcase-dolist ((map (:name query-name) (:from query-from)
+                            (:where query-where)
+                            (:group query-group) (:sort query-sort)
+                            :query)
+                       queries)
+          (setf query-name (or query-name name)
+                query-from (or query-from from)
+                query-where (or query-where where)
+                query-group (or query-group group)
+                ;; FIXME: Query binding is ugly, but it seems necessary
+                ;; due to the way the `make-fn' closes over the
+                ;; argument passed to `taxy-make-take-function'
+                ;; (passing it as an argument to `make-fn' does not
+                ;; work).
+                make-fn-group (or query-group group)
+                query-sort (or query-sort sort))
+          ;; HACK: Probably not where we really want to add this face.
+          (add-face-text-property 0 (length query-name) 'org-ql-view-heading-2 nil query-name)
+          (let* ((title (or query-name
+                            (org-ql-view--header-line-format
+		             :buffers-files from
+		             :query query)))
+                 (items (org-ql-query :from query-from :where query-where
+                                      :order-by query-sort :narrow narrow))
+                 (taxy (thread-last (make-fn :name title)
+                                    (taxy-fill items))))
+            (push taxy (taxy-taxys instance-taxy))))
+        (setf (taxy-taxys instance-taxy) (nreverse (taxy-taxys instance-taxy))
+              (taxy-taxys taxy-org-ql-view-taxy) (append (taxy-taxys taxy-org-ql-view-taxy)
+                                                         (list instance-taxy)))
+        (let ((inhibit-read-only t)
+              (taxy-magit-section-insert-indent-items nil))
+          (erase-buffer)
+          (setf format-cons (taxy-org-ql-view-magit-section-format-items
+                             org-ql-view-columns org-ql-view-column-formatters taxy-org-ql-view-taxy
+                             :table taxy-org-ql-view-format-table)
+                column-sizes (cdr format-cons)
+                header-line-format (taxy-magit-section-format-header
+				    column-sizes org-ql-view-column-formatters))
+	  (add-face-text-property 0 (length header-line-format) 'org-ql-view-header-line
+				  nil header-line-format)
+          (taxy-magit-section-insert taxy-org-ql-view-taxy :items 'first
+            :initial-depth -1)
+          (goto-char (point-min)))
+        (pop-to-buffer (current-buffer))))))
+
+(cl-defun taxy-org-ql-report
+    (&key buffer queries from where sort group columns sections
+          &aux append)
+  (declare (indent defun))
+  (pcase-dolist ((map (:name section-name) (:from section-from)
+                      (:where section-where)
+                      (:sort section-sort) (:group section-group)
+                      (:queries section-queries)
+                      (:narrow section-narrow))
+                 sections)
+    (setf section-name (or section-name "[unnamed section]"))
+    ;; HACK: Probably not where we really want to add this face.
+    (add-face-text-property 0 (length section-name) 'org-ql-view-heading-1 nil section-name)
+    (taxy-org-ql-view :buffer buffer :columns columns
+      :name section-name :from (or section-from from)
+      :where (or section-where where)
+      :sort (or section-sort sort) :group (or section-group group)
+      :queries (or section-queries queries) :append append :narrow section-narrow)
+    (setf append t)))
+
+(defun taxy-org-ql-view-refresh ()
+  "Refresh buffer."
+  (interactive)
+  (cl-assert (eq 'taxy-org-ql-view-mode major-mode))
+  (let ((args taxy-org-ql-view-args)
+        (pos (point))
+        (append))
+    (dolist (args (reverse args))
+      (apply #'taxy-org-ql-view :buffer (current-buffer) :append append
+             args)
+      (setf append t))
+    (goto-char pos)))
+
+(cl-defun taxy-org-ql-view-magit-section-format-items
+    (columns formatters taxy
+             &key (table (make-hash-table)))
+  ;; TODO: Add :table argument to `taxy-magit-section-format-items' and release new version.
+  "Return a cons (table . column-sizes) for COLUMNS, FORMATTERS, and TAXY.
+COLUMNS is a list of column names, each of which should have an
+associated formatting function in FORMATTERS.
+
+Table is a hash table keyed by item whose values are display
+strings.  Column-sizes is an alist whose keys are column names
+and values are the column width.  Each string is formatted
+according to `columns' and takes into account the width of all
+the items' values for each column."
+  (let (column-aligns column-sizes image-p)
+    (cl-labels ((string-width*
+                 (string) (if-let (pos (text-property-not-all 0 (length string)
+                                                              'display nil string))
+                              ;; Text has a display property: check for an image.
+                              (pcase (get-text-property pos 'display string)
+                                ((and `(image . ,_rest) spec)
+                                 ;; An image: try to calcuate the display width.  (See also:
+                                 ;; `org-string-width'.)
+
+                                 ;; FIXME: The entire string may not be an image, so the
+                                 ;; image part needs to be handled separately from any
+                                 ;; non-image part.
+
+                                 ;; TODO: Do we need to specify the frame?  What if the
+                                 ;; buffer isn't currently displayed?
+                                 (setf image-p t)
+                                 (floor (car (image-size spec))))
+                                (_
+                                 ;; No image: just use `string-width'.
+                                 (setf image-p nil)
+                                 (string-width string)))
+                            ;; No display property.
+                            (setf image-p nil)
+                            (string-width string)))
+                (resize-image-string
+                 (string width) (let ((image
+                                       (get-text-property
+                                        (text-property-not-all 0 (length string)
+                                                               'display nil string)
+                                        'display string)))
+                                  (propertize (make-string width ? ) 'display image)))
+
+                (format-column
+                 (item depth column-name)
+                 (let* ((column-alist (alist-get column-name formatters nil nil #'equal))
+                        (fn (alist-get 'formatter column-alist))
+                        (value (funcall fn item depth))
+                        (current-column-size (or (map-elt column-sizes column-name) (string-width column-name))))
+                   (setf (map-elt column-sizes column-name)
+                         (max current-column-size (string-width* value)))
+                   (setf (map-elt column-aligns column-name)
+                         (or (alist-get 'align column-alist)
+                             'left))
+                   (when image-p
+                     ;; String probably is an image: set its non-image string value to a
+                     ;; number of matching spaces.  It's not always pixel-perfect, but
+                     ;; this is probably as good as we can do without using pixel-based
+                     ;; :align-to's for everything (which might be worth doing in the
+                     ;; future).
+
+                     ;; FIXME: This only works properly if the entire string has an image
+                     ;; display property (but this is good enough for now).
+                     (setf value (resize-image-string value (string-width* value))))
+                   value))
+                (format-item
+                 (depth item) (puthash item
+                                       (cl-loop for column in columns
+                                                collect (format-column item depth column))
+                                       table))
+                (format-taxy (depth taxy)
+                             (dolist (item (taxy-items taxy))
+                               (format-item depth item))
+                             (dolist (taxy (taxy-taxys taxy))
+                               (format-taxy (1+ depth) taxy))))
+      (format-taxy 0 taxy)
+      ;; Now format each item's string using the column sizes.
+      (let* ((column-sizes (nreverse column-sizes))
+             (format-string
+              (string-join
+               (cl-loop for (name . size) in column-sizes
+                        for align = (pcase-exhaustive (alist-get name column-aligns nil nil #'equal)
+                                      ((or `nil 'left) "-")
+                                      ('right ""))
+                        collect (format "%%%s%ss" align size))
+               " ")))
+        (maphash (lambda (item column-values)
+                   (puthash item (apply #'format format-string column-values)
+                            table))
+                 table)
+        (cons table column-sizes)))))
+
+;;;; Footer
+
+(provide 'taxy-org-ql-view)
+
+;;; taxy-org-ql-view.el ends here

tests/data-ts.org

@@ -1,29 +0,0 @@
-#+title: Timestamp-specific tests
-
-/Timestamps in this file are active ones./
-
-* Single-timestamp ranges
-
-** Single-timestamp, without repeater
-<2024-06-25 Tue 08:00-09:00>
-
-** Single-timestamp, with repeater (deadline)
-DEADLINE: <2024-06-25 Tue 08:00-09:00 ++7d>
-
-* Multi-timestamp ranges
-
-/Not sure that it would make sense to use repeaters for this kind of range./
-
-** Multi-timestamp, without repeater
-<2024-06-25 Tue 08:00>--<2024-06-26 Wed 08:00>
-
-* Day-of-week abbreviations
-
-** French
-
-<2024-07-12 ven.>
-
-* Canary
-
-/This entry should never be matched./
-

tests/test-org-ql.el

@@ -3,7 +3,7 @@
 ;; Copyright (C) 2019 Adam Porter
 
 ;; Author: Adam Porter <adam@alphapapa.net>
-;; Package-Requires: ((buttercup) (with-simulated-input) (xr))
+;; Package-Requires: ((buttercup) (with-simulated-input))
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -33,10 +33,6 @@
 (require 'org-ql-search)
 (require 'org-ql-view)
 
-(require 'xr)
-
-(declare-function org-ql--normalize-query "org-ql" t t)
-
 ;;;; Variables
 
 (defvar org-ql-test-buffer nil
@@ -220,8 +216,7 @@ with keyword arg NOW in PLIST."
       (it "coalesces a single AND clause that uses two predicates (and preserves predicate order)"
         (expect (org-ql--normalize-query '(and (rifle "foo") (rifle "bar")
                                                (heading "baz") (heading "buz")))
-                ;; NOTE: `heading' is normalized to `heading-regexp'.
-                :to-equal '(and (rifle :regexps '("foo" "bar")) (heading-regexp "baz" "buz"))))
+                :to-equal '(and (rifle :regexps '("foo" "bar")) (heading "baz" "buz"))))
       (it "preserves independent OR clauses"
         (expect (org-ql--normalize-query '(and (or (rifle "foo") (rifle "bar"))
                                                (or (rifle "baz") (rifle "buz"))))
@@ -256,18 +251,6 @@ with keyword arg NOW in PLIST."
         (expect (org-ql--normalize-query "\"quoted phrase\"")
                 :to-equal '(rifle :regexps '("\"quoted phrase\""))))
 
-      (describe "Ancestor/Parent predicates"
-        ;; NOTE: Because the ancestor and parent predicates byte-compile their
-        ;; subquery predicates, we have to test the byte-compiled forms here.
-        (expect (org-ql--normalize-query '(ancestors "scheduled"))
-                ;; No colon after keyword, so not a predicate query.
-                :to-equal ;; '(ancestors (rifle :regexps '("scheduled")))
-                `(ancestors #[nil "\300\301\302\"\207" [rifle :regexps ("scheduled")] 3]))
-        (expect (org-ql--normalize-query '(parent "scheduled"))
-                ;; No colon after keyword, so not a predicate query.
-                :to-equal ;; '(parent (rifle :regexps '("scheduled")))
-                `(parent #[nil "\300\301\302\"\207" [rifle :regexps ("scheduled")] 3])))
-
       (describe "Plain strings"
         (it "normalizes plain strings to the default predicate (using AND)"
           (expect (org-ql--normalize-query '(and "string1" "string2"))
@@ -638,11 +621,6 @@ with keyword arg NOW in PLIST."
                   :to-equal (list :query t
                                   :preamble (rx bol (repeat 2 4 "*") " ")
                                   :preamble-case-fold t)))
-        (it "with an expression in level number's place"
-          (expect (org-ql--query-preamble '(level <= (string-to-number (property "PROPERTY"))))
-                  :to-equal (list :query '(level <= (string-to-number (property "PROPERTY")))
-                                  :preamble nil
-                                  :preamble-case-fold t)))
         (it "<"
           (expect (org-ql--query-preamble '(level < 3))
                   :to-equal (list :query t
@@ -668,14 +646,6 @@ with keyword arg NOW in PLIST."
 
       ;; TODO: Other predicates.
 
-      (it "Ignores empty quoted strings"
-        (expect (org-ql--query-string-to-sexp "\"\"")
-                :to-equal nil)
-        (expect (org-ql--query-string-to-sexp "foo \"\" bar")
-                :to-equal '(and (rifle "foo") (rifle "bar")))
-        (expect (org-ql--query-string-to-sexp "foo \"baz\" bar")
-                :to-equal '(and (rifle "foo") (rifle "baz") (rifle "bar"))))
-
       (it "Negated terms"
         (expect (org-ql--query-string-to-sexp "todo: !todo:CHECK,SOMEDAY")
                 :to-equal '(and (todo) (not (todo "CHECK" "SOMEDAY"))))
@@ -1132,12 +1102,7 @@ with keyword arg NOW in PLIST."
           '("Take over the world")))
       (org-ql-it "with two arguments"
         (org-ql-expect ('(heading "Take over" "world"))
-          '("Take over the world")))
-      (org-ql-it "does not match strings as regexps"
-        (org-ql-expect ('(heading "over"))
-          '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon"))
-        (org-ql-expect ('(heading "[over]"))
-          nil)))
+          '("Take over the world"))))
 
     (describe "(heading-regexp)"
       (org-ql-it "with one argument"
@@ -1344,15 +1309,7 @@ with keyword arg NOW in PLIST."
 
       (org-ql-it "with a property and a value"
         (org-ql-expect ('(property "agenda-group" "plans"))
-          '("Take over the universe" "Write a symphony")))
-
-      (org-ql-it "with a property and \"nil :inherit t\""
-        (org-ql-expect ('(property "agenda-group" nil :inherit t))
-          '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Spaceship lease" "Recurring" "/r/emacs" "Shop for groceries" "Sunrise/sunset" "Write a symphony")))
-
-      (org-ql-it "with a property and \":inherit t\""
-        (org-ql-expect ('(property "agenda-group" :inherit t))
-          '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Spaceship lease" "Recurring" "/r/emacs" "Shop for groceries" "Sunrise/sunset" "Write a symphony"))))
+          '("Take over the universe" "Write a symphony"))))
 
     (describe "(regexp)"
 
@@ -1703,36 +1660,7 @@ with keyword arg NOW in PLIST."
           (org-ql-expect ((org-ql--query-string-to-sexp "ts-active:with-time="))
             '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
           (org-ql-expect ((org-ql--query-string-to-sexp "ts-active:with-time=t"))
-            '("Skype with president of Antarctica" "Renew membership in supervillain club" "Order a pizza")))
-
-        (describe "matches timestamps with inner time ranges"
-          (before-each
-            (setq org-ql-test-buffer (org-ql-test-data-buffer "data-ts.org")
-                  org-ql-test-num-headings (with-current-buffer org-ql-test-buffer
-                                             (org-with-wide-buffer
-                                              (goto-char (point-min))
-                                              ;; Exclude the "Canary" heading.
-                                              (1- (cl-loop while (re-search-forward org-heading-regexp nil t)
-                                                           sum 1))))))
-
-          (org-ql-it "without :with-time"
-            (org-ql-expect ('(ts-active))
-              '("Single-timestamp, without repeater" "Single-timestamp, with repeater (deadline)" "Multi-timestamp, without repeater" "French")))
-          (org-ql-it ":with-time t"
-            (org-ql-expect ('(ts-active :on "2024-06-25" :with-time t))
-              '("Single-timestamp, without repeater" "Single-timestamp, with repeater (deadline)" "Multi-timestamp, without repeater"))
-            (org-ql-expect ('(ts-active :on "2024-06-26" :with-time t))
-              '("Multi-timestamp, without repeater")))
-          (org-ql-it ":with-time t and with specified time value in :to"
-            (org-ql-expect ('(ts-active :to "2024-06-25 09:00" :with-time t))
-              '("Single-timestamp, without repeater" "Single-timestamp, with repeater (deadline)" "Multi-timestamp, without repeater"))
-            ;; FIXME: The test below fails because timestamps with
-            ;; ranges are not yet parsed into multiple timestamps and
-            ;; compared as a range.  This will have to be addressed in
-            ;; a new version.
-            ;; (org-ql-expect ('(ts-active :from "2024-06-25 08:30"))
-            ;;   '("Single-timestamp, without repeater" "Single-timestamp, with repeater (deadline)" "Multi-timestamp, without repeater"))
-            )))
+            '("Skype with president of Antarctica" "Renew membership in supervillain club" "Order a pizza"))))
 
       (describe "inactive"
 
@@ -1871,20 +1799,7 @@ with keyword arg NOW in PLIST."
               '("Visit Mars")))
           (org-ql-then (:now "2019-07-07")
             (org-ql-expect ('(ts :on today))
-              nil))))
-
-      (describe "Day-of-week abbreviations"
-        (before-each
-          (setq org-ql-test-buffer (org-ql-test-data-buffer "data-ts.org")
-                org-ql-test-num-headings (with-current-buffer org-ql-test-buffer
-                                           (org-with-wide-buffer
-                                            (goto-char (point-min))
-                                            ;; Exclude the "Canary" heading.
-                                            (1- (cl-loop while (re-search-forward org-heading-regexp nil t)
-                                                         sum 1))))))
-        (org-ql-it "matches French abbreviations (with trailing period)"
-          (org-ql-expect ('(ts :on "2024-07-12"))
-            '("French")))))
+              nil)))))
 
     (describe "Compound queries"
 
@@ -1919,14 +1834,14 @@ with keyword arg NOW in PLIST."
     ;; have a chance to be gathered.  So we make a test buffer and run the test in that, with a test heading.
 
     (let ((test-buffer (get-buffer-create "*test-org-ql*")))
-      (cl-flet ((open-link (link)
-                  (with-current-buffer test-buffer
-                    (erase-buffer)
-                    (org-mode)
-                    (insert "* TODO Test heading \n\n")
-                    (insert link)
-                    (backward-char 1)
-                    (call-interactively #'org-open-at-point))))
+      (cl-flet ((open-link
+                 (link) (with-current-buffer test-buffer
+                          (erase-buffer)
+                          (org-mode)
+                          (insert "* TODO Test heading \n\n")
+                          (insert link)
+                          (backward-char 1)
+                          (call-interactively #'org-open-at-point))))
 
         (describe "buffers-files parameter"
           :var ((quoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]")
@@ -1986,13 +1901,13 @@ with keyword arg NOW in PLIST."
                 (expression-link "[[org-ql-search:todo:?title%3D%28error%20%22UNSAFE%22%29]]"))
           (it "Errors for a quoted lambda"
             (expect (open-link quoted-lambda-link)
-                    :to-throw 'error '("CAUTION: Link not opened because unsafe title parameter detected: (lambda (_ _) (error \"UNSAFE\"))")))
+                    :to-throw 'wrong-type-argument '(characterp lambda)))
           (it "Errors for an unquoted lambda"
             (expect (open-link unquoted-lambda-link)
-                    :to-throw 'error '("CAUTION: Link not opened because unsafe title parameter detected: (lambda (_ _) (error \"UNSAFE\"))")))
+                    :to-throw 'wrong-type-argument '(characterp lambda)))
           (it "Errors for an expression"
             (expect (open-link expression-link)
-                    :to-throw 'error '("CAUTION: Link not opened because unsafe title parameter detected: (error \"UNSAFE\")"))))
+                    :to-throw 'wrong-type-argument '(characterp error))))
 
         (describe "sort parameter"
           :var ((quoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28error%20%22UNSAFE%22%29%29]]")
@@ -2018,7 +1933,7 @@ with keyword arg NOW in PLIST."
   (describe "View saving/loading"
     :var* ((temp-dir (make-temp-file "test-org-ql-" 'dir))
            (temp-filenames (cl-loop for file in '("test1.org" "test2.org")
-                                    collect (abbreviate-file-name (expand-file-name file temp-dir))))
+                                    collect (expand-file-name file temp-dir)))
            (file-contents (with-temp-buffer
                             (insert "#+TITLE: Test data\n\n"
                                     "* TODO Heading 1\n"
@@ -2081,15 +1996,16 @@ with keyword arg NOW in PLIST."
           (when-let ((buffer (find-file-noselect filename 'nowarn)))
             (kill-buffer buffer))))
 
-      (cl-flet ((var-after-bookmark-set-and-jump (var buffers-files query &key sort super-groups)
-                  (org-ql-search buffers-files query
-                    :super-groups super-groups
-                    :sort sort :title title :buffer view-buffer)
-                  (set-buffer view-buffer)
-                  (bookmark-set title)
-                  (kill-buffer)
-                  (bookmark-jump title)
-                  (buffer-local-value var (get-buffer (concat "*Org QL View: " title "*")))))
+      (cl-flet ((var-after-bookmark-set-and-jump
+                 (var buffers-files query &key sort super-groups)
+                 (org-ql-search buffers-files query
+                   :super-groups super-groups
+                   :sort sort :title title :buffer view-buffer)
+                 (set-buffer view-buffer)
+                 (bookmark-set title)
+                 (kill-buffer)
+                 (bookmark-jump title)
+                 (buffer-local-value var (get-buffer (concat "*Org QL View: " title "*")))))
 
         (describe "Grouping"
           :var ((query '(and (todo "TODO") (regexp "heading")))
@@ -2143,18 +2059,18 @@ with keyword arg NOW in PLIST."
     (describe "Dynamic blocks"
       (describe "warn about sexp queries"
 
-        (cl-flet ((test-dblock (&optional input)
-                    (with-current-buffer (get-buffer-create "*TEST DBLOCK*")
-                      (erase-buffer)
-                      (org-mode)
-                      (insert "* TODO Heading 1\n\n"
-                              "#+BEGIN: org-ql :query (or (todo) (regexp \"Heading\")) :columns (todo)\n"
-                              "#+END:")
-                      (goto-char (point-min))
-                      (forward-line 2)
-                      (with-simulated-input input
-                        (org-dblock-update))
-                      (kill-buffer))))
+        (cl-flet ((test-dblock
+                   (&optional input) (with-current-buffer (get-buffer-create "*TEST DBLOCK*")
+                                       (erase-buffer)
+                                       (org-mode)
+                                       (insert "* TODO Heading 1\n\n"
+                                               "#+BEGIN: org-ql :query (or (todo) (regexp \"Heading\")) :columns (todo)\n"
+                                               "#+END:")
+                                       (goto-char (point-min))
+                                       (forward-line 2)
+                                       (with-simulated-input input
+                                         (org-dblock-update))
+                                       (kill-buffer))))
 
           (it "when org-ql-ask-unsafe-queries is non-nil"
             ;; TODO: Should the query be converted to string form if possible and only warn if not?
@@ -2183,37 +2099,39 @@ with keyword arg NOW in PLIST."
           (insert "* TODO Test heading\n\n")
           (org-mode)))
 
-      (cl-flet* ((open-link-in (link buffer input)
-                   ;; Org REDUCED THE NUMBER OF ARGUMENTS TO `org-open-link-from-string'!  That BREAKS BACKWARD
-                   ;; COMPATIBILITY!  So I have to make my own function so these tests can work across Org versions!
-                   (with-current-buffer buffer
-                     (erase-buffer)
-                     (org-mode)
-                     (insert "* TODO Test heading\n\n")
-                     (insert link)
-                     (backward-char 1)
-                     (with-simulated-input input
-                       (org-open-at-point))))
+      (cl-flet* ((open-link-in
+                  (link buffer input)
+                  ;; Org REDUCED THE NUMBER OF ARGUMENTS TO `org-open-link-from-string'!  That BREAKS BACKWARD
+                  ;; COMPATIBILITY!  So I have to make my own function so these tests can work across Org versions!
+                  (with-current-buffer buffer
+                    (erase-buffer)
+                    (org-mode)
+                    (insert "* TODO Test heading\n\n")
+                    (insert link)
+                    (backward-char 1)
+                    (with-simulated-input input
+                      (org-open-at-point))))
 
-                 (var-after-link-save-open (var buffers-files query &key sort super-groups
-                                                (buffer link-buffer) (store-input "RET") open-input)
-                   (org-ql-search buffers-files query
-                     :super-groups super-groups
-                     :sort sort :title title :buffer view-buffer)
-                   (with-current-buffer view-buffer
-                     (cl-assert (member '("org-ql-search" :follow org-ql-view--link-follow :store org-ql-view--link-store)
-                                        org-link-parameters)
-                                t)
-                     (with-simulated-input store-input
-                       ;; Avoid writing "Stored: ..." to test output.
-                       (let ((inhibit-message t))
-                         (call-interactively #'org-store-link nil)))
-                     (kill-buffer))
-                   (cl-assert (and org-stored-links (caar org-stored-links)) t)
-                   (open-link-in (caar org-stored-links) buffer open-input)
-                   (with-current-buffer (get-buffer (concat "*Org QL View: " title "*"))
-                     (prog1 (buffer-local-value var (current-buffer))
-                       (kill-buffer)))))
+                 (var-after-link-save-open
+                  (var buffers-files query &key sort super-groups
+                       (buffer link-buffer) (store-input "RET") open-input)
+                  (org-ql-search buffers-files query
+                    :super-groups super-groups
+                    :sort sort :title title :buffer view-buffer)
+                  (with-current-buffer view-buffer
+                    (cl-assert (member '("org-ql-search" :follow org-ql-view--link-follow :store org-ql-view--link-store)
+                                       org-link-parameters)
+                               t)
+                    (with-simulated-input store-input
+                      ;; Avoid writing "Stored: ..." to test output.
+                      (let ((inhibit-message t))
+                        (call-interactively #'org-store-link nil)))
+                    (kill-buffer))
+                  (cl-assert (and org-stored-links (caar org-stored-links)) t)
+                  (open-link-in (caar org-stored-links) buffer open-input)
+                  (with-current-buffer (get-buffer (concat "*Org QL View: " title "*"))
+                    (prog1 (buffer-local-value var (current-buffer))
+                      (kill-buffer)))))
 
         (describe "Queries"
           :var ((string-query "todo:TODO regexp:heading")