Compare commits

...
Sign in to create a new pull request.

271 commits

Author SHA1 Message Date
Jiri Jakes
ed23480e4b Apply #459
Some checks failed
CI / build (27.1) (push) Has been cancelled
CI / build (27.2) (push) Has been cancelled
CI / build (28.1) (push) Has been cancelled
CI / build (28.2) (push) Has been cancelled
CI / build (29.1) (push) Has been cancelled
CI / build (29.2) (push) Has been cancelled
CI / build (29.3) (push) Has been cancelled
CI / build (29.4) (push) Has been cancelled
CI / build (snapshot) (push) Has been cancelled
2026-08-17 19:55:50 +08:00
Adam Porter
4b8330a683
Merge pull request #491 from alhassy/master
Docs: Remove grammatical typo from “org-ql-search-block”
2025-04-20 20:33:00 -05:00
Musa Al-hassy
9946299bec Docs: Remove grammatical typo from “org-ql-search-block” 2025-04-20 07:50:43 -04:00
Adam Porter
98c62ab0a6 Docs: Fix some predicate arguments
Reported-by: Trevoke <https://github.com/Trevoke>
2024-11-25 17:49:54 -06:00
Adam Porter
a5650e2be8 Merge: v0.8.10 2024-11-06 21:45:09 -06:00
Adam Porter
9c53c1bddf Release: v0.8.10 2024-11-06 21:43:13 -06:00
Adam Porter
c95bb8a3ef Fix: (org-ql-refile) Use base buffer
See #466.
2024-11-06 21:42:40 -06:00
Adam Porter
0e68cc9fac Fix: (link) Don't match against null groups
e.g. in a source block containing Bash shell code like:

  [[ -z $data ]]

The matched groups could be null, since it's not actually an Org link,
so calling STRING-MATCH-P on them would signal an error.

Reported-by: John Wiegley <jwiegley@gmail.com>
2024-11-06 21:42:27 -06:00
Adam Porter
3cfc77d2ff Meta: v0.8.10-pre 2024-11-06 21:42:10 -06:00
Adam Porter
b6f8a315e9 Fix: (org-ql-view--format-element) Font-lock Org syntax
Not sure why I overlooked this for so long (links already worked,
which is probably why).
2024-09-16 18:25:02 -05:00
Adam Porter
fff110acde Fix: (org-ql-refile) Use base buffer
Should probably release this in a v0.8.10.

See #466.
2024-09-16 13:42:17 -05:00
Adam Porter
d574b60551 Add: (defface org-ql-view-query) 2024-09-11 01:50:16 -05:00
Adam Porter
82f762e31c Add: (org-ql-view-relative-deadline-prefix) 2024-09-11 01:01:30 -05:00
Adam Porter
a3c0205a68 Fix: (defface org-ql-view-due-date) Customization group 2024-09-10 22:38:19 -05:00
Adam Porter
1c8c89f264 Add: (defface org-ql-view-title) Use in -view--header-line-format
Note that we also add a safety check in ORG-QL-VIEW--LINK-FOLLOW,
because the addition of a call to PROPERTIZE in
ORG-QL-VIEW--HEADER-LINE-FORMAT effectively removes what was
functioning as a safety check there (as CONCAT had been signaling an
error for the unsafe argument, whereas PROPERTIZE, which is called to
apply the new face, does not).  We also change the expected error in
the tests accordingly.
2024-09-10 22:37:19 -05:00
Adam Porter
c3519fb4a0 Merge: v0.8.9 2024-09-05 18:58:13 -05:00
Adam Porter
81281350d4 Release: v0.8.9 2024-09-05 18:56:47 -05:00
Adam Porter
e241354fd6 Fix: (org-ql--define-query-preamble-fn) Pcase pattern for Emacs 30
Now all tests and lints pass on Emacs versions 27.1-29.4, and the
current 30.0.50-ish snapshot build.

Note: This change was originally applied on master, but it seems
reasonable to apply it to this stable bugfix release now.

Fixes #433.

Reported-by: Akira Komamura <akira.komamura@gmail.com>
Co-developed-by: Stefan Monnier <monnier@iro.umontreal.ca>
2024-09-05 18:45:58 -05:00
Adam Porter
5ea97d2272 Fix: (level) Check number argument for preamble
This allows a query like this:

  (level <= (string-to-number (property PROPERTY)))

to proceed without signaling an error from ORG-QL--QUERY-PREAMBLE.

See #460.

Reported-by: Stewmath <https://github.com/Stewmath>
2024-09-05 18:35:19 -05:00
Adam Porter
3e7f48ad7e Meta: (test.yml) Also test on Emacs 29.1-29.4 2024-09-05 04:26:59 -05:00
Adam Porter
c77bade432 Tests: Fix filenames for CI (better)
This is much simpler.
2024-09-05 04:25:59 -05:00
Adam Porter
86d338729f Fix: (property) Calling like (property PROPERTY :inherit t)
Supporting this form isn't really required, since it violates the
CL-style argument parsing of CL-DEFUN, but it's convenient, and
probably saves some hair-pulling for users who are less familiar with
Elisp.

Fixes #460.

Reported-by: Stewmath <https://github.com/Stewmath>
2024-09-05 04:24:24 -05:00
Adam Porter
a373e812d0 Fix: (org-ql-view--link-follow) Reading link parameters
This is needed due to changes in Emacs 30, but this code was always
mistaken, and it just happened to work.

See <https://github.com/jorgenschaefer/emacs-buttercup/issues/247>.

Fixes #441.

Suggested-by: Ola Nilsson <ola.nilsson@gmail.com>
2024-09-04 23:48:34 -05:00
Adam Porter
bcb77b75cc Meta: v0.8.9-pre 2024-09-04 21:55:10 -05:00
Adam Porter
831a1d4736 Tests: Fix filenames for CI (better)
This is much simpler.
2024-09-04 21:47:53 -05:00
Adam Porter
f72feb8018 Revert "Tests: Fix filename tests for CI"
This reverts commit 611198155d.
2024-09-04 21:40:36 -05:00
Adam Porter
fcb4e3ee62 Merge: v0.8.8 2024-08-29 16:38:58 -05:00
Adam Porter
20c0e5a9a7 Release: v0.8.8 2024-08-29 16:37:08 -05:00
Adam Porter
fd82c83d49 Fix: (org-ql-defpred) Docstring quote escapes 2024-08-29 16:35:57 -05:00
Adam Porter
847c066d54 Comment: TODO 2024-08-29 16:31:42 -05:00
Adam Porter
04b3bd2664 Fix: Use of org-ql-completing-read--snippet-regexp
* org-ql-completing-read.el (org-ql-completing-read-snippet): Call
snippet function with argument
(org-ql-completing-read): Call snippet function passed in rather than
hard-coded function.
(org-ql-completing-read--snippet-simple): Accept optional, ignored argument.
(org-ql-completing-read--snippet-regexp): Make argument optional;
rename for clarity.

Fixes #419.

Reported-by: tpeacock19 <https://github.com/tpeacock19>
2024-08-29 16:31:07 -05:00
Adam Porter
3c1dd36990 Fix: (org-ql-completing-read) Binding of completion-styles-alist
Fixes #337.

Thanks to Nicholas Vollmer (@progfolio), viz (@9viz), and Karthik
Chikmagalur (@karthink) for reporting and suggesting fixes.
2024-08-29 14:39:55 -05:00
Adam Porter
357d533b75 Fix: (-view--format-element) Remove text properties from keywords
Modes like org-indent-mode and org-modern can add text properties to
to-do keywords in Org buffers, and those properties can "bleed over"
when org-element copies those regions into strings.  When those
strings are then displayed in an org-ql-view buffer, they can affect
how the keywords appear, e.g. having extra spaces prefixing them,
which breaks alignment.  We apply faces to the keywords ourselves, so
we don't need any properties from the source buffer.

Fixes #455.
2024-08-29 14:27:09 -05:00
Adam Porter
b6704c2814 Meta: v0.8.8-pre 2024-08-29 14:19:10 -05:00
Adam Porter
b0cb7618e9 Merge: Respect narrowing in org-ql-find 2024-08-26 07:19:18 -05:00
Adam Porter
cfe5300987 Docs: Update changelog 2024-08-26 07:19:09 -05:00
Adam Porter
ba49d0e3c7 Change: Respect narrowing in org-ql-find
This allows searching within a narrowed buffer with org-ql-find.
Using "C-u" searches the widened buffer, while "C-u C-u" prompts to
select the buffers to search (which previously worked with just
"C-u").
2024-08-26 07:14:31 -05:00
Adam Porter
b7d4856f92 Fix: (org-ql--define-query-preamble-fn) Pcase pattern for Emacs 30
Now all tests and lints pass on Emacs versions 27.1-29.4.  But on the
current Emacs snapshot build used in CI, Buttercup is hanging
indefinitely, which may be the same problem that led Guix to disable
the tests in
<https://git.savannah.gnu.org/cgit/guix.git/commit/gnu/packages/emacs-xyz.scm?id=3add97c7761e6c58a1d7405f417a49dda5f0a742>.
But I've no way of knowing whether that's a problem in org-ql (seems
unlikely), Emacs snapshot, or Buttercup.  It would be nice to solve
this before Emacs 30.1 is released, but I don't know how to peer
inside Buttercup to find out what it's hanging on.

Fixes #433.

Reported-by: Akira Komamura <akira.komamura@gmail.com>
Co-developed-by: Stefan Monnier <monnier@iro.umontreal.ca>
2024-06-27 09:32:34 -05:00
Adam Porter
611198155d Tests: Fix filename tests for CI
As the comment says, in CI the filenames are being abbreviated, which
I can't explain (it has not always been this way).  So we compare them
in abbreviated form.
2024-06-27 08:03:04 -05:00
Adam Porter
a8608f408b Fix/Meta: (makem.sh) Update to v0.7.1
This omits the obsolete Org ELPA repository, which apparently was
causing a very old version of Org to be installed, which appeared to
be causing Buttercup to inexplicably hang (sometimes, on some systems,
in some circumstances...?).

I don't know if this is related to Guix commit
<https://git.savannah.gnu.org/cgit/guix.git/commit/gnu/packages/emacs-xyz.scm?id=3add97c7761e6c58a1d7405f417a49dda5f0a742>,
which disables the tests due to Buttercup hanging, because Guix is not
running the tests through makem.sh.
2024-06-27 07:44:10 -05:00
Adam Porter
bfb0fbeec1 Tests: Declare requirement on xr
This was overlooked because makem.sh gets run with --install-linters,
which installs relint, which depends on xr.
2024-06-27 07:41:16 -05:00
Adam Porter
ccbd5b4594 Meta: (test.yml) Also test on Emacs 29.1-29.4 2024-06-27 07:02:09 -05:00
Adam Porter
d4faa21640 Fix: (data-ts.org) French day-of-week abbreviation
The test data in v0.8.7 was accidentally changed to the English
abbreviation (the perils of working on systems with differing
locales), but the feature works as intended.

See <ffc3477013 (r143566834)>.
2024-06-26 12:01:32 -05:00
Adam Porter
f24d93f038 Merge: v0.8.7 2024-06-26 11:32:45 -05:00
Adam Porter
c2b4404808 Release: v0.8.7 2024-06-26 11:31:17 -05:00
Adam Porter
b362dd68b0 Fix: (org-dblock-write:org-ql) Resolve element properties
Fixes <https://github.com/alphapapa/org-ql/issues/431>.

Reported-by: Jez Cope <https://github.com/jezcope>
2024-06-26 11:30:26 -05:00
Adam Porter
ffc3477013 Fix: (org-ql-regexp-part-ts-date) Allow punctuation in day-of-week
Fixes <https://github.com/alphapapa/org-ql/issues/432>.  Closes
<https://github.com/alphapapa/org-ql/pull/435>.

Reported-by: Florian D. <https://github.com/neurolit>
2024-06-26 11:20:28 -05:00
Adam Porter
914e64746f Fix: (org-ql-search) Interactive narrowing
Fixes #430.  Closes #436.

Reported-by: Akira Komamura <akira.komamura@gmail.com>
2024-06-26 10:41:58 -05:00
Adam Porter
4af08e37f9 Merge: Match timestamps with inner time ranges
Note that this is a form of basic, initial support.  More
comprehensive support will require refactoring of how timestamp values
are handled, which is deferred until a future version.

See <https://github.com/alphapapa/org-ql/pull/237> and
<https://github.com/alphapapa/org-ql/issues/371>.

Reported-by: Ihor Radchenko <yantar92@gmail.com>
2024-06-26 10:29:28 -05:00
Adam Porter
e3b956e54d Docs: Update changelog 2024-06-26 10:25:41 -05:00
Adam Porter
02b4213826 Tests: Timestamps with inner time ranges 2024-06-26 10:20:35 -05:00
Ihor Radchenko
0d9c46247d org-ql-regexp-part-ts-time: Fix for time intervals 2024-06-26 10:01:20 -05:00
Adam Porter
b8284c8f5c Meta: v0.8.7-pre 2024-06-26 09:58:11 -05:00
Adam Porter
5ef4364d0a Tidy: Compiler warnings 2024-06-22 05:00:03 -05:00
Adam Porter
d5269bb5e2 Comment: Add FIXME 2024-06-12 23:45:43 -05:00
Adam Porter
e9d08ca344 Tidy: (org-ql-defpred) Docstring
This does not solve the compilation warning, because that's caused by
the Pcase patterns at the end of the docstring, which the linter
falsely identifies as incorrect.
2024-06-12 23:33:36 -05:00
Adam Porter
f7c3a61e32 Fix: (helm-org-ql [v0.6.2]) Compilation warnings 2024-06-12 22:55:29 -05:00
Adam Porter
0f01f0a9d8 Tidy: Compilation warnings 2024-06-12 22:47:33 -05:00
Adam Porter
c9370982bf Merge: v0.8.6 2024-04-03 15:27:29 -05:00
Adam Porter
1f264bf464 Release: v0.8.6 2024-04-03 15:26:33 -05:00
Adam Porter
8bd73b4b46 Fix: (org-ql-view-bookmark-make-record) buffers-files as symbol 2024-04-03 15:25:58 -05:00
Adam Porter
d3f6dde344 Meta: v0.8.6-pre 2024-04-03 15:25:06 -05:00
Adam Porter
e41fe9018a Docs: Add development section 2024-02-21 20:00:39 -06:00
Adam Porter
f5cda3d127 Merge: v0.8.5 2024-02-21 05:47:17 -06:00
Adam Porter
bfff0b5517 Release: v0.8.5 2024-02-21 05:46:04 -06:00
Adam Porter
c90bae0eab Fix: (ancestors, parent) Normalize sub-queries
I'm not sure why calling the REC labeled function didn't correctly
normalize these sub-queries; it seemed to only normalize for one
round, leaving some queries incorrectly normalized.  But this fixes
it.

Fixes #365.

Reported-by: Gabriele Mongiano <https://github.com/kofm>
2024-02-21 05:45:46 -06:00
Adam Porter
b6efba9aeb Fix: (heading) Don't match strings as regexps
Reported-by: Alex Popescu <https://github.com/al3xandru>
2024-02-21 05:45:36 -06:00
Adam Porter
770e60766a Meta: v0.8.5-pre 2024-02-21 05:45:25 -06:00
Adam Porter
8d3c93b883 Tidy: Compiler warning
I've no explanation for why this isn't caught by makem.sh's linting
compilation and declarations, but somehow it shows up at installation
time.
2024-01-13 00:47:47 -06:00
Adam Porter
9c63a45821 Meta: Update makem.sh 2024-01-13 00:47:35 -06:00
Adam Porter
a305862d7e Merge: v0.8.4 2024-01-13 00:04:27 -06:00
Adam Porter
9606aaf812 Release: v0.8.4 2024-01-13 00:03:28 -06:00
Adam Porter
34f8b75b35 Fix: (org-ql-find) Go to base buffer if possible
Use the base buffer if it has one, because if we run the search from
an indirect buffer, it's likely already narrowed to a different entry,
and making an indirect buffer from that one would end up with a
restriction that would likely hide the selected entry.
2024-01-13 00:03:03 -06:00
Adam Porter
0168171a14 Meta: v0.8.4-pre 2024-01-12 23:58:41 -06:00
Adam Porter
6679bdea00 Merge: v0.8.3 2024-01-10 01:56:57 -06:00
Adam Porter
7d8bd8b884 Release: v0.8.3 2024-01-10 01:56:00 -06:00
Adam Porter
0b1e4b43ec Fix: (org-ql-find) Moving point and widening buffer as needed
See #380.

Reported-by: Omar Antolín Camarena <omar.antolin@gmail.com>
2024-01-10 01:55:16 -06:00
Adam Porter
694739b31d Meta: v0.8.3-pre 2024-01-10 01:38:15 -06:00
Adam Porter
5b0026260a Merge: v0.8.2 2024-01-09 02:28:19 -06:00
Adam Porter
3448e49d86 Release: v0.8.2 2024-01-09 02:27:11 -06:00
Adam Porter
7ff6cc2ef7 Fix: (org-ql-find) Don't use org-with-point-at
See <https://github.com/alphapapa/org-ql/issues/380#issuecomment-1881913025>.

Reported-by: Bram Schoenmakers <me@bramschoenmakers.nl>
2024-01-09 02:25:46 -06:00
Adam Porter
8595139f5b Meta: v0.8.2-pre 2024-01-09 02:22:38 -06:00
Adam Porter
39394c831a Merge: v0.8.1 2024-01-03 18:49:09 -06:00
Adam Porter
51869fd7f9 Release: v0.8.1 2024-01-03 18:47:44 -06:00
Adam Porter
02a2e256dc Docs: Fix v0.7 changelog
Fixes #335.

Reported-by: Nicholas Vollmer <https://github.com/progfolio>
2024-01-03 18:46:21 -06:00
Ivan Perez
393f88e7f3 Remove mentions of removed functions from v0.7 subheading in Changelog.
These commands were removed in 5768c685ad,
but they were still mentioned in the release that was going to
incorporate those two functions, v0.7.

This commit removes the mention of those two functions from the v0.7
subheading in the changelog. Note that `org-ql-find-path` was
re-introduced in v0.8, so it remains under that subheading as a separate
addition.
2024-01-03 18:44:56 -06:00
Adam Porter
529e05851b Fix: (org-ql-view--format-element) Avoid unlinkifying links
I don't fully understand why this is the correct fix, because I don't
know where the raw heading text is being linkified (it seems like the
:raw-value property should be the unlinkified text), but this seems to
work correctly now.  If it turns out to break something else, we'll
find out and fix it.

Fixes #282.

Reported-by: Jacob Boxerman <https://github.com/jakebox>
2024-01-03 18:35:11 -06:00
Adam Porter
8e9a8fe090 Fix: (org-ql-find) Widen buffer
This fixes the case in which a user calls org-ql-find from a narrowed
buffer and chooses a result outside the restriction.  This is already
done in, e.g. org-ql-open-link; it's just an oversight here.
2024-01-03 18:28:06 -06:00
Adam Porter
24b799ab0b Meta: v0.8.1-pre 2024-01-03 18:25:18 -06:00
Adam Porter
a4bf5b0a92 Tidy: (org-ql-view--display) Take STRINGS instead of STRING
No need to allocate one large string just to insert it into the
buffer.
2023-12-24 01:10:27 -06:00
Adam Porter
0e39372146 Meta: v0.9-pre 2023-12-24 01:09:49 -06:00
Adam Porter
087e99703e Release: v0.8 2023-12-21 17:14:30 -06:00
Adam Porter
09e7b60505 Tidy: Compatibility aliases for Org 9.6 2023-12-21 17:11:01 -06:00
Adam Porter
b015b3b910 Tidy: Indentation, variable 2023-12-21 17:10:53 -06:00
Adam Porter
eaf58b463e Meta: Update copyright years
Fixes #336.
2023-12-21 16:54:17 -06:00
Adam Porter
08497a1648 Merge: org-ql-completing-read-export 2023-12-21 16:49:13 -06:00
Adam Porter
f98dee54c8 Docs: Update changelog and usage 2023-12-21 16:49:06 -06:00
Adam Porter
f4b006ffb9 Remap embark-collect to embark-export 2023-12-21 16:40:09 -06:00
Adam Porter
2644f53fe2 Tidy, rename 2023-12-21 16:40:09 -06:00
Omar Antolín
0552aa8b93 Use a keymap for the org-ql-view export functionality 2023-12-21 16:40:09 -06:00
Omar Antolín Camarena
121af5c5d5 Add C-c C-e key binding to save an org-ql-find session 2023-12-21 16:40:09 -06:00
Adam Porter
4ef9d9efed Meta: (bug_report.yml) Add Org version, remove labels and assignee 2023-12-19 03:27:01 -06:00
Adam Porter
77b4c2bce2 Meta: Add bug report template 2023-12-16 07:55:16 -06:00
Adam Porter
3dc2409539 Meta: Require Emacs 27.1 or later
Emacs 26.3 is quite old now, and I can't practically run tests for it
anymore because some other dependencies have dropped support for it.
2023-12-16 07:10:52 -06:00
Adam Porter
9a5680c6f3 Merge: (property) Use 'selective argument to org-entry-get
Closes #346.  See also #356.

Reported-by: Bram Schoenmakers <https://github.com/bram85>
Co-developed-by: Bram Schoenmakers <https://github.com/bram85>
2023-12-16 05:39:33 -06:00
Adam Porter
c78f785378 Docs: Update changelog 2023-12-16 05:39:08 -06:00
Bram Schoenmakers
f6d7514159 Handle the case when org-use-property-inheritance is a list of strings
When org-use-property-inheritance is a list, then the query

(property "FOO" "BAR")

would bail out with:

org-ql--byte-compile-warning: Invalid Org QL query: "Invalid Org QL
query: \"‘\\\"BLAH\\\"’ is a malformed function\", :warning", :error

(property "FOO") would still work though.

So, if org-use-property-inheritance is a list, cast it to
the (default) boolean value for this variable: nil.

Use 'selective' inheritance when org-use-property-inheritance is a list

This symbol is mentioned in the org-entry-get documentation.
2023-12-16 05:39:05 -06:00
Adam Porter
1496185141 Fix: (property) Handle org-use-property-inheritance when unspecified
Fixes #356.

Reported-by: beast-pro <https://github.com/beast-pro>
Reported-by: pcompassion <https://github.com/pcompassion>
2023-12-16 05:37:48 -06:00
Adam Porter
004ed1ee0f Tidy: Indentation
For Emacs 29.1's and with-simulated-input's changes.
2023-12-16 05:37:48 -06:00
Adam Porter
c62ff77cd3 Tidy: Use compat and newer symbol names 2023-12-16 05:37:48 -06:00
Adam Porter
0ab236f95b Tidy: Docstring
The compiler still complains that it has wrong usage of an unescaped
single quote, but nothing seems to fix it.
2023-12-16 05:37:48 -06:00
Adam Porter
a31baebc4f Add: (org-ql-view--format-element) org-category property
Hopefully this does not cause a noticeable performance impact.  Maybe
the new org-element caching features in Org will help with that.

