Compare commits

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

22 commits

Author SHA1 Message Date
Adam Porter
155ad6b80a WIP: Add optional context to Helm searches 2019-10-19 01:17:32 -05:00
Adam Porter
80b8bada7b Merge: 0.3.2 2019-10-19 01:11:07 -05:00
Adam Porter
c3c5fd14e1 Release: 0.3.2 2019-10-19 01:09:05 -05:00
Adam Porter
949a06c3ab Add: Negation in plain queries 2019-10-09 19:05:11 -05:00
Adam Porter
6b2004e678 Change/Fix: (src) predicate
Use keyword args, fix non-sexp syntax and searching.
2019-10-09 17:21:47 -05:00
Adam Porter
af0ef304e1 Merge: 0.3.1 2019-10-09 15:17:54 -05:00
Adam Porter
8e6f221063 Fix: Require map
Thanks to Brian Leung (@leungbk).  See #49.
2019-10-09 14:45:24 -05:00
Adam Porter
37ba30c969 Add: src predicate 2019-10-09 14:23:29 -05:00
Adam Porter
a60c238417 Fix: (org-ql-search) Bind print-length in interactive form
The list of buffers/files must always be printed completely.
2019-10-08 21:02:18 -05:00
Adam Porter
e9e756331c Fix: (--outline-path) Always return a string
org-heading-components returns nil for a heading without heading text,
which causes string-match to signal an error.  So we'll match the
regexp ourselves and return an empty string in that case.  Should be
slightly faster, anyway.
2019-10-08 20:55:51 -05:00
Adam Porter
da9be83326 Add: helm-org-ql-views, helm-source-org-ql-views 2019-10-08 16:45:41 -05:00
Adam Porter
13723f8163 Change: (helm-org-ql) Disable highlighting
Doesn't work properly because input contains predicates and keywords
that shouldn't be highlighted.  Might try to fix it someday to only
use args to (regexp) and (heading).
2019-10-07 22:45:39 -05:00
Adam Porter
553c22c3ac Add: Adjust search parameters in view buffers 2019-10-07 22:44:56 -05:00
Adam Porter
7fa0d83a54 Add: helm-org-ql-source, org-ql-search-directories-files, etc. 2019-10-07 20:08:01 -05:00
Adam Porter
34cdbd5c87 Docs: Add info manual
Updating readme accordingly, based on org-super-agenda's, which is
based on Magit's and Org's.
2019-10-07 19:53:11 -05:00
Adam Porter
ad20029721 Notes: Update 2019-10-07 19:53:11 -05:00
Adam Porter
c06e5518eb Add: Predicates outline-path, outline-path-segment 2019-10-07 19:53:10 -05:00
Adam Porter
8d680a8e79 Add: node-value-cache, --value-at
Not used for anything in this comment, but will be in the outline-path
predicates.  Also should probably use it for the tags cache.
2019-10-07 19:52:02 -05:00
Adam Porter
7e11145bad Fix: (--defpred) Debug declaration
To work with preds with aliases.
2019-10-07 12:38:02 -05:00
Adam Porter
acf8e0e0fb Notes: Add idea 2019-10-07 11:16:08 -05:00
Adam Porter
51ab6401b2 Docs: (--def-plain-query-fn) Fix docstring 2019-10-07 10:12:20 -05:00
Adam Porter
2a5ec2e4fd Meta: 0.4-pre 2019-10-07 10:12:13 -05:00
8 changed files with 1689 additions and 205 deletions

View file

