Compare commits

..

No commits in common. "master" and "v0.7.3" have entirely different histories.

15 changed files with 709 additions and 1831 deletions

View file

@ -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

View file

@ -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.

View file

@ -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

View file

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

View file

@ -19,7 +19,6 @@ It includes three libraries: The =org-ql= library is flexible and may be used as
- [[#installation][Installation]] - [[#installation][Installation]]
- [[#usage][Usage]] - [[#usage][Usage]]
- [[#changelog][Changelog]] - [[#changelog][Changelog]]
- [[#development][Development]]
:END: :END:
@ -112,20 +111,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: 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~ 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-agenda~ searches in ~(org-agenda-files)~.
- ~org-ql-find-in-org-directory~ searches in ~org-directory~. - ~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]] [[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 *** 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. 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 +146,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:* 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 *** helm-org-ql
/Note: This command uses [[#non-sexp-query-syntax][non-sexp queries]]. It is available separately in the package =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 +221,7 @@ Note that the =effort=, =level=, and =priority= predicates do not support compar
Arguments are listed next to predicate names, where applicable. 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. + =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~. + =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=. + =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. + =habit= :: Return non-nil if entry is a habit.
@ -249,23 +237,23 @@ Arguments are listed next to predicate names, where applicable.
- Aliases: ~olps~. - 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. + =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~). + =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. + =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=. - 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. + =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~. - 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~. - *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. + ~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 (&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 (&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-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~. - 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~. - 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&~. - 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. + =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*~. - 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 *** Ancestor/descendant predicates
@ -554,119 +542,6 @@ 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. /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 ** 0.7.3
*Fixes* *Fixes*
@ -693,7 +568,7 @@ Tagged v0.6.2, fixing a compilation warning.
** 0.7 ** 0.7
*Added* *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. + 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=.) + 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). + 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 +878,6 @@ Tagged v0.6.2, fixing a compilation warning.
First tagged release. 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 * Notes
:PROPERTIES: :PROPERTIES:
:TOC: :ignore this :TOC: :ignore this

View file

@ -2,8 +2,8 @@
;; Author: Adam Porter <adam@alphapapa.net> ;; Author: Adam Porter <adam@alphapapa.net>
;; URL: https://github.com/alphapapa/org-ql ;; URL: https://github.com/alphapapa/org-ql
;; Version: 0.6.2 ;; Version: 0.6.1
;; 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")) ;; Package-Requires: ((emacs "26.1") (dash "2.18.1") (s "1.12.0") (helm-org "1.0") (org-ql "0.6-pre"))
;;; Commentary: ;;; Commentary:
@ -35,7 +35,6 @@
(require 'cl-lib) (require 'cl-lib)
(require 'org) (require 'org)
(require 'compat)
(require 'dash) (require 'dash)
(require 's) (require 's)
@ -45,15 +44,6 @@
(require 'org-ql) (require 'org-ql)
(require 'org-ql-search) (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 ;;;; Variables
(defvar helm-org-ql-map (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 NOTE: Atoms in the query are turned into strings where
appropriate, which makes it unnecessary to type quotation marks 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. strings.
All query tokens are wrapped in the operator BOOLEAN (default 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. ;; it to go to the previous heading. I don't know why it does that.
(switch-to-buffer (marker-buffer marker)) (switch-to-buffer (marker-buffer marker))
(goto-char marker) (goto-char marker)
(helm-org-ql--show-entry)) (org-show-entry))
(defun helm-org-ql-show-marker-indirect (marker) (defun helm-org-ql-show-marker-indirect (marker)
"Show heading at MARKER with `org-tree-to-indirect-buffer'." "Show heading at MARKER with `org-tree-to-indirect-buffer'."
@ -187,7 +177,7 @@ Is transformed into this query:
;;;###autoload ;;;###autoload
(cl-defun helm-org-ql-source (buffers-files &key (name "helm-org-ql")) (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. ;; Expansion of `helm-build-sync-source' macro.
(helm-make-source name 'helm-source-sync (helm-make-source name 'helm-source-sync
:candidates (lambda () :candidates (lambda ()
@ -211,7 +201,7 @@ Is transformed into this query:
(defun helm-org-ql--heading (window-width) (defun helm-org-ql--heading (window-width)
"Return string for Helm for heading at point. "Return string for Helm for heading at point.
WINDOW-WIDTH should be the width of the Helm window." 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 ;; 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 ;; 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 ;; buffer, unless we manually called `org-ql' in each buffer, which

View file

@ -3,7 +3,7 @@
# * makem.sh --- Script to aid building and testing Emacs Lisp packages # * makem.sh --- Script to aid building and testing Emacs Lisp packages
# URL: https://github.com/alphapapa/makem.sh # URL: https://github.com/alphapapa/makem.sh
# Version: 0.7.1 # Version: 0.6-pre
# * Commentary: # * Commentary:
@ -112,12 +112,6 @@ Source files are automatically discovered from git, or may be
specified with options. Package dependencies are discovered from specified with options. Package dependencies are discovered from
"Package-Requires" headers in source files, from -pkg.el files, and "Package-Requires" headers in source files, from -pkg.el files, and
from a Cask file. 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 EOF
} }
@ -183,7 +177,6 @@ function elisp-checkdoc-file {
(setq makem-checkdoc-errors-p t) (setq makem-checkdoc-errors-p t)
;; Return nil because we *are* generating a buffered list of errors. ;; Return nil because we *are* generating a buffered list of errors.
nil)))) nil))))
(put 'ispell-buffer-session-localwords 'safe-local-variable #'list-of-strings-p)
(mapcar #'checkdoc-file files) (mapcar #'checkdoc-file files)
(when makem-checkdoc-errors-p (when makem-checkdoc-errors-p
(kill-emacs 1)))) (kill-emacs 1))))
@ -307,6 +300,7 @@ function elisp-package-initialize-file {
(setq package-archives (list (cons "gnu" "https://elpa.gnu.org/packages/") (setq package-archives (list (cons "gnu" "https://elpa.gnu.org/packages/")
(cons "melpa" "https://melpa.org/packages/") (cons "melpa" "https://melpa.org/packages/")
(cons "melpa-stable" "https://stable.melpa.org/packages/"))) (cons "melpa-stable" "https://stable.melpa.org/packages/")))
$elisp_org_package_archive
(package-initialize) (package-initialize)
EOF EOF
echo $file echo $file
@ -385,36 +379,6 @@ function byte-compile-file {
# ** Files # ** 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 { function dirs-project {
# Echo list of directories to be used in load path. # Echo list of directories to be used in load path.
files-project-feature | dirnames files-project-feature | dirnames
@ -423,7 +387,7 @@ function dirs-project {
function files-project-elisp { function files-project-elisp {
# Echo list of Elisp files in project. # Echo list of Elisp files in project.
files-project 2>/dev/null \ git ls-files 2>/dev/null \
| egrep "\.el$" \ | egrep "\.el$" \
| filter-files-exclude-default \ | filter-files-exclude-default \
| filter-files-exclude-args | filter-files-exclude-args
@ -432,13 +396,13 @@ function files-project-elisp {
function files-project-feature { function files-project-feature {
# Echo list of Elisp files that are not tests and provide a feature. # Echo list of Elisp files that are not tests and provide a feature.
files-project-elisp \ files-project-elisp \
| grep -E -v "$test_files_regexp" \ | egrep -v "$test_files_regexp" \
| filter-files-feature | filter-files-feature
} }
function files-project-test { function files-project-test {
# Echo list of Elisp test files. # Echo list of Elisp test files.
files-project-elisp | grep -E "$test_files_regexp" files-project-elisp | egrep "$test_files_regexp"
} }
function dirnames { function dirnames {
@ -451,7 +415,7 @@ function dirnames {
function filter-files-exclude-default { function filter-files-exclude-default {
# Filter out paths (STDIN) which should be excluded by 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 { function filter-files-exclude-args {
@ -477,7 +441,7 @@ function filter-files-feature {
# Read paths on STDIN and echo ones that (provide 'a-feature). # Read paths on STDIN and echo ones that (provide 'a-feature).
while read path while read path
do do
grep -E "^\\(provide '" "$path" &>/dev/null \ egrep "^\\(provide '" "$path" &>/dev/null \
&& echo "$path" && echo "$path"
done done
} }
@ -525,7 +489,7 @@ function ert-tests-p {
function package-main-file { function package-main-file {
# Echo the package's 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 ]] if [[ $file_pkg ]]
then then
@ -548,23 +512,23 @@ function dependencies {
# Search package headers. Use -a so grep won't think that an Elisp file containing # 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. # 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) \ egrep -a -i '^;; Package-Requires: ' $(files-project-feature) $(files-project-test) \
| grep -E -o '\([^([:space:]][^)]*\)' \ | egrep -o '\([^([:space:]][^)]*\)' \
| grep -E -o '^[^[:space:])]+' \ | egrep -o '^[^[:space:])]+' \
| sed -r 's/\(//g' \ | sed -r 's/\(//g' \
| grep -E -v '^emacs$' # Ignore Emacs version requirement. | egrep -v '^emacs$' # Ignore Emacs version requirement.
# Search Cask file. # Search Cask file.
if [[ -r Cask ]] if [[ -r Cask ]]
then then
grep -E '\(depends-on "[^"]+"' Cask \ egrep '\(depends-on "[^"]+"' Cask \
| sed -r -e 's/\(depends-on "([^"]+)".*/\1/g' | sed -r -e 's/\(depends-on "([^"]+)".*/\1/g'
fi fi
# Search -pkg.el file. # Search -pkg.el file.
if [[ $(files-project "*-pkg.el" 2>/dev/null) ]] if [[ $(git ls-files ./*-pkg.el 2>/dev/null) ]]
then 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 fi
} }
@ -617,9 +581,6 @@ function sandbox {
local deps=($(dependencies)) local deps=($(dependencies))
debug "Installing dependencies: ${deps[@]}" 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[@]}" for package in "${deps[@]}"
do do
args_sandbox_package_install+=(--eval "(package-install '$package)") 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)" --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=( args_package_init=(
--eval "(package-initialize)" --eval "(package-initialize)"
) )
elisp_org_package_archive="(add-to-list 'package-archives '(\"org\" . \"https://orgmode.org/elpa/\") t)"
# * Args # * Args
args=$(getopt -n "$0" \ args=$(getopt -n "$0" \
-o dhce:E:i:s::vf:C \ -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,sandbox:: \ -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; } || { usage; exit 1; }
eval set -- "$args" eval set -- "$args"
@ -1195,6 +1162,9 @@ do
shift shift
args_files+=("$1") args_files+=("$1")
;; ;;
-O|--no-org-repo)
unset elisp_org_package_archive
;;
--no-color) --no-color)
unset color unset color
;; ;;
@ -1223,9 +1193,6 @@ paths_temp+=("$package_initialize_file")
trap cleanup EXIT INT TERM trap cleanup EXIT INT TERM
# Change to project root directory first.
cd "$(project-root)"
# Discover project files. # Discover project files.
files_project_feature=($(files-project-feature)) files_project_feature=($(files-project-feature))
files_project_test=($(files-project-test)) files_project_test=($(files-project-test))

View file

@ -1,6 +1,6 @@
;;; org-ql-completing-read.el --- Completing read of Org entries using org-ql -*- lexical-binding: t; -*- ;;; 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> ;; Author: Adam Porter <adam@alphapapa.net>
@ -26,19 +26,6 @@
(require 'org-ql) (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 ;;;; Customization
(defgroup org-ql-completing-read nil (defgroup org-ql-completing-read nil
@ -50,10 +37,12 @@
:type 'boolean) :type 'boolean)
(defcustom org-ql-completing-read-snippet-function #'org-ql-completing-read--snippet-simple (defcustom org-ql-completing-read-snippet-function #'org-ql-completing-read--snippet-simple
;; TODO(v0.9): Performance of completion annotations seems to be ;; TODO: I'd like to make the -regexp one the default, but with
;; much improved now (whether due to changes in Emacs, Vertico, or ;; default Emacs completion affixation, it can sometimes be a bit
;; both, I don't know). It may be reasonable to make the context ;; slow, and I don't want that to be a user's first impression. It
;; snippet the default now. ;; 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 used to annotate results in `org-ql-completing-read'.
Function is called at entry beginning. (When set to Function is called at entry beginning. (When set to
`org-ql-completing-read--snippet-regexp', it is called with a `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))) (defface org-ql-completing-read-snippet '((t (:inherit font-lock-comment-face)))
"Snippets.") "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 ;;;; 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 ;;;;; 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 ;;;###autoload
(cl-defun org-ql-completing-read (cl-defun org-ql-completing-read (buffers-files &key query-prefix query-filter
(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: ")) (prompt "Find entry: "))
"Return marker at entry in BUFFERS-FILES selected with `org-ql'. "Return marker at Org entry in BUFFERS-FILES selected with `org-ql'.
PROMPT is shown to the user. 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 QUERY-PREFIX may be a string to prepend to the query entered by
the user (e.g. use \"heading:\" to only search headings, easily the user (e.g. use \"heading:\" to only search headings, easily
creating a custom command that saves the user from having to type creating a custom command that saves the user from having to type
@ -171,28 +107,30 @@ single predicate)."
(let ((table (make-hash-table :test #'equal)) (let ((table (make-hash-table :test #'equal))
(disambiguations (make-hash-table :test #'equal)) (disambiguations (make-hash-table :test #'equal))
(window-width (window-width)) (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 (cl-labels (;; (debug-message
;; (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args)) ;; (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args))
(action () (action
(font-lock-ensure (pos-bol) (pos-eol)) () (font-lock-ensure (point-at-bol) (point-at-eol))
;; This function needs to handle multiple candidates per ;; FIXME: We want the fontified heading, and `org-heading-components' returns it
;; call, so we loop over a list of values by default. ;; without properties, so we have to use `org-get-heading', which added additional
(pcase-dolist (`(,string . ,marker) (funcall action-filter (funcall action))) ;; optional arguments in a certain Org version, so in those versions, it will
(when string ;; return priority cookies and comment strings.
(if (string-empty-p string) (let ((heading (org-link-display-format (org-entry-get (point) "ITEM"))))
(if (string-empty-p heading)
;; A heading's string can be empty, but we can't use one because it ;; 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 ;; 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 ;; likely to indicate an unnoticed mistake or corruption in the
;; file: so display a warning and don't record it as a candidate. ;; 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)) (warn "Empty heading at %S in %S" (point) (buffer-name))
(when (gethash string table) (when (gethash heading table)
;; Disambiguate string (even adding the path isn't enough, because that could ;; Disambiguate heading (even adding the path isn't enough, because that could
;; also be duplicated). ;; also be duplicated).
(if-let ((suffix (gethash string disambiguations))) (if-let ((suffix (gethash heading disambiguations)))
(setf string (format "%s <%s>" string (cl-incf suffix))) (setf heading (format "%s <%s>" heading (cl-incf suffix)))
(setf string (format "%s <%s>" string (puthash string 2 disambiguations))))) (setf heading (format "%s <%s>" heading (puthash heading 2 disambiguations)))))
(puthash (propertize string 'org-marker marker) marker table))))) (let ((marker (point-marker)))
(puthash (propertize heading 'org-marker marker) marker table)))))
(path (marker) (path (marker)
(org-with-point-at marker (org-with-point-at marker
(let* ((path (thread-first (org-get-outline-path nil t) (let* ((path (thread-first (org-get-outline-path nil t)
@ -202,8 +140,8 @@ single predicate)."
(concat "\\" (string-join (reverse path) "\\")) (concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/"))))) (concat "/" (string-join path "/")))))
formatted-path))) formatted-path)))
(todo (marker) (todo
(if-let (it (org-entry-get marker "TODO")) (marker) (if-let (it (org-entry-get marker "TODO"))
(concat (propertize it 'face (org-get-todo-face it)) " ") (concat (propertize it 'face (org-get-todo-face it)) " ")
"")) ""))
(affix (completions) (affix (completions)
@ -211,7 +149,7 @@ single predicate)."
(cl-loop for completion in completions (cl-loop for completion in completions
for marker = (get-text-property 0 'org-marker completion) for marker = (get-text-property 0 'org-marker completion)
for prefix = (todo marker) for prefix = (todo marker)
for suffix = (concat (funcall path marker) " " (funcall snippet marker)) for suffix = (concat (path marker) " " (snippet marker))
collect (list completion prefix suffix))) collect (list completion prefix suffix)))
(annotate (candidate) (annotate (candidate)
;; (debug-message "ANNOTATE:%S" candidate) ;; (debug-message "ANNOTATE:%S" candidate)
@ -219,7 +157,15 @@ single predicate)."
;; Using `while-no-input' here doesn't make it as responsive as, ;; 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 ;; e.g. Helm while typing, but it seems to help a little when using the
;; org-rifle-style snippets. ;; org-rifle-style snippets.
(or (funcall snippet (get-text-property 0 'org-marker candidate)) ""))) (or (snippet (get-text-property 0 'org-marker candidate)) "")))
(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) (group (candidate transform)
(pcase transform (pcase transform
(`nil (buffer-name (marker-buffer (get-text-property 0 'org-marker candidate)))) (`nil (buffer-name (marker-buffer (get-text-property 0 'org-marker candidate))))
@ -234,19 +180,9 @@ single predicate)."
(collection (input _pred flag) (collection (input _pred flag)
(pcase flag (pcase flag
('metadata (list 'metadata ('metadata (list 'metadata
(cons 'category 'org-heading)
(cons 'group-function #'group) (cons 'group-function #'group)
(cons 'affixation-function #'affix) (cons 'affixation-function #'affix)
(cons 'annotation-function #'annotate) (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 (`t
;; (debug-message "COLLECTION:t INPUT:%S KEYS:%S" ;; (debug-message "COLLECTION:t INPUT:%S KEYS:%S"
;; input (hash-table-keys table)) ;; input (hash-table-keys table))
@ -303,25 +239,23 @@ single predicate)."
(clrhash disambiguations) (clrhash disambiguations)
(when query-filter (when query-filter
(setf input (funcall query-filter input))) (setf input (funcall query-filter input)))
(pcase org-ql-completing-read-snippet-function
('org-ql-completing-read--snippet-regexp
(setf query-tokens (setf query-tokens
;; Remove any tokens that specify predicates or are too short. ;; Remove any tokens that specify predicates or are too short.
(--select (not (or (string-match-p (rx bos (1+ (not (any ":"))) ":") it) (--select (not (or (string-match-p (rx bos (1+ (not (any ":"))) ":") it)
(< (length it) org-ql-completing-read-snippet-minimum-token-length))) (< (length it) org-ql-completing-read-snippet-minimum-token-length)))
(split-string input nil t (rx blank))) (split-string input nil t (rx space)))
org-ql-completing-read-input-regexp snippet-regexp
(when query-tokens (when query-tokens
;; Limiting each context word to 15 characters prevents ;; Limiting each context word to 15 characters prevents
;; excessively long, non-word strings from ending up in ;; excessively long, non-word strings from ending up in
;; snippets, which can adversely affect performance. ;; snippets, which can adversely affect performance.
(rx-to-string `(seq (optional (repeat 1 3 (repeat 1 15 (not space)) (0+ space))) (rx-to-string `(seq (optional (repeat 1 3 (repeat 1 15 (not space)) (0+ space)))
bow (or ,@query-tokens) (0+ (not space)) bow (or ,@query-tokens) (0+ (not space))
(optional (repeat 1 3 (0+ space) (repeat 1 15 (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) (org-ql-select buffers-files (org-ql--query-string-to-sexp input)
:narrow narrowp
:action #'action)))) :action #'action))))
(unless (listp buffers-files)
;; Since we map across this argument, we ensure it's a list.
(setf buffers-files (list buffers-files)))
;; NOTE: It seems that the `completing-read' machinery can call, abort, and re-call the ;; 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 ;; 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 ;; prepare an Org buffer when an Org file is loaded. This results in, e.g. the buffer being
@ -331,27 +265,13 @@ single predicate)."
;; `completing-read' machinery, which interrupts it, so we must work around this problem by ;; `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 ;; ensuring all of the BUFFERS-FILES are loaded and initialized before calling
;; `completing-read'. ;; `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) (mapc #'org-ql--ensure-buffer buffers-files)
(let* ((completion-styles '(org-ql-completing-read)) (let* ((completion-styles '(org-ql-completing-read))
(completion-styles-alist (cons (list 'org-ql-completing-read #'try #'all "Org QL Find") (completion-styles-alist (list (list 'org-ql-completing-read #'try #'all "Org QL Find")))
completion-styles-alist)) (selected (completing-read prompt #'collection nil t)))
(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)))))
;; (debug-message "SELECTED:%S KEYS:%S" selected (hash-table-keys table)) ;; (debug-message "SELECTED:%S KEYS:%S" selected (hash-table-keys table))
(or (gethash selected table) (or (gethash selected table)
;; If there are completions in the table, but none of them exactly match the user input ;; If there are completions in the table, but none of them exactly match the user input
@ -366,7 +286,7 @@ single predicate)."
(car (hash-table-values table)) (car (hash-table-values table))
(user-error "No results for input")))))) (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. "Return a snippet of the current entry.
Returns up to `org-ql-completing-read-snippet-length' characters." Returns up to `org-ql-completing-read-snippet-length' characters."
(save-excursion (save-excursion
@ -380,15 +300,15 @@ Returns up to `org-ql-completing-read-snippet-length' characters."
t t) t t)
50 nil nil t)))))) 50 nil nil t))))))
(defun org-ql-completing-read--snippet-regexp (&optional input-regexp) (defun org-ql-completing-read--snippet-regexp (regexp)
"Return a snippet of the current entry's matches for INPUT-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. ;; REGEXP may be nil if there are no qualifying tokens in the query.
(when input-regexp (when regexp
(save-excursion (save-excursion
(org-end-of-meta-data t) (org-end-of-meta-data t)
(unless (org-at-heading-p) (unless (org-at-heading-p)
(let* ((end (org-entry-end-position)) (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 "" concat (match-string 0) concat ""
do (goto-char (match-end 0))))) do (goto-char (match-end 0)))))
(unless (string-empty-p snippets) (unless (string-empty-p snippets)

View file

@ -1,6 +1,6 @@
;;; org-ql-find.el --- Find headings with completion using org-ql -*- lexical-binding: t; -*- ;;; 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> ;; Author: Adam Porter <adam@alphapapa.net>
@ -33,8 +33,6 @@
(require 'org-ql-search) (require 'org-ql-search)
(require 'org-ql-completing-read) (require 'org-ql-completing-read)
(declare-function org-ql--normalize-query "org-ql" t t)
;;;; Customization ;;;; Customization
(defgroup org-ql-find nil (defgroup org-ql-find nil
@ -51,21 +49,14 @@
See function `display-buffer'." See function `display-buffer'."
:type 'sexp) :type 'sexp)
;;;; Commands ;;;; Functions
;;;###autoload ;;;###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: ")) (prompt "Find entry: "))
"Go to an Org entry in BUFFERS-FILES selected by searching entries with `org-ql'. "Go to an Org entry in BUFFERS-FILES selected by searching entries with `org-ql'.
Interactively, search the buffers and files relevant to the Interactively, with universal prefix, select multiple buffers to
current buffer (i.e. in `org-agenda-mode', the value of search with completion and PROMPT.
`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.
QUERY-PREFIX may be a string to prepend to the query (e.g. use QUERY-PREFIX may be a string to prepend to the query (e.g. use
\"heading:\" to only search headings, easily creating a custom \"heading:\" to only search headings, easily creating a custom
@ -76,35 +67,28 @@ types is filtered before execution (e.g. it could replace spaces
with commas to turn multiple tokens, which would normally be with commas to turn multiple tokens, which would normally be
treated as multiple predicates, into multiple arguments to a treated as multiple predicates, into multiple arguments to a
single predicate)." single predicate)."
(interactive (list (org-ql-find--buffers (interactive
:read-buffer-p (equal '(16) current-prefix-arg)) (list (if current-prefix-arg
:widen current-prefix-arg)) (mapcar #'get-buffer
(let ((marker (save-restriction (completing-read-multiple
(when (and widen (equal (current-buffer) buffers-files)) "Buffers: "
(widen)) (cl-loop for buffer in (buffer-list)
(org-ql-completing-read buffers-files when (eq 'org-mode (buffer-local-value 'major-mode buffer))
:narrowp (not widen) 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-prefix query-prefix
:query-filter query-filter :query-filter query-filter
:prompt prompt)))) :prompt prompt)))
(set-buffer (or (buffer-base-buffer (marker-buffer marker)) (set-buffer (marker-buffer marker))
(marker-buffer marker)))
(pop-to-buffer (current-buffer) org-ql-find-display-buffer-action)
(without-restriction
(goto-char marker) (goto-char marker)
(run-hook-with-args 'org-ql-find-goto-hook)) (display-buffer (current-buffer) org-ql-find-display-buffer-action)
(when (equal (current-buffer) (marker-buffer marker)) (select-window (get-buffer-window (current-buffer)))
;; Ensure point is still within visible portion of buffer. (If (run-hook-with-args 'org-ql-find-goto-hook)))
;; `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))))))
;;;###autoload ;;;###autoload
(defun org-ql-refile (marker) (defun org-ql-refile (marker)
@ -122,8 +106,6 @@ which see (but only the files are used)."
((and (pred listp) files) files))) ((and (pred listp) files) files)))
(list files-spec))))))) (list files-spec)))))))
(list (org-ql-completing-read buffers-files :prompt "Refile to: ")))) (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 (org-refile nil nil
;; The RFLOC argument: ;; The RFLOC argument:
(list (list
@ -131,11 +113,11 @@ which see (but only the files are used)."
(org-with-point-at marker (org-with-point-at marker
(nth 4 (org-heading-components))) (nth 4 (org-heading-components)))
;; File ;; File
(buffer-file-name buffer) (buffer-file-name (marker-buffer marker))
;; nil ;; nil
nil nil
;; Position ;; Position
marker)))) marker)))
;;;###autoload ;;;###autoload
(defun org-ql-find-in-agenda () (defun org-ql-find-in-agenda ()
@ -149,85 +131,6 @@ which see (but only the files are used)."
(interactive) (interactive)
(org-ql-find (org-ql-search-directories-files))) (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) (provide 'org-ql-find)
;;; org-ql-find.el ends here ;;; org-ql-find.el ends here

View file

@ -1,7 +1,5 @@
;;; org-ql-search.el --- Search commands for org-ql -*- lexical-binding: t; -*- ;;; org-ql-search.el --- Search commands for org-ql -*- lexical-binding: t; -*-
;; Copyright (C) 2019-2023 Adam Porter
;; Author: Adam Porter <adam@alphapapa.net> ;; Author: Adam Porter <adam@alphapapa.net>
;; Url: https://github.com/alphapapa/org-ql ;; Url: https://github.com/alphapapa/org-ql
@ -40,8 +38,6 @@
(require 'org-ql) (require 'org-ql)
(require 'org-ql-view) (require 'org-ql-view)
(declare-function org-ql--normalize-query "org-ql" t t)
;;;; Compatibility ;;;; Compatibility
(defalias 'org-ql-search--link-heading-search-string (defalias 'org-ql-search--link-heading-search-string
@ -60,16 +56,6 @@
((fboundp 'org-store-link-props) #'org-store-link-props) ((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")))) (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 ;;;; Variables
(defvar org-ql-block-header nil (defvar org-ql-block-header nil
@ -138,10 +124,10 @@ Runs `org-occur-hook' after making the sparse tree."
query)))) query))))
(org-ql-select buffer query (org-ql-select buffer query
:action (lambda () :action (lambda ()
(org-ql--org-show-context 'occur-tree) (org-show-context 'occur-tree)
(cl-incf num-results))) (cl-incf num-results)))
(unless org-sparse-tree-open-archived-trees (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) (run-hooks 'org-occur-hook)
(unless (get-buffer-window buffer) (unless (get-buffer-window buffer)
(pop-to-buffer buffer)) (pop-to-buffer buffer))
@ -186,7 +172,7 @@ necessary."
(interactive (list (org-ql-view--complete-buffers-files) (interactive (list (org-ql-view--complete-buffers-files)
(read-string "Query: " (when org-ql-view-query (read-string "Query: " (when org-ql-view-query
(format "%S" 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) :super-groups (org-ql-view--complete-super-groups)
:sort (org-ql-view--complete-sort))) :sort (org-ql-view--complete-sort)))
;; NOTE: Using `with-temp-buffer' is a hack to work around the fact that `make-local-variable' ;; 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)) (symbol (symbol-value super-groups))
(list super-groups)))) (list super-groups))))
(setf strings (org-super-agenda--group-items strings)))) (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 ;;;###autoload
(defun org-ql-search-block (args) (defun org-ql-search-block (query)
"Insert items for ARGS into current buffer. "Insert items for QUERY into current buffer.
Intended to be used as a user-defined function in QUERY should be an `org-ql' query form. Intended to be used as a
`org-agenda-custom-commands'. ARGS corresponds to the `match' user-defined function in `org-agenda-custom-commands'. QUERY
item in the custom command form. It should be a list of corresponds to the `match' item in the custom command form.
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'.
Like other agenda block commands, it searches files returned by Like other agenda block commands, it searches files returned by
function `org-agenda-files'. Inserts a newline after the block. function `org-agenda-files'. Inserts a newline after the block.
If `org-ql-block-header' is non-nil, it is used as the header 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." automatically from the query."
(pcase-let ((`(,query . ,(map :header :sort)) args) (let (narrow-p old-beg old-end)
(narrow-p) (old-beg) (old-end))
(when-let* ((from (pcase org-agenda-restrict (when-let* ((from (pcase org-agenda-restrict
('nil (org-agenda-files nil 'ifmode)) ('nil (org-agenda-files nil 'ifmode))
(_ (prog1 org-agenda-restrict (_ (prog1 org-agenda-restrict
@ -254,7 +235,7 @@ automatically from the query."
(narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end)))))) (narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end))))))
(items (org-ql-select from query (items (org-ql-select from query
:action 'element-with-markers :action 'element-with-markers
:narrow narrow-p :sort sort))) :narrow narrow-p)))
(when narrow-p (when narrow-p
;; Restore buffer's previous restrictions. ;; Restore buffer's previous restrictions.
(with-current-buffer from (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 ;; 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. ;; 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))) ;; (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 (org-ql-view--header-line-format
(insert (org-add-props (or org-ql-block-header header
(org-ql-view--header-line-format
:buffers-files from :query query)) :buffers-files from :query query))
nil 'face 'org-agenda-structure) "\n") nil 'face 'org-agenda-structure) "\n")
;; Calling `org-agenda-finalize' should be unnecessary, because in a "series" agenda, ;; 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. ;; `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. ;; 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 (->> items
(-map #'org-ql-view--format-element) (-map #'org-ql-view--format-element)
org-agenda-finalize-entries org-agenda-finalize-entries
insert)) insert)
(insert "\n")))) (insert "\n"))))
;;;###autoload ;;;###autoload
@ -363,15 +335,14 @@ this (must be a single line in the Org buffer):
(org-element-property (intern (concat ":" (upcase property))) element))))) (org-element-property (intern (concat ":" (upcase property))) element)))))
(elements (org-ql-query :from (current-buffer) (elements (org-ql-query :from (current-buffer)
:where query :where query
:select '(org-ql-view--resolve-element-properties :select '(org-element-headline-parser (line-end-position))
(org-element-headline-parser (line-end-position)))
:order-by sort))) :order-by sort)))
(when take (when take
(setf elements (cl-etypecase take (setf elements (cl-etypecase take
((and integer (satisfies cl-minusp)) (-take-last (abs take) elements)) ((and integer (satisfies cl-minusp)) (-take-last (abs take) elements))
(integer (-take take elements))))) (integer (-take take elements)))))
(cl-labels ((format-element (element) (cl-labels ((format-element
(string-join (cl-loop for column in columns (element) (string-join (cl-loop for column in columns
collect (or (pcase-exhaustive column collect (or (pcase-exhaustive column
((pred symbolp) ((pred symbolp)
(funcall (alist-get column format-fns) element)) (funcall (alist-get column format-fns) element))

View file

@ -1,7 +1,5 @@
;;; org-ql-view.el --- Agenda-like view based on org-ql -*- lexical-binding: t; -*- ;;; 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> ;; Author: Adam Porter <adam@alphapapa.net>
;; Url: https://github.com/alphapapa/org-ql ;; 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-ql-search" t)
(declare-function org-ql-search--org-link-store-props "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 'dash)
(require 's) (require 's)
@ -57,18 +54,7 @@
(defface org-ql-view-due-date (defface org-ql-view-due-date
'((t (:slant italic :weight bold))) '((t (:slant italic :weight bold)))
"Face for due dates in `org-ql-view' views." "Face for due dates in `org-ql-view' views."
:group 'org-ql-view) :group 'org-ql)
(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)
;;;; Variables ;;;; Variables
@ -249,12 +235,6 @@ See info node `(elisp)Cyclic Window Ordering'."
(sexp :tag "org-super-agenda grouping expression") (sexp :tag "org-super-agenda grouping expression")
(variable :tag "Variable holding 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 ;;;; Commands
;;;###autoload ;;;###autoload
@ -322,10 +302,10 @@ SLOT is passed to `display-buffer-in-side-window', which see."
(defun org-ql-view-switch () (defun org-ql-view-switch ()
"Switch to view at point." "Switch to view at point."
(interactive) (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) (unless (string-empty-p key)
(ov-clear :org-ql-view-selected) (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)) 'face '(:weight bold :inherit highlight))
(org-ql-view key)))) (org-ql-view key))))
@ -389,7 +369,7 @@ update search arguments."
(defun org-ql-view-customize () (defun org-ql-view-customize ()
"Customize view at point in `org-ql-view-sidebar' buffer." "Customize view at point in `org-ql-view-sidebar' buffer."
(interactive) (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) (customize-option 'org-ql-views)
(search-forward (concat "Name: " key)))) (search-forward (concat "Name: " key))))
@ -426,7 +406,7 @@ update search arguments."
(defvar bookmark-make-record-function) (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. "Display STRING in `org-ql-view' BUFFER.
BUFFER may be a buffer, or a string naming a buffer, which is BUFFER may be a buffer, or a string naming a buffer, which is
@ -464,9 +444,7 @@ subsequent refreshing of the buffer: `org-ql-view-buffers-files',
;; Clear buffer, insert entries, etc. ;; Clear buffer, insert entries, etc.
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(erase-buffer) (erase-buffer)
(dolist (string strings) (insert string "\n")
(insert string "\n"))
(insert "\n")
(pop-to-buffer (current-buffer) org-ql-view-display-buffer-action) (pop-to-buffer (current-buffer) org-ql-view-display-buffer-action)
(org-agenda-finalize) (org-agenda-finalize)
(goto-char (point-min)))))) (goto-char (point-min))))))
@ -476,8 +454,7 @@ subsequent refreshing of the buffer: `org-ql-view-buffers-files',
If TITLE, prepend it to the header." If TITLE, prepend it to the header."
(let* ((title (if title (let* ((title (if title
(concat (propertize "View:" 'face 'transient-argument) (concat (propertize "View:" 'face 'transient-argument)
(propertize title 'face 'org-ql-view-title) title " ")
" ")
"")) ""))
(query-formatted (when query (query-formatted (when query
(org-ql-view--format-query query))) (org-ql-view--format-query query)))
@ -496,7 +473,6 @@ If TITLE, prepend it to the header."
(org-ql-view--font-lock-string 'emacs-lisp-mode) (org-ql-view--font-lock-string 'emacs-lisp-mode)
(s-truncate available-width)) (s-truncate available-width))
'help-echo buffers-files-formatted)))) 'help-echo buffers-files-formatted))))
(add-face-text-property 0 (length query-propertized) 'org-ql-view-query 'append query-propertized)
(concat title (concat title
(when query (propertize "Query:" 'face 'transient-argument)) (when query (propertize "Query:" 'face 'transient-argument))
(when query query-propertized) (when query query-propertized)
@ -528,22 +504,6 @@ with human-readable strings."
(font-lock-ensure) (font-lock-ensure)
(buffer-string)))) (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) (defun org-ql-view--buffer (&optional name)
"Return `org-ql-view' buffer, creating it if necessary. "Return `org-ql-view' buffer, creating it if necessary.
If NAME is non-nil, return buffer by that name instead of using If NAME is non-nil, return buffer by that name instead of using
@ -573,8 +533,8 @@ dates in the past, and negative for dates in the future."
(defun org-ql-view-bookmark-make-record () (defun org-ql-view-bookmark-make-record ()
"Return a bookmark record for the current Org QL View buffer." "Return a bookmark record for the current Org QL View buffer."
(cl-labels ((file-nameize (b-f) (cl-labels ((file-nameize
(abbreviate-file-name (b-f) (abbreviate-file-name
(cl-typecase b-f (cl-typecase b-f
(string b-f) (string b-f)
(buffer (or (buffer-file-name b-f) (buffer (or (buffer-file-name b-f)
@ -586,7 +546,6 @@ dates in the past, and negative for dates in the future."
;; Replace buffers with their filenames, and signal error if any are not file-backed. ;; Replace buffers with their filenames, and signal error if any are not file-backed.
(setf plist (plist-put plist :buffers-files (setf plist (plist-put plist :buffers-files
(cl-etypecase buffers-files (cl-etypecase buffers-files
(symbol buffers-files)
(string buffers-files) (string buffers-files)
(buffer (file-nameize buffers-files)) (buffer (file-nameize buffers-files))
(list (mapcar #'file-nameize buffers-files))))) (list (mapcar #'file-nameize buffers-files)))))
@ -646,7 +605,6 @@ The optional, second argument is temporarily _IGNORED for
purposes of compatibility with changes in Org 9.4." purposes of compatibility with changes in Org 9.4."
(require 'url-parse) (require 'url-parse)
(require 'url-util) (require 'url-util)
(declare-function url-path-and-query "url-parse")
(when (version<= "9.3" (org-version)) (when (version<= "9.3" (org-version))
;; Org 9.3+ makes a backward-incompatible change to link escaping. ;; 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 ;; I don't think it would be a good idea to try to guess whether
@ -661,7 +619,7 @@ purposes of compatibility with changes in Org 9.4."
(query (url-unhex-string query)) (query (url-unhex-string query))
(params (when params (url-parse-query-string params))) (params (when params (url-parse-query-string params)))
;; `url-parse-query-string' returns "improper" alists, which makes this awkward. ;; `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))) (read-value (read stored-string)))
;; Ensure the value is either a symbol or list of symbols (which excludes lambdas). ;; Ensure the value is either a symbol or list of symbols (which excludes lambdas).
(unless (or (symbolp read-value) (cl-every #'symbolp read-value)) (unless (or (symbolp read-value) (cl-every #'symbolp read-value))
@ -669,19 +627,17 @@ purposes of compatibility with changes in Org 9.4."
read-value)) read-value))
read-value)) read-value))
(org-super-agenda-allow-unsafe-groups nil) ; Disallow unsafe group selectors. (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))) (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))) (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)) (org-ql-view--expand-buffers-files (read it))
(current-buffer)))) (current-buffer))))
(unless (or (bufferp buffers-files) (unless (or (bufferp buffers-files)
(stringp buffers-files) (stringp buffers-files)
(cl-every #'stringp buffers-files)) (cl-every #'stringp buffers-files))
(error "CAUTION: Link not opened because unsafe buffers-files parameter detected: %s" 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) (when (or (listp query)
(string-match (rx bol (0+ space) "(") query)) (string-match (rx bol (0+ space) "(") query))
;; SAFETY: Query is in sexp form: ask for confirmation, because it could contain arbitrary code. ;; SAFETY: Query is in sexp form: ask for confirmation, because it could contain arbitrary code.
@ -705,17 +661,15 @@ When opened, the link searches the buffer it's opened from."
nil t nil nil "file link is in") nil t nil nil "file link is in")
("file link is in" nil) ("file link is in" nil)
("files currently searched" buffers-files))) ("files currently searched" buffers-files)))
(strings-or-file-buffers-p (thing) (strings-or-file-buffers-p
(cl-etypecase thing (thing) (cl-etypecase thing
(list (cl-every #'strings-or-file-buffers-p thing)) (list (cl-every #'strings-or-file-buffers-p thing))
(string thing) (string thing)
(buffer (or (buffer-file-name thing) (buffer (or (buffer-file-name thing)
;; TODO: Should indirect buffers be allowed? Maybe not, since their ;; TODO: Should indirect buffers be allowed? Maybe not, since their narrowing isn't preserved.
;; narrowing isn't preserved. On the other hand, it's possible to ;; On the other hand, it's possible to accidentally make a search view for an indirect buffer
;; accidentally make a search view for an indirect buffer that's ;; that's since been widened, and forcing the user to manually change that would be awkward,
;; since been widened, and forcing the user to manually change that ;; and trying to communicate the problem would be difficult, so maybe it's okay to allow it.
;; 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) (when (buffer-base-buffer thing)
(buffer-file-name (buffer-base-buffer thing)))))))) (buffer-file-name (buffer-base-buffer thing))))))))
(unless (strings-or-file-buffers-p org-ql-view-buffers-files) (unless (strings-or-file-buffers-p org-ql-view-buffers-files)
@ -750,8 +704,6 @@ When opened, the link searches the buffer it's opened from."
;; Transient manual is written very well, not everything is covered in ;; Transient manual is written very well, not everything is covered in
;; it, so I'm having to try to imitate examples from `magit-transient'. ;; it, so I'm having to try to imitate examples from `magit-transient'.
(require 'eieio-core)
(require 'transient) (require 'transient)
(defclass org-ql-view--variable (transient-variable) (defclass org-ql-view--variable (transient-variable)
@ -868,20 +820,6 @@ When opened, the link searches the buffer it's opened from."
;;;; Faces/properties ;;;; 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) (defun org-ql-view--format-element (element)
;; This essentially needs to do what `org-agenda-format-item' does, ;; 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. ;; which is a lot. We are a long way from that, but it's a start.
@ -891,7 +829,6 @@ returned by `org-element-parse-buffer'. If ELEMENT is nil,
return an empty string." return an empty string."
(if (not element) (if (not element)
"" ""
(setf element (org-ql-view--resolve-element-properties element))
(let* ((properties (cadr element)) (let* ((properties (cadr element))
;; Remove the :parent property, which so bloats the size of ;; Remove the :parent property, which so bloats the size of
;; the properties list that it makes it essentially ;; the properties list that it makes it essentially
@ -913,15 +850,10 @@ return an empty string."
;; Adding the relative due date property should probably be done explicitly and separately ;; 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). ;; (which would also make it easier to do it independently of faces, etc).
(title (--> (org-ql-view--add-faces element) (title (--> (org-ql-view--add-faces element)
(org-element-property :raw-value it))) (org-element-property :raw-value it)
;; TODO(B): Needs refactoring. A function like `org-ql-view--add-faces' (org-link-display-format it)))
;; 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))
(todo-keyword (-some--> (org-element-property :todo-keyword element) (todo-keyword (-some--> (org-element-property :todo-keyword element)
(org-ql-view--add-todo-face (org-ql-view--add-todo-face it)))
(substring-no-properties it))))
(tag-list (if org-use-tag-inheritance (tag-list (if org-use-tag-inheritance
;; MAYBE: Use our own variable instead of `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) (if-let ((marker (or (org-element-property :org-hd-marker element)
@ -942,21 +874,12 @@ return an empty string."
(s-join ":" it) (s-join ":" it)
(s-wrap it ":") (s-wrap it ":")
(org-add-props it nil 'face 'org-tag)))) (org-add-props it nil 'face 'org-tag))))
(category (or (org-element-property :CATEGORY element) ;; (category (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))))))
""))
(priority-string (-some->> (org-element-property :priority element) (priority-string (-some->> (org-element-property :priority element)
(char-to-string) (char-to-string)
(format "[#%s]") (format "[#%s]")
(org-ql-view--add-priority-face))) (org-ql-view--add-priority-face)))
(habit-property (org-with-point-at (or (org-element-property :org-hd-marker element) (habit-property (org-with-point-at (org-element-property :begin element)
(org-element-property :org-marker element))
(when (org-is-habit-p) (when (org-is-habit-p)
(org-habit-parse-todo)))) (org-habit-parse-todo))))
(due-string (pcase (org-element-property :relative-due-date element) (due-string (pcase (org-element-property :relative-due-date element)
@ -970,7 +893,6 @@ return an empty string."
(concat " " it) (concat " " it)
(org-add-props it properties (org-add-props it properties
'org-agenda-type 'search 'org-agenda-type 'search
'org-category category
'todo-state todo-keyword 'todo-state todo-keyword
'tags tag-list 'tags tag-list
'org-habit-p habit-property))))) 'org-habit-p habit-property)))))
@ -1056,9 +978,7 @@ property."
(deadline-day-number (org-time-string-to-absolute (deadline-day-number (org-time-string-to-absolute
(org-element-timestamp-interpreter deadline-date 'ignore))) (org-element-timestamp-interpreter deadline-date 'ignore)))
(difference-days (- today-day-number deadline-day-number)) (difference-days (- today-day-number deadline-day-number))
(relative-due-date (org-add-props (relative-due-date (org-add-props (org-ql-view--format-relative-date difference-days) nil
(concat org-ql-view-relative-deadline-prefix
(org-ql-view--format-relative-date difference-days)) nil
'help-echo (org-element-property :raw-value deadline-date))) '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: (todo-keyword (org-element-property :todo-keyword element))
;; FIXME: Unused for now: (done-p (member todo-keyword org-done-keywords)) ;; FIXME: Unused for now: (done-p (member todo-keyword org-done-keywords))
@ -1103,8 +1023,8 @@ the variable), \"org-directory\" if it matches the value of
current buffer. Otherwise BUFFERS-FILES is returned unchanged." current buffer. Otherwise BUFFERS-FILES is returned unchanged."
;; Used in `org-ql-view--complete-buffers-files' and ;; Used in `org-ql-view--complete-buffers-files' and
;; `org-ql-view--header-line-format'. ;; `org-ql-view--header-line-format'.
(cl-labels ((expand-files (list) (cl-labels ((expand-files
(--map (cl-typecase it (list) (--map (cl-typecase it
(string (expand-file-name it)) (string (expand-file-name it))
(otherwise it)) (otherwise it))
list))) list)))
@ -1129,8 +1049,8 @@ current buffer. Otherwise BUFFERS-FILES is returned unchanged."
(defun org-ql-view--complete-buffers-files () (defun org-ql-view--complete-buffers-files ()
"Return value for `org-ql-view-buffers-files' using completion." "Return value for `org-ql-view-buffers-files' using completion."
(cl-labels ((initial-input () (cl-labels ((initial-input
(when org-ql-view-buffers-files () (when org-ql-view-buffers-files
(org-ql-view--contract-buffers-files (org-ql-view--contract-buffers-files
org-ql-view-buffers-files)))) org-ql-view-buffers-files))))
(if (and org-ql-view-buffers-files (if (and org-ql-view-buffers-files

211
org-ql.el
View file

@ -1,11 +1,11 @@
;;; org-ql.el --- Org Query Language, search command, and agenda-like view -*- lexical-binding: t; -*- ;;; 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> ;; Author: Adam Porter <adam@alphapapa.net>
;; Url: https://github.com/alphapapa/org-ql ;; Url: https://github.com/alphapapa/org-ql
;; Version: 0.9-pre ;; Version: 0.7.3
;; 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")) ;; 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 ;; Keywords: hypermedia, outlines, Org, agenda
;;; License: ;;; License:
@ -43,7 +43,6 @@
(require 'seq) (require 'seq)
(require 'subr-x) (require 'subr-x)
(require 'compat)
(require 'dash) (require 'dash)
(require 'map) (require 'map)
(require 'ts) (require 'ts)
@ -96,12 +95,6 @@ Necessary because of backward-incompatible changes in Org
`org-bracket-link-regexp' was marked as an obsolete alias for it, `org-bracket-link-regexp' was marked as an obsolete alias for it,
but the match groups were changed, so they are not compatible.") 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 ;;;; Variables
(defvar org-ql--today nil) (defvar org-ql--today nil)
@ -157,9 +150,10 @@ This list should not contain any duplicates."))
(defvar org-ql-regexp-part-ts-date (defvar org-ql-regexp-part-ts-date
(rx (repeat 4 digit) "-" (repeat 2 digit) "-" (repeat 2 digit) (rx (repeat 4 digit) "-" (repeat 2 digit) "-" (repeat 2 digit)
;; Day of week ;; Day of week
(optional " " (1+ (or alpha punct)))) (optional " " (1+ alpha)))
"Matches the inner, date part of an Org timestamp, both active and inactive. "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 (defvar org-ql-regexp-part-ts-repeaters
;; Repeaters (not sure if the colon is necessary, but it's in the org.el one) ;; Repeaters (not sure if the colon is necessary, but it's in the org.el one)
@ -169,8 +163,7 @@ Used to build other timestamp regexps.")
Includes leading space character.") Includes leading space character.")
(defvar org-ql-regexp-part-ts-time (defvar org-ql-regexp-part-ts-time
(rx " " (repeat 1 2 digit) ":" (repeat 2 digit) (rx " " (repeat 1 2 digit) ":" (repeat 2 digit))
(optional "-" (repeat 1 2 digit) ":" (repeat 2 digit)))
"Matches the inner, time part of an Org timestamp (i.e. HH:MM). "Matches the inner, time part of an Org timestamp (i.e. HH:MM).
Includes leading space character. Used to build other timestamp Includes leading space character. Used to build other timestamp
regexps.") regexps.")
@ -292,11 +285,6 @@ Matches with or without time.")
:link '(custom-manual "(org-ql)Usage") :link '(custom-manual "(org-ql)Usage")
:link '(url-link "https://github.com/alphapapa/org-ql")) :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 (defcustom org-ql-ask-unsafe-queries t
"Ask before running a query that could run arbitrary code. "Ask before running a query that could run arbitrary code.
Org QL queries in sexp form can contain arbitrary expressions. Org QL queries in sexp form can contain arbitrary expressions.
@ -814,24 +802,25 @@ respectively."
(and "\\" (0+ "\\\\") (any "[]")) (and "\\" (0+ "\\\\") (any "[]"))
(and (1+ "\\") (not (any "[]"))))))) (and (1+ "\\") (not (any "[]")))))))
(cl-labels (cl-labels
((no-desc (match) ((no-desc
(rx-to-string `(seq (or bol (1+ blank)) (match) (rx-to-string `(seq (or bol (1+ blank))
"[[" ,link-target-part (regexp ,match) ,link-target-part "[[" ,link-target-part (regexp ,match) ,link-target-part
"]]"))) "]]")))
(match-both (description target) (match-both
(description target)
(rx-to-string `(seq (or bol (1+ blank)) (rx-to-string `(seq (or bol (1+ blank))
"[[" ,link-target-part (regexp ,target) ,link-target-part "[[" ,link-target-part (regexp ,target) ,link-target-part
"][" (*? anything) (regexp ,description) (*? anything) "][" (*? anything) (regexp ,description) (*? anything)
"]]"))) "]]")))
;; Note that these actually allow empty descriptions ;; Note that these actually allow empty descriptions
;; or targets, depending on what they are matching. ;; or targets, depending on what they are matching.
(match-desc (match) (match-desc
(rx-to-string `(seq (or bol (1+ blank)) (match) (rx-to-string `(seq (or bol (1+ blank))
"[[" ,link-target-part "[[" ,link-target-part
"][" (*? anything) (regexp ,match) (*? anything) "][" (*? anything) (regexp ,match) (*? anything)
"]]"))) "]]")))
(match-target (match) (match-target
(rx-to-string `(seq (or bol (1+ blank)) (match) (rx-to-string `(seq (or bol (1+ blank))
"[[" ,link-target-part (regexp ,match) ,link-target-part "[[" ,link-target-part (regexp ,match) ,link-target-part
"][" (*? anything) "][" (*? anything)
"]]")))) "]]"))))
@ -961,7 +950,7 @@ value of `org-ql-predicates')."
(term (or (and negation (list positive-term) (term (or (and negation (list positive-term)
;; This is a bit confusing, but it seems to work. There's probably a better way. ;; This is a bit confusing, but it seems to work. There's probably a better way.
`(pred -- (list 'not (car pred)))) `(pred -- (list 'not (car pred))))
positive-term empty-quote)) positive-term))
(positive-term (or (and predicate-with-args `(pred args -- (cons (intern pred) args))) (positive-term (or (and predicate-with-args `(pred args -- (cons (intern pred) args)))
(and predicate-without-args `(pred -- (list (intern pred)))) (and predicate-without-args `(pred -- (list (intern pred))))
(and plain-string `(s -- (list org-ql-default-predicate s))))) (and plain-string `(s -- (list org-ql-default-predicate s)))))
@ -974,12 +963,6 @@ value of `org-ql-predicates')."
(keyword (substring (+ (not (or separator "=" "\"" (syntax-class whitespace))) (any)))) (keyword (substring (+ (not (or separator "=" "\"" (syntax-class whitespace))) (any))))
(quoted-arg "\"" (substring (+ (not (or separator "\"")) (any))) "\"") (quoted-arg "\"" (substring (+ (not (or separator "\"")) (any))) "\"")
(unquoted-arg (substring (+ (not (or separator "\"" (syntax-class whitespace))) (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 "!") (negation "!")
(separator "," ))) (separator "," )))
(closure (lambda (input &optional boolean) (closure (lambda (input &optional boolean)
@ -1000,10 +983,7 @@ value of `org-ql-predicates')."
;; have to borrow some code. It ends up that we only have to ;; have to borrow some code. It ends up that we only have to
;; borrow this `with-peg-rules' call, which isn't too bad. ;; borrow this `with-peg-rules' call, which isn't too bad.
(eval `(with-peg-rules ,pexs (eval `(with-peg-rules ,pexs
(peg-run (peg ,(caar pexs)) (peg-run (peg ,(caar pexs)) #'peg-signal-failure))))))
(lambda (failures)
(when org-ql-signal-peg-failure
(peg-signal-failure failures)))))))))
(pcase parsed-sexp (pcase parsed-sexp
(`(,one-predicate) one-predicate) (`(,one-predicate) one-predicate)
(`(,_ . ,_) (cons boolean (reverse parsed-sexp))) (`(,_ . ,_) (cons boolean (reverse parsed-sexp)))
@ -1118,10 +1098,7 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'."
;; Only one preamble is allowed ;; Only one preamble is allowed
element) element)
(pcase element (pcase element
(`(or ,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)
,@preamble-patterns ,@preamble-patterns
@ -1144,7 +1121,7 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'."
(byte-compile 'org-ql--query-preamble))) (byte-compile 'org-ql--query-preamble)))
(cl-defmacro org-ql-defpred (name args docstring &key body preambles normalizers coalesce) (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 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 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 created for NAME, not for aliases, so a normalizer should be used
@ -1189,7 +1166,7 @@ to variables bound in the pattern:
:case-fold Bound to `case-fold-search' around the regexp search. :case-fold Bound to `case-fold-search' around the regexp search.
:query Expression which should replace the query expression, :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 regexp is insufficient to determine whether a
heading matches, in which case the predicate's body heading matches, in which case the predicate's body
needs to be tested on the heading). If the regexp needs to be tested on the heading). If the regexp
@ -1216,7 +1193,7 @@ e.g. a predicate takes keyword arguments, so arguments to
multiple calls can't be simply appended.) multiple calls can't be simply appended.)
For convenience, within the `pcase' patterns, the symbol 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 pattern matching any of the predicate's name and aliases. For
example, if NAME were: example, if NAME were:
@ -1224,13 +1201,13 @@ example, if NAME were:
Then if NORMALIZERS were: Then if NORMALIZERS were:
((\\=`(,predicate-names . ,args) ((`(,predicate-names . ,args)
\\=`(heading ,@args))) `(heading ,@args)))
It would be expanded to: It would be expanded to:
((\\=`(,(or \\='heading \\='h) . ,args) ((`(,(or 'heading 'h) . ,args)
\\=`(heading ,@args)))" `(heading ,@args)))"
;; FIXME: Update defpred tutorial to include :coalesce. ;; FIXME: Update defpred tutorial to include :coalesce.
;; NOTE: The debug form works, completely! For example, use `edebug-defun' ;; NOTE: The debug form works, completely! For example, use `edebug-defun'
@ -1464,16 +1441,40 @@ Org effort string, like \"5\" or \"0:05\"."
(list :regexp (rx bol (0+ space) ":STYLE:" (1+ space) "habit" (0+ space) eol)))) (list :regexp (rx bol (0+ space) ":STYLE:" (1+ space) "habit" (0+ space) eol))))
:body (org-is-habit-p)) :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. "Return non-nil if current entry's heading matches all STRINGS.
Matching is done case-insensitively." Matching is done case-insensitively."
:coalesce t :coalesce t
:normalizers ((`(,predicate-names . ,args) :normalizers ((`(,predicate-names . ,args)
;; NOTE: Each string argument must be converted to a regexp ;; "h" alias.
;; for testing by the body, so we just normalize to the `(heading ,@args)))
;; `heading-regexp' predicate, leaving this predicate as ;; TODO: Adjust regexp to avoid matching in tag list.
;; one that merely regexp-quotes its arguments. :preambles ((`(,predicate-names)
`(heading-regexp ,@(mapcar #'regexp-quote args))))) ;; 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) (org-ql-defpred (heading-regexp h*) (&rest regexps)
"Return non-nil if current entry's heading matches all REGEXPS (regexp strings). "Return non-nil if current entry's heading matches all REGEXPS (regexp strings).
@ -1537,8 +1538,7 @@ COMPARATOR may be `<', `<=', `>', or `>='."
;; is "h:" while the user is typing. ;; is "h:" while the user is typing.
(list :regexp (rx bol (1+ "*") " ") (list :regexp (rx bol (1+ "*") " ")
:case-fold t)) :case-fold t))
((and `(,predicate-names ,comparator-or-num ,num) (`(,predicate-names ,comparator-or-num ,num)
(guard (numberp num)))
(let ((repeat (pcase comparator-or-num (let ((repeat (pcase comparator-or-num
('< `(repeat 1 ,(1- num) "*")) ('< `(repeat 1 ,(1- num) "*"))
('<= `(repeat 1 ,num "*")) ('<= `(repeat 1 ,num "*"))
@ -1547,8 +1547,7 @@ COMPARATOR may be `<', `<=', `>', or `>='."
((pred integerp) `(repeat ,comparator-or-num ,num "*"))))) ((pred integerp) `(repeat ,comparator-or-num ,num "*")))))
(list :regexp (rx-to-string `(seq bol ,repeat " ") t) (list :regexp (rx-to-string `(seq bol ,repeat " ") t)
:case-fold t))) :case-fold t)))
((and `(,predicate-names ,num) (`(,predicate-names ,num)
(guard (numberp num)))
(list :regexp (rx-to-string `(seq bol (repeat ,num "*") " ") t) (list :regexp (rx-to-string `(seq bol (repeat ,num "*") " ") t)
:case-fold t))) :case-fold t)))
;; NOTE: It might be necessary to take into account `org-odd-levels'; see docstring for ;; NOTE: It might be necessary to take into account `org-odd-levels'; see docstring for
@ -1626,15 +1625,11 @@ any link is found."
(or (null description) (or (null description)
(string-match-p description (match-string org-ql-link-description-group))))) (string-match-p description (match-string org-ql-link-description-group)))))
(_ (if (and description target) (_ (if (and description target)
(and (and (match-string 1) (and (string-match-p target (match-string 1))
(string-match-p target (match-string 1))) (string-match-p description (match-string org-ql-link-description-group)))
(and (match-string org-ql-link-description-group) (or (string-match-p description-or-target (match-string 1))
(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 (string-match-p description-or-target
(match-string org-ql-link-description-group)))))))))) (match-string org-ql-link-description-group)))))))))
(org-ql-defpred (rifle smart) (&rest strings) (org-ql-defpred (rifle smart) (&rest strings)
"Return non-nil if each of strings is found in the entry or its outline path. "Return non-nil if each of strings is found in the entry or its outline path.
@ -1808,62 +1803,34 @@ interpreted as nil or non-nil)."
;; predicate test for whether an entry has local ;; predicate test for whether an entry has local
;; properties when no arguments are given. ;; properties when no arguments are given.
(list 'property "")) (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 ;; Convert keyword property arguments to strings. Non-sexp
;; queries result in keyword property arguments (because to do ;; queries result in keyword property arguments (because to do
;; otherwise would require ugly special-casing in the parsing). ;; otherwise would require ugly special-casing in the parsing).
(when (keywordp property) (when (keywordp property)
(setf property (substring (symbol-name property) 1))) (setf property (substring (symbol-name property) 1)))
(list 'property property value (list 'property property value
:inherit (cond ((plist-member plist :inherit) (plist-get plist :inherit)) :inherit (if (plist-member plist :inherit)
((listp org-use-property-inheritance) ''selective) (plist-get plist :inherit)
(t org-use-property-inheritance)))) 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)))))))
;; MAYBE: Should case folding be disabled for properties? What about values? ;; MAYBE: Should case folding be disabled for properties? What about values?
;; MAYBE: Support (property) without args. ;; MAYBE: Support (property) without args.
;; NOTE: When inheritance is enabled, the preamble can't be used, ;; NOTE: When inheritance is enabled, the preamble can't be used,
;; which will make the search slower. ;; which will make the search slower.
:preambles (((and `(,predicate-names ,property ,value) :preambles ((`(,predicate-names ,property ,value . ,(map :inherit))
(guard (atom value)))
;; We do NOT return nil, because the predicate still needs to be tested, ;; 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. ;; because the regexp could match a string not inside a property drawer.
(list :regexp (rx-to-string `(seq bol (0+ space) ":" ,property ":" (list :regexp (unless inherit
(1+ space) ,value (0+ space) eol)) (rx-to-string `(seq bol (0+ space) ":" ,property ":"
(1+ space) ,value (0+ space) eol)))
:query query)) :query query))
((and `(,predicate-names ,property ,value . ,plist) (`(,predicate-names ,property . ,(map :inherit))
(guard (keywordp (car plist)))) ;; We do NOT return nil, because the predicate still needs to be tested,
;; 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. ;; because the regexp could match a string not inside a property drawer.
;; NOTE: The preamble only matches if there appears to be a value. ;; NOTE: The preamble only matches if there appears to be a value.
;; A line like ":ID: " without any other text does not match. ;; 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) (rx-to-string `(seq bol (0+ space) ":" ,property ":" (1+ space)
(minimal-match (1+ not-newline)) eol))) (minimal-match (1+ not-newline)) eol)))
:query query))) :query query)))
@ -1875,7 +1842,7 @@ interpreted as nil or non-nil)."
;; Check that PROPERTY exists ;; Check that PROPERTY exists
(org-ql--value-at (org-ql--value-at
(point) (lambda () (point) (lambda ()
(org-entry-get (point) property inherit)))) (org-entry-get (point) property))))
(_ (_
;; Check that PROPERTY has VALUE. ;; Check that PROPERTY has VALUE.
@ -1992,7 +1959,7 @@ language. Matching is done case-insensitively."
(point))) (point)))
(contents-end (progn (contents-end (progn
(goto-char (match-end 0)) (goto-char (match-end 0))
(pos-bol)))) (point-at-bol))))
(cl-loop for re in regexps (cl-loop for re in regexps
do (goto-char contents-beg) do (goto-char contents-beg)
always (re-search-forward re contents-end t)))))))))) always (re-search-forward re contents-end t))))))))))
@ -2114,7 +2081,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
:normalizers ((`(,predicate-names :normalizers ((`(,predicate-names
;; Avoid infinitely compiling already-compiled functions. ;; Avoid infinitely compiling already-compiled functions.
,(and query (guard (not (byte-code-function-p query))))) ,(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)))) (`(,predicate-names) '(ancestors (lambda () t))))
:body :body
(org-with-wide-buffer (org-with-wide-buffer
@ -2126,7 +2093,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
:normalizers ((`(,predicate-names :normalizers ((`(,predicate-names
;; Avoid infinitely compiling already-compiled functions. ;; Avoid infinitely compiling already-compiled functions.
,(and query (guard (not (byte-code-function-p query))))) ,(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)))) (`(,predicate-names) '(parent (lambda () t))))
:body :body
(org-with-wide-buffer (org-with-wide-buffer
@ -2497,7 +2464,7 @@ Deadline is considered before scheduled."
A and B are Org timestamp elements." A and B are Org timestamp elements."
(cl-macrolet ((ts (ts) (cl-macrolet ((ts (ts)
`(when ,ts `(when ,ts
(org-ql--org-timestamp-format ,ts "%s")))) (org-timestamp-format ,ts "%s"))))
(let* ((a-ts (ts a)) (let* ((a-ts (ts a))
(b-ts (ts b))) (b-ts (ts b)))
(cond ((and a-ts b-ts) (cond ((and a-ts b-ts)
@ -2547,8 +2514,8 @@ If QUERY can't be converted to a string, return nil."
thereis (or (eq symbol element) thereis (or (eq symbol element)
(and (listp element) (and (listp element)
(contains-p symbol element))))) (contains-p symbol element)))))
(format-args (args) (format-args
(let (non-paired paired next-keyword) (args) (let (non-paired paired next-keyword)
(cl-loop for arg in args (cl-loop for arg in args
do (cond (next-keyword (push (cons next-keyword arg) paired) do (cond (next-keyword (push (cons next-keyword arg) paired)
(setf next-keyword nil)) (setf next-keyword nil))
@ -2558,14 +2525,14 @@ If QUERY can't be converted to a string, return nil."
(nreverse (--map (format "%s=%s" (car it) (cdr it)) (nreverse (--map (format "%s=%s" (car it) (cdr it))
paired))) paired)))
","))) ",")))
(format-atom (atom) (format-atom
(cl-typecase atom (atom) (cl-typecase atom
(string (if (string-match (rx space) atom) (string (if (string-match (rx space) atom)
(format "%S" atom) (format "%S" atom)
(format "%s" atom))) (format "%s" atom)))
(t (format "%s" atom)))) (t (format "%s" atom))))
(format-form (form) (format-form
(pcase form (form) (pcase form
(`(not . (,rest)) (concat "!" (format-form rest))) (`(not . (,rest)) (concat "!" (format-form rest)))
(`(priority . ,_) (format-priority form)) (`(priority . ,_) (format-priority form))
;; FIXME: Convert (src) queries to non-sexp form...someday... ;; FIXME: Convert (src) queries to non-sexp form...someday...
@ -2576,18 +2543,18 @@ If QUERY can't be converted to a string, return nil."
((guard (= 1 (length args))) (format "%s" (car args))) ((guard (= 1 (length args))) (format "%s" (car args)))
(_ (format-args args))))) (_ (format-args args)))))
(format "%s:%s" pred args-string))))) (format "%s:%s" pred args-string)))))
(format-and (form) (format-and
(pcase-let* ((`(and . ,rest) form)) (form) (pcase-let* ((`(and . ,rest) form))
(string-join (mapcar #'format-form rest) " "))) (string-join (mapcar #'format-form rest) " ")))
(format-priority (form) (format-priority
(pcase-let* ((`(priority . ,rest) form) (form) (pcase-let* ((`(priority . ,rest) form)
(args (pcase rest (args (pcase rest
(`(,(and comparator (or '< '<= '> '>= '=)) ,letter) (`(,(and comparator (or '< '<= '> '>= '=)) ,letter)
(priority-letters comparator letter)) (priority-letters comparator letter))
(_ rest)))) (_ rest))))
(concat "priority:" (string-join args ",")))) (concat "priority:" (string-join args ","))))
(priority-letters (comparator letter) (priority-letters
(let* ((char (string-to-char (upcase (symbol-name letter)))) (comparator letter) (let* ((char (string-to-char (upcase (symbol-name letter))))
(numeric-priorities '(?A ?B ?C)) (numeric-priorities '(?A ?B ?C))
;; NOTE: The comparator inversion is intentional. ;; NOTE: The comparator inversion is intentional.
(others (pcase comparator (others (pcase comparator

View file

@ -26,7 +26,6 @@ and saved views.
* Installation:: * Installation::
* Usage:: * Usage::
* Changelog:: * Changelog::
* Development::
* Notes:: * Notes::
* License:: * License::
@ -49,7 +48,6 @@ Usage
Commands Commands
* org-ql-find:: * org-ql-find::
* org-ql-open-link::
* org-ql-refile:: * org-ql-refile::
* org-ql-search:: * org-ql-search::
* helm-org-ql:: * helm-org-ql::
@ -73,19 +71,6 @@ Functions / Macros
Changelog Changelog
* 0.9-pre: 09-pre.
* 0.8.10: 0810.
* 0.8.9: 089.
* 0.8.8: 088.
* 0.8.7: 087.
* 0.8.6: 086.
* 0.8.5: 085.
* 0.8.4: 084.
* 0.8.3: 083.
* 0.8.2: 082.
* 0.8.1: 081.
* 0.8: 08.
* 0.7.4: 074.
* 0.7.3: 073. * 0.7.3: 073.
* 0.7.2: 072. * 0.7.2: 072.
* 0.7.1: 071. * 0.7.1: 071.
@ -116,14 +101,6 @@ Changelog
* 0.2: 02. * 0.2: 02.
* 0.1: 01. * 0.1: 01.
0.9-pre
* helm-org-ql: helm-org-ql (1).
Development
* Copyright assignment::
Notes Notes
* Comparison with Org Agenda searches:: * Comparison with Org Agenda searches::
@ -136,7 +113,7 @@ File: README.info, Node: Contents, Next: Screenshots, Prev: Top, Up: Top
1 Contents 1 Contents
********** **********
• • • • • • • •
 
File: README.info, Node: Screenshots, Next: Installation, Prev: Contents, Up: Top File: README.info, Node: Screenshots, Next: Installation, Prev: Contents, Up: Top
@ -229,7 +206,6 @@ File: README.info, Node: Commands, Next: Queries, Up: Usage
* Menu: * Menu:
* org-ql-find:: * org-ql-find::
* org-ql-open-link::
* org-ql-refile:: * org-ql-refile::
* org-ql-search:: * org-ql-search::
* helm-org-ql:: * helm-org-ql::
@ -239,7 +215,7 @@ File: README.info, Node: Commands, Next: Queries, Up: Usage
* org-ql-sparse-tree:: * org-ql-sparse-tree::
 
File: README.info, Node: org-ql-find, Next: org-ql-open-link, Up: Commands File: README.info, Node: org-ql-find, Next: org-ql-refile, Up: Commands
4.1.1 org-ql-find 4.1.1 org-ql-find
----------------- -----------------
@ -250,40 +226,13 @@ _Note: These commands use ._
completion facilities with an Org QL query: completion facilities with an Org QL query:
org-ql-find searches in the current buffer. 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-agenda searches in (org-agenda-files).
org-ql-find-in-org-directory searches in org-directory. org-ql-find-in-org-directory searches in org-directory.
Note that these commands are compatible with Embark
(https://github.com/oantolin/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.
 
File: README.info, Node: org-ql-open-link, Next: org-ql-refile, Prev: org-ql-find, Up: Commands File: README.info, Node: org-ql-refile, Next: org-ql-search, Prev: org-ql-find, Up: Commands
4.1.2 org-ql-open-link 4.1.2 org-ql-refile
----------------------
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.

File: README.info, Node: org-ql-refile, Next: org-ql-search, Prev: org-ql-open-link, Up: Commands
4.1.3 org-ql-refile
------------------- -------------------
This command refiles the current Org entry to one selected by searching This command refiles the current Org entry to one selected by searching
@ -293,7 +242,7 @@ with Org QL completion. It searches files listed in
 
File: README.info, Node: org-ql-search, Next: helm-org-ql, Prev: org-ql-refile, Up: Commands File: README.info, Node: org-ql-search, Next: helm-org-ql, Prev: org-ql-refile, Up: Commands
4.1.4 org-ql-search 4.1.3 org-ql-search
------------------- -------------------
_Note: This command supports both sexp queries and ._ _Note: This command supports both sexp queries and ._
@ -333,15 +282,10 @@ This feature is experimental and not guaranteed to work correctly with
all commands. (It works to the extent it does because the appropriate all commands. (It works to the extent it does because the appropriate
text properties are placed on each item, imitating an Agenda buffer.) text properties are placed on each item, imitating an Agenda buffer.)
*Note:* Also, this buffer is compatible with Embark
(https://github.com/oantolin/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.
 
File: README.info, Node: helm-org-ql, Next: org-ql-view, Prev: org-ql-search, Up: Commands File: README.info, Node: helm-org-ql, Next: org-ql-view, Prev: org-ql-search, Up: Commands
4.1.5 helm-org-ql 4.1.4 helm-org-ql
----------------- -----------------
_Note: This command uses . It is available separately in the package _Note: This command uses . It is available separately in the package
@ -355,7 +299,7 @@ _Note: This command uses . It is available separately in the package
 
File: README.info, Node: org-ql-view, Next: org-ql-view-sidebar, Prev: helm-org-ql, Up: Commands File: README.info, Node: org-ql-view, Next: org-ql-view-sidebar, Prev: helm-org-ql, Up: Commands
4.1.6 org-ql-view 4.1.5 org-ql-view
----------------- -----------------
Choose and display a view stored in org-ql-views. Choose and display a view stored in org-ql-views.
@ -370,7 +314,7 @@ Choose and display a view stored in org-ql-views.
 
File: README.info, Node: org-ql-view-sidebar, Next: org-ql-view-recent-items, Prev: org-ql-view, Up: Commands File: README.info, Node: org-ql-view-sidebar, Next: org-ql-view-recent-items, Prev: org-ql-view, Up: Commands
4.1.7 org-ql-view-sidebar 4.1.6 org-ql-view-sidebar
------------------------- -------------------------
Show a sidebar window listing views stored in org-ql-views for easy Show a sidebar window listing views stored in org-ql-views for easy
@ -380,7 +324,7 @@ point, and press c to customize the view at point.
 
File: README.info, Node: org-ql-view-recent-items, Next: org-ql-sparse-tree, Prev: org-ql-view-sidebar, Up: Commands File: README.info, Node: org-ql-view-recent-items, Next: org-ql-sparse-tree, Prev: org-ql-view-sidebar, Up: Commands
4.1.8 org-ql-view-recent-items 4.1.7 org-ql-view-recent-items
------------------------------ ------------------------------
Show items in FILES from last DAYS days with timestamps of TYPE. Show items in FILES from last DAYS days with timestamps of TYPE.
@ -391,7 +335,7 @@ returned by the function org-agenda-files.
 
File: README.info, Node: org-ql-sparse-tree, Prev: org-ql-view-recent-items, Up: Commands File: README.info, Node: org-ql-sparse-tree, Prev: org-ql-view-recent-items, Up: Commands
4.1.9 org-ql-sparse-tree 4.1.8 org-ql-sparse-tree
------------------------ ------------------------
Arguments: (query &key keep-previous (buffer (current-buffer))) Arguments: (query &key keep-previous (buffer (current-buffer)))
@ -543,8 +487,9 @@ Arguments are listed next to predicate names, where applicable.
Return non-nil if current entry has PROPERTY (a string), and Return non-nil if current entry has PROPERTY (a string), and
optionally VALUE (a string). If INHERIT is nil, only match optionally VALUE (a string). If INHERIT is nil, only match
entries with PROPERTY set on the entry; if t, also match entries entries with PROPERTY set on the entry; if t, also match entries
with inheritance. If INHERIT is not specified, use the value of with inheritance. If INHERIT is not specified, use the Boolean
org-use-property-inheritance, which see. value of org-use-property-inheritance, which see (i.e. it is
only interpreted as nil or non-nil).
regexp (&rest regexps) regexp (&rest regexps)
Return non-nil if current entry matches all of REGEXPS (regexp Return non-nil if current entry matches all of REGEXPS (regexp
strings). Matches against entire entry, from beginning of its strings). Matches against entire entry, from beginning of its
@ -1035,7 +980,7 @@ File: README.info, Node: Tips, Prev: Links, Up: Usage
(https://github.com/alphapapa/burly.el). (https://github.com/alphapapa/burly.el).
 
File: README.info, Node: Changelog, Next: Development, Prev: Usage, Up: Top File: README.info, Node: Changelog, Next: Notes, Prev: Usage, Up: Top
5 Changelog 5 Changelog
*********** ***********
@ -1048,19 +993,6 @@ releases.
* Menu: * Menu:
* 0.9-pre: 09-pre.
* 0.8.10: 0810.
* 0.8.9: 089.
* 0.8.8: 088.
* 0.8.7: 087.
* 0.8.6: 086.
* 0.8.5: 085.
* 0.8.4: 084.
* 0.8.3: 083.
* 0.8.2: 082.
* 0.8.1: 081.
* 0.8: 08.
* 0.7.4: 074.
* 0.7.3: 073. * 0.7.3: 073.
* 0.7.2: 072. * 0.7.2: 072.
* 0.7.1: 071. * 0.7.1: 071.
@ -1092,287 +1024,11 @@ releases.
* 0.1: 01. * 0.1: 01.
 
File: README.info, Node: 09-pre, Next: 0810, Up: Changelog File: README.info, Node: 073, Next: 072, Up: Changelog
5.1 0.9-pre 5.1 0.7.3
===========
*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.
* Menu:
* helm-org-ql: helm-org-ql (1).

File: README.info, Node: helm-org-ql (1), Up: 09-pre
5.1.1 helm-org-ql
-----------------
Tagged v0.6.2, fixing a compilation warning.

File: README.info, Node: 0810, Next: 089, Prev: 09-pre, Up: Changelog
5.2 0.8.10
==========
*Fixes*
• Command org-ql-refile uses the base buffer when refiling to an
indirect buffer. (#466
(https://github.com/alphapapa/org-ql/issues/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 John Wiegley
(https://github.com/jwiegley) for reporting.)

File: README.info, Node: 089, Next: 088, Prev: 0810, Up: Changelog
5.3 0.8.9
========= =========
*Fixes*
• Predicate property when called with argument form (property
"PROPERTY-NAME" :inherit t). (#460
(https://github.com/alphapapa/org-ql/issues/460). Thanks to
Stewmath (https://github.com/Stewmath) for reporting.)
• Predicate levels preamble optimizer allows expressions in place
of the numeric argument. (See #460
(https://github.com/alphapapa/org-ql/issues/460). Thanks to
Stewmath (https://github.com/Stewmath) for reporting.)
• Reading of view settings from Org links in upcoming Emacs version.
(#461 (https://github.com/alphapapa/org-ql/issues/461). Thanks to
Ola Nilsson (https://github.com/snogge) for help debugging, and for
maintaining Buttercup
(https://github.com/jorgenschaefer/emacs-buttercup).)
*Compatibility*
• Fix compilation error on Emacs 30. (#433
(https://github.com/alphapapa/org-ql/issues/433). Thanks to Akira
Komamura (https://github.com/akirak) and Stefan Monnier
(https://github.com/monnier).)

File: README.info, Node: 088, Next: 087, Prev: 089, Up: Changelog
5.4 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 Helms helm completion style, as
well as default Emacs completion in recursive minibuffers. #337
(https://github.com/alphapapa/org-ql/issues/337). Thanks to
Nicholas Vollmer (https://github.com/progfolio), viz
(https://github.com/9viz), and Karthik Chikmagalur
(https://github.com/karthink) for reporting and suggesting fixes.)
• Use of the context snippet function for org-ql-completing-read.
(#419 (https://github.com/alphapapa/org-ql/issues/419). Thanks to
tpeacock19 (https://github.com/tpeacock19) for reporting.)

File: README.info, Node: 087, Next: 086, Prev: 088, Up: Changelog
5.5 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 #237
(https://github.com/alphapapa/org-ql/pull/237) and #371
(https://github.com/alphapapa/org-ql/issues/371). Thanks to Ihor
Radchenko (https://github.com/yantar92).)
• Timestamps with day-of-the-week abbreviations are matched more
flexibly (allowing, e.g. a period in French locales). (See #429
(https://github.com/alphapapa/org-ql/discussions/429), #432
(https://github.com/alphapapa/org-ql/issues/432). Thanks to
Florian D. (https://github.com/neurolit) for reporting.)
• Command org-ql-search did not narrow properly when called
interactively.
*Compatibility*
• Dynamic blocks work with Org 9.7. (#431
(https://github.com/alphapapa/org-ql/issues/431). Thanks to Jez
Cope (https://github.com/jezcope) for reporting.)

File: README.info, Node: 086, Next: 085, Prev: 087, Up: Changelog
5.6 0.8.6
=========
*Fixes*
• Bookmarking org-ql-view buffers when the buffers-files argument
is a symbol (like org-agenda-files).

File: README.info, Node: 085, Next: 084, Prev: 086, Up: Changelog
5.7 0.8.5
=========
*Fixes*
• Predicate heading incorrectly matched strings as regular
expressions, sometimes returning incorrect results. (See
discussion (https://github.com/alphapapa/org-ql/discussions/410).
Thanks to Alex Popescu (https://github.com/al3xandru) for
reporting.)
• Predicates ancestor and parent did not normalize their
sub-queries, sometimes returning incorrect results. (#365
(https://github.com/alphapapa/org-ql/issues/365). Thanks to
Gabriele Mongiano (https://github.com/kofm) for reporting.)

File: README.info, Node: 084, Next: 083, Prev: 085, Up: Changelog
5.8 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).

File: README.info, Node: 083, Next: 082, Prev: 084, Up: Changelog
5.9 0.8.3
=========
*Fixes*
• Command org-ql-find incorrectly moved point. (See #380
(https://github.com/alphapapa/org-ql/issues/380#issuecomment-1881913025).
Thanks to Omar Antolín Camarena (https://github.com/oantolin) for
reporting.)

File: README.info, Node: 082, Next: 081, Prev: 083, Up: Changelog
5.10 0.8.2
==========
*Fixes*
• Command org-ql-find incorrectly restored the buffer after jumping
when not using indirect buffers. (See #380
(https://github.com/alphapapa/org-ql/issues/380#issuecomment-1881913025).
Thanks to Bram Schoenmakers (https://github.com/bram85) for
reporting.)

File: README.info, Node: 081, Next: 08, Prev: 082, Up: Changelog
5.11 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 #282 (https://github.com/alphapapa/org-ql/issues/282).
Thanks to Jacob Boxerman (https://github.com/jakebox) for
reporting.)

File: README.info, Node: 08, Next: 074, Prev: 081, Up: Changelog
5.12 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 Embark (https://github.com/oantolin/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.) (#299 (https://github.com/alphapapa/org-ql/issues/299).
Thanks to Omar Antolín Camarena (https://github.com/oantolin),
Daniel Mendler (https://github.com/minad), and Akira Komamura
(https://github.com/akirak).)
• 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-agendas category-related selectors. (#363
(https://github.com/alphapapa/org-ql/issues/363). Thanks to
Gabriele Mongiano (https://github.com/kofm) for reporting.)
*Fixes*
• Predicate property correctly uses the value of
org-use-property-inheritance when not specified. (#346
(https://github.com/alphapapa/org-ql/pull/346), #356
(https://github.com/alphapapa/org-ql/issues/356). Thanks to Bram
Schoenmakers (https://github.com/bram85).)
*Compatibility*
• Emacs 27.1 or later is now required.
• Org v9.7s org-element API changes required some adjustments.
(#364 (https://github.com/alphapapa/org-ql/issues/364). Thanks to
several users for reporting, and to Ihor Radchenko
(https://github.com/yantar92) for his feedback.)

File: README.info, Node: 074, Next: 073, Prev: 08, Up: Changelog
5.13 0.7.4
==========
*Fixes*
• Ignore empty quoted strings in plain-string queries (#383
(https://github.com/alphapapa/org-ql/issues/383)).

File: README.info, Node: 073, Next: 072, Prev: 074, Up: Changelog
5.14 0.7.3
==========
*Fixes* *Fixes*
• Disable case-fold-search when collecting headings in outline • Disable case-fold-search when collecting headings in outline
paths. (Headings that started with a word that is also a to-do paths. (Headings that started with a word that is also a to-do
@ -1388,8 +1044,8 @@ File: README.info, Node: 073, Next: 072, Prev: 074, Up: Changelog
 
File: README.info, Node: 072, Next: 071, Prev: 073, Up: Changelog File: README.info, Node: 072, Next: 071, Prev: 073, Up: Changelog
5.15 0.7.2 5.2 0.7.2
========== =========
*Fixes* *Fixes*
• Timestamp predicates are more tolerant of partial input (e.g. • Timestamp predicates are more tolerant of partial input (e.g.
@ -1409,8 +1065,8 @@ File: README.info, Node: 072, Next: 071, Prev: 073, Up: Changelog
 
File: README.info, Node: 071, Next: 07, Prev: 072, Up: Changelog File: README.info, Node: 071, Next: 07, Prev: 072, Up: Changelog
5.16 0.7.1 5.3 0.7.1
========== =========
*Fixes* *Fixes*
• Function org-ql-completing-read is more compatible with default • Function org-ql-completing-read is more compatible with default
@ -1428,12 +1084,13 @@ File: README.info, Node: 071, Next: 07, Prev: 072, Up: Changelog
 
File: README.info, Node: 07, Next: 063, Prev: 071, Up: Changelog File: README.info, Node: 07, Next: 063, Prev: 071, Up: Changelog
5.17 0.7 5.4 0.7
======== =======
*Added* *Added*
• Command org-ql-find, which jumps to entries selected using • Commands org-ql-find, org-ql-find-heading, and
Emacss built-in completion facilities and Org QL queries (like org-ql-find-path, which jump to entries selected using Emacss
built-in completion facilities and Org QL queries (like
helm-org-ql, but doesnt require Helm.). helm-org-ql, but doesnt require Helm.).
• Command org-ql-refile, which refiles the entry at point to one • Command org-ql-refile, which refiles the entry at point to one
selected using Org QL completion. selected using Org QL completion.
@ -1487,8 +1144,8 @@ File: README.info, Node: 07, Next: 063, Prev: 071, Up: Changelog
 
File: README.info, Node: 063, Next: 062, Prev: 07, Up: Changelog File: README.info, Node: 063, Next: 062, Prev: 07, Up: Changelog
5.18 0.6.3 5.5 0.6.3
========== =========
*Fixed* *Fixed*
• Non-sexp query parsing with updated version 1.0.1 of the peg • Non-sexp query parsing with updated version 1.0.1 of the peg
@ -1503,8 +1160,8 @@ File: README.info, Node: 063, Next: 062, Prev: 07, Up: Changelog
 
File: README.info, Node: 062, Next: 061, Prev: 063, Up: Changelog File: README.info, Node: 062, Next: 061, Prev: 063, Up: Changelog
5.19 0.6.2 5.6 0.6.2
========== =========
*Fixed* *Fixed*
link predicate when used in an ored query. (#279 link predicate when used in an ored query. (#279
@ -1514,8 +1171,8 @@ File: README.info, Node: 062, Next: 061, Prev: 063, Up: Changelog
 
File: README.info, Node: 061, Next: 06, Prev: 062, Up: Changelog File: README.info, Node: 061, Next: 06, Prev: 062, Up: Changelog
5.20 0.6.1 5.7 0.6.1
========== =========
*Fixed* *Fixed*
• In dynamic blocks, links to headings with statistics cookies were • In dynamic blocks, links to headings with statistics cookies were
@ -1532,8 +1189,8 @@ File: README.info, Node: 061, Next: 06, Prev: 062, Up: Changelog
 
File: README.info, Node: 06, Next: 052, Prev: 061, Up: Changelog File: README.info, Node: 06, Next: 052, Prev: 061, Up: Changelog
5.21 0.6 5.8 0.6
======== =======
*Added* *Added*
• Macro org-ql-defpred, used to define search predicates. (See • Macro org-ql-defpred, used to define search predicates. (See
@ -1599,8 +1256,8 @@ File: README.info, Node: 06, Next: 052, Prev: 061, Up: Changelog
 
File: README.info, Node: 052, Next: 051, Prev: 06, Up: Changelog File: README.info, Node: 052, Next: 051, Prev: 06, Up: Changelog
5.22 0.5.2 5.9 0.5.2
========== =========
*Fixed* *Fixed*
• Predicate links :target and :regexp-p arguments. (#220 • Predicate links :target and :regexp-p arguments. (#220
@ -1610,7 +1267,7 @@ File: README.info, Node: 052, Next: 051, Prev: 06, Up: Changelog
 
File: README.info, Node: 051, Next: 05, Prev: 052, Up: Changelog File: README.info, Node: 051, Next: 05, Prev: 052, Up: Changelog
5.23 0.5.1 5.10 0.5.1
========== ==========
*Fixed* *Fixed*
@ -1623,7 +1280,7 @@ File: README.info, Node: 051, Next: 05, Prev: 052, Up: Changelog
 
File: README.info, Node: 05, Next: 049, Prev: 051, Up: Changelog File: README.info, Node: 05, Next: 049, Prev: 051, Up: Changelog
5.24 0.5 5.11 0.5
======== ========
*Added* *Added*
@ -1664,7 +1321,7 @@ File: README.info, Node: 05, Next: 049, Prev: 051, Up: Changelog
 
File: README.info, Node: 049, Next: 048, Prev: 05, Up: Changelog File: README.info, Node: 049, Next: 048, Prev: 05, Up: Changelog
5.25 0.4.9 5.12 0.4.9
========== ==========
*Fixed* *Fixed*
@ -1675,7 +1332,7 @@ File: README.info, Node: 049, Next: 048, Prev: 05, Up: Changelog
 
File: README.info, Node: 048, Next: 047, Prev: 049, Up: Changelog File: README.info, Node: 048, Next: 047, Prev: 049, Up: Changelog
5.26 0.4.8 5.13 0.4.8
========== ==========
*Fixed* *Fixed*
@ -1687,7 +1344,7 @@ File: README.info, Node: 048, Next: 047, Prev: 049, Up: Changelog
 
File: README.info, Node: 047, Next: 046, Prev: 048, Up: Changelog File: README.info, Node: 047, Next: 046, Prev: 048, Up: Changelog
5.27 0.4.7 5.14 0.4.7
========== ==========
*Fixed* *Fixed*
@ -1700,7 +1357,7 @@ File: README.info, Node: 047, Next: 046, Prev: 048, Up: Changelog
 
File: README.info, Node: 046, Next: 045, Prev: 047, Up: Changelog File: README.info, Node: 046, Next: 045, Prev: 047, Up: Changelog
5.28 0.4.6 5.15 0.4.6
========== ==========
*Fixed* *Fixed*
@ -1713,7 +1370,7 @@ File: README.info, Node: 046, Next: 045, Prev: 047, Up: Changelog
 
File: README.info, Node: 045, Next: 044, Prev: 046, Up: Changelog File: README.info, Node: 045, Next: 044, Prev: 046, Up: Changelog
5.29 0.4.5 5.16 0.4.5
========== ==========
*Fixed* *Fixed*
@ -1725,7 +1382,7 @@ File: README.info, Node: 045, Next: 044, Prev: 046, Up: Changelog
 
File: README.info, Node: 044, Next: 043, Prev: 045, Up: Changelog File: README.info, Node: 044, Next: 043, Prev: 045, Up: Changelog
5.30 0.4.4 5.17 0.4.4
========== ==========
*Fixed* *Fixed*
@ -1737,7 +1394,7 @@ File: README.info, Node: 044, Next: 043, Prev: 045, Up: Changelog
 
File: README.info, Node: 043, Next: 042, Prev: 044, Up: Changelog File: README.info, Node: 043, Next: 042, Prev: 044, Up: Changelog
5.31 0.4.3 5.18 0.4.3
========== ==========
*Fixed* *Fixed*
@ -1747,7 +1404,7 @@ File: README.info, Node: 043, Next: 042, Prev: 044, Up: Changelog
 
File: README.info, Node: 042, Next: 041, Prev: 043, Up: Changelog File: README.info, Node: 042, Next: 041, Prev: 043, Up: Changelog
5.32 0.4.2 5.19 0.4.2
========== ==========
*Fixed* *Fixed*
@ -1756,7 +1413,7 @@ File: README.info, Node: 042, Next: 041, Prev: 043, Up: Changelog
 
File: README.info, Node: 041, Next: 04, Prev: 042, Up: Changelog File: README.info, Node: 041, Next: 04, Prev: 042, Up: Changelog
5.33 0.4.1 5.20 0.4.1
========== ==========
*Fixed* *Fixed*
@ -1766,7 +1423,7 @@ File: README.info, Node: 041, Next: 04, Prev: 042, Up: Changelog
 
File: README.info, Node: 04, Next: 032, Prev: 041, Up: Changelog File: README.info, Node: 04, Next: 032, Prev: 041, Up: Changelog
5.34 0.4 5.21 0.4
======== ========
_Note:_ The next release, 0.5, may include changes which will require _Note:_ The next release, 0.5, may include changes which will require
@ -1847,7 +1504,7 @@ automatically, as they will be pushed to the master branch when ready.
 
File: README.info, Node: 032, Next: 031, Prev: 04, Up: Changelog File: README.info, Node: 032, Next: 031, Prev: 04, Up: Changelog
5.35 0.3.2 5.22 0.3.2
========== ==========
*Fixed* *Fixed*
@ -1860,7 +1517,7 @@ File: README.info, Node: 032, Next: 031, Prev: 04, Up: Changelog
 
File: README.info, Node: 031, Next: 03, Prev: 032, Up: Changelog File: README.info, Node: 031, Next: 03, Prev: 032, Up: Changelog
5.36 0.3.1 5.23 0.3.1
========== ==========
*Fixed* *Fixed*
@ -1870,7 +1527,7 @@ File: README.info, Node: 031, Next: 03, Prev: 032, Up: Changelog
 
File: README.info, Node: 03, Next: 023, Prev: 031, Up: Changelog File: README.info, Node: 03, Next: 023, Prev: 031, Up: Changelog
5.37 0.3 5.24 0.3
======== ========
*Added* *Added*
@ -1938,7 +1595,7 @@ File: README.info, Node: 03, Next: 023, Prev: 031, Up: Changelog
 
File: README.info, Node: 023, Next: 022, Prev: 03, Up: Changelog File: README.info, Node: 023, Next: 022, Prev: 03, Up: Changelog
5.38 0.2.3 5.25 0.2.3
========== ==========
*Fixed* *Fixed*
@ -1948,7 +1605,7 @@ File: README.info, Node: 023, Next: 022, Prev: 03, Up: Changelog
 
File: README.info, Node: 022, Next: 021, Prev: 023, Up: Changelog File: README.info, Node: 022, Next: 021, Prev: 023, Up: Changelog
5.39 0.2.2 5.26 0.2.2
========== ==========
*Fixed* *Fixed*
@ -1959,7 +1616,7 @@ File: README.info, Node: 022, Next: 021, Prev: 023, Up: Changelog
 
File: README.info, Node: 021, Next: 02, Prev: 022, Up: Changelog File: README.info, Node: 021, Next: 02, Prev: 022, Up: Changelog
5.40 0.2.1 5.27 0.2.1
========== ==========
*Fixed* *Fixed*
@ -1969,7 +1626,7 @@ File: README.info, Node: 021, Next: 02, Prev: 022, Up: Changelog
 
File: README.info, Node: 02, Next: 01, Prev: 021, Up: Changelog File: README.info, Node: 02, Next: 01, Prev: 021, Up: Changelog
5.41 0.2 5.28 0.2
======== ========
*Added* *Added*
@ -2052,42 +1709,15 @@ File: README.info, Node: 02, Next: 01, Prev: 021, Up: Changelog
 
File: README.info, Node: 01, Prev: 02, Up: Changelog File: README.info, Node: 01, Prev: 02, Up: Changelog
5.42 0.1 5.29 0.1
======== ========
First tagged release. First tagged release.
 
File: README.info, Node: Development, Next: Notes, Prev: Changelog, Up: Top File: README.info, Node: Notes, Next: License, Prev: Changelog, Up: Top
6 Development 6 Notes
*************
Bug reports, feature requests, and suggestions are welcome. For
patches, see below.
* Menu:
* Copyright assignment::

File: README.info, Node: Copyright assignment, Up: Development
6.1 Copyright assignment
========================
While Org QL is currently distributed in MELPA, its intended
(https://github.com/alphapapa/org-ql/issues/409) 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
assign@gnu.org <assign@gnu.org> to request the appropriate form.

File: README.info, Node: Notes, Next: License, Prev: Development, Up: Top
7 Notes
******* *******
* Menu: * Menu:
@ -2098,7 +1728,7 @@ File: README.info, Node: Notes, Next: License, Prev: Development, Up: Top
 
File: README.info, Node: Comparison with Org Agenda searches, Next: org-sidebar, Up: Notes File: README.info, Node: Comparison with Org Agenda searches, Next: org-sidebar, Up: Notes
7.1 Comparison with Org Agenda searches 6.1 Comparison with Org Agenda searches
======================================= =======================================
Of course, queries like these can already be written with Org Agenda Of course, queries like these can already be written with Org Agenda
@ -2118,7 +1748,7 @@ todo:TO-READ, or in Lisp syntax, (and "lisp" (todo "TO-READ")).
 
File: README.info, Node: org-sidebar, Prev: Comparison with Org Agenda searches, Up: Notes File: README.info, Node: org-sidebar, Prev: Comparison with Org Agenda searches, Up: Notes
7.2 org-sidebar 6.2 org-sidebar
=============== ===============
This package is used by org-sidebar This package is used by org-sidebar
@ -2128,7 +1758,7 @@ customizable agenda-like view in a sidebar window.
 
File: README.info, Node: License, Prev: Notes, Up: Top File: README.info, Node: License, Prev: Notes, Up: Top
8 License 7 License
********* *********
GPLv3 GPLv3
@ -2137,90 +1767,73 @@ GPLv3
 
Tag Table: Tag Table:
Node: Top225 Node: Top225
Node: Contents2109 Node: Contents1805
Node: Screenshots2236 Node: Screenshots1928
Node: Installation2354 Node: Installation2046
Node: Quelpa2868 Node: Quelpa2560
Node: Helm support3396 Node: Helm support3088
Node: Usage3799 Node: Usage3491
Node: Commands4197 Node: Commands3889
Node: org-ql-find4662 Node: org-ql-find4333
Node: org-ql-open-link5570 Node: org-ql-refile4799
Node: org-ql-refile6425 Node: org-ql-search5122
Node: org-ql-search6753 Node: helm-org-ql6818
Node: helm-org-ql8684 Node: org-ql-view7196
Node: org-ql-view9062 Node: org-ql-view-sidebar7726
Node: org-ql-view-sidebar9592 Node: org-ql-view-recent-items8106
Node: org-ql-view-recent-items9972 Node: org-ql-sparse-tree8602
Node: org-ql-sparse-tree10468 Node: Queries9402
Node: Queries11268 Node: Non-sexp query syntax10519
Node: Non-sexp query syntax12385 Node: General predicates12278
Node: General predicates14144 Node: Ancestor/descendant predicates19265
Node: Ancestor/descendant predicates21069 Node: Date/time predicates20393
Node: Date/time predicates22197 Node: Functions / Macros23517
Node: Functions / Macros25321 Node: Agenda-like views23815
Node: Agenda-like views25619 Ref: Function org-ql-block23977
Ref: Function org-ql-block25781 Node: Listing / acting-on results25238
Node: Listing / acting-on results27042 Ref: Caching25446
Ref: Caching27250 Ref: Function org-ql-select26359
Ref: Function org-ql-select28163 Ref: Function org-ql-query28785
Ref: Function org-ql-query30589 Ref: Macro org-ql (deprecated)30559
Ref: Macro org-ql (deprecated)32363 Node: Custom predicates30874
Node: Custom predicates32678 Ref: Macro org-ql-defpred31098
Ref: Macro org-ql-defpred32902 Node: Dynamic block34539
Node: Dynamic block36343 Node: Links37263
Node: Links39067 Node: Tips37950
Node: Tips39754 Node: Changelog38274
Node: Changelog40078 Node: 07339065
Node: 09-pre41061 Node: 07239785
Node: helm-org-ql (1)41987 Node: 07140704
Node: 081042128 Node: 0741513
Node: 08942657 Node: 06344437
Node: 08843797 Node: 06244968
Node: 08744873 Node: 06145273
Node: 08646101 Node: 0645841
Node: 08546335 Node: 05248895
Node: 08446991 Node: 05149195
Node: 08347443 Node: 0549620
Node: 08247784 Node: 04951151
Node: 08148179 Node: 04851433
Node: 0848602 Node: 04751782
Node: 07451328 Node: 04652191
Node: 07351553 Node: 04552599
Node: 07252287 Node: 04452960
Node: 07153208 Node: 04353319
Node: 0754019 Node: 04253522
Node: 06356885 Node: 04153683
Node: 06257418 Node: 0453930
Node: 06157725 Node: 03258031
Node: 0658295 Node: 03158434
Node: 05261351 Node: 0358631
Node: 05161653 Node: 02361931
Node: 0562078 Node: 02262165
Node: 04963609 Node: 02162445
Node: 04863891 Node: 0262650
Node: 04764240 Node: 0166728
Node: 04664649 Node: Notes66829
Node: 04565057 Node: Comparison with Org Agenda searches66991
Node: 04465418 Node: org-sidebar67880
Node: 04365777 Node: License68159
Node: 04265980
Node: 04166141
Node: 0466388
Node: 03270489
Node: 03170892
Node: 0371089
Node: 02374389
Node: 02274623
Node: 02174903
Node: 0275108
Node: 0179186
Node: Development79287
Node: Copyright assignment79520
Node: Notes80110
Node: Comparison with Org Agenda searches80274
Node: org-sidebar81163
Node: License81442
 
End Tag Table End Tag Table

View file

@ -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./

View file

@ -3,7 +3,7 @@
;; Copyright (C) 2019 Adam Porter ;; Copyright (C) 2019 Adam Porter
;; Author: Adam Porter <adam@alphapapa.net> ;; 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 ;; 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 ;; it under the terms of the GNU General Public License as published by
@ -35,8 +35,6 @@
(require 'xr) (require 'xr)
(declare-function org-ql--normalize-query "org-ql" t t)
;;;; Variables ;;;; Variables
(defvar org-ql-test-buffer nil (defvar org-ql-test-buffer nil
@ -220,8 +218,7 @@ with keyword arg NOW in PLIST."
(it "coalesces a single AND clause that uses two predicates (and preserves predicate order)" (it "coalesces a single AND clause that uses two predicates (and preserves predicate order)"
(expect (org-ql--normalize-query '(and (rifle "foo") (rifle "bar") (expect (org-ql--normalize-query '(and (rifle "foo") (rifle "bar")
(heading "baz") (heading "buz"))) (heading "baz") (heading "buz")))
;; NOTE: `heading' is normalized to `heading-regexp'. :to-equal '(and (rifle :regexps '("foo" "bar")) (heading "baz" "buz"))))
:to-equal '(and (rifle :regexps '("foo" "bar")) (heading-regexp "baz" "buz"))))
(it "preserves independent OR clauses" (it "preserves independent OR clauses"
(expect (org-ql--normalize-query '(and (or (rifle "foo") (rifle "bar")) (expect (org-ql--normalize-query '(and (or (rifle "foo") (rifle "bar"))
(or (rifle "baz") (rifle "buz")))) (or (rifle "baz") (rifle "buz"))))
@ -256,18 +253,6 @@ with keyword arg NOW in PLIST."
(expect (org-ql--normalize-query "\"quoted phrase\"") (expect (org-ql--normalize-query "\"quoted phrase\"")
:to-equal '(rifle :regexps '("\"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" (describe "Plain strings"
(it "normalizes plain strings to the default predicate (using AND)" (it "normalizes plain strings to the default predicate (using AND)"
(expect (org-ql--normalize-query '(and "string1" "string2")) (expect (org-ql--normalize-query '(and "string1" "string2"))
@ -638,11 +623,6 @@ with keyword arg NOW in PLIST."
:to-equal (list :query t :to-equal (list :query t
:preamble (rx bol (repeat 2 4 "*") " ") :preamble (rx bol (repeat 2 4 "*") " ")
:preamble-case-fold t))) :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 "<" (it "<"
(expect (org-ql--query-preamble '(level < 3)) (expect (org-ql--query-preamble '(level < 3))
:to-equal (list :query t :to-equal (list :query t
@ -668,14 +648,6 @@ with keyword arg NOW in PLIST."
;; TODO: Other predicates. ;; 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" (it "Negated terms"
(expect (org-ql--query-string-to-sexp "todo: !todo:CHECK,SOMEDAY") (expect (org-ql--query-string-to-sexp "todo: !todo:CHECK,SOMEDAY")
:to-equal '(and (todo) (not (todo "CHECK" "SOMEDAY")))) :to-equal '(and (todo) (not (todo "CHECK" "SOMEDAY"))))
@ -1132,12 +1104,7 @@ with keyword arg NOW in PLIST."
'("Take over the world"))) '("Take over the world")))
(org-ql-it "with two arguments" (org-ql-it "with two arguments"
(org-ql-expect ('(heading "Take over" "world")) (org-ql-expect ('(heading "Take over" "world"))
'("Take over the 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)))
(describe "(heading-regexp)" (describe "(heading-regexp)"
(org-ql-it "with one argument" (org-ql-it "with one argument"
@ -1344,15 +1311,7 @@ with keyword arg NOW in PLIST."
(org-ql-it "with a property and a value" (org-ql-it "with a property and a value"
(org-ql-expect ('(property "agenda-group" "plans")) (org-ql-expect ('(property "agenda-group" "plans"))
'("Take over the universe" "Write a symphony"))) '("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"))))
(describe "(regexp)" (describe "(regexp)"
@ -1703,36 +1662,7 @@ with keyword arg NOW in PLIST."
(org-ql-expect ((org-ql--query-string-to-sexp "ts-active:with-time=")) (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")) '("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")) (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"))) '("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"))
)))
(describe "inactive" (describe "inactive"
@ -1871,20 +1801,7 @@ with keyword arg NOW in PLIST."
'("Visit Mars"))) '("Visit Mars")))
(org-ql-then (:now "2019-07-07") (org-ql-then (:now "2019-07-07")
(org-ql-expect ('(ts :on today)) (org-ql-expect ('(ts :on today))
nil)))) 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")))))
(describe "Compound queries" (describe "Compound queries"
@ -1919,8 +1836,8 @@ 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. ;; 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*"))) (let ((test-buffer (get-buffer-create "*test-org-ql*")))
(cl-flet ((open-link (link) (cl-flet ((open-link
(with-current-buffer test-buffer (link) (with-current-buffer test-buffer
(erase-buffer) (erase-buffer)
(org-mode) (org-mode)
(insert "* TODO Test heading \n\n") (insert "* TODO Test heading \n\n")
@ -1986,13 +1903,13 @@ with keyword arg NOW in PLIST."
(expression-link "[[org-ql-search:todo:?title%3D%28error%20%22UNSAFE%22%29]]")) (expression-link "[[org-ql-search:todo:?title%3D%28error%20%22UNSAFE%22%29]]"))
(it "Errors for a quoted lambda" (it "Errors for a quoted lambda"
(expect (open-link quoted-lambda-link) (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" (it "Errors for an unquoted lambda"
(expect (open-link unquoted-lambda-link) (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" (it "Errors for an expression"
(expect (open-link expression-link) (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" (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]]") :var ((quoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28error%20%22UNSAFE%22%29%29]]")
@ -2018,7 +1935,7 @@ with keyword arg NOW in PLIST."
(describe "View saving/loading" (describe "View saving/loading"
:var* ((temp-dir (make-temp-file "test-org-ql-" 'dir)) :var* ((temp-dir (make-temp-file "test-org-ql-" 'dir))
(temp-filenames (cl-loop for file in '("test1.org" "test2.org") (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 (file-contents (with-temp-buffer
(insert "#+TITLE: Test data\n\n" (insert "#+TITLE: Test data\n\n"
"* TODO Heading 1\n" "* TODO Heading 1\n"
@ -2081,7 +1998,8 @@ with keyword arg NOW in PLIST."
(when-let ((buffer (find-file-noselect filename 'nowarn))) (when-let ((buffer (find-file-noselect filename 'nowarn)))
(kill-buffer buffer)))) (kill-buffer buffer))))
(cl-flet ((var-after-bookmark-set-and-jump (var buffers-files query &key sort super-groups) (cl-flet ((var-after-bookmark-set-and-jump
(var buffers-files query &key sort super-groups)
(org-ql-search buffers-files query (org-ql-search buffers-files query
:super-groups super-groups :super-groups super-groups
:sort sort :title title :buffer view-buffer) :sort sort :title title :buffer view-buffer)
@ -2143,8 +2061,8 @@ with keyword arg NOW in PLIST."
(describe "Dynamic blocks" (describe "Dynamic blocks"
(describe "warn about sexp queries" (describe "warn about sexp queries"
(cl-flet ((test-dblock (&optional input) (cl-flet ((test-dblock
(with-current-buffer (get-buffer-create "*TEST DBLOCK*") (&optional input) (with-current-buffer (get-buffer-create "*TEST DBLOCK*")
(erase-buffer) (erase-buffer)
(org-mode) (org-mode)
(insert "* TODO Heading 1\n\n" (insert "* TODO Heading 1\n\n"
@ -2183,7 +2101,8 @@ with keyword arg NOW in PLIST."
(insert "* TODO Test heading\n\n") (insert "* TODO Test heading\n\n")
(org-mode))) (org-mode)))
(cl-flet* ((open-link-in (link buffer input) (cl-flet* ((open-link-in
(link buffer input)
;; Org REDUCED THE NUMBER OF ARGUMENTS TO `org-open-link-from-string'! That BREAKS BACKWARD ;; 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! ;; COMPATIBILITY! So I have to make my own function so these tests can work across Org versions!
(with-current-buffer buffer (with-current-buffer buffer
@ -2195,7 +2114,8 @@ with keyword arg NOW in PLIST."
(with-simulated-input input (with-simulated-input input
(org-open-at-point)))) (org-open-at-point))))
(var-after-link-save-open (var buffers-files query &key sort super-groups (var-after-link-save-open
(var buffers-files query &key sort super-groups
(buffer link-buffer) (store-input "RET") open-input) (buffer link-buffer) (store-input "RET") open-input)
(org-ql-search buffers-files query (org-ql-search buffers-files query
:super-groups super-groups :super-groups super-groups