Fixes #363.

Reported-by: Gabriele Mongiano <https://github.com/kofm>
2023-12-16 04:47:06 -06:00
Adam Porter
ace5e361af Merge: v0.7.4 2023-12-16 04:13:38 -06:00
Adam Porter
38e16b4a5f Release: v0.7.4 2023-12-16 04:11:01 -06:00
Adam Porter
7a6b622cd0 Fix: Ignore empty quoted strings when parsing string queries
Fixes #383.

Reported-by: Adam Porter <adam@alphapapa.net>
2023-12-16 04:10:34 -06:00
Adam Porter
5775848b8a Meta: v0.7.4-pre 2023-12-16 03:56:58 -06:00
Adam Porter
4f62ba3bd6 Fix: (org-ql-find) Pop to buffer then go to position
Seems that selecting the window after going to the position can
sometimes break (probably because of the window point).
2023-11-06 16:30:20 -06:00
Adam Porter
72b9934d1f Change: (org-ql-find.el) Factor out interactive form
And use in org-ql-find-path.
2023-11-06 15:55:39 -06:00
Adam Porter
e885001a2a Comment: Add TODO 2023-11-01 14:37:59 -05:00
Adam Porter
bd2dd12a41 Merge: (org-ql-open-link) And associated changes 2023-10-25 03:30:41 -05:00
Adam Porter
2319fc9d8b Docs: Update changelog, Usage 2023-10-25 03:29:03 -05:00
Adam Porter
58d29d0fff Comment: Add FIXME 2023-10-25 03:21:03 -05:00
Adam Porter
a802579f86 Tidy 2023-10-25 03:19:29 -05:00
Adam Porter
40b25ac319 Fix: (org-ql-completing-read-snippet) while-no-input 2023-10-23 18:57:58 -05:00
Adam Porter
7ecb4a8b10 Tidy 2023-10-23 18:57:58 -05:00
Adam Porter
9aba73a28b WIP 2023-10-23 18:57:58 -05:00
Adam Porter
3f08d45ace Fix: (org-ql-completing-read-action) Format link 2023-10-23 18:57:58 -05:00
Adam Porter
6c18f133e9 Tidy: Function, docstrings, commented code 2023-10-23 18:57:58 -05:00
Adam Porter
e030627aeb WIP: Add display-sort-function 2023-10-23 18:57:58 -05:00
Adam Porter
28f5aa3100 WIP: Many improvements
Now need to do some kind of sorting...
2023-10-23 18:57:56 -05:00
Adam Porter
deada67e1d WIP: org-ql-open-link
Need to tidy up and generalize org-ql-completing-read a bit more, but
this is basically working, and should be very useful.
2023-10-23 18:56:45 -05:00
Adam Porter
ee01bcb6e8 Merge: v0.7.3 2023-10-23 18:55:00 -05:00
Adam Porter
28c4215704 Release: v0.7.3 2023-10-23 18:52:04 -05:00
Adam Porter
631cd80ce8 Fix: (org-ql-find) Go to selected entry
Fixes #380.

Reported-by: Omar Antolín Camarena <omar@matem.unam.mx>
2023-10-23 01:26:39 -05:00
Adam Porter
de80f9a764 Comment: Add TODO 2023-10-23 01:23:48 -05:00
Adam Porter
09c3591504 Fix: Saving of org-ql-view views
It didn't seem that calling custom-save-all was necessary in the past,
but it appears that it is now.

Closes #378.

Reported-by: Pentaquark1 <https://github.com/Pentaquark1>
2023-10-19 21:50:30 -05:00
Adam Porter
4476759dc9 Fix: (org-ql--outline-path) Disable case-fold-search 2023-10-19 21:47:34 -05:00
Adam Porter
daad25e079 Meta: v0.7.3-pre 2023-10-19 21:45:22 -05:00
Adam Porter
ac2d43588a Add: (org-ql-find-path) 2023-10-19 21:44:26 -05:00
Adam Porter
6d5b614fc5 Fix: (org-ql-find) Interactive form
Fixes silly mistake in ab720689e9.
2023-10-02 22:52:25 -05:00
Adam Porter
ab720689e9 Change: (org-ql-find) Interactively, search relevant buffers 2023-09-30 20:09:12 -05:00
Adam Porter
ca23b1c7bd Merge: Embark support 2023-09-27 15:03:30 -05:00
Adam Porter
a41dfe25ea Docs: Update changelog, usage 2023-09-27 15:02:40 -05:00
Omar Antolín Camarena
641ec0ac50 Add category metadatum to org-ql-completing-read
This is all that is needed to gain support for Embark actions on
org-ql-find candidates.
2023-09-27 14:53:44 -05:00
Adam Porter
8250349e35 Merge: Update for Org 9.7 org-element API changes
See #364.
2023-09-27 13:40:53 -05:00
Adam Porter
5c9d4cdb48 Docs: Update changelog 2023-09-27 13:40:30 -05:00
Adam Porter
9e72bf6947 Fix: (org-ql-view--format-element) Check habit in source buffer
See #364.
2023-09-27 13:36:47 -05:00
Adam Porter
0e702ecb48 Change: Resolve Org element properties on 9.7+
See #364.
2023-09-27 13:36:47 -05:00
Adam Porter
0a0291288e Meta: v0.8-pre 2023-09-27 13:36:18 -05:00
Adam Porter
f9d4f62415 Release: v0.7.2 2023-09-27 00:21:21 -05:00
Adam Porter
56e203110b Fix: (org-ql-completing-read) Warn about empty headings 2023-09-26 20:48:59 -05:00
Adam Porter
be20dc3d5b Fix: (org-ql-find) Use org-with-point-at
I keep pointing out to other people that they should use
org-with-point-at, but I still have places in my own code where I need
to use it, too!
2023-09-26 13:42:00 -05:00
Adam Porter
8412d1a23d Tidy: Indentation
For Emacs 29.1.
2023-09-22 22:08:57 -05:00
Adam Porter
95abce2340 Fix: (org-ql-completing-read) :query-prefix prevented selection
COMPLETING-READ, when used with its REQUIRE-MATCH argument, would not
allow a result to be selected when ORG-QL-FIND was called with its
QUERY-PREFIX argument.

This change moves where the query is modified to include the prefix,
putting it into the RUN-QUERY function instead of the COLLECTION
function.  It seems to solve the problem, and the function seems to
still work when used without QUERY-PREFIX.  However, due to the
complexity of all this (we really need a SELECTING-READ API), it
wouldn't surprise me if something is later found to have been broken
by it...

Fixes #351.

Reported-by: Daniel Fleischer <https://github.com/danielfleischer>
2023-09-14 08:10:49 -05:00
Adam Porter
131407814e Fix: (org-ql--def-query-string-to-sexp-fn) Ignore leading blanks 2023-09-08 02:22:40 -05:00
Adam Porter
f65b1d91a4 Fix: (org-ql--normalize-from-to-on) Tolerate "-" input
Avoids errors while typing a query (e.g. a negative number) into
org-ql-find, which interrupts completion altogether.
2023-09-06 20:51:41 -05:00
Adam Porter
3622b92403 Meta: v0.7.2-pre 2023-09-06 20:49:12 -05:00
Adam Porter
d776e205d5 Release: v0.7.1 2023-09-06 18:57:36 -05:00
Adam Porter
ed81b7d7c8 Tests: Require xr
This is only a development dependency.
2023-09-06 18:56:32 -05:00
Adam Porter
3c24958738 Fix: (org-ql-completing-read) Variable name 2023-09-06 18:55:39 -05:00
Adam Porter
f9b60d8ef8 Fix: (org-ql-completing-read) Propertize strings with markers
Fixes #350.  Closes #357.
2023-09-06 16:09:18 -05:00
Adam Porter
2d29d69133 Docs: Update changelog 2023-09-06 16:08:54 -05:00
Ankit Pandey
a7af6d78b2 Fix: (org-ql-completing-read) Store markers as text property
Fixes #350
2023-09-06 11:11:17 -05:00
Adam Porter
898addeee9 Docs: Tidy
The circumstances which precipitated this expression of support for
fellow developers thankfully passed some time ago.
2023-09-04 22:40:52 -05:00
Adam Porter
eb5377320f Comment: Add FIXME 2023-05-25 10:48:47 -05:00
Adam Porter
2c098540ca Fix: (org-ql-completing-read) Format links before display
Also use org-entry-get to get the heading, which should avoid issues
with different Org versions having different optional arguments to
org-get-heading.
2023-05-05 17:25:21 -05:00
Adam Porter
1d98c7d07c Tests: Disable Org link bracket tests on old Org versions 2023-03-14 12:13:07 -05:00
Adam Porter
4c1a4b169f Fix: (org-ql-completing-read)
This seems to work better now with default Emacs completion (i.e. not
using Vertico or Helm).  It's still not perfect, but it seems to work
reasonably well and be more correct.

Fixes #338.  Thanks to @arozbiz for reporting.
2023-03-12 09:33:28 -05:00
Adam Porter
e08de2a76c Fix: (org-ql-completing-read) Bind org-outline-path-cache nil 2023-03-12 05:59:22 -05:00
Adam Porter
ce66f67c96 Meta: v0.7.1-pre 2023-03-12 05:59:13 -05:00
Adam Porter
aadddc4d84 Release: v0.7 2023-03-10 06:25:45 -06:00
Adam Porter
107fc66d08 Change: (org-ql-view--format-element) Use display-warning 2023-03-10 06:24:03 -06:00
Adam Porter
44679a6c93 Comment: Remove old FIXMEs 2023-03-10 06:23:53 -06:00
Adam Porter
962a3dc414 Comment: Remove old FIXME
See 3c73888b98.
2023-03-10 06:19:01 -06:00
Adam Porter
9e14f9eefa Fix: (link) Allow brackets in description
Org 9.3 stopped replacing brackets in link descriptions with braces
and started escaping them instead.

Fixes #283.  Thanks to Daniel Borchmann (@exot) for reporting.
2023-03-10 05:56:01 -06:00
Adam Porter
3c73888b98 Merge: (org-ql-sparse-tree) Accept string queries
Thanks to Akira Komamura (@akirak).
2023-03-10 04:46:45 -06:00
Adam Porter
d92afcda06 Docs: Update changelog 2023-03-10 04:46:32 -06:00
Adam Porter
99e580b530 Tidy: (org-ql-sparse-tree) Docstring; use pcase 2023-03-10 04:44:39 -06:00
Akira Komamura
1ae2f0cd60 Update the docstring 2023-03-10 04:44:39 -06:00
Akira Komamura
2b7d4e0e79 Fix: Accept plain queries in interactive org-ql-sparse-tree 2023-03-10 04:44:39 -06:00
Adam Porter
7f68db962e Merge: (blocked) predicate
Thanks to Akira Komamura (@akirak).
2023-03-10 03:42:37 -06:00
Adam Porter
902dad04c1 Docs/Tidy: Update readme, reorder forms 2023-03-10 03:36:21 -06:00
Akira Komamura
6afe3be572 Add: (blocked) predicate 2023-03-10 03:33:08 -06:00
Adam Porter
e5e9daab07 Fix: Aliases
One of them seems to break on Emacs 26.3 only...
2023-03-09 05:00:14 -06:00
Adam Porter
d21da3682b Tidy: Compilation warnings 2023-03-09 03:23:42 -06:00
Adam Porter
d86a402ba5 Tidy: Docstrings 2023-03-09 03:04:15 -06:00
Adam Porter
5c5a15a09b Fix: (org-ql--sanity-check-form) Use pcase 2023-03-09 02:47:23 -06:00
Adam Porter
2bc327d85f Fix: (org-ql-view--link-store) Error message for test suite
Use format string to prevent `substitute-quotes' from changing the
error string, breaking the test suite when run on CI.

Fixes #317.
2023-03-09 02:45:48 -06:00
Adam Porter
8bb1739661 Tests: (src) Normalization with no args
Closes #293.  Thanks to Akira Komamura (@akirak) for reporting.
2023-03-09 02:45:48 -06:00
Adam Porter
0d9940c5df Docs: Update README 2023-03-09 02:45:48 -06:00
Adam Porter
d784f8f71c Tests: (src) Implement 2023-03-09 02:45:48 -06:00
Adam Porter
68ac6ddd28 Tests: Use before-each for org-ql-test-data-buffer
This seems like the best way.
2023-03-09 02:45:48 -06:00
Adam Porter
2ae60f8dc5 Tests: (src) More normal forms 2023-03-09 02:45:48 -06:00
Adam Porter
1fdad05fef Tests: Tidy 2023-03-09 01:46:46 -06:00
Adam Porter
1996969920 Fix: (src) Rewrite body
Fixes #304.  Thanks to @johanwk for reporting.
2023-03-09 01:46:34 -06:00
Adam Porter
0304a2c9dc Tests: (org-ql-it) Expand using Buttercup's it
As the implementation of `it' changes, this will change with
it (correctly).
2023-03-09 00:52:47 -06:00
Adam Porter
6c9c0b957a Tests: Rename data2.org to data-file-tags.org
It appears likely that we'll need a few test-specific data files, so
we should use descriptive names.
2023-03-09 00:05:14 -06:00
Adam Porter
a5fbb5d976 Tidy: Indentation of dash forms
See, e.g. <https://github.com/magnars/dash.el/pull/375>.

Ultimately I'd prefer to indent with one distinguished argument, but
the noise it causes downstream is likely not worth it.  (And,
unfortunately, the indentation of the built-in thread-first and
thread-last forms has changed to be like this as well, which is even
worse, causing 10-11 characters of extra indentation in those forms'
bodies!)
2023-03-09 00:01:32 -06:00
Adam Porter
29533525c3 Tidy: (org-ql--plist-get*) Docstring 2022-12-25 17:51:00 -06:00
Adam Porter
36ff9854ce Fix: (category) Add normalizer for alias 2022-12-25 12:09:50 -06:00
Adam Porter
8dae879841 Change: (org-ql-defpred) Ensure aliased predicates have normalizers
Would have prevented me from releasing the "c" alias for "category"
without a normalizer.
2022-12-25 12:05:52 -06:00
Adam Porter
d253b123cf Docs: Add credits for v0.7-pre 2022-12-09 20:33:01 -06:00
Adam Porter
3d3d958d20 Meta: Test on CI with Emacs 28.1 and 28.2 2022-12-09 20:21:23 -06:00
Adam Porter
91908186fc Change/Fix: Preambles for predicates that expect arguments
Closes #285.  Thanks to Caleb Chase (@chasecaleb) for reporting.
2022-12-09 20:19:55 -06:00
Adam Porter
ecde3a0420 Change/Fix: (src) Normalization, case-insensitivity 2022-12-09 20:19:55 -06:00
Adam Porter
6e3a5eebe7 Fix: (src) Coalesce function 2022-12-08 21:22:40 -06:00
Adam Porter
9dd1bbb10b Merge: 0.6.3 2022-12-08 20:50:01 -06:00
Adam Porter
80b334c269 Release: v0.6.3 2022-12-08 20:45:14 -06:00
Adam Porter
2ddfb7c231 Fix: Require org-duration
This appears to be necessary on newer Org versions, but I don't know
exactly when.
2022-12-08 20:45:14 -06:00
Adam Porter
9f00fa3890 Fix: (org-ql--def-query-string-to-sexp-fn) Updated for peg v1.0.1
Fixes #314, fixes #316.  Thanks to Akira Komamura (@akirak) and Joon
Ro (@joonro) for reporting.

Instead of `[blank]` in this PEX, it used to be `(syntax-class
whitespace)`, which worked fine with peg v1.0.  Then
<https://debbugs.gnu.org/cgi/bugreport.cgi?bug=59345> was filed and
resulted in the release of peg v1.0.1, after which that no longer
worked.  As best I can tell from reading the discussion, `[blank]` and
`(syntax-class whitespace)` should behave the same way, yet here they
do not: with peg v1.0.1, only `[blank]` works.  Why, I do not know; I
only tried it because I could find no explanation for the broken
behavior, and luckily, it works.  Maybe it's due to the use of
`(syntax-class whitespace)` later in the `pexs`; but since it finally
works again, let's take the victory as-is.
2022-12-08 20:44:24 -06:00
Adam Porter
85aee42fae Meta: Update makem.sh to v0.6-pre
Needed for testing on Emacs 28+.
2022-12-08 20:38:47 -06:00
Adam Porter
f22fdd457b Meta: v0.6.3-pre 2022-12-08 19:48:40 -06:00
Adam Porter
5f70636556 Add: (org-ql-find-display-buffer-action) 2022-10-07 18:34:55 -05:00
Adam Porter
e54ba0102c Add: (property) :inherit argument 2022-10-07 18:33:35 -05:00
Adam Porter
e41cdb4591 Change: (org-ql-find-goto-hook) Add org-reveal
Showing the context is much better for the user.
2022-08-25 16:55:58 -05:00
Adam Porter
d7ada532c7 Add: Alias "c" to (category) 2022-08-19 03:38:43 -05:00
Adam Porter
7f4faff27b Add: (org-ql-refile) 2022-08-19 03:26:15 -05:00
Adam Porter
cfa3b307ec Add/Change: org-ql-completing-read, etc. 2022-08-19 03:26:15 -05:00
Adam Porter
18869c47ff Tidy: Headers 2022-08-19 03:14:46 -05:00
Adam Porter
6257ae8304 Fix: (org-ql-find--snippet-*) Use save-excursion 2022-08-15 16:16:55 -05:00
Adam Porter
06f1e1be6f Revert "Change: (org-ql-find) Add workaround for Ivy support"
This reverts commit a02ed48ac8.

See <https://github.com/alphapapa/org-ql/issues/284#issuecomment-1187705847>.
2022-07-18 13:44:25 -05:00
Adam Porter
a02ed48ac8 Change: (org-ql-find) Add workaround for Ivy support
See <https://github.com/alphapapa/org-ql/issues/284>.
2022-07-18 10:57:50 -05:00
Adam Porter
98b6049ecc Fix: (org-ql-find) Check major mode
See https://github.com/alphapapa/org-ql/issues/284#issuecomment-1185367899.
2022-07-15 13:50:10 -05:00
Adam Porter
a986e360c3 Fix: (org-ql-find) Select buffer
Thanks again to Thomas Bergheim (@bergheim).
2022-07-14 13:05:42 -05:00
Adam Porter
d46e69b0fc Fix: (org-ql-find) Always include query-prefix
Thanks to Thomas Bergheim (@bergheim) for his help!
2022-07-14 12:52:44 -05:00
Adam Porter
c2b8af3181 Fix: (org-ql-find) Always map across a list 2022-06-26 22:55:20 -05:00
Adam Porter
77916a1c4f Tidy: Indentation 2022-06-25 10:58:33 -05:00
Adam Porter
5f058b9eee Add: (org-ql-find-in-agenda, org-ql-find-in-org-directory) 2022-06-25 10:58:17 -05:00
Adam Porter
dc02c59cad Add: (org-ql--ensure-buffer)
And use in org-ql-find.  This seems to solve a problem I've been
noticing in helm-org-ql for a long time: that it can apparently
interrupt Org's initialization code, which can leave buffers
unprepared for Org, even stuck in fundamental-mode.  This should also
be used in helm-org-ql...
2022-06-25 10:56:18 -05:00
Adam Porter
bbd164c6ae Change/Fix: (org-ql-select) Warn instead of erroring on bad files
This helps prevent unexpected errors from making it impossible to
search, and displaying the messages in the warnings buffer makes them
more noticeable and readable for the user.
2022-06-25 10:54:38 -05:00
Adam Porter
5768c685ad Remove: org-ql-find-heading, org-ql-find-path
These are virtually obsolete with the introduction of the "rifle"
predicate as the default one.  Having them now is just confusing.
2022-06-25 10:53:29 -05:00
Adam Porter
bacdacb1b2 Change: Use buffer-chars-modified-tick
Closes #203.  Thanks to Ihor Radchenko (@yantar92).
2022-06-13 19:08:36 -05:00
Adam Porter
e22890ad04 Docs: Update changelog 2022-06-13 19:07:44 -05:00
Ihor Radchenko
675d333b91 Use buffer-chars-modified-tick instead of buffer-modified-tick 2022-06-13 19:05:34 -05:00
Adam Porter
6e7371ce61 Add: (org-ql-find) Snippet functions
The default is even more like org-rifle now.
2022-06-11 11:01:52 -05:00
Adam Porter
ede1a6b10b Change: Don't use (setf (plist-get ...))
That expansion is new in Emacs 28, which we don't yet target as the
minimum version.
2022-06-11 09:19:35 -05:00
Adam Porter
1ddc505977 Change: Rename coalesce-multiple-calls to coalesce 2022-06-11 08:16:15 -05:00
Adam Porter
6602f32165 Tests: Update (add, reorganize)
They all pass now (with a temporary, uncommitted workaround in
makem.sh for a Buttercup bug:
<https://github.com/jorgenschaefer/emacs-buttercup/issues/218>).
2022-06-11 08:15:24 -05:00
Adam Porter
73ef71ced7 Comment: Add FIXME 2022-06-11 08:15:24 -05:00
Adam Porter
4f29bcfd67 Add: (rifle/smart) Predicate 2022-06-11 08:15:24 -05:00
Adam Porter
968a249ae3 Add: Query coalescing for AND clauses
A later commit will update and add tests.
2022-06-11 08:15:24 -05:00
Adam Porter
0057972069 Add: (org-ql-default-predicate) 2022-06-10 01:32:48 -05:00
Adam Porter
c8c89be7bc Meta: Update makem.sh, Makefile 2022-06-09 22:34:07 -05:00
Adam Porter
d4f2eb760e Fix: (src) Normalization
Some argument combinations weren't normalized correctly and could
cause an infinite loop.

This commit doesn't update any corresponding tests, because they are
being rearranged in the WIP branch where this commit originates, and
teasing them out wouldn't be worth it.
2022-06-09 22:34:07 -05:00
Adam Porter
c7fab9dfce Tests: Wrap bare (expect) forms in (it) forms 2022-06-09 22:34:07 -05:00
Adam Porter
36e97d51cf Tests: Fix non-file-backed-buffer test
Somehow a Unicode "RIGHT SINGLE QUOTATION MARK" replaced the ASCII
apostrophe in this string, which broke the test.  Weird!
2022-06-09 22:16:59 -05:00
Adam Porter
64a9234733 Add: (org-ql-find) :query-filter
Also, tidy docstring.
2022-06-02 11:51:57 -05:00
Adam Porter
67506a56f8 Change: (org-ql--byte-compile-warning) More useful error message
e.g. if a predicate only accepts one argument, but the query gives
two, now the error will say, "PREDICATE called with 2 arguments, but
accepts only 1" (so maybe the predicate definition just needs
"&rest").
2022-05-31 12:01:42 -05:00
Adam Porter
d0acc8cbba Add: (org-ql-find) 2022-05-30 11:27:12 -05:00
Adam Porter
8933f8853c Merge: 0.6.2 2022-05-27 02:05:56 -05:00
Adam Porter
115500c8a0 Fix: (link) Save excursion around regexp search
Fixes #279.  Thanks to Marc Fargas (@telenieko) for reporting.