@ -1,10 +1,10 @@
#+TITLE: org-ql
#+BEGIN_HTML
<a href=https://alphapapa.github.io/dont-tread-on-emacs/><img src="images/dont-tread-on-emacs-150.png" align="right"></a>
#+END_HTML
# 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>
[[https://melpa.org/#/org-ql][file:https://melpa.org/packages/org-ql-badge.svg]] [[https://stable.melpa.org/#/org-ql][file:https://stable.melpa.org/packages/org-ql-badge.svg]]
# NOTE: To avoid having this in the info manual, we use HTML rather than Org syntax; it still appears with the GitHub renderer.
#+HTML: <a href="https://melpa.org/#/org-ql"><img src="https://melpa.org/packages/org-ql-badge.svg"></a> <a href="https://stable.melpa.org/#/org-ql"><img src="https://stable.melpa.org/packages/org-ql-badge.svg"></a>
This package provides a query language for Org files. It offers two syntax styles: Lisp-like sexps and search engine-like keywords.
@ -63,12 +63,12 @@ These commands and functions are included:
+ *Showing an agenda-like view:*
- ~org-ql-search~ (command)
- ~org-ql-view~ (command)
- =org-ql-view-sidebar= (command)
- ~org-ql-view-sidebar~ (command)
- ~org-ql-block~ (agenda block function)
+ *Showing a tree in a buffer:*
- =org-ql-sparse-tree= (command)
- ~org-ql-sparse-tree~ (command)
+ *Showing results with Helm*:
- =helm-org-ql= (command)
- ~helm-org-ql~ (command)
+ *Returning a list of matches or acting on them:*
- ~org-ql~ (macro)
- ~org-ql-select~ (function)
@ -76,6 +76,7 @@ These commands and functions are included:
Feedback on these APIs is welcome. Eventually, after being tested and polished, they will be considered stable.
# TODO: Find a way to get these examples included in the info manual.
Lisp code examples are in [[examples.org]].
** Commands
@ -104,7 +105,7 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable
~SORT~: One or a list of ~org-ql~ sorting functions, like ~date~ or ~priority~.
*Bindings:* Keys bound in results buffer.
+ =g=: Refresh results.
+ =g=: Refresh results. With prefix, prompt to adjust search parameters.
+ =C-x C-s=: Save query to variable ~org-ql-views~ (accessible with command ~org-ql-view~).
*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.)
@ -129,7 +130,9 @@ Show a sidebar window listing views stored in =org-ql-views= for easy access. I
Show items in ~FILES~ from last ~DAYS~ days with timestamps of ~TYPE~. ~TYPE~ may be ~ts~, ~ts-active~, ~ts-inactive~, ~clocked~, ~closed~, ~deadline~, ~planning~, or ~scheduled~. =FILES= defaults to those returned by the function =org-agenda-files=.
*** org-ql-sparse-tree =(query &key keep-previous (buffer (current-buffer)))=
*** org-ql-sparse-tree
Arguments: ~(query &key keep-previous (buffer (current-buffer)))~
Show a sparse tree for ~QUERY~ in ~BUFFER~ and return number of results. The tree will show the lines where the query matches, and any other context defined in ~org-show-context-detail~, which see.
@ -151,7 +154,7 @@ An =org-ql= query is a lisp form which may contain arbitrary lisp forms, as well
The command =org-ql-search= also accepts, and the command =helm-org-ql= only accepts, an alternative, non-sexp query syntax. The syntax is simple, and a few examples of queries in both syntaxes should suffice. By default, when multiple predicates are used, they are combined with boolean =and=.
| Sexp syntax | Non-sexp syntax |
|-------------------------------------------------+-----------------------------------------|
|-------------------------------------------------+----------------------------------------------|
| ~(todo)~ | ~todo:~ |
| ~(todo "SOMEDAY")~ | ~todo:SOMEDAY~ |
| ~(todo "SOMEDAY" "WAITING")~ | ~todo:SOMEDAY,WAITING~ |
@ -160,6 +163,8 @@ The command =org-ql-search= also accepts, and the command =helm-org-ql= only acc
| ~(clocked :on -1)~ | ~clocked:on=-1~ |
| ~(heading "quoted phrase" "word")~ | ~heading:"quoted phrase",word~ |
| ~(and (tags "book" "books") (priority "A"))~ | ~tags:book,books priority:A~ |
| ~(src :lang "elisp" :regexps ("defun"))~ | ~src:defun,lang=elisp~ or ~src:lang=elisp,defun~ |
| ~(and (tags "space") (not (regexp "moon")))~ | ~tags:space !moon~ |
| ~(priority >= B)~ | ~priority:A,B~ |
Note that the =priority= predicate does not support comparators in the non-sexp syntax, so multiple priorities should be passed instead, as seen in the last example.
@ -171,25 +176,30 @@ Note that the =priority= predicate does not support comparators in the non-sexp
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).
+ ~children (&optional query)~ :: Return non-nil if current heading has direct child headings. If ~QUERY~, test it against child headings. This selector may be nested, e.g. to match grandchild headings.
+ ~descendants (&optional query)~ :: Return non-nil if current heading has descendant headings. If ~QUERY~, test it against descendant headings. This selector may be nested (if you can grok the nesting!).
+ ~done~ :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
+ ~habit~ :: Return non-nil if entry is a habit.
+ ~heading (&rest regexps)~ :: Return non-nil if current entry's heading matches all ~REGEXPS~ (regexp strings).
+ ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches arguments. The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~. ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs. ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~.
+ =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 (&optional comparator-or-priority priority)~ :: Return non-nil if current heading has a certain priority. ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator). If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string. If both arguments are nil, return non-nil if heading has any defined priority.
+ ~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)~.
+ ~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.
+ ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). Tests both inherited and local tags.
+ =tags-inherited (&optional tags)= :: Return non-nil if current heading's inherited tags include one or more of =TAGS= (a list of strings). If TAGS is nil, return non-nil if heading has any inherited tags.
- Aliases: =inherited-tags=, =tags-i=, =itags=.
+ =tags-local (&optional tags)= :: Return non-nil if current heading's local tags include one or more of =TAGS= (a list of strings). If TAGS is nil, return non-nil if heading has any local tags.
- Aliases: =local-tags=, =tags-l=, =ltags=.
+ =tags-all (tags)= :: Return non-nil if current heading includes all of =TAGS=. Tests both inherited and local 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~).
+ =category (&optional categories)= :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
+ =children (&optional query)= :: Return non-nil if current heading has direct child headings. If ~QUERY~, test it against child headings. This selector may be nested, e.g. to match grandchild headings.
+ =descendants (&optional query)= :: Return non-nil if current heading has descendant headings. If ~QUERY~, test it against descendant headings. This selector may be nested (if you can grok the nesting!).
+ =done= :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
+ =habit= :: Return non-nil if entry is a habit.
+ =heading (&rest regexps)= :: Return non-nil if current entry's heading matches all ~REGEXPS~ (regexp strings).
+ =level (level-or-comparator &optional level)= :: Return non-nil if current heading's outline level matches arguments. The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~. ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs. ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~.
+ =outline-path (&rest strings)= :: Return non-nil if current node's outline path matches all of ~STRINGS~. Each string may appear as a substring in any part of the node's outline path. For example, the path =Food/Fruits/Grapes= would match ~(olp "Fruit" "Grape")~.
- Aliases: ~olp~.
+ =outline-path-segment (&rest strings)= :: Return non-nil if current node's outline path matches ~STRINGS~. Matches ~STRINGS~ as a contiguous segment of the outline path. Each string is compared as a substring. For example the path ~Food/Fruits/Grapes~ would match ~(olps "Fruit" "Grape")~ but not ~(olps "Food" "Grape")~.
- Aliases: ~olps~.
+ =path (&rest regexps)= :: Return non-nil if current heading's buffer's filename path matches any of ~REGEXPS~ (regexp strings). Without arguments, return non-nil if buffer is file-backed.
+ =priority (&optional comparator-or-priority priority)= :: Return non-nil if current heading has a certain priority. ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator). If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string. If both arguments are nil, return non-nil if heading has any defined priority.
+ =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)~.
+ =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.
+ ~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.
+ =tags (&optional tags)= :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). Tests both inherited and local tags.
+ =tags-inherited (&optional tags)= :: Return non-nil if current heading's inherited tags include one or more of ~TAGS~ (a list of strings). If ~TAGS~ is nil, return non-nil if heading has any inherited tags.
- Aliases: ~inherited-tags~, ~tags-i~, ~itags~.
+ =tags-local (&optional tags)= :: Return non-nil if current heading's local tags include one or more of ~TAGS~ (a list of strings). If ~TAGS~ is nil, return non-nil if heading has any local tags.
- Aliases: ~local-tags~, ~tags-l~, ~ltags~.
+ =tags-all (tags)= :: Return non-nil if current heading includes all of ~TAGS~. Tests both inherited and local 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~).
*** Date/time predicates
:PROPERTIES:
@ -204,21 +214,21 @@ All of these predicates take optional keyword arguments ~:from~, ~:to:~, and ~:o
Argument values should be either a number of days (positive to look forward, or negative to look backward), a ~ts~ struct, or a string parseable by ~parse-time-string~ (the string may omit the time value).
*Predicates:*
+ ~ts~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp.
+ ~ts-active~, ~ts-a~ :: Like ~ts~, but only matches active timestamps.
+ ~ts-inactive~, ~ts-i~ :: Like ~ts~, but only matches inactive timestamps.
+ *Predicates*
- =ts= :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp.
- =ts-active=, =ts-a= :: Like =ts=, but only matches active timestamps.
- =ts-inactive=, =ts-i= :: Like =ts=, but only matches inactive timestamps.
The following predicates, in addition to the keyword arguments, can also take a single argument, a number, which looks backward or forward a number of days. The number can be negative to invert the direction.
*Backward-looking:*
+ ~clocked~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
+ ~closed~ :: Return non-nil if current entry was closed in given period. If no arguments are specified, return non-nil if entry was closed at any time.
+ *Backward-looking*
- =clocked= :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
- =closed= :: Return non-nil if current entry was closed in given period. If no arguments are specified, return non-nil if entry was closed at any time.
*Forward-looking:*
+ ~deadline~ :: Return non-nil if current entry has deadline in given period. If argument is =auto=, return non-nil if entry has deadline within =org-deadline-warning-days=. If no arguments are specified, return non-nil if entry has any deadline.
+ ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). If no arguments are specified, return non-nil if entry is scheduled at any time.
+ ~scheduled~ :: Return non-nil if current entry is scheduled in given period. If no arguments are specified, return non-nil if entry is scheduled at any time.
+ *Forward-looking*
- =deadline= :: Return non-nil if current entry has deadline in given period. If argument is =auto=, return non-nil if entry has deadline within =org-deadline-warning-days=. If no arguments are specified, return non-nil if entry has any deadline.
- =planning= :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). If no arguments are specified, return non-nil if entry is scheduled at any time.
- =scheduled= :: Return non-nil if current entry is scheduled in given period. If no arguments are specified, return non-nil if entry is scheduled at any time.
** Functions / Macros
:PROPERTIES:
@ -363,7 +373,22 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience
/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.3.2-pre
** 0.4-pre
*Added*
+ Negation of terms in plain queries using ~!~. For example, ~tags:space !moon~ to exclude entries which contain ~moon~.
+ Predicates =outline-path= (alias =olp=) and =outline-path-segment= (alias =olps=).
+ Info manual.
+ Command ~org-ql-search~ can search files in ~org-directory~; customization options are available in the ~org-ql-search~ group.
+ Command ~org-ql-view-refresh~ can be called with a prefix argument to adjust search parameters.
+ Function ~helm-org-ql-source~, which returns a Helm source that searches given buffers/files with ~helm-org-ql~. It can be used for custom Helm commands that search certain files.
+ Command ~helm-org-ql-views~, which shows one of ~org-ql-views~ selected with Helm.
+ Predicate ~src~, which matches Org Babel source blocks.
*Internal*
+ Added generic node data cache to speed up recursive, tree-based queries.
** 0.3.2
*Fixed*
+ In =org-ql-search=, accept symbol as ~:super-groups~ argument.
@ -570,9 +595,32 @@ Generates the predicate subtree.
If ~org-ql~ is loaded byte-compiled, the argument lists are not named properly (not sure why, as ~help-function-arglist~ is supposed to handle that). We could run the function in another Emacs process with ~async~ to avoid this.
* COMMENT Export setup :noexport:
:PROPERTIES:
:TOC: ignore
:END:
# Copied from org-super-agenda's readme, in which much was borrowed from Org's =org-manual.org=.
#+OPTIONS: broken-links:t *:t
** Info export options
#+TEXINFO_DIR_CATEGORY: Emacs
#+TEXINFO_DIR_TITLE: Org QL: (org-ql)
#+TEXINFO_DIR_DESC: Query language, search commands, and saved views for Org files
# NOTE: We could use these, but that causes a pointless error, "org-compile-file: File "..README.info" wasn't produced...", so we just rename the files in the after-save-hook instead.
# #+TEXINFO_FILENAME: org-ql.info
# #+EXPORT_FILE_NAME: org-ql.texi
** File-local variables
# NOTE: Setting org-comment-string buffer-locally is a nasty hack to work around GitHub's org-ruby's HTML rendering, which does not respect noexport tags. The only way to hide this tree from its output is to use the COMMENT keyword, but that prevents Org from processing the export options declared in it. So since these file-local variables don't affect org-ruby, wet set org-comment-string to an unused keyword, which prevents Org from deleting this tree from the export buffer, which allows it to find the export options in it. And since org-export does respect the noexport tag, the tree is excluded from the info page.
# Local Variables:
# eval: (require 'org-make-toc)
# before-save-hook: org-make-toc
# after-save-hook: (lambda nil (when (and (require 'ox-texinfo nil t) (org-texinfo-export-to-info)) (delete-file "README.texi") (rename-file "README.info" "org-ql.info" t)))
# org-export-initial-scope: buffer
# org-comment-string: "NOTCOMMENT"
# End:

View file

@ -33,6 +33,7 @@
(require 'org)
(require 'org-ql)
(require 'org-ql-search)
;; (require 'helm)
;; (require 'helm-org)
@ -65,6 +66,15 @@
"Keymap for `helm-org-ql' sessions.
Based on `helm-map'.")
(defvar helm-source-org-ql-views
(helm-build-sync-source "Org QL Views"
:candidates (lambda ()
(->> org-ql-views
(-map #'car)
(-sort #'string<)))
:action (list (cons "Show view" #'org-ql-view)))
"Helm source for `org-ql-views'.")
(defvar-local helm-org-ql-buffers-files nil
"Used for `helm-org-ql-save'.")
@ -89,11 +99,24 @@ Based on `helm-map'.")
:type '(alist :key-type (string :tag "Description")
:value-type (function :tag "Command")))
(defcustom helm-org-ql-context nil
"Whether to show context around search terms in results."
:type 'boolean)
(defcustom helm-org-ql-context-chars 25
"Number of characters around search terms to display as context."
:type 'integer)
(defcustom helm-org-ql-context-max 10
"Maximum number of context strings around search terms to display."
:type 'integer)
;;;; Commands
;;;###autoload
(cl-defun helm-org-ql (buffers-files
&key (boolean 'and) (name "helm-org-ql"))
&key (boolean 'and) (name "helm-org-ql")
(context helm-org-ql-context))
"Display results in BUFFERS-FILES for an `org-ql' non-sexp query using Helm.
Interactively, search the current buffer. Note that this command
only accepts non-sexp, \"plain\" queries.
@ -122,54 +145,26 @@ Is transformed into this query:
(and \"something else\" (tags \"funny\"))"
(interactive (list (current-buffer)))
(let ((boolean (if current-prefix-arg 'or boolean))
(helm-input-idle-delay helm-org-ql-input-idle-delay))
(let ((helm-org-ql-context (if current-prefix-arg
(not context)
context))
(helm-input-idle-delay helm-org-ql-input-idle-delay)
(helm-candidate-separator " "))
(helm :prompt (format "Query (boolean %s): " (-> boolean symbol-name upcase))
:sources
;; Expansion of `helm-build-sync-source' macro.
(helm-make-source name 'helm-source-sync
:candidates (lambda nil
(let* ((query (org-ql--plain-query helm-pattern boolean))
(window-width (window-width (helm-window))))
(when query
(with-current-buffer (helm-buffer-get)
(setq helm-org-ql-buffers-files buffers-files))
(ignore-errors
;; Ignore errors that might be caused by partially typed queries.
;; FIXME: This doesn't prevent warnings that are errors occurring during
;; byte-compilation due to partially typed values which can't be correctly
;; pre-processed, e.g. "ts:to=2019-01-0", which can't be parsed into a
;; timestamp. A "*Compile-Log*" buffer is displayed with "Error: Wrong type
;; argument: integerp, nil". With my Helm settings, it's hidden as soon as
;; the query is typed correctly, so it's tolerable, but I'd prefer to fix it.
;; I haven't found a way to ignore the error/warning; `with-no-warnings' has
;; no effect, and we're already using `ignore-errors'. The only solution I
;; can think of would be to ignore the errors/warnings higher up the chain
;; where byte-compilation is actually done, but it might not be a good idea
;; to always ignore such errors/warnings.
(org-ql-select buffers-files query
:action (list 'helm-org-ql--heading window-width))))))
:match #'identity
:fuzzy-match nil
:multimatch nil
:volatile t
:keymap helm-org-ql-map
:action helm-org-ql-actions))))
:sources (helm-org-ql-source buffers-files :name name))))
;;;###autoload
(defun helm-org-ql-agenda-files ()
"Search agenda files with `helm-org-ql', which see."
(interactive)
(helm-org-ql (org-agenda-files) :name "helm-org-ql-agenda-files"))
(helm-org-ql (org-agenda-files) :name "Org Agenda Files"))
;;;###autoload
(defun helm-org-ql-org-directory ()
"Search Org files in `org-directory' with `helm-org-ql'."
(interactive)
(helm-org-ql (directory-files org-directory 'full
(rx ".org" eos))
:name "helm-org-ql-org-directory"))
(helm-org-ql (org-ql-search-directories-files)
:name "Org Directory Files"))
(defun helm-org-ql-show-marker (marker)
"Show heading at MARKER."
@ -196,18 +191,92 @@ Is transformed into this query:
(query (org-ql--plain-query helm-pattern)))
(helm-run-after-exit #'org-ql-search buffers-files query)))
;;;###autoload
(defun helm-org-ql-views ()
"Show an `org-ql' view selected with Helm."
(interactive)
(helm :sources helm-source-org-ql-views))
;;;; Functions
(defun helm-org-ql--heading (window-width)
"Return string for Helm for heading at point.
WINDOW-WIDTH should be the width of the Helm window."
(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'."
;; Expansion of `helm-build-sync-source' macro.
(helm-make-source name 'helm-source-sync
:candidates (lambda nil
(let* ((query (org-ql--plain-query helm-pattern))
(window-width (window-width (helm-window)))
strings context-re)
(when query
(with-current-buffer (helm-buffer-get)
(setq helm-org-ql-buffers-files buffers-files))
(setf strings (org-ql--query-strings query)
context-re (when helm-org-ql-context
(rx-to-string `(seq (or ,@strings)) t)))
(ignore-errors
;; Ignore errors that might be caused by partially typed queries.
;; FIXME: This doesn't prevent warnings that are errors occurring during
;; byte-compilation due to partially typed values which can't be correctly
;; pre-processed, e.g. "ts:to=2019-01-0", which can't be parsed into a
;; timestamp. A "*Compile-Log*" buffer is displayed with "Error: Wrong type
;; argument: integerp, nil". With my Helm settings, it's hidden as soon as
;; the query is typed correctly, so it's tolerable, but I'd prefer to fix it.
;; I haven't found a way to ignore the error/warning; `with-no-warnings' has
;; no effect, and we're already using `ignore-errors'. The only solution I
;; can think of would be to ignore the errors/warnings higher up the chain
;; where byte-compilation is actually done, but it might not be a good idea
;; to always ignore such errors/warnings.
(org-ql-select buffers-files query
:action `(helm-org-ql--entry-cons ,window-width ,context-re))))))
:multiline helm-org-ql-context
:match #'identity
:fuzzy-match nil
:multimatch nil
:nohighlight t
:volatile t
:keymap helm-org-ql-map
:action helm-org-ql-actions))
(defun helm-org-ql--query-strings (query)
"Return list of plain strings in QUERY suitable for highlighting and context."
(cl-labels ((rec (sexp)
(pcase sexp
(`(,(or 'heading 'regexp) . ,strings)
strings)
((and (pred listp) (guard sexp))
(append (rec (car sexp))
(rec (cdr sexp)))))))
(rec query)))
(defun org-ql--entry-context (regexp)
"Return string showing context around REGEXP for current entry.
Assumes point is on heading."
(let* ((beg (point))
(limit (org-entry-end-position))
(context-strings
(save-excursion
(forward-line 1)
(cl-loop for i to helm-org-ql-context-max
while (re-search-forward regexp limit t)
collect (s-trim (buffer-substring-no-properties
(max beg (- (match-beginning 0) helm-org-ql-context-chars))
(min limit (+ (match-end 0) helm-org-ql-context-chars))))))))
(when context-strings
(s-replace-regexp "\n+" " " (s-join "..." context-strings)))))
(defun helm-org-ql--entry-cons (window-width &optional context-re)
"Return (DISPLAY . MARKER) pair for Helm for heading at point.
WINDOW-WIDTH should be the width of the Helm window. If
CONTEXT-RE is non-nil, include entry text matching around it."
(font-lock-ensure (point-at-bol) (point-at-eol))
;; TODO: It would be better to avoid calculating the prefix and width
;; at each heading, but there's no easy way to do that once in each
;; buffer, unless we manually called `org-ql' in each buffer, which
;; I'd prefer not to do. Maybe I should add a feature to `org-ql' to
;; call a setup function in a buffer before running queries.
(let* ((prefix (concat (buffer-name) ":"))
(let* ((prefix (propertize (concat (buffer-name) ":")
'face '(:weight bold)))
(width (- window-width (length prefix)))
(path (org-split-string (org-format-outline-path (org-get-outline-path)
width nil "")
@ -215,8 +284,13 @@ WINDOW-WIDTH should be the width of the Helm window."
(heading (org-get-heading t))
(path (if helm-org-ql-reverse-paths
(concat heading "\\" (s-join "\\" (nreverse path)))
(concat (s-join "/" path) "/" heading))))
(cons (concat prefix path) (point-marker))))
(concat (s-join "/" path) "/" heading)))
(context (when context-re
(org-ql--entry-context context-re)))
(display (if (s-present? context)
(concat prefix path "\n" context)
(concat prefix path))))
(cons display (point-marker))))
;;;; Footer