Released as 0.6.2.
2022-05-27 02:03:20 -05:00
Adam Porter
46f523d94a Meta: 0.7-pre 2022-03-18 10:34:54 -05:00
Adam Porter
f666fe150f Release: 0.6.1 2022-03-18 10:29:50 -05:00
Adam Porter
4f11878b7d Update: Transient macro names
Closes #269.  See https://github.com/magit/transient/issues/192.
Thanks to Jonas Bernoulli (@tarsius).
2022-03-18 10:29:07 -05:00
Adam Porter
1e7700e64e Fix: Links to headings with stats cookies in dynamic blocks
Fixes #248.  Closes #249.

Thanks to Maikol Solis (@maikol-solis) for reporting, and to him and
Ihor Radchenko (@yantar92) for helping plan the fix.
2022-03-18 10:28:17 -05:00
Adam Porter
49b973ab11 Meta: 0.6.1-pre 2022-03-18 10:06:58 -05:00
Adam Porter
31aeb0a250 Release: 0.6 2021-09-22 01:15:26 -05:00
Adam Porter
d2c3fb32d9 Tidy: Indentation 2021-09-22 01:11:38 -05:00
Adam Porter
140aa891f4 Remove: Obsolete macro org-ql 2021-09-22 01:08:54 -05:00
Adam Porter
e49cafe022 Merge: Abbreviate filenames in bookmarks 2021-09-22 01:00:58 -05:00
Adam Porter
c006bc3804 Docs: Update changelog 2021-09-22 01:00:22 -05:00
Akira Komamura
da2bab2552 Fix: Abbreviate file paths in created org-ql bookmarks 2021-09-22 00:59:18 -05:00
Adam Porter
9dfa534e60 Merge: branch 'dynamic-block-closed' 2021-09-22 00:57:00 -05:00
Adam Porter
1c9b99ace9 Docs: Update changelog 2021-09-22 00:56:45 -05:00
Jianye Ye
4646d6d307 Add: (closed) column for dynamic block 2021-09-22 00:52:08 -05:00
Jianye Ye
80970856d6 Add: Sort by (closed) for org-ql-select 2021-09-22 00:52:08 -05:00
Adam Porter
8f307a8820 Merge: Fix shadowed pcase pattern
Fixes #214.  Thanks to Cyrille Froehlich (@cfroehli), Ihor
Radchenko (@yantar92), Kai von Fintel (@fintelkai), and @aur3l14no.
2021-09-22 00:37:17 -05:00
Cyrille Froehlich
bbeee64f41 Simplify tags-all/tags-local too + Fix formatting 2021-07-28 08:39:22 +09:00
Cyrille Froehlich
99a2285317 Simplify tags-inherited normalizer 2021-07-28 08:35:13 +09:00
Cyrille Froehlich
363f7623c1 Fix: pcase pattern shadowed 2021-07-28 08:35:13 +09:00
Adam Porter
94f9e6f303 Add/Change: reverse sorter, and reverse sorting order
This is a breaking change of sorts in that searches using multiple
sorting methods will have to have the order of the sorters reversed to
get the same result.  Unfortunate, but I think it's worth it in the
end, and this is pre-1.0, anyway.

Fixes #143.
2021-07-12 21:33:24 -05:00
22 changed files with 4121 additions and 1583 deletions

78
.github/ISSUE_TEMPLATE/bug_report.yml vendored Normal file
View file

@ -0,0 +1,78 @@
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

5
.github/ISSUE_TEMPLATE/config.yml vendored Normal file
View file

@ -0,0 +1,5 @@
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

@ -0,0 +1,45 @@
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,9 +41,14 @@ 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.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

@ -1,7 +1,7 @@
# * makem.sh/Makefile --- Script to aid building and testing Emacs Lisp packages # * makem.sh/Makefile --- 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.3 # Version: 0.5
# * Arguments # * Arguments
@ -38,7 +38,9 @@ endif
verbose = $(v) verbose = $(v)
ifneq (,$(findstring vv,$(verbose))) ifneq (,$(findstring vvv,$(verbose)))
VERBOSE = "-vvv"
else ifneq (,$(findstring vv,$(verbose)))
VERBOSE = "-vv" VERBOSE = "-vv"
else ifneq (,$(findstring v,$(verbose))) else ifneq (,$(findstring v,$(verbose)))
VERBOSE = "-v" VERBOSE = "-v"

View file

@ -1,7 +1,6 @@
#+TITLE: org-ql #+TITLE: org-ql
# NOTE: Using =BEGIN_HTML= for this causes TeX/info export to fail, but this HTML block works. # NOTE: Using =BEGIN_HTML= for this causes TeX/info export to fail, but this HTML block works.
# #+HTML: <a href=https://alphapapa.github.io/dont-tread-on-emacs/><img src="images/dont-tread-on-emacs-150.png" align="right"></a>
#+HTML: <img src="images/dog.png" align="right"> #+HTML: <img src="images/dog.png" align="right">
# NOTE: To avoid having this in the info manual, we use HTML rather than Org syntax; it still appears with the GitHub renderer. # NOTE: To avoid having this in the info manual, we use HTML rather than Org syntax; it still appears with the GitHub renderer.
@ -20,6 +19,7 @@ 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:
@ -94,15 +94,41 @@ Lisp code examples are in [[examples.org]].
:TOC: ignore-children :TOC: ignore-children
:END: :END:
+ *Jumping to an entry:*
- [[#org-ql-find][org-ql-find]] and related commands
- [[#helm-org-ql][helm-org-ql]]
+ *Showing an agenda-like view:* + *Showing an agenda-like view:*
- [[#org-ql-search][org-ql-search]] (command) - [[#org-ql-search][org-ql-search]]
- [[#org-ql-view][org-ql-view]] (command) - [[#org-ql-view][org-ql-view]]
- [[#org-ql-view-sidebar][org-ql-view-sidebar]] (command) - [[#org-ql-view-sidebar][org-ql-view-sidebar]]
- [[#org-ql-view-recent-items][org-ql-view-recent-items]] (command) - [[#org-ql-view-recent-items][org-ql-view-recent-items]]
+ *Showing a tree in a buffer:* + *Showing a tree in a buffer:*
- [[#org-ql-sparse-tree][org-ql-sparse-tree]] (command) - [[#org-ql-sparse-tree][org-ql-sparse-tree]]
+ *Showing results with Helm*:
- [[#helm-org-ql][helm-org-ql]] (command) *** org-ql-find
/Note: These commands use [[#non-sexp-query-syntax][non-sexp queries]]./
These commands jump to a heading selected using Emacs's built-in completion facilities with an Org QL query:
- ~org-ql-find~ searches in the current buffer.
- ~org-ql-find-path~ searches outline paths in the current buffer.
- ~org-ql-find-in-agenda~ searches in ~(org-agenda-files)~.
- ~org-ql-find-in-org-directory~ searches in ~org-directory~.
Note that these commands are compatible with [[https://github.com/oantolin/embark][Embark]]: the ~embark-act~ command can be called on a completion candidate (i.e. a search result) to act on it immediately, without having to visit the entry in its source Org buffer, and ~embark-export~ may be called to show the results in an ~org-ql-view~ buffer.
[[images/org-ql-find.png]]
*** org-ql-open-link
This command finds links in entries matching the input query and offers them for selection; the selected link is then opened with ~org-open-at-point~.
The input is matched using the default predicate, which means it searches both entry content and outline paths. This is helpful when a collection of links are kept in Org files: rather than having to first visit the entry containing the desired link, then locate it within the entry, and then open it, the user can simply select the link and open it directly. For example, if an entry with the heading =Emacs= contained a link named =mailing list=, one could search for =Emacs list= and open the link to the mailing list directly.
*** org-ql-refile
This command refiles the current Org entry to one selected by searching with Org QL completion. It searches files listed in ~org-refile-targets~ as well as the current buffer.
*** org-ql-search *** org-ql-search
@ -130,6 +156,8 @@ 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=./
@ -204,7 +232,8 @@ 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.
+ =category (&optional categories)= :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings). + =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).
+ =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.
@ -220,20 +249,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)= :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string). Note that property inheritance is currently /not/ enabled for this predicate. If you need to test with inheritance, you could use a custom predicate form, like ~(org-entry-get (point) "PROPERTY" 'inherit)~. + =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.
+ =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=.
+ ~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. + =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.
+ =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. - Aliases: ~smart~.
+ =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. - *Note:* By default, this is the default predicate used for plain-string query tokens (i.e. given without a specified predicate). This can be customized with the option ~org-ql-default-predicate~.
+ ~src (&key lang regexps)~ :: Return non-nil if current entry contains an Org Babel source block. If ~LANG~ is non-nil, match blocks of that language. If ~REGEXPS~ is non-nil, require that block's contents match all regexps. Matching is done case-insensitively.
+ =tags (&rest tags)= :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). Tests both inherited and local tags.
+ =tags-inherited (&rest tags)= :: Return non-nil if current heading's inherited tags include one or more of ~TAGS~ (a list of strings). If ~TAGS~ is nil, return non-nil if heading has any inherited tags.
- Aliases: ~inherited-tags~, ~tags-i~, ~itags~. - Aliases: ~inherited-tags~, ~tags-i~, ~itags~.
+ =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. + =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.
- Aliases: ~local-tags~, ~tags-l~, ~ltags~. - Aliases: ~local-tags~, ~tags-l~, ~ltags~.
+ =tags-all (tags)= :: Return non-nil if current heading includes all of ~TAGS~. Tests both inherited and local tags. + =tags-all (&rest 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 (&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~). + =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~).
*** Ancestor/descendant predicates *** Ancestor/descendant predicates
@ -348,7 +380,7 @@ Return items matching ~QUERY~ in ~BUFFERS-OR-FILES~.
If ~NARROW~ is non-nil, buffers are not widened (the default is to widen and search the entire buffer). If ~NARROW~ is non-nil, buffers are not widened (the default is to widen and search the entire buffer).
~SORT~ is either nil, in which case items are not sorted; or one or a list of defined ~org-ql~ sorting methods (~date~, ~deadline~, ~scheduled~, ~todo~, ~priority~, or ~random~); or a user-defined comparator function that accepts two items as arguments and returns nil or non-nil. ~SORT~ is either nil, in which case items are not sorted; or one or a list of defined ~org-ql~ sorting methods (~date~, ~deadline~, ~scheduled~, ~closed~, ~todo~, ~priority~, or ~random~); or a user-defined comparator function that accepts two items as arguments and returns nil or non-nil.
Examples: Examples:
@ -471,7 +503,7 @@ It would be expanded to:
Org QL provides a dynamic block that lists entries in the current document matching a query. In the header, these parameters are supported: Org QL provides a dynamic block that lists entries in the current document matching a query. In the header, these parameters are supported:
+ ~:query~: An Org QL query expression in either sexp or non-sexp form. + ~:query~: An Org QL query expression in either sexp or non-sexp form.
+ ~:columns~ A list of columns, including ~heading~, ~todo~, ~property~, ~priority~, ~deadline~, ~scheduled~. + ~:columns~ A list of columns, including ~heading~, ~todo~, ~property~, ~priority~, ~deadline~, ~scheduled~, ~closed~.
- Each column may also be specified as a list with the second element being a header string. For example, to abbreviate the priority column: ~(priority "P")~. - Each column may also be specified as a list with the second element being a header string. For example, to abbreviate the priority column: ~(priority "P")~.
- For certain columns, like =property=, arguments may be passed by specifying the column type itself as a list. For example, to display a column showing the values of a ~property~ named ~milestone~, with the header being abbreviated to ~M~: ~((property "milestone") "M")~. - For certain columns, like =property=, arguments may be passed by specifying the column type itself as a list. For example, to display a column showing the values of a ~property~ named ~milestone~, with the header being abbreviated to ~M~: ~((property "milestone") "M")~.
+ ~:sort~ One or a list of Org QL sorting methods (see ~org-ql-select~). + ~:sort~ One or a list of Org QL sorting methods (see ~org-ql-select~).
@ -522,19 +554,213 @@ 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.6-pre ** 0.9-pre
*Additions*
+ Face ~org-ql-view-query~, applied to view queries in header line.
+ Face ~org-ql-view-title~, applied to view titles in header line.
+ Option ~org-ql-view-relative-deadline-prefix~.
*Changes*
+ Command ~org-ql-find~ respects narrowing of the current buffer by default, allowing searching within the narrowed region. (Using one ~C-u~ argument widens the current buffer, and using two ~C-u~ arguments prompts for the buffers to search.)
+ Function ~org-ql-completing-read~ accepts a new ~NARROWP~ argument, which is passed to ~org-ql-select~.
*Fixes*
+ Customization group for face ~org-ql-view-due-date~.
+ Apply Org syntax font-locking to items in ~org-ql-view~ buffers.
*** helm-org-ql
Tagged v0.6.2, fixing a compilation warning.
** 0.8.10
*Fixes*
+ Command ~org-ql-refile~ uses the base buffer when refiling to an indirect buffer. ([[https://github.com/alphapapa/org-ql/issues/466][#466]].)
+ Predicate ~link~ could signal an error when searching text that is mistakenly recognized as an Org link (e.g. Bash double-bracket constructs in a source block). (Thanks to [[https://github.com/jwiegley][John Wiegley]] for reporting.)
** 0.8.9
*Fixes*
+ Predicate ~property~ when called with argument form ~(property "PROPERTY-NAME" :inherit t)~. ([[https://github.com/alphapapa/org-ql/issues/460][#460]]. Thanks to [[https://github.com/Stewmath][Stewmath]] for reporting.)
+ Predicate ~level~'s preamble optimizer allows expressions in place of the numeric argument. (See [[https://github.com/alphapapa/org-ql/issues/460][#460]]. Thanks to [[https://github.com/Stewmath][Stewmath]] for reporting.)
+ Reading of view settings from Org links in upcoming Emacs version. ([[https://github.com/alphapapa/org-ql/issues/461][#461]]. Thanks to [[https://github.com/snogge][Ola Nilsson]] for help debugging, and for maintaining [[https://github.com/jorgenschaefer/emacs-buttercup][Buttercup]].)
*Compatibility*
+ Fix compilation error on Emacs 30. ([[https://github.com/alphapapa/org-ql/issues/433][#433]]. Thanks to [[https://github.com/akirak][Akira Komamura]] and [[https://github.com/monnier][Stefan Monnier]].)
** 0.8.8
*Fixes*
+ Remove text properties from to-do keywords before displaying them in an ~org-ql-view~ buffer. (Such text properties could cause them to, e.g. display with extra leading spaces, depending on which other modes might be enabled in the source Org buffer.)
+ Binding of ~completion-styles-alist~ in ~org-ql-completing-read~. (This fixes compatibility with Helm's ~helm~ completion style, as well as default Emacs completion in recursive minibuffers. [[https://github.com/alphapapa/org-ql/issues/337][#337]]. Thanks to [[https://github.com/progfolio][Nicholas Vollmer]], [[https://github.com/9viz][viz]], and [[https://github.com/karthink][Karthik Chikmagalur]] for reporting and suggesting fixes.)
+ Use of the context snippet function for ~org-ql-completing-read~. ([[https://github.com/alphapapa/org-ql/issues/419][#419]]. Thanks to [[https://github.com/tpeacock19][tpeacock19]] for reporting.)
** 0.8.7
*Fixes*
+ Timestamps with internal time ranges (e.g. ~<2024-06-26 10:00-11:00>~) are matched for simple queries. (This support is not yet comprehensive, e.g. a query that depends on the specific inner time range may not behave as expected. Previously such timestamps were not matched at all. See [[https://github.com/alphapapa/org-ql/pull/237][#237]] and [[https://github.com/alphapapa/org-ql/issues/371][#371]]. Thanks to [[https://github.com/yantar92][Ihor Radchenko]].)
+ Timestamps with day-of-the-week abbreviations are matched more flexibly (allowing, e.g. a period in French locales). (See [[https://github.com/alphapapa/org-ql/discussions/429][#429]], [[https://github.com/alphapapa/org-ql/issues/432][#432]]. Thanks to [[https://github.com/neurolit][Florian D.]] for reporting.)
+ Command ~org-ql-search~ did not narrow properly when called interactively.
*Compatibility*
+ Dynamic blocks work with Org 9.7. ([[https://github.com/alphapapa/org-ql/issues/431][#431]]. Thanks to [[https://github.com/jezcope][Jez Cope]] for reporting.)
** 0.8.6
*Fixes*
+ Bookmarking ~org-ql-view~ buffers when the ~buffers-files~ argument is a symbol (like ~org-agenda-files~).
** 0.8.5
*Fixes*
+ Predicate ~heading~ incorrectly matched strings as regular expressions, sometimes returning incorrect results. (See [[https://github.com/alphapapa/org-ql/discussions/410][discussion]]. Thanks to [[https://github.com/al3xandru][Alex Popescu]] for reporting.)
+ Predicates ~ancestor~ and ~parent~ did not normalize their sub-queries, sometimes returning incorrect results. ([[https://github.com/alphapapa/org-ql/issues/365][#365]]. Thanks to [[https://github.com/kofm][Gabriele Mongiano]] for reporting.)
** 0.8.4
*Fixes*
+ Command ~org-ql-find~ goes to the selected entry in the base buffer (rather than potentially an indirect buffer, whose narrowing could leave the selected entry hidden. The nuances around going to entries in buffers that may be indirect and/or narrowed are surprisingly complicated. Hopefully this is the last fix).
** 0.8.3
*Fixes*
+ Command ~org-ql-find~ incorrectly moved point. (See [[https://github.com/alphapapa/org-ql/issues/380#issuecomment-1881913025][#380]]. Thanks to [[https://github.com/oantolin][Omar Antolín Camarena]] for reporting.)
** 0.8.2
*Fixes*
+ Command ~org-ql-find~ incorrectly restored the buffer after jumping when not using indirect buffers. (See [[https://github.com/alphapapa/org-ql/issues/380#issuecomment-1881913025][#380]]. Thanks to [[https://github.com/bram85][Bram Schoenmakers]] for reporting.)
** 0.8.1
*Fixes*
+ Command ~org-ql-find~ widens the buffer before going to the selected entry.
+ In ~org-ql-view~ buffers, links in headings remain clickable links. (Fixes [[https://github.com/alphapapa/org-ql/issues/282][#282]]. Thanks to [[https://github.com/jakebox][Jacob Boxerman]] for reporting.)
** 0.8
*Additions*
+ Function ~org-ql-completing-read~, used by command ~org-ql-find~, now specifies the completion category as ~org-heading~, providing compatibility with [[https://github.com/oantolin/embark][Embark]]. (This is a powerful feature, as it means any ~org-ql-find~ result can be acted on from inside the search results with Embark, which provides common actions from Org Agenda and Org speed keys bindings.) ([[https://github.com/alphapapa/org-ql/issues/299][#299]]. Thanks to [[https://github.com/oantolin][Omar Antolín Camarena]], [[https://github.com/minad][Daniel Mendler]], and [[https://github.com/akirak][Akira Komamura]].)
- Command ~org-ql-completing-read-export~, bound to ~C-c C-e~ or ~embark-export~ while in an ~org-ql-completing-read~ session, exits and shows an ~org-ql-view~ buffer for the current search.
+ Command ~org-ql-find~ may be called in an ~org-agenda~ or ~org-ql-view~ buffer to search the buffers which contributed to the agenda/view buffer.
+ Command ~org-ql-find-path~, which searches outline paths in the current buffer.
+ Command ~org-ql-open-link~, which finds links in entries matching the given query, and opens the selected one with ~org-open-at-point~. (This is helpful when a collection of links are kept in Org files: rather than having to first visit the entry containing the desired link, then locate it within the entry, and then open it, the user can simply select the link and open it directly.)
+ Items in ~org-ql-view~ buffers now include the ~org-category~ text property, like Org Agenda buffers, which allows grouping with ~org-super-agenda~'s category-related selectors. ([[https://github.com/alphapapa/org-ql/issues/363][#363]]. Thanks to [[https://github.com/kofm][Gabriele Mongiano]] for reporting.)
*Fixes*
+ Predicate ~property~ correctly uses the value of ~org-use-property-inheritance~ when not specified. ([[https://github.com/alphapapa/org-ql/pull/346][#346]], [[https://github.com/alphapapa/org-ql/issues/356][#356]]. Thanks to [[https://github.com/bram85][Bram Schoenmakers]].)
*Compatibility*
+ Emacs 27.1 or later is now required.
+ Org v9.7's ~org-element~ API changes required some adjustments. ([[https://github.com/alphapapa/org-ql/issues/364][#364]]. Thanks to several users for reporting, and to [[https://github.com/yantar92][Ihor Radchenko]] for his feedback.)
** 0.7.4
*Fixes*
+ Ignore empty quoted strings in plain-string queries ([[https://github.com/alphapapa/org-ql/issues/383][#383]]).
** 0.7.3
*Fixes*
+ Disable ~case-fold-search~ when collecting headings in outline paths. (Headings that started with a word that is also a to-do keyword but with different capitalization would be matched incorrectly.)
+ Saving of ~org-ql-view~ views. ([[https://github.com/alphapapa/org-ql/issues/378][#378]]. Thanks to [[https://github.com/Pentaquark1][Pentaquark1]] for reporting.)
+ Command ~org-ql-find~ didn't move point to the selected entry. ([[https://github.com/alphapapa/org-ql/issues/380][#380]]. Thanks to [[https://github.com/oantolin][Omar Antolín Camarena]] for reporting.)
** 0.7.2
*Fixes*
+ Timestamp predicates are more tolerant of partial input (e.g. preventing errors while the user is typing a query into ~org-ql-find~).
+ Query parser ignores leading whitespace (e.g. preventing errors while the user is typing a query into ~org-ql-find~).
+ Use of ~org-ql-find~ with ~:query-prefix~ argument prevented selection of results. ([[https://github.com/alphapapa/org-ql/issues/351][#351]]. Thanks to [[https://github.com/danielfleischer][Daniel Fleischer]] for reporting.)
+ Handle narrowed buffers correctly in ~org-ql-find~.
+ Warn about empty headings in ~org-ql-completing-read~ (the Org format allows a heading line to have no text, but it's useless for this purpose, and usually indicates unnoticed corruption).
** 0.7.1
*Fixes*
+ Function ~org-ql-completing-read~ is more compatible with default Emacs completion. (See [[https://github.com/alphapapa/org-ql/issues/338][#338]]. Thanks to [[https://github.com/arozbiz][arozbiz]] for reporting.)
+ Function ~org-ql-completing-read~ would sometimes stop updating with changes in input. (See [[https://github.com/alphapapa/org-ql/issues/350][#350]]. Thanks to [[https://github.com/anpandey][Ankit Raj Pandey]] for reporting and fixing, and to [[https://github.com/minad][Daniel Mendler]] for advising.)
+ In ~org-ql-completing-read~, format links for display, and use ~org-entry-get~ internally rather than ~org-get-heading~.
** 0.7
*Added*
+ Command ~org-ql-find~, which jumps to entries selected using Emacs's built-in completion facilities and Org QL queries (like ~helm-org-ql~, but doesn't require Helm.).
+ Command ~org-ql-refile~, which refiles the entry at point to one selected using Org QL completion.
+ Predicate ~rifle~, which matches an entry if each of the given arguments is found in either the entry's contents or its outline path. This provides very intuitive results, mimicing the behavior of [[https://github.com/alphapapa/org-rifle][=org-rifle=]]. In fact, the results are so useful that it's now the default predicate for plain-string query tokens. (It is also aliased to ~smart~, since it's so "smart," and not all users have used =org-rifle=.)
+ Option ~org-ql-default-predicate~, applied to plain-string query tokens (before, the ~regexp~ predicate was always used, but now it may be customized).
+ Alias ~c~ for predicate ~category~.
+ Predicate ~property~ now accepts the argument ~:inherit~ to match entries with property inheritance, and when unspecified, the option ~org-use-property-inheritance~ controls whether inheritance is used.
+ Predicate ~blocked~. (Thanks to [[https://github.com/akirak][Akira Komamura]].)
*Changed*
+ Give more useful error message for invalid queries.
+ Predicate ~src~ now matches case-insensitively.
+ Command ~org-ql-sparse-tree~ accepts both string and sexp queries. (Thanks to [[https://github.com/akirak][Akira Komamura]].)
*Fixed*
+ Predicate ~link~ matches links whose descriptions contain escaped brackets (changed in Org 9.3). (Thanks to [[https://github.com/exot][Daniel Borchmann]] for reporting.)
+ Predicate ~src~'s matching of begin/end block lines, normalization of arguments, and handling in non-sexp queries. (Thanks to [[https://github.com/akirak][Akira Komamura]] for reporting.)
+ Predicate ~src~'s behavior with various arguments.
+ Various compilation warnings.
*Internal*
+ Certain query predicates, when called multiple times in an ~and~ sub-expression, are optimized to a single call.
+ Use ~buffer-chars-modified-tick~ instead of ~buffer-modified-tick~. (Thanks to [[https://github.com/yantar92][Ihor Radchenko]].)
+ Implemented tests for ~src~ predicate.
*Credits*
+ Thanks to [[https://github.com/chasecaleb][Caleb Chase]] for help with [[https://github.com/alphapapa/org-ql/pull/285][#285]], fixed in [[https://github.com/alphapapa/org-ql/commit/91908186fcca4b5fd2e9d26da5bc0375c2b41acf][9190818]].
** 0.6.3
*Fixed*
+ Non-sexp query parsing with updated version 1.0.1 of the ~peg~ package. (Fixes [[https://github.com/alphapapa/org-ql/issues/314][#314]], [[https://github.com/alphapapa/org-ql/issues/316][#316]]. Thanks to [[https://github.com/akirak][Akira Komamura]] and [[https://github.com/joonro][Joon Ro]] for reporting.)
+ Require library ~org-duration~ (apparently necessary in newer Org versions).
** 0.6.2
*Fixed*
+ ~link~ predicate when used in an ~or~'ed query. ([[https://github.com/alphapapa/org-ql/issues/279][#279]]. Thanks to [[https://github.com/telenieko][Marc Fargas]] for reporting.)
** 0.6.1
*Fixed*
+ In dynamic blocks, links to headings with statistics cookies were broken. (Fixes [[https://github.com/alphapapa/org-ql/issues/248][#248]]. Thanks to [[https://github.com/maikol-solis][Maikol Solis]] and [[https://github.com/yantar92][Ihor Radchenko]].)
*Updated*
+ Compatibility with new macro names in Transient. ([[https://github.com/alphapapa/org-ql/pull/269][#269]]. Thanks to [[https://github.com/tarsius][Jonas Bernoulli]].)
** 0.6
*Added* *Added*
+ Macro =org-ql-defpred=, used to define search predicates. (See [[file:examples/defpred.org][tutorial]].) + Macro =org-ql-defpred=, used to define search predicates. (See [[file:examples/defpred.org][tutorial]].)
+ Predicate ~effort~. + Predicate ~effort~.
+ Predicate ~heading-regexp~, which matches regular expressions against heading text (alias: ~h*~). + Predicate ~heading-regexp~, which matches regular expressions against heading text (alias: ~h*~).
+ Timestamp-related predicates now accept an optional ~:with-time~ argument, which allows matching timestamps with or without times (i.e. HH:MM). + Timestamp-related predicates now accept an optional ~:with-time~ argument, which allows matching timestamps with or without times (i.e. HH:MM).
+ Sorting methods:
- ~reverse~
- ~closed~ (Thanks to [[https://github.com/yejianye][Ryan Ye]].)
+ Dynamic block column ~closed~. (Thanks to [[https://github.com/yejianye][Ryan Ye]].)
+ Abbreviate filenames in bookmarks. (Thanks to [[https://github.com/akirak][Akira Komamura]].)
*Changed* *Changed*
+ The order in which sorting functions is applied has been reversed. For example, ~:sort '(todo priority date)~ now does what ~:sort '(date priority todo)~ did in earlier versions. (This change is made to enable the new ~reverse~ sorting method.) Users who have customized =org-ql-views= will need to update the stored views' sorting methods to preserve the desired sort order.
+ Helm support (including the command =helm-org-ql=) has been moved to a separate package, =helm-org-ql=. + Helm support (including the command =helm-org-ql=) has been moved to a separate package, =helm-org-ql=.
+ Predicate ~heading~ now matches plain strings instead of regular expressions. + Predicate ~heading~ now matches plain strings instead of regular expressions.
+ Update =dash= dependency, and remove dependency on obsolete =dash-functional=. (Fixes [[https://github.com/alphapapa/org-ql/issues/179][#179]], [[https://github.com/alphapapa/org-ql/issues/209][#209]]. Thanks to [[https://github.com/landakram][Mark Hudnall]], [[https://github.com/akirak][Akira Komamura]], [[https://github.com/natask][Nathanael kinfe]], [[https://github.com/benthamite][Pablo Stafforini]], [[https://github.com/jmay][Jason May]], and [[https://github.com/basil-conto][Basil L. Contovounesios]].) + Update =dash= dependency, and remove dependency on obsolete =dash-functional=. (Fixes [[https://github.com/alphapapa/org-ql/issues/179][#179]], [[https://github.com/alphapapa/org-ql/issues/209][#209]]. Thanks to [[https://github.com/landakram][Mark Hudnall]], [[https://github.com/akirak][Akira Komamura]], [[https://github.com/natask][Nathanael kinfe]], [[https://github.com/benthamite][Pablo Stafforini]], [[https://github.com/jmay][Jason May]], and [[https://github.com/basil-conto][Basil L. Contovounesios]].)
*Removed*
+ Obsolete macro ~org-ql~ (obsolete since 0.5, replaced by functions ~org-ql-select~ and ~org-ql-query~).
*Fixed* *Fixed*
+ Timestamp-related predicates called with relative-date arguments did not properly invalidate the query cache. (Fixes [[https://github.com/alphapapa/org-ql/issues/223][#223]]. Thanks to [[https://github.com/yantar92][Ihor Radchenko]] for reporting.) + Timestamp-related predicates called with relative-date arguments did not properly invalidate the query cache. (Fixes [[https://github.com/alphapapa/org-ql/issues/223][#223]]. Thanks to [[https://github.com/yantar92][Ihor Radchenko]] for reporting.)
@ -777,6 +1003,14 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
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

@ -35,7 +35,7 @@ Show an agenda-like view, similar to a "traditional" Org Agenda with Log Mode tu
(scheduled :to today) (scheduled :to today)
(ts-active :on today))) (ts-active :on today)))
(closed :on today)) (closed :on today))
:sort '(date priority todo)) :sort '(todo priority date))
#+END_SRC #+END_SRC
Another example, showing grouping with [[https://github.com/alphapapa/org-super-agenda][org-super-agenda]]: Another example, showing grouping with [[https://github.com/alphapapa/org-super-agenda][org-super-agenda]]:
@ -76,7 +76,7 @@ Show entries that have any timestamp within the past week. Group by date using
(org-ql-search (org-agenda-files) (org-ql-search (org-agenda-files)
'(ts :from -7 :to today) '(ts :from -7 :to today)
:title "Recent Items" :title "Recent Items"
:sort '(date priority todo) :sort '(todo priority date)
:super-groups '((:auto-ts t))) :super-groups '((:auto-ts t)))
#+END_SRC #+END_SRC

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-pre ;; Version: 0.6.2
;; Package-Requires: ((emacs "26.1") (dash "2.18.1") (s "1.12.0") (helm-org "1.0") (org-ql "0.6-pre")) ;; 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"))
;;; Commentary: ;;; Commentary:
@ -35,6 +35,7 @@
(require 'cl-lib) (require 'cl-lib)
(require 'org) (require 'org)
(require 'compat)
(require 'dash) (require 'dash)
(require 's) (require 's)
@ -44,6 +45,15 @@
(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
@ -98,9 +108,11 @@ Based on `helm-map'.")
Interactively, search the current buffer. Note that this command Interactively, search the current buffer. Note that this command
only accepts non-sexp, \"plain\" queries. only accepts non-sexp, \"plain\" queries.
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 indepenent around words that are intended to be searched for as independent
strings. strings.
All query tokens are wrapped in the operator BOOLEAN (default All query tokens are wrapped in the operator BOOLEAN (default
@ -149,7 +161,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)
(org-show-entry)) (helm-org-ql--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'."
@ -175,7 +187,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 that searches BUFFERS-FILES with `helm-org-ql'." "Return Helm source named NAME to search 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 ()
@ -199,7 +211,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 (point-at-bol) (point-at-eol)) (font-lock-ensure (pos-bol) (pos-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

Binary file not shown.

Before

Width:  |  Height:  |  Size: 5.5 KiB

BIN
images/org-ql-find.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 92 KiB

251
makem.sh
View file

@ -3,11 +3,11 @@
# * 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.3 # Version: 0.7.1
# * Commentary: # * Commentary:
# makem.sh is a script helps to build, lint, and test Emacs Lisp # makem.sh is a script that helps to build, lint, and test Emacs Lisp
# packages. It aims to make linting and testing as simple as possible # packages. It aims to make linting and testing as simple as possible
# without requiring per-package configuration. # without requiring per-package configuration.
@ -79,7 +79,7 @@ Rules:
Options: Options:
-d, --debug Print debug info. -d, --debug Print debug info.
-h, --help I need somebody! -h, --help I need somebody!
-v, --verbose Increase verbosity, up to -vv. -v, --verbose Increase verbosity, up to -vvv.
--no-color Disable color output. --no-color Disable color output.
--debug-load-path Print load-path from inside Emacs. --debug-load-path Print load-path from inside Emacs.
@ -112,6 +112,12 @@ 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
} }
@ -136,6 +142,27 @@ EOF
echo $file echo $file
} }
function elisp-elint-file {
local file=$(mktemp)
cat >$file <<EOF
(require 'cl-lib)
(require 'elint)
(defun makem-elint-file (file)
(let ((errors 0))
(cl-letf (((symbol-function 'orig-message) (symbol-function 'message))
((symbol-function 'message) (symbol-function 'ignore))
((symbol-function 'elint-output)
(lambda (string)
(cl-incf errors)
(orig-message "%s" string))))
(elint-file file)
;; NOTE: \`errors' is not actually the number of errors, because
;; it's incremented for non-error header strings as well.
(kill-emacs errors))))
EOF
echo "$file"
}
function elisp-checkdoc-file { function elisp-checkdoc-file {
# Since checkdoc doesn't have a batch function that exits non-zero # Since checkdoc doesn't have a batch function that exits non-zero
# when errors are found, we make one. # when errors are found, we make one.
@ -154,7 +181,9 @@ function elisp-checkdoc-file {
": " text))) ": " text)))
(message msg) (message msg)
(setq makem-checkdoc-errors-p t) (setq makem-checkdoc-errors-p t)
(list text start end unfixable))))) ;; Return nil because we *are* generating a buffered list of errors.
nil))))
(put 'ispell-buffer-session-localwords 'safe-local-variable #'list-of-strings-p)
(mapcar #'checkdoc-file files) (mapcar #'checkdoc-file files)
(when makem-checkdoc-errors-p (when makem-checkdoc-errors-p
(kill-emacs 1)))) (kill-emacs 1))))
@ -165,6 +194,51 @@ EOF
echo $file echo $file
} }
function elisp-byte-compile-file {
# This seems to be the only way to make byte-compilation signal
# errors for warnings AND display all warnings rather than only
# the first one.
local file=$(mktemp)
# TODO: Add file to $paths_temp in other elisp- functions.
paths_temp+=("$file")
cat >"$file" <<EOF
(defun makem-batch-byte-compile (&rest args)
""
(let ((num-errors 0)
(num-warnings 0))
;; NOTE: Only accepts files as args, not directories.
(dolist (file command-line-args-left)
(pcase-let ((\`(,errors ,warnings) (makem-byte-compile-file file)))
(cl-incf num-errors errors)
(cl-incf num-warnings warnings)))
(zerop num-errors)))
(defun makem-byte-compile-file (filename &optional load)
"Call \`byte-compile-warn', returning the number of errors and the number of warnings."
(let ((num-warnings 0)
(num-errors 0))
(cl-letf (((symbol-function 'byte-compile-warn)
(lambda (format &rest args)
;; Copied from \`byte-compile-warn'.
(cl-incf num-warnings)
(setq format (apply #'format-message format args))
(byte-compile-log-warning format t :warning)))
((symbol-function 'byte-compile-report-error)
(lambda (error-info &optional fill &rest args)
(cl-incf num-errors)
;; Copied from \`byte-compile-report-error'.
(setq byte-compiler-error-flag t)
(byte-compile-log-warning
(if (stringp error-info) error-info
(error-message-string error-info))
fill :error))))
(byte-compile-file filename load))
(list num-errors num-warnings)))
EOF
echo "$file"
}
function elisp-check-declare-file { function elisp-check-declare-file {
# Since check-declare doesn't have a batch function that exits # Since check-declare doesn't have a batch function that exits
# non-zero when errors are found, we make one. # non-zero when errors are found, we make one.
@ -200,20 +274,23 @@ Exits non-zero if mis-indented lines are found. Checks files in
(let ((errors-p)) (let ((errors-p))
(cl-labels ((lint-file (file) (cl-labels ((lint-file (file)
(find-file file) (find-file file)
(let ((tick (buffer-modified-tick)))
(let ((inhibit-message t)) (let ((inhibit-message t))
(indent-region (point-min) (point-max))) (indent-region (point-min) (point-max)))
(when (/= tick (buffer-modified-tick)) (when buffer-undo-list
;; Indentation changed: warn for each line. ;; Indentation changed: warn for each line.
(dolist (line (undo-lines buffer-undo-list)) (dolist (line (undo-lines buffer-undo-list))
(message "%s:%s: Indentation mismatch" (buffer-name) line)) (message "%s:%s: Indentation mismatch" (buffer-name) line))
(setf errors-p t)))) (setf errors-p t)))
(undo-pos (entry)
(cl-typecase (car entry)
(number (car entry))
(string (abs (cdr entry)))))
(undo-lines (undo-list) (undo-lines (undo-list)
;; Return list of lines changed in UNDO-LIST. ;; Return list of lines changed in UNDO-LIST.
(nreverse (cl-loop for elt in undo-list (nreverse (cl-loop for elt in undo-list
when (and (consp elt) for pos = (undo-pos elt)
(numberp (car elt))) when pos
collect (line-number-at-pos (car elt)))))) collect (line-number-at-pos pos)))))
(mapc #'lint-file (mapcar #'expand-file-name command-line-args-left)) (mapc #'lint-file (mapcar #'expand-file-name command-line-args-left))
(when errors-p (when errors-p
(kill-emacs 1))))) (kill-emacs 1)))))
@ -230,9 +307,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)
(setq load-prefer-newer t)
EOF EOF
echo $file echo $file
} }
@ -245,6 +320,7 @@ function run_emacs {
local emacs_command=( local emacs_command=(
"${emacs_command[@]}" "${emacs_command[@]}"
-Q -Q
--eval "(setq load-prefer-newer t)"
"${args_debug[@]}" "${args_debug[@]}"
"${args_sandbox[@]}" "${args_sandbox[@]}"
-l $package_initialize_file -l $package_initialize_file
@ -286,8 +362,9 @@ function batch-byte-compile {
[[ $compile_error_on_warn ]] && local error_on_warn=(--eval "(setq byte-compile-error-on-warn t)") [[ $compile_error_on_warn ]] && local error_on_warn=(--eval "(setq byte-compile-error-on-warn t)")
run_emacs \ run_emacs \
--load "$(elisp-byte-compile-file)" \
"${error_on_warn[@]}" \ "${error_on_warn[@]}" \
--funcall batch-byte-compile \ --eval "(unless (makem-batch-byte-compile) (kill-emacs 1))" \
"$@" "$@"
} }
@ -297,14 +374,47 @@ function byte-compile-file {
[[ $compile_error_on_warn ]] && local error_on_warn=(--eval "(setq byte-compile-error-on-warn t)") [[ $compile_error_on_warn ]] && local error_on_warn=(--eval "(setq byte-compile-error-on-warn t)")
# FIXME: Why is the line starting with "&& verbose 3" not indented properly? Emacs insists on indenting it back a level.
run_emacs \ run_emacs \
--load "$(elisp-byte-compile-file)" \
"${error_on_warn[@]}" \ "${error_on_warn[@]}" \
--eval "(byte-compile-file \"$file\")" \ --eval "(pcase-let ((\`(,num-errors ,num-warnings) (makem-byte-compile-file \"$file\"))) (when (or (and byte-compile-error-on-warn (not (zerop num-warnings))) (not (zerop num-errors))) (kill-emacs 1)))" \
|| error "Compiling file failed: $file" && verbose 3 "Compiling $file finished without errors." \
|| { verbose 3 "Compiling file failed: $file"; return 1; }
} }
# ** 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
@ -313,7 +423,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.
git ls-files 2>/dev/null \ files-project 2>/dev/null \
| egrep "\.el$" \ | egrep "\.el$" \
| filter-files-exclude-default \ | filter-files-exclude-default \
| filter-files-exclude-args | filter-files-exclude-args
@ -322,13 +432,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 \
| egrep -v "$test_files_regexp" \ | grep -E -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 | egrep "$test_files_regexp" files-project-elisp | grep -E "$test_files_regexp"
} }
function dirnames { function dirnames {
@ -341,7 +451,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.
egrep -v "(/\.cask/|-autoloads.el|.dir-locals)" grep -E -v "(/\.cask/|-autoloads\.el|\.dir-locals)"
} }
function filter-files-exclude-args { function filter-files-exclude-args {
@ -367,7 +477,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
egrep "^\\(provide '" "$path" &>/dev/null \ grep -E "^\\(provide '" "$path" &>/dev/null \
&& echo "$path" && echo "$path"
done done
} }
@ -376,7 +486,8 @@ function args-load-files {
# For file in $@, echo "--load $file". # For file in $@, echo "--load $file".
for file in "$@" for file in "$@"
do do
printf -- '--load %q ' "$file" sans_extension=${file%%.el}
printf -- '--load %q ' "$sans_extension"
done done
} }
@ -413,9 +524,8 @@ function ert-tests-p {
} }
function package-main-file { function package-main-file {
# Echo the package's main file. Helpful for setting package-lint-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
@ -438,23 +548,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.
egrep -a -i '^;; Package-Requires: ' $(files-project-feature) $(files-project-test) \ grep -E -a -i '^;; Package-Requires: ' $(files-project-feature) $(files-project-test) \
| egrep -o '\([^([:space:]][^)]*\)' \ | grep -E -o '\([^([:space:]][^)]*\)' \
| egrep -o '^[^[:space:])]+' \ | grep -E -o '^[^[:space:])]+' \
| sed -r 's/\(//g' \ | sed -r 's/\(//g' \
| egrep -v '^emacs$' # Ignore Emacs version requirement. | grep -E -v '^emacs$' # Ignore Emacs version requirement.
# Search Cask file. # Search Cask file.
if [[ -r Cask ]] if [[ -r Cask ]]
then then
egrep '\(depends-on "[^"]+"' Cask \ grep -E '\(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 [[ $(git ls-files ./*-pkg.el 2>/dev/null) ]] if [[ $(files-project "*-pkg.el" 2>/dev/null) ]]
then then
sed -nr 's/.*\(([-[:alnum:]]+)[[:blank:]]+"[.[:digit:]]+"\).*/\1/p' $(git ls-files ./*-pkg.el 2>/dev/null) sed -nr 's/.*\(([-[:alnum:]]+)[[:blank:]]+"[.[:digit:]]+"\).*/\1/p' $(files-project- -- -pkg.el 2>/dev/null)
fi fi
} }
@ -496,6 +606,8 @@ function sandbox {
args_sandbox=( args_sandbox=(
--title "makem.sh: $(basename $(pwd)) (sandbox: $sandbox_dir)" --title "makem.sh: $(basename $(pwd)) (sandbox: $sandbox_dir)"
--eval "(setq user-emacs-directory (file-truename \"$sandbox_dir\"))" --eval "(setq user-emacs-directory (file-truename \"$sandbox_dir\"))"
--load package
--eval "(setq package-user-dir (expand-file-name \"elpa\" user-emacs-directory))"
--eval "(setq user-init-file (file-truename \"$init_file\"))" --eval "(setq user-init-file (file-truename \"$init_file\"))"
) )
@ -505,6 +617,9 @@ 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)")
@ -658,7 +773,8 @@ function verbose {
if [[ $verbose -ge $1 ]] if [[ $verbose -ge $1 ]]
then then
[[ $1 -eq 1 ]] && local color_name=blue [[ $1 -eq 1 ]] && local color_name=blue
[[ $1 -ge 2 ]] && local color_name=cyan [[ $1 -eq 2 ]] && local color_name=cyan
[[ $1 -ge 3 ]] && local color_name=white
shift shift
log_color $color_name "$@" >&2 log_color $color_name "$@" >&2
@ -706,9 +822,7 @@ function compile-batch {
verbose 2 "Batch-compiling files..." verbose 2 "Batch-compiling files..."
debug "Byte-compile files: ${files_project_byte_compile[@]}" debug "Byte-compile files: ${files_project_byte_compile[@]}"
batch-byte-compile "${files_project_byte_compile[@]}" \ batch-byte-compile "${files_project_byte_compile[@]}"
&& success "Compiling finished without errors." \
|| error "Compilation failed."
} }
function compile-each { function compile-each {
@ -726,9 +840,7 @@ function compile-each {
|| compile_errors=t || compile_errors=t
done done
! [[ $compile_errors ]] \ [[ ! $compile_errors ]]
&& success "Compiling finished without errors." \
|| error "Compilation failed."
} }
function compile { function compile {
@ -738,6 +850,18 @@ function compile {
else else
compile-each "$@" compile-each "$@"
fi fi
local status=$?
if [[ $compile_error_on_warn ]]
then
# Linting: just return status code, because lint rule will print messages.
[[ $status = 0 ]]
else
# Not linting: print messages here.
[[ $status = 0 ]] \
&& success "Compiling finished without errors." \
|| error "Compiling failed."
fi
} }
function batch { function batch {
@ -752,12 +876,15 @@ function batch {
function interactive { function interactive {
# Run Emacs interactively. Most useful with --sandbox and --install-deps. # Run Emacs interactively. Most useful with --sandbox and --install-deps.
local load_file_args=$(args-load-files "${files_project_feature[@]}" "${files_project_test[@]}")
verbose 1 "Running Emacs interactively..." verbose 1 "Running Emacs interactively..."
verbose 2 "Loading files:" "${files_project_feature[@]}" "${files_project_test[@]}" verbose 2 "Loading files: ${load_file_args//--load /}"
[[ $compile ]] && compile
unset arg_batch unset arg_batch
run_emacs \ run_emacs \
$(args-load-files "${files_project_feature[@]}" "${files_project_test[@]}") \ $load_file_args \
--eval "(load user-init-file)" \ --eval "(load user-init-file)" \
"${args_batch_interactive[@]}" "${args_batch_interactive[@]}"
arg_batch="--batch" arg_batch="--batch"
@ -769,6 +896,9 @@ function lint {
lint-checkdoc lint-checkdoc
lint-compile lint-compile
lint-declare lint-declare
# NOTE: Elint doesn't seem very useful at the moment. See comment
# in lint-elint function.
# lint-elint
lint-indent lint-indent
lint-package lint-package
lint-regexps lint-regexps
@ -825,6 +955,28 @@ function lint-elsa {
|| error "Linting with Elsa failed." || error "Linting with Elsa failed."
} }
function lint-elint {
# NOTE: Elint gives a lot of spurious warnings, apparently because it doesn't load files
# that are `require'd, so its output isn't very useful. But in case it's improved in
# the future, and since this wrapper code already works, we might as well leave it in.
verbose 1 "Linting with Elint..."
local errors=0
for file in "${files_project_feature[@]}"
do
verbose 2 "Linting with Elint: $file..."
run_emacs \
--load "$(elisp-elint-file)" \
--eval "(makem-elint-file \"$file\")" \
&& verbose 3 "Linting with Elint found no errors." \
|| { error "Linting with Elint failed: $file"; ((errors++)) ; }
done
[[ $errors = 0 ]] \
&& success "Linting with Elint finished without errors." \
|| error "Linting with Elint failed."
}
function lint-indent { function lint-indent {
verbose 1 "Linting indentation..." verbose 1 "Linting indentation..."
@ -896,7 +1048,8 @@ function test-buttercup {
run_emacs \ run_emacs \
$(args-load-files "${files_project_test[@]}") \ $(args-load-files "${files_project_test[@]}") \
-f buttercup-run \ --load "$buttercup_file" \
--eval "(progn (setq backtrace-on-error-noninteractive nil) (buttercup-run))" \
&& success "Buttercup tests finished without errors." \ && success "Buttercup tests finished without errors." \
|| error "Buttercup tests failed." || error "Buttercup tests failed."
} }
@ -970,21 +1123,15 @@ 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:CO \ -o dhce:E:i:s::vf:C \
-l compile-batch,exclude:,emacs:,install-deps,install-linters,debug,debug-load-path,help,install:,verbose,file:,no-color,no-compile,no-org-repo,sandbox:: \ -l compile-batch,exclude:,emacs:,install-deps,install-linters,debug,debug-load-path,help,install:,verbose,file:,no-color,no-compile,sandbox:: \
-- "$@") \ -- "$@") \
|| { usage; exit 1; } || { usage; exit 1; }
eval set -- "$args" eval set -- "$args"
@ -1048,9 +1195,6 @@ 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
;; ;;
@ -1079,6 +1223,9 @@ 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))

402
org-ql-completing-read.el Normal file
View file

@ -0,0 +1,402 @@
;;; org-ql-completing-read.el --- Completing read of Org entries using org-ql -*- lexical-binding: t; -*-
;; Copyright (C) 2022-2023 Adam Porter
;; Author: Adam Porter <adam@alphapapa.net>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides completing-read of Org entries using `org-ql'
;; search.
;;; Code:
(require 'org-ql)
(declare-function org-ql-search "org-ql-search")
(declare-function org-ql--normalize-query "org-ql" t t)
;;;; Variables
(defvar-keymap org-ql-completing-read-map
:doc "Active during `org-ql-completing-read' sessions."
"C-c C-e" #'org-ql-completing-read-export)
;; `embark-collect' doesn't work for `org-ql-completing-read', so remap
;; it to `embark-export' (which `keymap-set', et al doesn't allow).
(define-key org-ql-completing-read-map [remap embark-collect] 'embark-export)
;;;; Customization
(defgroup org-ql-completing-read nil
"Completing-read of Org entries using `org-ql' search."
:group 'org-ql)
(defcustom org-ql-completing-read-reverse-paths t
"Whether to reverse Org outline paths in `org-ql-completing-read' results."
:type 'boolean)
(defcustom org-ql-completing-read-snippet-function #'org-ql-completing-read--snippet-simple
;; TODO(v0.9): Performance of completion annotations seems to be
;; much improved now (whether due to changes in Emacs, Vertico, or
;; both, I don't know). It may be reasonable to make the context
;; snippet the default now.
"Function used to annotate results in `org-ql-completing-read'.
Function is called at entry beginning. (When set to
`org-ql-completing-read--snippet-regexp', it is called with a
regexp matching plain query tokens.)"
:type '(choice (function-item :tag "Show context around search terms" org-ql-completing-read--snippet-regexp)
(function-item :tag "Show first N characters" org-ql-completing-read--snippet-simple)
(function :tag "Custom function")))
(defcustom org-ql-completing-read-snippet-length 51
"Size of snippets of entry content to include in completion annotations.
Only used when `org-ql-completing-read-snippet-function' is set
to `org-ql-completing-read--snippet-regexp'."
:type 'integer)
(defcustom org-ql-completing-read-snippet-minimum-token-length 3
"Query tokens shorter than this many characters are ignored.
That is, they are not included when gathering entry snippets.
This avoids too-small tokens causing performance problems."
:type 'integer)
(defcustom org-ql-completing-read-snippet-prefix nil
"String prepended to snippets.
For an experience like `org-rifle', use a newline."
:type '(choice (const :tag "None (shown on same line)" nil)
(const :tag "New line (shown under heading)" "\n")
string))
(defface org-ql-completing-read-snippet '((t (:inherit font-lock-comment-face)))
"Snippets.")
(defvar org-ql-completing-read-input-regexp nil
"Current regexp for `org-ql-completing-read' input.
To be used in, e.g. annotation functions.")
;;;; Functions
(defun org-ql-completing-read-action ()
"Default action for `org-ql-completing-read'.
Returns (STRING . MARKER) cons for entry at point."
(font-lock-ensure (pos-bol) (pos-eol))
(cons (org-link-display-format (org-entry-get nil "ITEM")) (point-marker)))
(defun org-ql-completing-read-snippet (marker)
"Return snippet for entry at MARKER.
Returns value returned by function
`org-ql-completing-read-snippet-function' or
`org-ql-completing-read--snippet-simple', whichever returns a
value, or nil."
(pcase (while-no-input
;; Using `while-no-input' here doesn't make it as
;; responsive as, e.g. Helm while typing, but it seems to
;; help a little when using the org-rifle-style snippets.
(org-with-point-at marker
(or (funcall org-ql-completing-read-snippet-function
org-ql-completing-read-input-regexp)
(org-ql-completing-read--snippet-simple))))
(`t ;; Interrupted: return nil (which can be concatted).
nil)
(else (propertize (concat " " else)
'face 'org-ql-completing-read-snippet))))
(defun org-ql-completing-read-path (marker)
"Return formatted outline path for entry at MARKER."
(org-with-point-at marker
(let ((path (thread-first (org-get-outline-path nil t)
(org-format-outline-path (window-width) nil "")
(org-split-string ""))))
(if org-ql-completing-read-reverse-paths
(concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/"))))))
;;;;; Completing read
(defun org-ql-completing-read-export ()
"Show `org-ql-view' buffer for current `org-ql-completing-read'-based search."
(interactive)
(user-error "Not in an `org-ql-completing-read' session"))
;;;###autoload
(cl-defun org-ql-completing-read
(buffers-files &key query-prefix query-filter narrowp
(action #'org-ql-completing-read-action)
;; FIXME: Unused argument.
;; (annotate #'org-ql-completing-read-snippet)
(snippet #'org-ql-completing-read-snippet)
(path #'org-ql-completing-read-path)
(action-filter #'list)
(prompt "Find entry: "))
"Return marker at entry in BUFFERS-FILES selected with `org-ql'.
PROMPT is shown to the user.
NARROWP is passed to `org-ql-select', which see.
QUERY-PREFIX may be a string to prepend to the query entered by
the user (e.g. use \"heading:\" to only search headings, easily
creating a custom command that saves the user from having to type
it).
QUERY-FILTER may be a function through which the query the user
types is filtered before execution (e.g. it could replace spaces
with commas to turn multiple tokens, which would normally be
treated as multiple predicates, into multiple arguments to a
single predicate)."
(declare (indent defun))
;; Emacs's completion API is not always easy to understand, especially when using "programmed
;; completion." This code was made possible by the example Clemens Radermacher shared at
;; <https://github.com/radian-software/selectrum/issues/114#issuecomment-744041532>.
;; NOTE: I don't usually leave commented-out debugging code, but due to the incredibly tedious
;; complexity of the "Programmed Completion" API and the time spent trying to get this reasonably
;; close to "correct," I'm leaving it in, because I will undoubtedly have to go through this
;; process again.
;; (message "ORG-QL-COMPLETING-READ: Starts.")
(let ((table (make-hash-table :test #'equal))
(disambiguations (make-hash-table :test #'equal))
(window-width (window-width))
last-input org-outline-path-cache query-tokens)
(cl-labels (;; (debug-message
;; (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args))
(action ()
(font-lock-ensure (pos-bol) (pos-eol))
;; This function needs to handle multiple candidates per
;; call, so we loop over a list of values by default.
(pcase-dolist (`(,string . ,marker) (funcall action-filter (funcall action)))
(when string
(if (string-empty-p string)
;; A heading's string can be empty, but we can't use one because it
;; wouldn't be useful to the user; and if one is found, it's very
;; likely to indicate an unnoticed mistake or corruption in the
;; file: so display a warning and don't record it as a candidate.
(display-warning 'org-ql-completing-read (format-message "Empty heading at %S" marker))
(when (gethash string table)
;; Disambiguate string (even adding the path isn't enough, because that could
;; also be duplicated).
(if-let ((suffix (gethash string disambiguations)))
(setf string (format "%s <%s>" string (cl-incf suffix)))
(setf string (format "%s <%s>" string (puthash string 2 disambiguations)))))
(puthash (propertize string 'org-marker marker) marker table)))))
(path (marker)
(org-with-point-at marker
(let* ((path (thread-first (org-get-outline-path nil t)
(org-format-outline-path window-width nil "")
(org-split-string "")))
(formatted-path (if org-ql-completing-read-reverse-paths
(concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/")))))
formatted-path)))
(todo (marker)
(if-let (it (org-entry-get marker "TODO"))
(concat (propertize it 'face (org-get-todo-face it)) " ")
""))
(affix (completions)
;; (debug-message "AFFIX:%S" completions)
(cl-loop for completion in completions
for marker = (get-text-property 0 'org-marker completion)
for prefix = (todo marker)
for suffix = (concat (funcall path marker) " " (funcall snippet marker))
collect (list completion prefix suffix)))
(annotate (candidate)
;; (debug-message "ANNOTATE:%S" candidate)
(while-no-input
;; Using `while-no-input' here doesn't make it as responsive as,
;; e.g. Helm while typing, but it seems to help a little when using the
;; org-rifle-style snippets.
(or (funcall snippet (get-text-property 0 'org-marker candidate)) "")))
(group (candidate transform)
(pcase transform
(`nil (buffer-name (marker-buffer (get-text-property 0 'org-marker candidate))))
(_ candidate)))
(try (string _collection _pred point &optional _metadata)
;; (debug-message "TRY: STRING:%S" string)
(cons string point))
(all (string table pred _point)
;; (debug-message "all: STRING:%S" string)
;; (debug-message "all-completions RETURNS: %S" (all-completions string table pred))
(all-completions string table pred))
(collection (input _pred flag)
(pcase flag
('metadata (list 'metadata
(cons 'category 'org-heading)
(cons 'group-function #'group)
(cons 'affixation-function #'affix)
(cons 'annotation-function #'annotate)
(cons 'display-sort-function
(lambda (strings)
(let ((quoted-tokens (mapcar #'regexp-quote query-tokens)))
(sort strings
(lambda (a b)
(cl-labels ((matches
(s) (cl-loop for token in quoted-tokens
count (string-match-p token s))))
(> (matches a) (matches b))))))))))
(`t
;; (debug-message "COLLECTION:t INPUT:%S KEYS:%S"
;; input (hash-table-keys table))
;; It's not ideal to call `run-query' unconditionally here, but due to
;; the complexity of the "Programmed Completion" API, it's basically
;; necessary, and org-ql's caching should make it nearly free.
(run-query input)
(hash-table-keys table))
('lambda
;; (debug-message "COLLECTION:lambda INPUT:%S KEYS:%S"
;; input (hash-table-keys table))
(if (not (hash-table-empty-p table))
(when (gethash input table)
t)
(run-query input)
(when (gethash input table)
;; (debug-message "COLLECTION:lambda INPUT:%S FOUND" input)
t)))
(`nil
;; (debug-message "COLLECTION:nil INPUT:%S" input)
(if (not (hash-table-empty-p table))
(when (gethash input table)
t)
(run-query input)
;; (debug-message "COLLECTION:nil INPUT:%S KEYS:%S"
;; input (hash-table-keys table))
(cond ((hash-table-empty-p table)
nil)
((gethash input table)
t)
(t
;; FIXME: "it should return the longest common prefix
;; substring of all matches otherwise"...but there's no
;; function to compute that? At least returning an empty
;; string doesn't seem to break anything.
input))))
(`(boundaries . ,suffix)
;; (debug-message "COLLECTION:boundaries INPUT:%S SUFFIX:%S KEYS:%S"
;; input suffix (hash-table-keys table))
;; FIXME: This is unlikely to be correct, but I'm not even sure if it
;; can be correct in this case since the input (e.g. "todo: foo")
;; usually won't match a completion candidate directly.
`(boundaries 0 . ,(length suffix)))))
(run-query (input)
;; (debug-message "RUN-QUERY:%S" input)
(when query-prefix
(setf input (concat query-prefix input)))
(unless (or (string-empty-p input)
(equal last-input input))
;; (debug-message "RUN-QUERY:%S RUNNING" input)
(setf last-input input)
;; Clear hash table each time the user changes the input.
(clrhash table)
(clrhash disambiguations)
(when query-filter
(setf input (funcall query-filter input)))
(setf query-tokens
;; Remove any tokens that specify predicates or are too short.
(--select (not (or (string-match-p (rx bos (1+ (not (any ":"))) ":") it)
(< (length it) org-ql-completing-read-snippet-minimum-token-length)))
(split-string input nil t (rx blank)))
org-ql-completing-read-input-regexp
(when query-tokens
;; Limiting each context word to 15 characters prevents
;; excessively long, non-word strings from ending up in
;; snippets, which can adversely affect performance.
(rx-to-string `(seq (optional (repeat 1 3 (repeat 1 15 (not space)) (0+ space)))
bow (or ,@query-tokens) (0+ (not space))
(optional (repeat 1 3 (0+ space) (repeat 1 15 (not space))))))))
(org-ql-select buffers-files (org-ql--query-string-to-sexp input)
:narrow narrowp
:action #'action))))
(unless (listp buffers-files)
;; Since we map across this argument, we ensure it's a list.
(setf buffers-files (list buffers-files)))
;; NOTE: It seems that the `completing-read' machinery can call, abort, and re-call the
;; collection function while the user is typing, which can interrupt the machinery Org uses to
;; prepare an Org buffer when an Org file is loaded. This results in, e.g. the buffer being
;; left in fundamental-mode, unprepared to be used as an Org buffer, which breaks many things
;; and is very confusing for the user. Ideally, of course, we would solve this in
;; `org-ql-select', and we already attempt to, but that function is called by the
;; `completing-read' machinery, which interrupts it, so we must work around this problem by
;; ensuring all of the BUFFERS-FILES are loaded and initialized before calling
;; `completing-read'.
(mapc #'org-ql--ensure-buffer buffers-files)
(let* ((completion-styles '(org-ql-completing-read))
(completion-styles-alist (cons (list 'org-ql-completing-read #'try #'all "Org QL Find")
completion-styles-alist))
(selected
(minibuffer-with-setup-hook
(lambda ()
(use-local-map (make-composed-keymap org-ql-completing-read-map (current-local-map))))
(cl-letf* (((symbol-function 'org-ql-completing-read-export)
(lambda ()
(interactive)
(run-at-time 0 nil
#'org-ql-search
buffers-files
(minibuffer-contents-no-properties))
(if (fboundp 'minibuffer-quit-recursive-edit)
(minibuffer-quit-recursive-edit)
(abort-recursive-edit))))
((symbol-function 'embark-export)
(symbol-function 'org-ql-completing-read-export)))
(completing-read prompt #'collection nil t)))))
;; (debug-message "SELECTED:%S KEYS:%S" selected (hash-table-keys table))
(or (gethash selected table)
;; If there are completions in the table, but none of them exactly match the user input
;; (e.g. a heading "foo" that matches a query "todo:"), `completing-read' will not
;; select it automatically, so we return it ourselves. But note that this is not
;; necessarily correct. For example, if the user types "todo:" and gets a list of
;; completions ("foo" "bar"), and then changes the input to "ba" and presses RET
;; immediately (without getting a new list of completions), the table will include "foo"
;; and "bar", and we will return "foo"'s value rather than the first match for the query
;; "ba", because `completing-read' will not cause the COLLECTION function to run a new
;; query for the new input.
(car (hash-table-values table))
(user-error "No results for input"))))))
(defun org-ql-completing-read--snippet-simple (&optional _input-regexp)
"Return a snippet of the current entry.
Returns up to `org-ql-completing-read-snippet-length' characters."
(save-excursion
(org-end-of-meta-data t)
(unless (org-at-heading-p)
(let ((end (min (+ (point) org-ql-completing-read-snippet-length)
(org-entry-end-position))))
(concat org-ql-completing-read-snippet-prefix
(truncate-string-to-width
(replace-regexp-in-string "\n" " " (buffer-substring (point) end)
t t)
50 nil nil t))))))
(defun org-ql-completing-read--snippet-regexp (&optional input-regexp)
"Return a snippet of the current entry's matches for INPUT-REGEXP."
;; REGEXP may be nil if there are no qualifying tokens in the query.
(when input-regexp
(save-excursion
(org-end-of-meta-data t)
(unless (org-at-heading-p)
(let* ((end (org-entry-end-position))
(snippets (cl-loop while (re-search-forward input-regexp end t)
concat (match-string 0) concat ""
do (goto-char (match-end 0)))))
(unless (string-empty-p snippets)
(concat org-ql-completing-read-snippet-prefix
(replace-regexp-in-string (rx (1+ "\n")) " " snippets t t))))))))
;;;; Footer
(provide 'org-ql-completing-read)
;;; org-ql-completing-read.el ends here

233
org-ql-find.el Normal file
View file

@ -0,0 +1,233 @@
;;; org-ql-find.el --- Find headings with completion using org-ql -*- lexical-binding: t; -*-
;; Copyright (C) 2022-2023 Adam Porter
;; Author: Adam Porter <adam@alphapapa.net>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides a way to quickly find and go to Org entries
;; selected with Emacs's built-in completions API (so it works with
;; packages that extend it, like Vertico, Marginalia, etc). It works
;; like `helm-org-ql' but does not require Helm.
;;; Code:
(require 'cl-lib)
(require 'org)
(require 'org-ql)
(require 'org-ql-search)
(require 'org-ql-completing-read)
(declare-function org-ql--normalize-query "org-ql" t t)
;;;; Customization
(defgroup org-ql-find nil
"Options for `org-ql-find'."
:group 'org-ql)
(defcustom org-ql-find-goto-hook '(org-show-entry org-reveal)
"Functions called when selecting an entry."
;; TODO: Add common choices, including `org-tree-to-indirect-buffer'.
:type 'hook)
(defcustom org-ql-find-display-buffer-action '(display-buffer-same-window)
"Display buffer action list for `org-ql-find'.
See function `display-buffer'."
:type 'sexp)
;;;; Commands
;;;###autoload
(cl-defun org-ql-find (buffers-files &key query-prefix query-filter widen
(prompt "Find entry: "))
"Go to an Org entry in BUFFERS-FILES selected by searching entries with `org-ql'.
Interactively, search the buffers and files relevant to the
current buffer (i.e. in `org-agenda-mode', the value of
`org-ql-view-buffers-files' or `org-agenda-contributing-files';
in `org-mode', that buffer).
With one or more universal prefix arguments, WIDEN buffers before
searching (otherwise, respect any narrowing). With two universal
prefix arguments, select multiple buffers to search with
completion and PROMPT.
QUERY-PREFIX may be a string to prepend to the query (e.g. use
\"heading:\" to only search headings, easily creating a custom
command that saves the user from having to type it).
QUERY-FILTER may be a function through which the query the user
types is filtered before execution (e.g. it could replace spaces
with commas to turn multiple tokens, which would normally be
treated as multiple predicates, into multiple arguments to a
single predicate)."
(interactive (list (org-ql-find--buffers
:read-buffer-p (equal '(16) current-prefix-arg))
:widen current-prefix-arg))
(let ((marker (save-restriction
(when (and widen (equal (current-buffer) buffers-files))
(widen))
(org-ql-completing-read buffers-files
:narrowp (not widen)
:query-prefix query-prefix
:query-filter query-filter
:prompt prompt))))
(set-buffer (or (buffer-base-buffer (marker-buffer marker))
(marker-buffer marker)))
(pop-to-buffer (current-buffer) org-ql-find-display-buffer-action)
(without-restriction
(goto-char marker)
(run-hook-with-args 'org-ql-find-goto-hook))
(when (equal (current-buffer) (marker-buffer marker))
;; Ensure point is still within visible portion of buffer. (If
;; `org-tree-to-indirect-buffer' is used in `org-ql-find-goto-hook',
;; the buffer will have been changed and it won't matter; otherwise,
;; the buffer could have been narrowed to a region excluding the
;; selected entry.)
(let ((end-of-subtree (org-with-point-at marker
(org-end-of-subtree 'invisible-ok))))
(unless (and (<= (point-min) marker)
(>= (point-max) end-of-subtree))
(widen)
(goto-char marker))))))
;;;###autoload
(defun org-ql-refile (marker)
"Refile current entry to MARKER (interactively, one selected with `org-ql').
Interactive completion uses files listed in `org-refile-targets',
which see (but only the files are used)."
(interactive (let ((buffers-files (delete-dups
;; Always include the current buffer.
(cons (current-buffer)
(cl-loop for (files-spec . _candidate-spec) in org-refile-targets
append (cl-typecase files-spec
(null (list (current-buffer)))
(symbol (pcase (funcall files-spec)
((and (pred stringp) file) (list file))
((and (pred listp) files) files)))
(list files-spec)))))))
(list (org-ql-completing-read buffers-files :prompt "Refile to: "))))
(let ((buffer (or (buffer-base-buffer (marker-buffer marker))
(marker-buffer marker))))
(org-refile nil nil
;; The RFLOC argument:
(list
;; Name
(org-with-point-at marker
(nth 4 (org-heading-components)))
;; File
(buffer-file-name buffer)
;; nil
nil
;; Position
marker))))
;;;###autoload
(defun org-ql-find-in-agenda ()
"Call `org-ql-find' on `org-agenda-files'."
(interactive)
(org-ql-find (org-agenda-files)))
;;;###autoload
(defun org-ql-find-in-org-directory ()
"Call `org-ql-find' on files in `org-directory'."
(interactive)
(org-ql-find (org-ql-search-directories-files)))
;;;###autoload
(defun org-ql-find-path (buffers-files)
"Call `org-ql-find' to search outline paths in BUFFERS-FILES.
Interactively, search the buffers and files relevant to the
current buffer (i.e. in `org-agenda-mode', the value of
`org-ql-view-buffers-files' or `org-agenda-contributing-files';
in `org-mode', that buffer). With universal prefix, select
multiple buffers to search with completion and PROMPT."
(interactive (list (org-ql-find--buffers)))
(let ((org-ql-default-predicate 'outline-path))
(org-ql-find buffers-files)))
;;;###autoload
(cl-defun org-ql-open-link (buffers-files &key query-prefix query-filter
(prompt "Open link: "))
"Open a link selected with `org-ql-completing-read'.
Links found in entries matching the input query are offered as
candidates, and the selected one is opened with
`org-open-at-point'. Arguments BUFFERS-FILES, QUERY-FILTER,
QUERY-PREFIX, and PROMPT are passed to `org-ql-completing-read',
which see.
Interactively, search the buffers and files relevant to the
current buffer (i.e. in `org-agenda-mode', the value of
`org-ql-view-buffers-files' or `org-agenda-contributing-files';
in `org-mode', that buffer). With universal prefix, select
multiple buffers to search with completion and PROMPT."
(interactive (list (org-ql-find--buffers)))
(let* ((marker (org-ql-completing-read buffers-files
:query-prefix query-prefix
:query-filter query-filter
:prompt prompt
:action-filter #'identity
:action (lambda ()
(save-excursion
(cl-loop with limit = (org-entry-end-position)
while (re-search-forward org-link-any-re limit t)
for link = (string-trim (match-string 0))
do (progn
(set-text-properties 0 (length link) '(face org-link) link)
(setf link (org-link-display-format link)))
collect (cons link (copy-marker (match-beginning 0))))))
:snippet (lambda (&rest _)
"")
:path (lambda (marker)
(org-with-point-at marker
(let* ((path (thread-first (org-get-outline-path t t)
(org-format-outline-path (window-width) nil "")
(org-split-string "")))
(formatted-path (if org-ql-completing-read-reverse-paths
(concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/")))))
formatted-path))))))
(org-with-point-at marker
(org-open-at-point))))
;;;; Functions
(cl-defun org-ql-find--buffers (&key read-buffer-p)
"Return buffer or list of buffers to search in.
In a mode derived from `org-agenda-mode', return the value of
`org-ql-view-buffers-files' or `org-agenda-contributing-files'.
In a mode derived from `org-mode', return the current buffer. If
READ-BUFFER-P, read a list of buffers in `org-mode' with
completion. To be used in `org-ql-find' commands' interactive
forms."
(if read-buffer-p
(mapcar #'get-buffer
(completing-read-multiple
"Buffers: "
(cl-loop for buffer in (buffer-list)
when (eq 'org-mode (buffer-local-value 'major-mode buffer))
collect (buffer-name buffer))
nil t))
(cond ((derived-mode-p 'org-agenda-mode) (or org-ql-view-buffers-files
org-agenda-contributing-files))
((derived-mode-p 'org-mode) (current-buffer))
(t (user-error "This is not an Org-related buffer: %S" (current-buffer))))))
(provide 'org-ql-find)
;;; org-ql-find.el ends here

View file

@ -1,5 +1,7 @@
;;; 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
@ -38,10 +40,40 @@
(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
(defalias 'org-ql-search--link-heading-search-string
(cond ((fboundp 'org-link--normalize-string) #'org-link--normalize-string)
((fboundp 'org-link-heading-search-string) #'org-link-heading-search-string)
((fboundp 'org-make-org-heading-search-string) #'org-make-org-heading-search-string)
(t (error "org-ql: Unable to define alias `org-ql-search--link-heading-search-string'. This may affect links in dynamic blocks. Please report this as a bug"))))
(defalias 'org-ql-search--org-make-link-string
(cond ((fboundp 'org-link-make-string) #'org-link-make-string)
((fboundp 'org-make-link-string) #'org-make-link-string)
(t (error "org-ql: Unable to define alias `org-ql-search--org-make-link-string'. Please report this as a bug"))))
(defalias 'org-ql-search--org-link-store-props
(cond ((fboundp 'org-link-store-props) #'org-link-store-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"))))
(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
"An optional string to override the default header in `org-ql-block' agenda blocks.") "Optional string overriding default header in `org-ql-block' agenda blocks.")
;;;; Customization ;;;; Customization
@ -75,8 +107,8 @@ directories, etc, which would make it slow to list the
The tree will show the lines where the query matches, and any The tree will show the lines where the query matches, and any
other context defined in `org-show-context-detail', which see. other context defined in `org-show-context-detail', which see.
QUERY is an `org-ql' query sexp (quoted, since this is a QUERY is an `org-ql' query in either sexp or string form (see
function). BUFFER defaults to the current buffer. Info node `(org-ql)Queries').
When KEEP-PREVIOUS is non-nil (interactively, with prefix), the When KEEP-PREVIOUS is non-nil (interactively, with prefix), the
outline is not reset to the overview state before finding outline is not reset to the overview state before finding
@ -84,7 +116,7 @@ matches, which allows stacking calls to this command.
Runs `org-occur-hook' after making the sparse tree." Runs `org-occur-hook' after making the sparse tree."
;; Code based on `org-occur'. ;; Code based on `org-occur'.
(interactive (list (read-minibuffer "Query: ") (interactive (list (read-string "Query: ")
:keep-previous current-prefix-arg)) :keep-previous current-prefix-arg))
(with-current-buffer buffer (with-current-buffer buffer
(unless keep-previous (unless keep-previous
@ -92,14 +124,24 @@ Runs `org-occur-hook' after making the sparse tree."
;; we remove existing `org-occur' highlights, just in case. ;; we remove existing `org-occur' highlights, just in case.
(org-remove-occur-highlights nil nil t) (org-remove-occur-highlights nil nil t)
(org-overview)) (org-overview))
(let ((num-results 0)) (let ((num-results 0)
;; FIXME: Accept plain queries as well. (query (pcase-exhaustive query
((and (pred stringp)
(rx bos (0+ blank) (or "(" "\"")))
;; Read sexp query from string.
(read query))
((pred stringp)
;; Parse string query into sexp query.
(org-ql--query-string-to-sexp query))
((pred listp)
;; Sexp query.
query))))
(org-ql-select buffer query (org-ql-select buffer query
:action (lambda () :action (lambda ()
(org-show-context 'occur-tree) (org-ql--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-hide-archived-subtrees (point-min) (point-max))) (org-ql--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))
@ -144,7 +186,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 (eq current-prefix-arg '(4))) :narrow (or org-ql-view-narrow (equal 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'
@ -180,23 +222,28 @@ 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 (org-ql-view--display :buffer buffer :header header :strings strings))))
:string (s-join "\n" strings)))))
;;;###autoload ;;;###autoload
(defun org-ql-search-block (query) (defun org-ql-search-block (args)
"Insert items for QUERY into current buffer. "Insert items for ARGS into current buffer.
QUERY should be an `org-ql' query form. Intended to be used as a Intended to be used as a user-defined function in
user-defined function in `org-agenda-custom-commands'. QUERY `org-agenda-custom-commands'. ARGS corresponds to the `match'
corresponds to the `match' item in the custom command form. item in the custom command form. It should be a list of
arguments which may be applied to `org-ql-select', which see, but
not including its BUFFERS-FILES argument (which is supplied
through the Agenda). An additional `:header' keyword argument
may be supplied as a string, like that supplied to
`org-ql-view--display'.
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 a the header is formed string for the block, otherwise the header is formed
automatically from the query." automatically from the query."
(let (narrow-p old-beg old-end) (pcase-let ((`(,query . ,(map :header :sort)) args)
(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
@ -207,7 +254,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))) :narrow narrow-p :sort sort)))
(when narrow-p (when narrow-p
;; Restore buffer's previous restrictions. ;; Restore buffer's previous restrictions.
(with-current-buffer from (with-current-buffer from
@ -217,16 +264,25 @@ 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)))
(insert (org-add-props (or org-ql-block-header (org-ql-view--header-line-format ;; FIXME: Should we really use `org-ql-block-header' AND `header', or just one of them?
(insert (org-add-props (or org-ql-block-header header
(org-ql-view--header-line-format
:buffers-files from :query query)) :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
@ -246,7 +302,7 @@ Valid parameters include:
form. form.
:columns A list of columns, including `heading', `todo', :columns A list of columns, including `heading', `todo',
`property', `priority', `deadline', `scheduled'. `property',`priority',`deadline',`scheduled',`closed'.
Each column may also be specified as a list with the Each column may also be specified as a list with the
second element being a header string. For example, second element being a header string. For example,
to abbreviate the priority column: (priority \"P\"). to abbreviate the priority column: (priority \"P\").
@ -268,9 +324,12 @@ Valid parameters include:
:ts-format Optional format string used to format :ts-format Optional format string used to format
timestamp-based columns. timestamp-based columns.
For example, an org-ql dynamic block header could look like: For example, an org-ql dynamic block header could look like
this (must be a single line in the Org buffer):
#+BEGIN: org-ql :query (todo \"UNDERWAY\") :columns (priority todo heading) :sort (priority date) :ts-format \"%Y-%m-%d %H:%M\"" #+BEGIN: org-ql :query (todo \"UNDERWAY\")
:columns (priority todo heading) :sort (priority date)
:ts-format \"%Y-%m-%d %H:%M\""
(-let* (((&plist :query :columns :sort :ts-format :take) params) (-let* (((&plist :query :columns :sort :ts-format :take) params)
(query (cl-etypecase query (query (cl-etypecase query
(string (org-ql--query-string-to-sexp query)) (string (org-ql--query-string-to-sexp query))
@ -285,9 +344,9 @@ For example, an org-ql dynamic block header could look like:
(list (cons 'todo (lambda (element) (list (cons 'todo (lambda (element)
(org-element-property :todo-keyword element))) (org-element-property :todo-keyword element)))
(cons 'heading (lambda (element) (cons 'heading (lambda (element)
(org-make-link-string (org-element-property :raw-value element) (let ((normalized-heading
(org-link-display-format (org-ql-search--link-heading-search-string (org-element-property :raw-value element))))
(org-element-property :raw-value element))))) (org-ql-search--org-make-link-string normalized-heading (org-link-display-format normalized-heading)))))
(cons 'priority (lambda (element) (cons 'priority (lambda (element)
(--when-let (org-element-property :priority element) (--when-let (org-element-property :priority element)
(char-to-string it)))) (char-to-string it))))
@ -297,18 +356,22 @@ For example, an org-ql dynamic block header could look like:
(cons 'scheduled (lambda (element) (cons 'scheduled (lambda (element)
(--when-let (org-element-property :scheduled element) (--when-let (org-element-property :scheduled element)
(ts-format ts-format (ts-parse-org-element it))))) (ts-format ts-format (ts-parse-org-element it)))))
(cons 'closed (lambda (element)
(--when-let (org-element-property :closed element)
(ts-format ts-format (ts-parse-org-element it)))))
(cons 'property (lambda (element property) (cons 'property (lambda (element property)
(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-element-headline-parser (line-end-position)) :select '(org-ql-view--resolve-element-properties
(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 (cl-labels ((format-element (element)
(element) (string-join (cl-loop for column in columns (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))
@ -333,13 +396,19 @@ For example, an org-ql dynamic block header could look like:
;;;; Functions ;;;; Functions
(defvar org-ql-search-directories-files-error
;; Workaround to silence byte-compiler which thinks having this string in an
;; argument's default value form is a too-long docstring.
"No DIRECTORIES given, and `org-directory' doesn't exist")
(cl-defun org-ql-search-directories-files (cl-defun org-ql-search-directories-files
(&key (directories (if (file-exists-p org-directory) (&key (directories
(if (file-exists-p org-directory)
(list org-directory) (list org-directory)
(user-error "Org-ql-search-directories-files: No DIRECTORIES given, and `org-directory' doesn't exist"))) (user-error org-ql-search-directories-files-error)))
(recurse org-ql-search-directories-files-recursive) (recurse org-ql-search-directories-files-recursive)
(regexp org-ql-search-directories-files-regexp)) (regexp org-ql-search-directories-files-regexp))
"Return list of matching files in DIRECTORIES, a list of directory paths. "Return list of matching files in DIRECTORIES.
When RECURSE is non-nil, recurse into subdirectories. When When RECURSE is non-nil, recurse into subdirectories. When
REGEXP is non-nil, only return files that match REGEXP." REGEXP is non-nil, only return files that match REGEXP."
(let ((files (->> directories (let ((files (->> directories

View file

@ -1,5 +1,7 @@
;;; 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
@ -40,10 +42,9 @@
(require 'org-ql) (require 'org-ql)
;; FIXME: check-declare declares "function not found", even though it
;; clearly is. It seems to not handle cl-defun, even though its code
;; appears to account for it.
(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--normalize-query "org-ql" t t)
(require 'dash) (require 'dash)
(require 's) (require 's)
@ -56,7 +57,18 @@
(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) :group 'org-ql-view)
(defface org-ql-view-query nil
"View query in header line.
This face is added to the formatted query after font-lock faces
are applied to it. It may be used, e.g. to reduce the height so
more of it is visible."
:group 'org-ql-view)
(defface org-ql-view-title '((t :weight bold))
"View title in header line."
:group 'org-ql-view)
;;;; Variables ;;;; Variables
@ -132,13 +144,13 @@ See info node `(elisp)Cyclic Window Ordering'."
(deadline auto) (deadline auto)
(scheduled :to today) (scheduled :to today)
(ts-active :on today))) (ts-active :on today)))
:sort '(date priority todo) :sort '(todo priority date)
:super-groups 'org-super-agenda-groups :super-groups 'org-super-agenda-groups
:title "Agenda-like")) :title "Agenda-like"))
(cons "Overview: NEXT tasks" (cons "Overview: NEXT tasks"
(list :buffers-files #'org-agenda-files (list :buffers-files #'org-agenda-files
:query '(todo "NEXT") :query '(todo "NEXT")
:sort '(priority date) :sort '(date priority)
:super-groups 'org-super-agenda-groups :super-groups 'org-super-agenda-groups
:title "Overview: NEXT tasks")) :title "Overview: NEXT tasks"))
(cons "Calendar: Today" (cons "Calendar: Today"
@ -189,7 +201,7 @@ See info node `(elisp)Cyclic Window Ordering'."
(ancestors (done))) (ancestors (done)))
:title (propertize "Review: Dangling tasks" :title (propertize "Review: Dangling tasks"
'help-echo "Tasks whose ancestor is done") 'help-echo "Tasks whose ancestor is done")
:sort '(date priority todo) :sort '(todo priority date)
:super-groups '((:auto-parent t)))) :super-groups '((:auto-parent t))))
(cons (propertize "Review: Stale tasks" (cons (propertize "Review: Stale tasks"
'help-echo "Tasks without a timestamp in the past 2 weeks") 'help-echo "Tasks without a timestamp in the past 2 weeks")
@ -198,7 +210,7 @@ See info node `(elisp)Cyclic Window Ordering'."
(not (ts :from -14))) (not (ts :from -14)))
:title (propertize "Review: Stale tasks" :title (propertize "Review: Stale tasks"
'help-echo "Tasks without a timestamp in the past 2 weeks") 'help-echo "Tasks without a timestamp in the past 2 weeks")
:sort '(date priority todo) :sort '(todo priority date)
:super-groups '((:auto-parent t)))) :super-groups '((:auto-parent t))))
(cons (propertize "Review: Stuck projects" (cons (propertize "Review: Stuck projects"
'help-echo "Tasks with sub-tasks but no NEXT sub-tasks") 'help-echo "Tasks with sub-tasks but no NEXT sub-tasks")
@ -208,7 +220,7 @@ See info node `(elisp)Cyclic Window Ordering'."
(not (descendants (todo "NEXT")))) (not (descendants (todo "NEXT"))))
:title (propertize "Review: Stuck projects" :title (propertize "Review: Stuck projects"
'help-echo "Tasks with sub-tasks but no NEXT sub-tasks") 'help-echo "Tasks with sub-tasks but no NEXT sub-tasks")
:sort '(priority date) :sort '(date priority)
:super-groups 'org-super-agenda-groups))) :super-groups 'org-super-agenda-groups)))
"Alist of `org-ql-view' commands." "Alist of `org-ql-view' commands."
:type :type
@ -230,12 +242,19 @@ See info node `(elisp)Cyclic Window Ordering'."
(const todo) (const todo)
(const priority) (const priority)
(const random) (const random)
(const reverse)
(function :tag "Custom comparator")))) (function :tag "Custom comparator"))))
((const :tag "Group-by" :super-groups) ((const :tag "Group-by" :super-groups)
(choice (variable-item :tag "Default org-super-agenda groups" org-super-agenda-groups) (choice (variable-item :tag "Default org-super-agenda groups" org-super-agenda-groups)
(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
@ -282,12 +301,13 @@ TYPE may be `ts', `ts-active', `ts-inactive', `clocked', or
`(,type :from ,(- num-days) :to 0))))) `(,type :from ,(- num-days) :to 0)))))
(org-ql-search files query (org-ql-search files query
:title "Recent items" :title "Recent items"
:sort '(date priority todo) :sort '(todo priority date)
:super-groups groups))) :super-groups groups)))
;;;###autoload ;;;###autoload
(cl-defun org-ql-view-sidebar (&key (slot org-ql-view-list-slot)) (cl-defun org-ql-view-sidebar (&key (slot org-ql-view-list-slot))
"Show `org-ql-view' view list sidebar." "Show `org-ql-view' view list sidebar.
SLOT is passed to `display-buffer-in-side-window', which see."
;; TODO: Update sidebar when `org-ql-views' changes. ;; TODO: Update sidebar when `org-ql-views' changes.
(interactive) (interactive)
(select-window (select-window
@ -302,10 +322,10 @@ TYPE may be `ts', `ts-active', `ts-inactive', `clocked', or
(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 (point-at-bol) (point-at-eol)))) (let ((key (buffer-substring-no-properties (pos-bol) (pos-eol))))
(unless (string-empty-p key) (unless (string-empty-p key)
(ov-clear :org-ql-view-selected) (ov-clear :org-ql-view-selected)
(ov (point-at-bol) (1+ (point-at-eol)) :org-ql-view-selected t (ov (pos-bol) (1+ (pos-eol)) :org-ql-view-selected t
'face '(:weight bold :inherit highlight)) 'face '(:weight bold :inherit highlight))
(org-ql-view key)))) (org-ql-view key))))
@ -352,7 +372,8 @@ update search arguments."
(yes-or-no-p (format "Overwrite view \"%s\"?" name))) (yes-or-no-p (format "Overwrite view \"%s\"?" name)))
(setf (map-elt org-ql-views name nil #'equal) plist) (setf (map-elt org-ql-views name nil #'equal) plist)
(customize-set-variable 'org-ql-views org-ql-views) (customize-set-variable 'org-ql-views org-ql-views)
(customize-mark-to-save 'org-ql-views)))) (customize-mark-to-save 'org-ql-views)
(custom-save-all))))
(defun org-ql-view-delete () (defun org-ql-view-delete ()
"Delete current view (with confirmation)." "Delete current view (with confirmation)."
@ -362,12 +383,13 @@ update search arguments."
(--remove (equal (car it) org-ql-view-title) (--remove (equal (car it) org-ql-view-title)
org-ql-views)) org-ql-views))
(customize-set-variable 'org-ql-views org-ql-views) (customize-set-variable 'org-ql-views org-ql-views)
(customize-mark-to-save 'org-ql-views))) (customize-mark-to-save 'org-ql-views)
(custom-save-all)))
(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 (point-at-bol) (point-at-eol)))) (let ((key (buffer-substring-no-properties (pos-bol) (pos-eol))))
(customize-option 'org-ql-views) (customize-option 'org-ql-views)
(search-forward (concat "Name: " key)))) (search-forward (concat "Name: " key))))
@ -404,7 +426,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 string) (cl-defun org-ql-view--display (&key (buffer org-ql-view-buffer) header strings)
"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
@ -442,7 +464,9 @@ 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)
(insert string "\n") (dolist (string strings)
(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))))))
@ -452,7 +476,8 @@ 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)
title " ") (propertize title 'face 'org-ql-view-title)
" ")
"")) ""))
(query-formatted (when query (query-formatted (when query
(org-ql-view--format-query query))) (org-ql-view--format-query query)))
@ -471,6 +496,7 @@ 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)
@ -502,6 +528,22 @@ 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
@ -531,18 +573,20 @@ 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 (cl-labels ((file-nameize (b-f)
(b-f) (cl-typecase b-f (abbreviate-file-name
(cl-typecase b-f
(string b-f) (string b-f)
(buffer (or (buffer-file-name b-f) (buffer (or (buffer-file-name b-f)
(when (buffer-base-buffer b-f) (when (buffer-base-buffer b-f)
(buffer-file-name (buffer-base-buffer b-f))))) (buffer-file-name (buffer-base-buffer b-f)))))
(t (user-error "Only file-backed buffers can be bookmarked by Org QL View: %s" b-f))))) (t (user-error "Only file-backed buffers can be bookmarked by Org QL View: %s" b-f))))))
(-let* ((plist (org-ql-view--plist (current-buffer))) (-let* ((plist (org-ql-view--plist (current-buffer)))
((&plist :buffers-files) plist)) ((&plist :buffers-files) plist))
;; 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)))))
@ -602,6 +646,7 @@ 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
@ -616,7 +661,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 (alist-get "sort" params nil nil #'string=)) (sort (when-let* ((stored-string (car (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))
@ -624,17 +669,19 @@ 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 (alist-get "super-groups" params nil nil #'string=) (groups (--when-let (car (alist-get "super-groups" params nil nil #'string=))
(read it))) (read it)))
(title (--when-let (alist-get "title" params nil nil #'string=) (title (--when-let (car (alist-get "title" params nil nil #'string=))
(read it))) (read it)))
(buffers-files (--if-let (alist-get "buffers-files" params nil nil #'string=) (buffers-files (--if-let (car (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.
@ -658,19 +705,21 @@ 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 (strings-or-file-buffers-p (thing)
(thing) (cl-etypecase 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 narrowing isn't preserved. ;; TODO: Should indirect buffers be allowed? Maybe not, since their
;; On the other hand, it's possible to accidentally make a search view for an indirect buffer ;; narrowing isn't preserved. On the other hand, it's possible to
;; that's since been widened, and forcing the user to manually change that would be awkward, ;; accidentally make a search view for an indirect buffer that's
;; and trying to communicate the problem would be difficult, so maybe it's okay to allow it. ;; since been widened, and forcing the user to manually change that
;; would be awkward, and trying to communicate the problem would be
;; difficult, so maybe it's okay to allow it.
(when (buffer-base-buffer thing) (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)
(user-error "Views that search non-file-backed buffers can't be linked to")) (user-error "%s" "Views that search non-file-backed buffers can't be linked to"))
(let* ((query-string (--if-let (org-ql--query-sexp-to-string org-ql-view-query) (let* ((query-string (--if-let (org-ql--query-sexp-to-string org-ql-view-query)
it (org-ql-view--format-query org-ql-view-query))) it (org-ql-view--format-query org-ql-view-query)))
(buffers-files (prompt-for (org-ql-view--contract-buffers-files org-ql-view-buffers-files))) (buffers-files (prompt-for (org-ql-view--contract-buffers-files org-ql-view-buffers-files)))
@ -686,8 +735,7 @@ When opened, the link searches the buffer it's opened from."
"?" (url-build-query-string (delete nil params)))) "?" (url-build-query-string (delete nil params))))
(url (url-recreate-url (url-parse-make-urlobj "org-ql-search" nil nil nil nil (url (url-recreate-url (url-parse-make-urlobj "org-ql-search" nil nil nil nil
filename)))) filename))))
;; FIXME: "Warning: org-store-link-props is an obsolete function (as of Org 9.3); use org-link-store-props instead" (org-ql-search--org-link-store-props
(org-store-link-props
:type "org-ql-search" :type "org-ql-search"
:link url :link url
:description (concat "org-ql-search: " org-ql-view-title)))) :description (concat "org-ql-search: " org-ql-view-title))))
@ -702,6 +750,8 @@ 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)
@ -716,7 +766,7 @@ When opened, the link searches the buffer it's opened from."
(unless (or value transient--prefix) (unless (or value transient--prefix)
(message "Unset %s" variable)))) (message "Unset %s" variable))))
(define-transient-command org-ql-view-dispatch () (transient-define-prefix org-ql-view-dispatch ()
"Show Org QL View dispatcher." "Show Org QL View dispatcher."
[["Edit" [["Edit"
("t" org-ql-view--transient-title) ("t" org-ql-view--transient-title)
@ -751,7 +801,7 @@ When opened, the link searches the buffer it's opened from."
org-ql-view--format-query org-ql-view--format-query
(org-ql-view--font-lock-string 'emacs-lisp-mode))))) (org-ql-view--font-lock-string 'emacs-lisp-mode)))))
(define-infix-command org-ql-view--transient-title () (transient-define-infix org-ql-view--transient-title ()
;; TODO: Add an asterisk or something when the view has been modified but not saved. ;; TODO: Add an asterisk or something when the view has been modified but not saved.
:description (lambda () (org-ql-view--format-transient-key-value "Title" org-ql-view-title)) :description (lambda () (org-ql-view--format-transient-key-value "Title" org-ql-view-title))
:class 'org-ql-view--variable :class 'org-ql-view--variable
@ -764,7 +814,7 @@ When opened, the link searches the buffer it's opened from."
(format "%s" org-ql-view-title)) (format "%s" org-ql-view-title))
history))) history)))
(define-infix-command org-ql-view--transient-query () (transient-define-infix org-ql-view--transient-query ()
:description (lambda () (org-ql-view--format-transient-lisp-argument "Query" org-ql-view-query)) :description (lambda () (org-ql-view--format-transient-lisp-argument "Query" org-ql-view-query))
:class 'org-ql-view--variable :class 'org-ql-view--variable
:argument "" :argument ""
@ -782,7 +832,7 @@ When opened, the link searches the buffer it's opened from."
;; Parse non-sexp query into sexp query. ;; Parse non-sexp query into sexp query.
(org-ql--query-string-to-sexp query))))) (org-ql--query-string-to-sexp query)))))
(define-infix-command org-ql-view--transient-in () (transient-define-infix org-ql-view--transient-in ()
:description (lambda () (org-ql-view--format-transient-lisp-argument "In buffers/files" org-ql-view-buffers-files)) :description (lambda () (org-ql-view--format-transient-lisp-argument "In buffers/files" org-ql-view-buffers-files))
:class 'org-ql-view--variable :class 'org-ql-view--variable
:argument "" :argument ""
@ -793,7 +843,7 @@ When opened, the link searches the buffer it's opened from."
;; argument, but it gives the same result. ;; argument, but it gives the same result.
(org-ql-view--complete-buffers-files))) (org-ql-view--complete-buffers-files)))
(define-infix-command org-ql-view--transient-super-groups () (transient-define-infix org-ql-view--transient-super-groups ()
:description (lambda () :description (lambda ()
(org-ql-view--format-transient-lisp-argument "Group by" org-ql-view-super-groups)) (org-ql-view--format-transient-lisp-argument "Group by" org-ql-view-super-groups))
:class 'org-ql-view--variable :class 'org-ql-view--variable
@ -804,7 +854,7 @@ When opened, the link searches the buffer it's opened from."
;; FIXME: Figure out how to integrate initial-input and history. ;; FIXME: Figure out how to integrate initial-input and history.
(org-ql-view--complete-super-groups))) (org-ql-view--complete-super-groups)))
(define-infix-command org-ql-view--transient-sort () (transient-define-infix org-ql-view--transient-sort ()
:description :description
(lambda () (lambda ()
(org-ql-view--format-transient-lisp-argument "Sort by" (or org-ql-view-sort 'buffer-order))) (org-ql-view--format-transient-lisp-argument "Sort by" (or org-ql-view-sort 'buffer-order)))
@ -818,6 +868,20 @@ 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.
@ -827,6 +891,7 @@ 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
@ -848,10 +913,15 @@ 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)))
(org-link-display-format it))) ;; TODO(B): Needs refactoring. A function like `org-ql-view--add-faces'
;; should return a list of faces to be added.
(title-faces (get-text-property 0 'face title))
(title (org-ql-view--font-lock-as-org title))
(_ (add-face-text-property 0 (length title) title-faces t title))
(todo-keyword (-some--> (org-element-property :todo-keyword element) (todo-keyword (-some--> (org-element-property :todo-keyword element)
(org-ql-view--add-todo-face it))) (org-ql-view--add-todo-face
(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)
@ -864,8 +934,7 @@ return an empty string."
(not type)) (not type))
append type))) append type)))
;; No marker found ;; No marker found
;; TODO: Use `display-warning' with `org-ql' as the type. (display-warning 'org-ql (format "No marker found for item: %s" title))
(warn "No marker found for item: %s" title)
(org-element-property :tags element)) (org-element-property :tags element))
(org-element-property :tags element))) (org-element-property :tags element)))
(tag-string (when tag-list (tag-string (when tag-list
@ -873,12 +942,21 @@ 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 (org-element-property :category element)) (category (or (org-element-property :CATEGORY element)
(when-let ((marker (or (org-element-property :org-hd-marker element)
(org-element-property :org-marker element))))
(org-with-point-at marker
(or (org-get-category)
(when buffer-file-name
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))))))
""))
(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 (org-element-property :begin element) (habit-property (org-with-point-at (or (org-element-property :org-hd-marker 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)
@ -892,6 +970,7 @@ 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)))))
@ -977,7 +1056,9 @@ 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 (org-ql-view--format-relative-date difference-days) nil (relative-due-date (org-add-props
(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))
@ -1011,10 +1092,6 @@ property."
;; These functions are somewhat regrettable because of the need to keep them ;; These functions are somewhat regrettable because of the need to keep them
;; in sync, but it seems worth it to provide users with the flexibility. ;; in sync, but it seems worth it to provide users with the flexibility.
;; FIXME: `check-declare' declares that this function is not in org-ql-search, even though
;; it is. It appears to happen because `org-ql-search-directories-files' is declared with
;; `cl-defun', because when I remove "cl-", it finds it. This makes no sense, because the
;; source code of `check-declare' shows that it searches for "cl-defun" declarations.
(declare-function org-ql-search-directories-files "org-ql-search" t) (declare-function org-ql-search-directories-files "org-ql-search" t)
(defun org-ql-view--contract-buffers-files (buffers-files) (defun org-ql-view--contract-buffers-files (buffers-files)
@ -1026,8 +1103,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 (cl-labels ((expand-files (list)
(list) (--map (cl-typecase it (--map (cl-typecase it
(string (expand-file-name it)) (string (expand-file-name it))
(otherwise it)) (otherwise it))
list))) list)))
@ -1052,8 +1129,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
@ -1110,6 +1187,7 @@ The counterpart to `org-ql-view--contract-buffers-files'."
"deadline" "deadline"
"priority" "priority"
"random" "random"
"reverse"
"scheduled" "scheduled"
"todo") "todo")
nil nil (when org-ql-view-sort nil nil (when org-ql-view-sort

716
org-ql.el

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

10
tests/data-links.org Normal file
View file

@ -0,0 +1,10 @@
* Alpha
Let us link to: [[id:74d357ac-fb9c-40d1-a63f-eca8a227321d][Bravo [a phrase in brackets]]].
* Bravo [a phrase in brackets]
:PROPERTIES:
:ID: 74d357ac-fb9c-40d1-a63f-eca8a227321d
:END:
* Charlie

29
tests/data-src.org Normal file
View file

@ -0,0 +1,29 @@
#+title: org-ql test data for ~src~ predicate
* Alpha
#+begin_src elisp
(message "foo")
#+end_src
#+begin_src python
print("foo")
#+end_src
#+begin_src js
console.log("foo")
#+end_src
* Bravo
#+begin_src elisp
(message "bar")
#+end_src
#+begin_src python
print("bar")
#+end_src
* Charlie
This entry has no source block.

29
tests/data-ts.org Normal file
View file

@ -0,0 +1,29 @@
#+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)) ;; Package-Requires: ((buttercup) (with-simulated-input) (xr))
;; 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
@ -30,8 +30,13 @@
(require 'with-simulated-input) (require 'with-simulated-input)
(require 'org-ql) (require 'org-ql)
(require 'org-ql-search)
(require 'org-ql-view) (require 'org-ql-view)
(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
@ -112,20 +117,17 @@ FILENAME should be a file in the \"tests\" directory."
;;;; Macros ;;;; Macros
(defmacro org-ql-it (description &rest body) (defmacro org-ql-it (description &rest body)
"Expand to two specs, one of which tests with preambles and the other without. "Expand to two specs, one of which tests with preambles and the other without."
Based on Buttercup macro `it'."
(declare (indent 1) (debug (&define sexp def-body))) (declare (indent 1) (debug (&define sexp def-body)))
(if body
`(progn `(progn
(buttercup-it ,(concat description " (preamble) ") (it ,(concat description " (preamble) ")
(lambda () ,(when body
(let ((org-ql-use-preamble t)) `(let ((org-ql-use-preamble t))
,@body))) ,@body)))
(buttercup-it ,(concat description " (no preamble)") (it ,(concat description " (no preamble) ")
(lambda () ,(when body
(let ((org-ql-use-preamble nil)) `(let ((org-ql-use-preamble nil))
,@body)))) ,@body)))) )
`(buttercup-xit ,description)))
(cl-defmacro org-ql-expect (ql-args results &key (buffer 'org-ql-test-buffer)) (cl-defmacro org-ql-expect (ql-args results &key (buffer 'org-ql-test-buffer))
"Expand to `expect' test form that expects QL-ARGS to equal RESULTS. "Expand to `expect' test form that expects QL-ARGS to equal RESULTS.
@ -164,8 +166,9 @@ with keyword arg NOW in PLIST."
(substring-no-properties (org-get-heading t t))) (substring-no-properties (org-get-heading t t)))
(defun org-ql-test-org-get-heading () (defun org-ql-test-org-get-heading ()
;; For Org 9.1.9. ;; For Org 9.1.9.
(substring-no-properties (org-get-heading t t t t)))) (substring-no-properties (org-get-heading t t t t)))) )
(before-each
(setq org-ql-test-buffer (org-ql-test-data-buffer "data.org") (setq org-ql-test-buffer (org-ql-test-data-buffer "data.org")
;; For manual testing: ;; For manual testing:
;; org-ql-test-buffer (find-file-noselect "data.org") ;; org-ql-test-buffer (find-file-noselect "data.org")
@ -202,31 +205,101 @@ with keyword arg NOW in PLIST."
(insert "* Heading 1") (insert "* Heading 1")
;; FIXME: `--value-at' does not actually move point, so we do it here. ;; FIXME: `--value-at' does not actually move point, so we do it here.
(goto-char (point-min)) (goto-char (point-min))
(expect (org-ql--value-at (point-min) #'org-get-local-tags) (expect (org-ql--value-at (point-min) #'ignore)
:to-be nil)))) :to-be nil))))
(describe "Query functions/macros"
(it "org-ql"
;; FIXME: Remove when org-ql macro is removed.
(expect (length (org-ql org-ql-test-buffer
(category)
:sort deadline))
:to-equal org-ql-test-num-headings))
(it "org-ql-select"
(expect (length (org-ql-select org-ql-test-buffer
'(category)
:sort 'deadline))
:to-equal org-ql-test-num-headings))
(it "org-ql-query"
(expect (length (org-ql-query :select 'element
:from org-ql-test-buffer
:where '(category)
:order-by 'date))
:to-equal org-ql-test-num-headings)))
(describe "Query pre-processing" (describe "Query pre-processing"
(describe "Coalescing"
;; NOTE: Queries are expected to be normalized before being coalesced,
;; and `org-ql--normalize-query' calls `org-ql--coalesce-ands' as its
;; final step, so in these tests we just call the former.
(it "coalesces a single AND clause that uses one predicate (and preserves argument order)"
(expect (org-ql--normalize-query '(and (rifle "foo") (rifle "bar")))
:to-equal '(and (rifle :regexps '("foo" "bar")))))
(it "coalesces a single AND clause that uses two predicates (and preserves predicate order)"
(expect (org-ql--normalize-query '(and (rifle "foo") (rifle "bar")
(heading "baz") (heading "buz")))
;; NOTE: `heading' is normalized to `heading-regexp'.
:to-equal '(and (rifle :regexps '("foo" "bar")) (heading-regexp "baz" "buz"))))
(it "preserves independent OR clauses"
(expect (org-ql--normalize-query '(and (or (rifle "foo") (rifle "bar"))
(or (rifle "baz") (rifle "buz"))))
:to-equal '(and (or (rifle :regexps '("foo")) (rifle :regexps '("bar"))) (or (rifle :regexps '("baz")) (rifle :regexps '("buz"))))))
(it "coalesces an AND clause within an OR clause"
(expect (org-ql--normalize-query '(or (regexp "bar") (and (rifle "foo") (rifle "bar"))))
:to-equal '(or (regexp "bar") (and (rifle :regexps '("foo" "bar"))))))
(it "coalesces multiple AND clauses within an OR clause"
(expect (org-ql--normalize-query '(or (and (rifle "foo") (rifle "bar"))
(and (rifle "baz") (rifle "buz"))))
:to-equal '(or (and (rifle :regexps '("foo" "bar"))) (and (rifle :regexps '("baz" "buz"))))))
(it "coalesces arguments to predicates which use coalescing functions and whose calls are eligible for coalescing"
(expect (org-ql--normalize-query '(and (src "foo") (src "bar")))
:to-equal '(and (src :lang nil :regexps '("foo" "bar"))))
(expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar" :lang "elisp")))
:to-equal '(and (src :lang "elisp" :regexps '("foo" "bar")))))
(it "does not coalesce arguments to predicates which use coalescing functions and whose calls are ineligible for coalescing"
(expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar")))
;; NOTE: The current implementation of `org-ql--normalize-query'
;; reorders clauses in this case. Fixing that would probably
;; not be worth the effort in code or runtime.
:to-equal '(and (src :regexps '("bar")) (src :lang "elisp" :regexps '("foo"))))
(expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar" :lang "python")))
:to-equal '(and (src :lang "python" :regexps '("bar")) (src :lang "elisp" :regexps '("foo"))))))
(describe "Normalization"
(it "Default predicate"
(expect (org-ql--normalize-query "scheduled")
;; No colon after keyword, so not a predicate query.
:to-equal '(rifle :regexps '("scheduled")))
(expect (org-ql--normalize-query "\"quoted phrase\"")
:to-equal '(rifle :regexps '("\"quoted phrase\""))))
(describe "Ancestor/Parent predicates"
;; NOTE: Because the ancestor and parent predicates byte-compile their
;; subquery predicates, we have to test the byte-compiled forms here.
(expect (org-ql--normalize-query '(ancestors "scheduled"))
;; No colon after keyword, so not a predicate query.
:to-equal ;; '(ancestors (rifle :regexps '("scheduled")))
`(ancestors #[nil "\300\301\302\"\207" [rifle :regexps ("scheduled")] 3]))
(expect (org-ql--normalize-query '(parent "scheduled"))
;; No colon after keyword, so not a predicate query.
:to-equal ;; '(parent (rifle :regexps '("scheduled")))
`(parent #[nil "\300\301\302\"\207" [rifle :regexps ("scheduled")] 3])))
(describe "Plain strings"
(it "normalizes plain strings to the default predicate (using AND)"
(expect (org-ql--normalize-query '(and "string1" "string2"))
:to-equal '(and (rifle :regexps '("string1" "string2")))))
(it "normalizes plain strings to the default predicate (using OR)"
(expect (org-ql--normalize-query '(or "string1" "string2"))
:to-equal '(or (rifle :regexps '("string1")) (rifle :regexps '("string2")))))
(it "normalizes plain strings within sub-expressions to the default predicate"
(expect (org-ql--normalize-query '(and (todo "TODO")
(or "string1" "string2")))
:to-equal '(and (todo "TODO") (or (rifle :regexps '("string1")) (rifle :regexps '("string2")))))
(expect (org-ql--normalize-query '(when (todo "TODO")
(or "string1" "string2")))
:to-equal '(when (todo "TODO") (or (rifle :regexps '("string1")) (rifle :regexps '("string2")))))
(expect (org-ql--normalize-query '(when "string-cond1"
(or "string1" "string2")))
:to-equal '(when (rifle :regexps '("string-cond1")) (or (rifle :regexps '("string1")) (rifle :regexps '("string2")))))
(expect (org-ql--normalize-query '(when (and "string-cond1" "string-cond2")
(or "string1" "string2")))
:to-equal '(when (and (rifle :regexps '("string-cond1")) (rifle :regexps '("string-cond2"))) (or (rifle :regexps '("string1")) (rifle :regexps '("string2")))))
(expect (org-ql--normalize-query '(unless (and "stringcondition1" "stringcond2")
(or "string1" "string2")))
:to-equal '(unless (and (rifle :regexps '("stringcondition1")) (rifle :regexps '("stringcond2"))) (or (rifle :regexps '("string1")) (rifle :regexps '("string2")))))))
(describe "(rifle)"
(it "with one argument"
(expect (org-ql--normalize-query '(rifle "foo."))
:to-equal '(rifle :regexps '("foo\\."))))
(it "with two arguments"
(expect (org-ql--normalize-query '(rifle "foo." "bar"))
:to-equal '(rifle :regexps '("foo\\." "bar")))))
(describe "(level)" (describe "(level)"
(it "with one level" (it "with one level"
(expect (org-ql--normalize-query '(level "1")) (expect (org-ql--normalize-query '(level "1"))
@ -257,19 +330,50 @@ with keyword arg NOW in PLIST."
(expect (org-ql--normalize-query '(olp "a." "b")) (expect (org-ql--normalize-query '(olp "a." "b"))
:to-equal '(org-ql--predicate-outline-path "a\\." "b")))) :to-equal '(org-ql--predicate-outline-path "a\\." "b"))))
(describe "(src)"
(it "normalizes a non-keyword arg to keywords"
(expect (org-ql--normalize-query '(src "foo"))
:to-equal '(src :regexps '("foo"))))
(it "normalizes non-keyword args to keywords"
(expect (org-ql--normalize-query '(src "foo" "bar"))
:to-equal '(src :regexps '("foo" "bar"))))
(it "normalizes a non-keyword arg with a :lang keyword arg to keywords"
(expect (org-ql--normalize-query '(src "foo" :lang "bar"))
:to-equal '(src :lang "bar" :regexps '("foo"))))
(it "normalizes non-keyword args with a :lang keyword arg to keywords"
(expect (org-ql--normalize-query '(src "foo" "bar" :lang "baz"))
:to-equal '(src :lang "baz" :regexps '("foo" "bar"))))
(it "normalizes zero args without looping"
(expect (org-ql--normalize-query '(src))
:to-equal '(src)))
(it "normalizes all-keyword args without looping"
(expect (org-ql--normalize-query '(src :regexps ("foo") :lang "bar"))
:to-equal '(src :lang "bar" :regexps '("foo")))
(expect (org-ql--normalize-query '(src :regexps ("foo") :lang))
:to-equal '(src :regexps '("foo"))))
(it "normalizes just the :lang keyword arg"
(expect (org-ql--normalize-query '(src :lang "bar"))
:to-equal '(src :lang "bar" :regexps 'nil))))
(describe "(tags-inherited)" (describe "(tags-inherited)"
(it "handles 0 arguments"
(expect (org-ql--normalize-query '(tags-inherited)) (expect (org-ql--normalize-query '(tags-inherited))
:to-equal '(tags-inherited)) :to-equal '(tags-inherited)))
(expect (org-ql--normalize-query '(itags)) (it "handles 1 argument"
:to-equal '(tags-inherited))
(expect (org-ql--normalize-query '(tags-inherited "foo")) (expect (org-ql--normalize-query '(tags-inherited "foo"))
:to-equal '(tags-inherited "foo")) :to-equal '(tags-inherited "foo")))
(expect (org-ql--normalize-query '(itags "foo")) (it "handles 2 arguments"
:to-equal '(tags-inherited "foo"))
(expect (org-ql--normalize-query '(tags-inherited "foo" "bar")) (expect (org-ql--normalize-query '(tags-inherited "foo" "bar"))
:to-equal '(tags-inherited "foo" "bar"))
(expect (org-ql--normalize-query '(itags "foo" "bar"))
:to-equal '(tags-inherited "foo" "bar"))) :to-equal '(tags-inherited "foo" "bar")))
(it "aliases to `itags'"
(expect (org-ql--normalize-query '(itags))
:to-equal '(tags-inherited)))
(it "aliases to `itags' with one argument"
(expect (org-ql--normalize-query '(itags "foo"))
:to-equal '(tags-inherited "foo")))
(it "aliases to `itags' with two arguments"
(expect (org-ql--normalize-query '(itags "foo" "bar"))
:to-equal '(tags-inherited "foo" "bar"))))
(describe "timestamp predicates" (describe "timestamp predicates"
;; NOTE: (clocked) and (closed) don't accept :with-time arguments. ;; NOTE: (clocked) and (closed) don't accept :with-time arguments.
@ -460,27 +564,7 @@ with keyword arg NOW in PLIST."
:with-time t)) :with-time t))
(expect (org-ql--normalize-query '(ts :on 1)) (expect (org-ql--normalize-query '(ts :on 1))
:to-equal `(ts :from ,(ts-inc 'day 1 beg-of-today-ts) :to-equal `(ts :from ,(ts-inc 'day 1 beg-of-today-ts)
:to ,(ts-inc 'day 1 end-of-today-ts))))))) :to ,(ts-inc 'day 1 end-of-today-ts)))
(expect (org-ql--normalize-query '(and "string1" "string2"))
:to-equal '(and (regexp "string1") (regexp "string2")))
(expect (org-ql--normalize-query '(or "string1" "string2"))
:to-equal '(or (regexp "string1") (regexp "string2")))
(expect (org-ql--normalize-query '(and (todo "TODO")
(or "string1" "string2")))
:to-equal '(and (todo "TODO") (or (regexp "string1") (regexp "string2"))))
(expect (org-ql--normalize-query '(when (todo "TODO")
(or "string1" "string2")))
:to-equal '(when (todo "TODO") (or (regexp "string1") (regexp "string2"))))
(expect (org-ql--normalize-query '(when "string-cond1"
(or "string1" "string2")))
:to-equal '(when (regexp "string-cond1") (or (regexp "string1") (regexp "string2"))))
(expect (org-ql--normalize-query '(when (and "string-cond1" "string-cond2")
(or "string1" "string2")))
:to-equal '(when (and (regexp "string-cond1") (regexp "string-cond2")) (or (regexp "string1") (regexp "string2"))))
(expect (org-ql--normalize-query '(unless (and "stringcondition1" "stringcond2")
(or "string1" "string2")))
:to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "string2"))))
;; FIXME: This test fails, but only on GitHub CI; it works fine ;; FIXME: This test fails, but only on GitHub CI; it works fine
;; locally. It seems to be something to do with Buttercup and ;; locally. It seems to be something to do with Buttercup and
@ -510,13 +594,25 @@ with keyword arg NOW in PLIST."
;; :to ,(make-ts :unix 1546408799.0)) ;; :to ,(make-ts :unix 1546408799.0))
;; (ts :type inactive ;; (ts :type inactive
;; :from ,(make-ts :unix 1546322400.0) ;; :from ,(make-ts :unix 1546322400.0)
;; :to ,(make-ts :unix 1546408799.0)))) ;; :to ,(make-ts :unix 1546408799.0)))))
) )))))
(describe "Query preambles" (describe "Query preambles"
;; TODO: Other predicates. ;; TODO: Other predicates.
(describe "(rifle)"
(it "with one argument"
(expect (org-ql--query-preamble (org-ql--normalize-query '(rifle "foo.")))
:to-equal (list :query '(rifle :regexps '("foo\\."))
:preamble "\\(?:\\<\\(?:foo\\.\\)\\)"
:preamble-case-fold t)))
(it "with two arguments"
(expect (org-ql--query-preamble (org-ql--normalize-query '(rifle "foo." "bar")))
:to-equal (list :query '(rifle :regexps '("foo\\." "bar"))
:preamble "\\(?:\\<\\(?:foo\\.\\|bar\\)\\)"
:preamble-case-fold t))))
(describe "(clocked)" (describe "(clocked)"
(it "without arguments" (it "without arguments"
(expect (org-ql--query-preamble '(clocked)) (expect (org-ql--query-preamble '(clocked))
@ -542,6 +638,11 @@ 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
@ -567,25 +668,28 @@ 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"))))
(expect (org-ql--query-string-to-sexp "!todo:CHECK,SOMEDAY todo:") (expect (org-ql--query-string-to-sexp "!todo:CHECK,SOMEDAY todo:")
:to-equal '(and (not (todo "CHECK" "SOMEDAY")) (todo))) :to-equal '(and (not (todo "CHECK" "SOMEDAY")) (todo)))
(expect (org-ql--query-string-to-sexp "tags:universe !moon") (expect (org-ql--query-string-to-sexp "tags:universe !moon")
:to-equal '(and (tags "universe") (not (regexp "moon")))) :to-equal '(and (tags "universe") (not (rifle "moon"))))
(expect (org-ql--query-string-to-sexp "!moon tags:universe") (expect (org-ql--query-string-to-sexp "!moon tags:universe")
:to-equal '(and (not (regexp "moon")) (tags "universe"))) :to-equal '(and (not (rifle "moon")) (tags "universe")))
(expect (org-ql--query-string-to-sexp "mars !ts:on=today") (expect (org-ql--query-string-to-sexp "mars !ts:on=today")
:to-equal '(and (regexp "mars") (not (ts :on "today")))) :to-equal '(and (rifle "mars") (not (ts :on "today"))))
(expect (org-ql--query-string-to-sexp "!\"quoted phrase\"") (expect (org-ql--query-string-to-sexp "!\"quoted phrase\"")
:to-equal '(not (regexp "quoted phrase")))) :to-equal '(not (rifle "quoted phrase"))))
(it "Regexp predicates" (it "Regexp predicates"
(expect (org-ql--query-string-to-sexp "scheduled")
;; No colon after keyword, so not a predicate query.
:to-equal '(regexp "scheduled"))
(expect (org-ql--query-string-to-sexp "\"quoted phrase\"")
:to-equal '(regexp "quoted phrase"))
(expect (org-ql--query-string-to-sexp "regexp:word") (expect (org-ql--query-string-to-sexp "regexp:word")
:to-equal '(regexp "word")) :to-equal '(regexp "word"))
(expect (org-ql--query-string-to-sexp "regexp:\"quoted phrase\"") (expect (org-ql--query-string-to-sexp "regexp:\"quoted phrase\"")
@ -669,7 +773,23 @@ with keyword arg NOW in PLIST."
:to-equal "tags:space !regexp:moon")) :to-equal "tags:space !regexp:moon"))
(it "(or ...)" (it "(or ...)"
(expect (org-ql--query-sexp-to-string '(or (tags "book" "books") (priority "A"))) (expect (org-ql--query-sexp-to-string '(or (tags "book" "books") (priority "A")))
:to-equal nil))) :to-equal nil))))
(describe "Query functions"
(describe "org-ql-select"
(it "returns matching entries"
(expect (length (org-ql-select org-ql-test-buffer
'(category)
:sort 'deadline))
:to-equal org-ql-test-num-headings)))
(describe "org-ql-query"
(it "returns matching entries"
(expect (length (org-ql-query :select 'element
:from org-ql-test-buffer
:where '(category)
:order-by 'date))
:to-equal org-ql-test-num-headings))))
(describe "Query results" (describe "Query results"
@ -725,7 +845,7 @@ with keyword arg NOW in PLIST."
(org-ql-expect ('(descendants (todo "CHECK"))) (org-ql-expect ('(descendants (todo "CHECK")))
'("Recurring"))) '("Recurring")))
(org-ql-it "with granddescendants query" (org-ql-it "with granddescendants query"
(org-ql-expect ('(descendants (descendants "moon"))) (org-ql-expect ('(descendants (descendants (regexp "moon"))))
'("Take over the universe"))) '("Take over the universe")))
(org-ql-it "with query that should not match parent" (org-ql-it "with query that should not match parent"
;; This test would fail if the `descendants' predicate did not properly exclude ;; This test would fail if the `descendants' predicate did not properly exclude
@ -1012,7 +1132,12 @@ 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"
@ -1051,7 +1176,41 @@ with keyword arg NOW in PLIST."
'("/r/emacs"))) '("/r/emacs")))
(org-ql-it "with :description and :target regexp" (org-ql-it "with :description and :target regexp"
(org-ql-expect ('(link :description "em.cs" :target "em.cs" :regexp-p t)) (org-ql-expect ('(link :description "em.cs" :target "em.cs" :regexp-p t))
'("/r/emacs")))) '("/r/emacs")))
(describe "matches links whose descriptions contain brackets"
(before-each
(setq org-ql-test-buffer (org-ql-test-data-buffer "data-links.org")))
(unless (version< org-version "9.3")
;; Earlier Org versions don't allow escaped brackets in descriptions.
(org-ql-it "without arguments"
(org-ql-expect ('(link))
'("Alpha")))
(org-ql-it "with description-or-target"
(org-ql-expect ('(link "phrase"))
'("Alpha")))
(org-ql-it "with :description"
(org-ql-expect ('(link :description "phrase"))
'("Alpha")))
(org-ql-it "with :target"
(org-ql-expect ('(link :target "id:"))
'("Alpha")))
(org-ql-it "with :description and :target"
(org-ql-expect ('(link :description "phrase" :target "id"))
'("Alpha")))
(org-ql-it "with description-or-target regexp"
(org-ql-expect ('(link "id:.*" :regexp-p t))
'("Alpha")))
(org-ql-it "with :description regexp"
(org-ql-expect ('(link :description "phr.se" :regexp-p t))
'("Alpha")))
(org-ql-it "with :target regexp"
(org-ql-expect ('(link :target "id:.*" :regexp-p t))
'("Alpha")))
(org-ql-it "with :description and :target regexp"
(org-ql-expect ('(link :description "phr.se" :target "id:.*" :regexp-p t))
'("Alpha"))))))
(describe "(outline-path)" (describe "(outline-path)"
(org-ql-it "with one argument" (org-ql-it "with one argument"
@ -1172,6 +1331,7 @@ with keyword arg NOW in PLIST."
(org-ql-it ">= a priority" (org-ql-it ">= a priority"
(org-ql-expect ('(priority >= "B")) (org-ql-expect ('(priority >= "B"))
'("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Renew membership in supervillain club" "Learn universal sign language" "Internet" "Spaceship lease" "Fix flux capacitor")))) '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Renew membership in supervillain club" "Learn universal sign language" "Internet" "Spaceship lease" "Fix flux capacitor"))))
(describe "(property)" (describe "(property)"
;; MAYBE: Add support for (property) without arguments. ;; MAYBE: Add support for (property) without arguments.
@ -1184,7 +1344,15 @@ 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)"
@ -1198,16 +1366,6 @@ with keyword arg NOW in PLIST."
:sort 'todo) :sort 'todo)
'("Take over the universe"))) '("Take over the universe")))
(org-ql-it "with a plain string"
(org-ql-expect ("Take over"
:sort 'todo)
'("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut")))
(org-ql-it "with two plain strings in an OR"
(org-ql-expect ('(or "Take over" "universe")
:sort 'todo)
'("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut")))
(org-ql-it "case-folding predicate with non-case-folding preamble" (org-ql-it "case-folding predicate with non-case-folding preamble"
;; e.g. the (todo) predicate disables case-folding in its preamble, but that ;; e.g. the (todo) predicate disables case-folding in its preamble, but that
;; should not prevent case-folding in this and other predicates (issue #114). ;; should not prevent case-folding in this and other predicates (issue #114).
@ -1215,6 +1373,19 @@ with keyword arg NOW in PLIST."
:sort 'todo) :sort 'todo)
'("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut")))) '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Get haircut"))))
(describe "(rifle)"
(org-ql-it "with one argument"
(org-ql-expect ('(rifle "weekend"))
;; In entry text.
'("Take over the world"))
(org-ql-expect ('(rifle "moon"))
;; In outline path.
'("Take over the moon" "Visit the moon")))
(org-ql-it "with two arguments"
(org-ql-expect ('(rifle "Take" "world"))
;; In entry text (including tags) and/or outline path.
'("Take over the world" "Skype with president of Antarctica" "Get haircut"))))
(describe "(scheduled)" (describe "(scheduled)"
(org-ql-it "without arguments" (org-ql-it "without arguments"
@ -1277,9 +1448,45 @@ with keyword arg NOW in PLIST."
(org-ql-expect ('(scheduled :on 0)) (org-ql-expect ('(scheduled :on 0))
'("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))))) '("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")))))
;; ;; TODO: Test (src) predicate. That will require modifying test data, which will be a (describe "(src)"
;; ;; significant hassle. Manual testing shows that the predicate appears to work properly. (before-each
;; ;; It would seem preferable to use :var for this, but this seems more reliable.
(setq org-ql-test-buffer (org-ql-test-data-buffer "data-src.org")))
(org-ql-it "without arguments"
(org-ql-expect ('(src))
'("Alpha" "Bravo")))
(org-ql-it "with plain argument"
;; Finds in first source block in entry.
(org-ql-expect ('(src "foo"))
'("Alpha"))
(org-ql-expect ('(src "bar"))
'("Bravo"))
(org-ql-expect ('(src "print"))
;; Finds in subsequent source block in entry.
'("Alpha" "Bravo")))
(org-ql-it "with :regexps argument"
(org-ql-expect ('(src :regexps ("foo")))
'("Alpha"))
(org-ql-expect ('(src :regexps ("bar")))
'("Bravo"))
(org-ql-expect ('(src :regexps ("print" "foo")))
'("Alpha"))
(org-ql-expect ('(src :regexps ("foo" "bar")))
nil))
(org-ql-it "with :lang argument"
;; Finds in first source block in entry.
(org-ql-expect ('(src :lang "elisp"))
'("Alpha" "Bravo"))
;; Finds in subsequent source block in entry.
(org-ql-expect ('(src :lang "python"))
'("Alpha" "Bravo"))
(org-ql-expect ('(src :lang "js"))
'("Alpha"))))
(describe "(todo)" (describe "(todo)"
(org-ql-it "without arguments" (org-ql-it "without arguments"
@ -1320,10 +1527,10 @@ with keyword arg NOW in PLIST."
(org-ql-it "with file tags" (org-ql-it "with file tags"
(org-ql-expect ('(tags "food")) (org-ql-expect ('(tags "food"))
'("Fruit" "Blueberry" "Strawberry" "Vegetable" "Broccoli" "Potato") '("Fruit" "Blueberry" "Strawberry" "Vegetable" "Broccoli" "Potato")
:buffer (org-ql-test-data-buffer "data2.org")) :buffer (org-ql-test-data-buffer "data-file-tags.org"))
(org-ql-expect ('(tags "fruit")) (org-ql-expect ('(tags "fruit"))
'("Fruit" "Blueberry" "Strawberry") '("Fruit" "Blueberry" "Strawberry")
:buffer (org-ql-test-data-buffer "data2.org")))) :buffer (org-ql-test-data-buffer "data-file-tags.org"))))
(describe "(tags-inherited)" (describe "(tags-inherited)"
@ -1351,10 +1558,10 @@ with keyword arg NOW in PLIST."
(org-ql-it "with file tags" (org-ql-it "with file tags"
(org-ql-expect ('(tags-inherited "food")) (org-ql-expect ('(tags-inherited "food"))
'("Fruit" "Blueberry" "Strawberry" "Vegetable" "Broccoli" "Potato") '("Fruit" "Blueberry" "Strawberry" "Vegetable" "Broccoli" "Potato")
:buffer (org-ql-test-data-buffer "data2.org")) :buffer (org-ql-test-data-buffer "data-file-tags.org"))
(org-ql-expect ('(tags-inherited "fruit")) (org-ql-expect ('(tags-inherited "fruit"))
'("Blueberry" "Strawberry") '("Blueberry" "Strawberry")
:buffer (org-ql-test-data-buffer "data2.org")))) :buffer (org-ql-test-data-buffer "data-file-tags.org"))))
(describe "(tags-local)" (describe "(tags-local)"
@ -1381,10 +1588,10 @@ with keyword arg NOW in PLIST."
(org-ql-it "with file tags" (org-ql-it "with file tags"
(org-ql-expect ('(tags-local "food")) (org-ql-expect ('(tags-local "food"))
nil nil
:buffer (org-ql-test-data-buffer "data2.org")) :buffer (org-ql-test-data-buffer "data-file-tags.org"))
(org-ql-expect ('(tags-local "fruit")) (org-ql-expect ('(tags-local "fruit"))
'("Fruit") '("Fruit")
:buffer (org-ql-test-data-buffer "data2.org")))) :buffer (org-ql-test-data-buffer "data-file-tags.org"))))
(describe "(tags-all), (tags&)" (describe "(tags-all), (tags&)"
@ -1397,7 +1604,7 @@ with keyword arg NOW in PLIST."
(org-ql-it "with file tags" (org-ql-it "with file tags"
(org-ql-expect ('(tags-all "food" "fruit")) (org-ql-expect ('(tags-all "food" "fruit"))
'("Fruit" "Blueberry" "Strawberry") '("Fruit" "Blueberry" "Strawberry")
:buffer (org-ql-test-data-buffer "data2.org")))) :buffer (org-ql-test-data-buffer "data-file-tags.org"))))
(describe "(tags-regexp), (tags*)" (describe "(tags-regexp), (tags*)"
@ -1422,10 +1629,10 @@ with keyword arg NOW in PLIST."
(org-ql-it "with regexp matching file tags" (org-ql-it "with regexp matching file tags"
(org-ql-expect ('(tags-regexp "foo")) (org-ql-expect ('(tags-regexp "foo"))
'("Fruit" "Blueberry" "Strawberry" "Vegetable" "Broccoli" "Potato") '("Fruit" "Blueberry" "Strawberry" "Vegetable" "Broccoli" "Potato")
:buffer (org-ql-test-data-buffer "data2.org")) :buffer (org-ql-test-data-buffer "data-file-tags.org"))
(org-ql-expect ('(tags* "frui")) (org-ql-expect ('(tags* "frui"))
'("Fruit" "Blueberry" "Strawberry") '("Fruit" "Blueberry" "Strawberry")
:buffer (org-ql-test-data-buffer "data2.org")))) :buffer (org-ql-test-data-buffer "data-file-tags.org"))))
(describe "(ts)" (describe "(ts)"
@ -1496,7 +1703,36 @@ 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"
@ -1635,7 +1871,20 @@ 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"
@ -1670,8 +1919,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 (cl-flet ((open-link (link)
(link) (with-current-buffer test-buffer (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")
@ -1737,13 +1986,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 'wrong-type-argument '(characterp lambda))) :to-throw 'error '("CAUTION: Link not opened because unsafe title parameter detected: (lambda (_ _) (error \"UNSAFE\"))")))
(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 'wrong-type-argument '(characterp lambda))) :to-throw 'error '("CAUTION: Link not opened because unsafe title parameter detected: (lambda (_ _) (error \"UNSAFE\"))")))
(it "Errors for an expression" (it "Errors for an expression"
(expect (open-link expression-link) (expect (open-link expression-link)
:to-throw 'wrong-type-argument '(characterp error)))) :to-throw 'error '("CAUTION: Link not opened because unsafe title parameter detected: (error \"UNSAFE\")"))))
(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]]")
@ -1769,7 +2018,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 (expand-file-name file temp-dir))) collect (abbreviate-file-name (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"
@ -1832,8 +2081,7 @@ 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 (cl-flet ((var-after-bookmark-set-and-jump (var buffers-files query &key sort super-groups)
(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)
@ -1895,8 +2143,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 (cl-flet ((test-dblock (&optional input)
(&optional input) (with-current-buffer (get-buffer-create "*TEST DBLOCK*") (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"
@ -1935,8 +2183,7 @@ 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 (cl-flet* ((open-link-in (link buffer input)
(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
@ -1948,8 +2195,7 @@ 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-after-link-save-open (var buffers-files query &key sort super-groups
(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
@ -2111,7 +2357,7 @@ with keyword arg NOW in PLIST."
(it "Refuses to link to non-file-backed buffer" (it "Refuses to link to non-file-backed buffer"
(expect (var-after-link-save-open 'org-ql-view-buffers-files link-buffer query (expect (var-after-link-save-open 'org-ql-view-buffers-files link-buffer query
:buffer link-buffer) :buffer link-buffer)
:to-throw 'user-error '("Views that search non-file-backed buffers cant be linked to")))))) :to-throw 'user-error '("Views that search non-file-backed buffers can't be linked to"))))))
;; MAYBE: Also test `org-ql-views', although I already know it works now. ;; MAYBE: Also test `org-ql-views', although I already know it works now.
;; (describe "org-ql-views") ;; (describe "org-ql-views")