114
notes.org
View file

@ -6,10 +6,6 @@
Note that the built-in sorting only works on Org elements, which is the default ~:action~. So if a different action is used, sorting will not work. In that case, the action should be mapped across the Org element results from outside the ~org-ql~ form.
** TODO [#C] Test caching
See notes on 1dce9467f25428b5289d3665cd840820969ed65a. It would be good to test the caching explicitly, at least for some queries, because if I were to completely break it again, in such a way that results were stored but retrieval always failed, the tests wouldn't catch it.
** TODO [#A] Helm command
In branch =wip/helm-org-ql=. Works really well, should add it and demonstrate it.
@ -129,6 +125,41 @@ Well, a bit of fiddling (lots of trial-and-error required) produced this:
That seems pretty usable!
** TODO [#A] Outline path in buffers-files arg
:PROPERTIES:
:ID: 6935361a-9e1d-48ec-8d17-876a90b90f50
:END:
e.g.
#+BEGIN_SRC elisp
(org-ql (olp "~/org/inbox.org" "Emacs" "Ideas")
(todo "NEXT"))
#+END_SRC
Also, should support an ~id~ one.
** TODO [#A] Tools for saving queries and accessing them [2/4]
+ Added example to =examples.org=.
*** DONE Save query from ql-agenda buffer
*** DONE Access saved query from saved query list
*** TODO Org link types
:PROPERTIES:
:ID: 4db73c1c-a4ed-425e-9e38-8d334ed03e1e
:END:
This would be useful for having a menu of saved queries as Org links, or even bookmarking saved queries.
**** TODO For all parameters
**** TODO For saved queries
*** TODO Bookmarks
** TODO [#B] Timeline view
e.g. as mentioned by Samuel Wales at https://lists.gnu.org/archive/html/emacs-orgmode/2019-08/msg00330.html. Prototype code:
@ -194,38 +225,6 @@ e.g. as mentioned by Samuel Wales at https://lists.gnu.org/archive/html/emacs-or
(org-ql-agenda--agenda nil nil :strings strings)))
#+END_SRC
** TODO [#A] Outline path in buffers-files arg
e.g.
#+BEGIN_SRC elisp
(org-ql (olp "~/org/inbox.org" "Emacs" "Ideas")
(todo "NEXT"))
#+END_SRC
Also, should support an ~id~ one.
** TODO [#A] Tools for saving queries and accessing them [2/4]
+ Added example to =examples.org=.
*** DONE Save query from ql-agenda buffer
*** DONE Access saved query from saved query list
*** TODO Org link types
:PROPERTIES:
:ID: 4db73c1c-a4ed-425e-9e38-8d334ed03e1e
:END:
This would be useful for having a menu of saved queries as Org links, or even bookmarking saved queries.
**** TODO For all parameters
**** TODO For saved queries
*** TODO Bookmarks
** TODO [#B] Add more sorters?
+ [ ] =category=
@ -403,6 +402,10 @@ e.g. as mentioned by Samuel Wales at https://lists.gnu.org/archive/html/emacs-or
e.g. doesn't currently show the =View= header.
** TODO [#C] Test caching
See notes on 1dce9467f25428b5289d3665cd840820969ed65a. It would be good to test the caching explicitly, at least for some queries, because if I were to completely break it again, in such a way that results were stored but retrieval always failed, the tests wouldn't catch it.
** TODO [#C] ~org-agenda-skip-function~
As discussed [[https://www.reddit.com/r/emacs/comments/cnrt2d/orgqlblock_integrates_orgql_into_org_agenda/ewi1q36/][here]], this is a cool feature that allows further integration into existing custom agenda commands. Example:
@ -452,6 +455,41 @@ See notes on 1dce9467f25428b5289d3665cd840820969ed65a. It would be good to test
** TODO [#C] Update commentary
** UNDERWAY [#A] Outline path predicate
[2019-10-07 Mon 11:15] There are two potential types of matching on outline paths: matching on any part of the outline path, and matching a specific path. For example, with this file:
#+BEGIN_SRC org
,* Food
,** Fruits
,*** Blueberries
,*** Grapes
,** Vegetables
,*** Carrots
,*** Potatoes
#+END_SRC
Matching could work like this:
+ ~(outline "Food")~ :: Would return all nodes.
+ ~(outline "Fruits")~ :: Would return all fruits.
Matching at a specific path would be something like:
+ ~(outline-path "Food" "Fruits")~ :: Would return all fruits. But if there were another =Fruits= heading somewhere in the file, under a different outline path, it would not return its nodes.
I'm not sure the second type of matching belongs in predicates, but rather in [[id:6935361a-9e1d-48ec-8d17-876a90b90f50][this]].
To implement this with good performance probably needs an outline-path cache. I can probably repurpose the tags caching, but maybe it should be generalized.
[2019-10-07 Mon 13:09] This is basically done with =be2bf6df316b96b3ed56851b8ffe0e227796b621= and =be2bf6df316b96b3ed56851b8ffe0e227796b621=, but not the specific-path matching. I left a =MAYBE= in the code about "anchored" path matching, which would accomplish that.
** UNDERWAY [#A] Helm command
In branch =wip/helm-org-ql=. Works really well, should add it and demonstrate it.
@ -495,7 +533,7 @@ Items would be structs, and the =group-by= argument would be a list of accessors
Not sure if it should automatically add the number of items to the header, or if that should be done manually.
** MAYBE [#C] "Node" caching
** UNDERWAY [#B] "Node" caching
[2019-09-05 Thu 12:30] At each node checked by a predicate, make a struct that stores attributes we can query for, as well as parent node position. This would let us speed up ancestor-based queries, like =(ancestor (todo "WAITING"))=. Ideally it would also serve as the tag hierarchy cache.
@ -503,6 +541,8 @@ It would probably be an all-encompassing system, because predicates would need t
Maybe a good improvement to make later, after the project is more developed.
[2019-10-07 Mon 13:08] This has basically been implemented in =be2bf6df316b96b3ed56851b8ffe0e227796b621=, but as functions and values rather than with structs. It remains to be seen how this works with =ancestor= queries, but I suspect it will help a lot.
*** Struct PoC code
This works okay (except the priority accessor needs to be fixed, because Org priorities are awkward to get). I'm guessing all the extra function calls would make it undesirable in cases of returning many results, but it's a flexible concept that makes sorting easy.

View file

@ -30,6 +30,7 @@
(require 'cl-lib)
(require 'dash)
(require 'f)
(require 'org-super-agenda)
(require 's)
@ -41,6 +42,30 @@
(defvar org-ql-block-header nil
"An optional string to override the default header in `org-ql-block' agenda blocks.")
;;;; Customization
(defgroup org-ql-search nil
"Options for `org-ql-search' commands."
:group 'org-ql)
(defcustom org-ql-search-directories-files-regexp "\.org$"
"Regular expression to match Org filenames in `org-directory'.
Files matching this regexp will be searched. By default,
\".org\" files are matched, but you may also select to include
\".org_archive\" files, or use a custom regexp."
:type '(radio (const :tag "Normal \".org\" files" :value "\.org$")
(const :tag "Also include \".org_archive\" files" "\.org\\(_archive\\)?$")
(string :tag "Custom regular expression")))
(defcustom org-ql-search-directories-files-recursive nil
"Recurse into subdirectories by default in `org-ql-search-directories-files'.
This should probably be disabled by default, because
e.g. `org-directory' may include deeply nested directories of
non-Org files, such as a \".git\" directory, Org attachments
directories, etc, which would make it slow to list the
`org-directory' files recursively."
:type 'boolean)
;;;; Commands
;;;###autoload
@ -91,6 +116,7 @@ Interactively, may also be:
- `buffer': search the current buffer
- `all': search all Org buffers
- `agenda': search buffers returned by the function `org-agenda-files'
- `directory': search Org files in `org-directory'
- An expression which evaluates to a list of files/buffers
- A space-separated list of file or buffer names
@ -113,27 +139,40 @@ display the results. By default, the value of
`org-ql-view-buffer' is used, and a new buffer is created if
necessary."
(declare (indent defun))
(interactive (list (pcase-exhaustive (completing-read "Buffers/Files: "
(list 'buffer 'agenda 'all)
nil t)
(interactive (list (if (and org-ql-view-buffers-files
(bufferp org-ql-view-buffers-files))
;; Buffers can't be input by name, so if the default value is a buffer, just use it.
;; TODO: Find a way to fix this.
org-ql-view-buffers-files
(pcase-exhaustive (completing-read "Buffers/Files: "
(list 'buffer 'agenda 'directory 'all)
nil nil (when org-ql-view-buffers-files
(let ((print-length nil))
(prin1-to-string (cons 'list org-ql-view-buffers-files)))))
((or "" "buffer") (current-buffer))
("agenda" (org-agenda-files))
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
(buffer-list)))
((or "" "buffer") (current-buffer))
("directory" (org-ql-search-directories-files))
((and form (guard (rx bos "("))) (-flatten (eval (read form))))
(else (s-split (rx (1+ space)) else)))
(read-string "Query: ")
:narrow (eq current-prefix-arg '(4))
(else (s-split (rx (1+ space)) else))))
(read-string "Query: " (when org-ql-view-query
(format "%S" org-ql-view-query)))
:narrow (or org-ql-view-narrow (eq current-prefix-arg '(4)))
:super-groups (when (bound-and-true-p org-super-agenda-auto-selector-keywords)
(let ((keywords (cl-loop for type in org-super-agenda-auto-selector-keywords
collect (substring (symbol-name type) 6))))
(pcase (completing-read "Group by: "
(append (list "Don't group"
"Global super-groups")
(cl-loop for type in org-super-agenda-auto-selector-keywords
collect (substring (symbol-name type) 6)))
nil t)
keywords)
nil nil (when org-ql-view-super-groups
(format "%S" org-ql-view-super-groups)))
("Global super-groups" org-super-agenda-groups)
((or "" "Don't group") nil)
(property (list (list (intern (concat ":auto-" property)))))))
((and keyword (guard (member keyword keywords)))
(list (list (intern (concat ":auto-" keyword)))))
(else (read else)))))
:sort (pcase (completing-read "Sort by: "
(list "Don't sort"
"date"
@ -141,15 +180,22 @@ necessary."
"priority"
"scheduled"
"todo")
nil t)
nil t (when org-ql-view-sort
(prin1-to-string org-ql-view-sort)))
((or "" "Don't sort") nil)
(sort (intern sort)))))
;; NOTE: Using `with-temp-buffer' is a hack to work around the fact that `make-local-variable'
;; does not work reliably from inside a `let' form when the target buffer is current on entry
;; to or exit from the `let', even though `make-local-variable' is actually done in
;; `org-ql-view--display'. So we do all this within a temp buffer, which works around it.
(with-temp-buffer
(let* ((query (cl-etypecase query
(string (if (string-match-p (rx bos (1+ alpha) ":") query)
;; Parse non-sexp query into sexp query.
(org-ql--plain-query query)
(string (if (or (string-prefix-p "(" query)
(string-prefix-p "\"" query))
;; Read sexp query.
(read query)))
(read query)
;; Parse non-sexp query into sexp query.
(org-ql--plain-query query)))
(list query)))
(results (org-ql-select buffers-files query
:action 'element-with-markers
@ -171,7 +217,7 @@ necessary."
(list super-groups))))
(setf strings (org-super-agenda--group-items strings))))
(org-ql-view--display :buffer buffer :header header
:string (s-join "\n" strings))))
:string (s-join "\n" strings)))))
(defun org-ql-search-block (query)
"Insert items for QUERY into current buffer.
@ -207,6 +253,22 @@ automatically from the query."
;;;###autoload
(defalias 'org-ql-block 'org-ql-search-block)
;;;; Functions
(cl-defun org-ql-search-directories-files (&key (directories (list org-directory))
(recurse org-ql-search-directories-files-recursive)
(regexp org-ql-search-directories-files-regexp))
"Return list of matching files in DIRECTORIES, a list of directory paths.
When RECURSE is non-nil, recurse into subdirectories. When
REGEXP is non-nil, only return files that match REGEXP."
(let ((files (->> directories
(--map (f-files it nil recurse))
-flatten)))
(if regexp
(--select (string-match regexp it)
files)
files)))
;;;; Footer
(provide 'org-ql-search)

View file

@ -275,18 +275,27 @@ TYPE may be `ts', `ts-active', `ts-inactive', `clocked', or
'face '(:weight bold :inherit highlight))
(org-ql-view key))))
(defun org-ql-view-refresh ()
"Refresh current `org-ql-search' buffer."
(interactive)
(let ((current-line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
(old-pos (point)))
(org-ql-search org-ql-view-buffers-files
(defun org-ql-view-refresh (&optional prompt)
"Refresh current `org-ql-search' buffer.
If PROMPT is non-nil (interactively, with prefix), prompt to
update search arguments."
(interactive "P")
(let* ((current-line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
(old-pos (point))
(defaults (list org-ql-view-buffers-files
org-ql-view-query
:sort org-ql-view-sort
:narrow org-ql-view-narrow
:super-groups org-ql-view-super-groups
:title org-ql-view-title
:buffer (current-buffer))
:title org-ql-view-title))
(org-ql-view-buffer (current-buffer)))
(if prompt
(call-interactively #'org-ql-search)
(apply #'org-ql-search defaults))
;; Now in the results buffer.
(rename-buffer (format "%s %s*"
org-ql-view-buffer-name-prefix
(or org-ql-view-title org-ql-view-query)))
(goto-char (point-min))
(or (when (search-forward current-line nil t)
(beginning-of-line))
@ -347,17 +356,24 @@ subsequent refreshing of the buffer: `org-ql-view-buffers-files',
`org-ql-view-query', `org-ql-view-sort', `org-ql-view-narrow',
`org-ql-view-super-groups', `org-ql-title.'"
(declare (indent defun))
(let* ((buffer (cl-etypecase buffer
(let* ((vars (list 'org-ql-view-buffers-files 'org-ql-view-query
'org-ql-view-sort 'org-ql-view-narrow
'org-ql-view-super-groups 'org-ql-view-title))
;; Save the values of variables which are set buffer-locally in the
;; results buffer, which we want to override and set buffer-locally again.
(vals (cl-loop for symbol in vars
collect (cons symbol (symbol-value symbol))))
(buffer (cl-etypecase buffer
(string (org-ql-view--buffer buffer))
(null (org-ql-view--buffer buffer))
(buffer buffer))))
(with-current-buffer buffer
(use-local-map org-ql-view-map)
;; Prepare buffer, saving data for refreshing.
(cl-loop for symbol in (list 'org-ql-view-buffers-files 'org-ql-view-query
'org-ql-view-sort 'org-ql-view-narrow
'org-ql-view-super-groups 'org-ql-view-title)
do (set (make-local-variable symbol) (symbol-value symbol)))
(cl-loop for symbol in vars
do (progn
(kill-local-variable symbol)
(set (make-local-variable symbol) (alist-get symbol vals nil nil #'equal))))
(setf header-line-format header)
;; Clear buffer, insert entries, etc.
(let ((inhibit-read-only t))

215
org-ql.el
View file

@ -2,8 +2,8 @@
;; Author: Adam Porter <adam@alphapapa.net>
;; Url: https://github.com/alphapapa/org-ql
;; Version: 0.3.2-pre
;; Package-Requires: ((emacs "26.1") (dash "2.13") (dash-functional "1.2.0") (org "9.0") (org-super-agenda "1.2-pre") (ov "1.0.6") (peg "0.6") (s "1.12.0") (ts "0.2-pre"))
;; Version: 0.4-pre
;; Package-Requires: ((emacs "26.1") (dash "2.13") (dash-functional "1.2.0") (f "0.17.2") (org "9.0") (org-super-agenda "1.2-pre") (ov "1.0.6") (peg "0.6") (s "1.12.0") (ts "0.2-pre"))
;; Keywords: hypermedia, outlines, Org, agenda
;;; Commentary:
@ -42,6 +42,7 @@
(require 'dash)
(require 'dash-functional)
(require 'map)
(require 'ts)
;;;; Constants
@ -96,6 +97,13 @@ tick, and another hash table keyed on buffer position, whose
values are a list of two lists, inherited tags and local tags, as
strings.")
(defvar org-ql-node-value-cache (make-hash-table :weakness 'key)
"Per-buffer node cache.
Keyed by buffer. Each value is a cons of the buffer's modified
tick, and another hash table keyed on buffer position, whose
values are alists in which the key is a function and the value is
the value returned by it at that node.")
(defvar org-ql-predicates
(list (list :name 'org-back-to-heading :fn (symbol-function 'org-back-to-heading)))
"Plist of predicates, their corresponding functions, and their docstrings.
@ -120,7 +128,7 @@ docstring. BODY is the body of the predicate.
Predicates will be called with point on the beginning of an Org
heading and should return non-nil if the heading's entry is a
match."
(declare (debug (symbolp listp stringp def-body))
(declare (debug ([&or symbolp listp] listp stringp def-body))
(indent defun))
(let* ((aliases (when (listp name)
(cdr name)))
@ -416,6 +424,60 @@ Returns cons (INHERITED-TAGS . LOCAL-TAGS)."
org-ql-tags-cache))
(puthash position all-tags tags-cache))))
(defun org-ql--outline-path ()
"Return outline path for heading at point."
(save-excursion
(let ((heading (save-match-data
(if (looking-at org-complex-heading-regexp)
(or (match-string 4) "")
""))))
(if (org-up-heading-safe)
;; MAYBE: It seems wrong to call the cache function from
;; inside this function, like a violation of separation of
;; concern. Can this be rewritten to not work that way?
(append (org-ql--value-at (point) #'org-ql--outline-path)
(list heading))
(list heading)))))
;; TODO: Use --value-at for tags cache.
(defun org-ql--value-at (position fn)
"Return FN's value at POSITION in current buffer.
Values compared with `equal'."
;; I'd like to use `-if-let*', but it doesn't leave non-nil variables
;; bound in the else clause, so destructured variables that are non-nil,
;; like found caches, are not available in the else clause.
(if-let* ((buffer-cache (gethash (current-buffer) org-ql-node-value-cache))
(modified-tick (car buffer-cache))
(position-cache (cdr buffer-cache))
(buffer-unmodified-p (eq (buffer-modified-tick) modified-tick))
(value-cache (gethash position position-cache))
(cached-value (alist-get fn value-cache nil nil #'equal)))
;; Found in cache: return it.
(pcase cached-value
('org-ql-nil nil)
(_ cached-value))
;; Not found in cache: get value and cache it.
(let ((new-value (or (funcall fn) 'org-ql-nil)))
;; Check caches again, because it may have been set now, e.g. by
;; recursively going up an outline tree.
;; TODO: Is there a clever way we could avoid doing this, or is it inherently necessary?
(setf buffer-cache (gethash (current-buffer) org-ql-node-value-cache)
modified-tick (car buffer-cache)
position-cache (cdr buffer-cache)
value-cache (when position-cache
(gethash position position-cache))
buffer-unmodified-p (eq (buffer-modified-tick) modified-tick))
(unless (and buffer-cache buffer-unmodified-p)
;; Buffer-local node cache empty or invalid: make new one.
(setf position-cache (make-hash-table))
(puthash (current-buffer)
(cons (buffer-modified-tick) position-cache)
org-ql-node-value-cache))
(map-put value-cache fn new-value)
(puthash position value-cache position-cache)
new-value)))
(defun org-ql--add-markers (element)
"Return ELEMENT with Org marker text properties added.
ELEMENT should be an Org element like that returned by
@ -507,6 +569,14 @@ Replaces bare strings with (regexp) selectors, and appropriate
(ts-apply :hour 23 :minute 59 :second 59))))
`(,pred :to ,to)))
;; Outline paths.
(`(,(or 'outline-path 'olp) . ,strings)
;; Regexp quote headings.
`(outline-path ,@(mapcar #'regexp-quote strings)))
(`(,(or 'outline-path-segment 'olps) . ,strings)
;; Regexp quote headings.
`(outline-path-segment ,@(mapcar #'regexp-quote strings)))
;; Priorities
(`(priority ,(and (or '= '< '> '<= '>=) comparator) ,letter)
;; Quote comparator.
@ -521,6 +591,26 @@ Replaces bare strings with (regexp) selectors, and appropriate
(setf property (substring (symbol-name property) 1)))
(cons 'property (cons property value)))
;; Source blocks.
(`(src . ,args)
;; Rewrite to use keyword args.
(-let (regexps lang keyword-index)
(cond ((plist-get args :lang)
;; Lang given first, or only lang given.
(setf lang (plist-get args :lang)
regexps (seq-difference args (list :lang lang))))
((setf keyword-index (-find-index #'keywordp args))
;; Regexps and lang given.
(setf lang (plist-get (cl-subseq args keyword-index) :lang)
regexps (cl-subseq args 0 keyword-index)))
(t ;; Only regexps given.
(setf regexps args)))
(when regexps
;; This feels awkward and wrong, but we have to quote lists
;; and avoid quoting nil. There must be a better way.
(setf regexps `(',regexps)))
`(src :lang ,lang :regexps ,@regexps)))
;; Tags.
(`(,(or 'tags-all 'tags&) . ,tags) `(and ,@(--map `(tags ,it) tags)))
;; MAYBE: -all versions for inherited and local.
@ -675,6 +765,13 @@ replace the clause with a preamble."
;; (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":" (1+ (not (or space ":"))) ":"
;; (1+ space) (minimal-match (1+ not-newline)) eol)))
;; element)
;; Src blocks.
(`(src . ,args)
(setq org-ql-preamble (org-ql--format-src-block-regexp (plist-get args :lang)))
;; Always check contents with predicate.
element)
(`(scheduled . ,_)
(setq org-ql-preamble org-scheduled-time-regexp)
;; Return element, because the predicate still needs testing.
@ -709,6 +806,29 @@ replace the clause with a preamble."
(query (-flatten-n 1 query))))
(list :query query :preamble org-ql-preamble :preamble-case-fold preamble-case-fold))))))
(defun org-ql--format-src-block-regexp (&optional lang)
"Return regexp equivalent to `org-babel-src-block-regexp' with LANG filled in."
;; I couldn't find a way to match block contents without the regexp
;; also matching past the end of the block and into later blocks. Even
;; using `minimal-match' in several different combinations didn't work.
;; So matching contents will have to be done with the predicate.
(rx-to-string `(seq bol (group (zero-or-more (any " ")))
"#+begin_src"
(one-or-more (any " "))
,(or lang `(1+ (not (any " \n \f "))))
(zero-or-more (any " "))
(group (or (seq (zero-or-more (not (any "\n\":")))
"\""
(zero-or-more (not (any "\n\"*")))
"\""
(zero-or-more (not (any "\n\":"))))
(zero-or-more (not (any "\n\":")))))
(group (zero-or-more (not (any "\n")))) "\n"
(63 (group (*\? (not (any ""))) "\n"))
(zero-or-more (any " "))
"#+end_src")
t))
(defmacro org-ql--from-to-on ()
"For internal use.
Expands into a form that processes arguments to timestamp-related
@ -873,6 +993,44 @@ Tests both inherited and local tags."
(when (tags-p local)
(seq-intersection tags local))))))))
;; MAYBE: Preambles for outline-path predicates. Not sure if possible without complicated logic.
(org-ql--defpred (outline-path olp) (&rest regexps)
"Return non-nil if current node's outline path matches all of REGEXPS.
Each string is compared as a regexp to each element of the node's
outline path with `string-match'. For example, if an entry's
outline path were \"Food/Fruits/Grapes\", it would match any of
the following queries:
(olp \"Food\")
(olp \"Fruits\")
(olp \"Food\" \"Fruits\")
(olp \"Fruits\" \"Grapes\")
(olp \"Food\" \"Grapes\")"
(let ((entry-olp (org-ql--value-at (point) #'org-ql--outline-path)))
(cl-loop for h in regexps
always (cl-member h entry-olp :test #'string-match))))
(org-ql--defpred (outline-path-segment olps) (&rest regexps)
"Return non-nil if current node's outline path matches segment REGEXPS.
Matches REGEXPS as a contiguous segment of the outline path.
Each regexp is compared to each element of the node's outline
path with `string-match'. For example, if an entry's outline
path were \"Food/Fruits/Grapes\", it would match any of the
following queries:
(olp \"Food\")
(olp \"Fruit\")
(olp \"Food\" \"Fruit\")
(olp \"Fruit\" \"Grape\")
But it would not match the following, because they do not match a
contiguous segment of the outline path:
(olp \"Food\" \"Grape\")"
;; MAYBE: Allow anchored matching.
(org-ql--infix-p regexps (org-ql--value-at (point) #'org-ql--outline-path)))
(org-ql--defpred (tags-inherited tags-i itags) (&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."
@ -992,6 +1150,31 @@ priority B)."
;; Check that PROPERTY has VALUE
(string-equal value (org-entry-get (point) property 'selective)))))))
(org-ql--defpred src (&key regexps lang)
"Return non-nil if current entry contains an Org source block matching all of REGEXPS.
If keyword argument LANG is non-nil, the block must be in that
language."
(catch 'return
(save-excursion
(save-match-data
(when (re-search-forward org-babel-src-block-regexp (org-entry-end-position) t)
(when lang
(unless (string= lang (match-string 2))
(throw 'return nil)))
(if regexps
(let ((contents-beg (progn
(goto-char (match-beginning 0))
(forward-line 1)
(point)))
(contents-end (progn
(goto-char (match-end 0))
(point-at-bol))))
(cl-loop for re in regexps
do (goto-char contents-beg)
always (re-search-forward re contents-end t)))
;; No regexps to check: return non-nil.
t))))))
;;;;;; Timestamps
;; TODO: Remove the _on vars from these arg lists. I think they're not
@ -1253,6 +1436,18 @@ A and B are Org headline elements."
(a-priority t)
(b-priority nil)))))
(defun org-ql--infix-p (infix list)
"Return non-nil if INFIX is an infix of LIST.
Each element of INFIX is compared using `string-match', so each
element should be a regexp string."
(cl-loop with infix-length = (length infix)
while (and list
(>= (length list) infix-length))
thereis (cl-loop for i in infix
for l in list
always (string-match i l))
do (pop list)))
;;;;; Plain query parsing
;; This section implements parsing of "plain," non-Lisp queries using the `peg'
@ -1271,7 +1466,7 @@ A and B are Org headline elements."
;; ends up being not defined correctly at expansion time.
(defmacro org-ql--def-plain-query-fn ()
"Define function `org-ql--input-query'.
"Define function `org-ql--plain-query'.
Builds the PEG expression using predicates defined in
`org-ql-predicates' and `org-ql-predicates-extra-aliases'."
(let* ((predicates (--map (symbol-name (plist-get it :name))
@ -1292,10 +1487,15 @@ Builds the PEG expression using predicates defined in
Multiple predicates are combined with BOOLEAN."
(unless (s-blank-str? input)
(let* ((query (peg-parse-string
((query (+ (or (and predicate-with-args `(pred args -- (cons (intern pred) args)))
(and predicate-without-args `(pred -- (list (intern pred))))
(and plain-string `(s -- (list 'regexp s))))
((query (+ term
(opt (+ (syntax-class whitespace) (any)))))
(term (or (and negation (list positive-term)
;; This is a bit confusing, but it seems to work. There's probably a better way.
`(pred -- (list 'not (car pred))))
positive-term))
(positive-term (or (and predicate-with-args `(pred args -- (cons (intern pred) args)))
(and predicate-without-args `(pred -- (list (intern pred))))
(and plain-string `(s -- (list 'regexp s)))))
(plain-string (substring (+ (not (syntax-class whitespace)) (any))))
(predicate-with-args (substring predicate) ":" args)
(predicate-without-args (substring predicate) ":")
@ -1305,6 +1505,7 @@ Multiple predicates are combined with BOOLEAN."
(keyword (substring (+ (not (or separator "=" "\"" (syntax-class whitespace))) (any))))
(quoted-arg "\"" (substring (+ (not (or separator "\"")) (any))) "\"")
(unquoted-arg (substring (+ (not (or separator "\"" (syntax-class whitespace))) (any))))
(negation "!")
(separator "," ))
input 'noerror)))
;; Discard the t that `peg-parse-string' always returns as the first

1010
org-ql.info Normal file

File diff suppressed because it is too large Load diff

View file

@ -231,6 +231,17 @@ RESULTS should be a list of strings as returned by
;; TODO: Other predicates.
(it "Negated terms"
(expect (org-ql--plain-query "todo: !todo:CHECK,SOMEDAY")
:to-equal '(and (todo) (not (todo "CHECK" "SOMEDAY"))))
(expect (org-ql--plain-query "!todo:CHECK,SOMEDAY todo:")
:to-equal '(and (not (todo "CHECK" "SOMEDAY")) (todo)))
(expect (org-ql--plain-query "tags:universe !moon")
:to-equal '(and (tags "universe") (not (regexp "moon"))))
(expect (org-ql--plain-query "!moon tags:universe")
:to-equal '(and (not (regexp "moon")) (tags "universe")))
(expect (org-ql--plain-query "mars !ts:on=today")
:to-equal '(and (regexp "mars") (not (ts :on "today")))))
(it "Regexp predicates"
(expect (org-ql--plain-query "scheduled")
;; No colon after keyword, so not a predicate query.
@ -479,6 +490,25 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((heading "Take over" "world"))
'("Take over the world"))))
(describe "(outline-path)"
(org-ql-it "with one argument"
(org-ql-expect ((outline-path "symphony"))
'("Write a symphony")))
(org-ql-it "with two arguments"
(org-ql-expect ((outline-path "idea" "symphony"))
'("Write a symphony"))))
(describe "(outline-path-segment)"
(org-ql-it "with one argument"
(org-ql-expect ((outline-path-segment "symphony"))
'("Write a symphony")))
(org-ql-it "with a contiguous segment"
(org-ql-expect ((outline-path-segment "idea" "symphony"))
'("Write a symphony")))
(org-ql-it "with a non-contiguous segment"
(org-ql-expect ((outline-path-segment "data" "symphony"))
nil)))
(describe "(path)"
(org-ql-it "without arguments"
(org-ql-expect ((path))
@ -637,6 +667,9 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((scheduled :to today))
'("Skype with president of Antarctica" "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
;; significant hassle. Manual testing shows that the predicate appears to work properly.
(describe "(todo)"
(org-ql-it "without arguments"