jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'gh/master' into HEAD

Browse source
This commit is contained in:
Salih Muhammed 2023-10-28 17:30:52 +02:00
commit 8b3bb74c94
13 changed files with 1084 additions and 492 deletions
Download patch file Download diff file Expand all files Collapse all files

59
README.org
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.
@ -112,11 +111,20 @@ Lisp code examples are in [[examples.org]].
These commands jump to a heading selected using Emacs's built-in completion facilities with an Org QL query: These commands jump to a heading selected using Emacs's built-in completion facilities with an Org QL query:
- ~org-ql-find~ searches in the current buffer. - ~org-ql-find~ searches in the current buffer.
- ~org-ql-find-path~ searches outline paths in the current buffer.
- ~org-ql-find-in-agenda~ searches in ~(org-agenda-files)~. - ~org-ql-find-in-agenda~ searches in ~(org-agenda-files)~.
- ~org-ql-find-in-org-directory~ searches in ~org-directory~. - ~org-ql-find-in-org-directory~ searches in ~org-directory~.
Note that these commands are compatible with [[https://github.com/oantolin/embark][Embark]]: the ~embark-act~ command can be called on a completion candidate (i.e. a search result) to act on it immediately, without having to visit the entry in its source Org buffer.
[[images/org-ql-find.png]] [[images/org-ql-find.png]]
*** org-ql-open-link
This command finds links in entries matching the input query and offers them for selection; the selected link is then opened with ~org-open-at-point~.
The input is matched using the default predicate, which means it searches both entry content and outline paths. This is helpful when a collection of links are kept in Org files: rather than having to first visit the entry containing the desired link, then locate it within the entry, and then open it, the user can simply select the link and open it directly. For example, if an entry with the heading =Emacs= contained a link named =mailing list=, one could search for =Emacs list= and open the link to the mailing list directly.
*** org-ql-refile *** org-ql-refile
This command refiles the current Org entry to one selected by searching with Org QL completion. It searches files listed in ~org-refile-targets~ as well as the current buffer. This command refiles the current Org entry to one selected by searching with Org QL completion. It searches files listed in ~org-refile-targets~ as well as the current buffer.
@ -147,6 +155,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=./
@ -221,6 +231,7 @@ Note that the =effort=, =level=, and =priority= predicates do not support compar
Arguments are listed next to predicate names, where applicable. Arguments are listed next to predicate names, where applicable.
+ =blocked= :: Return non-nil if current heading is blocked. Calls ~org-entry-blocked-p~, which see.
+ =category (&optional categories)= :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings). + =category (&optional categories)= :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
+ =done= :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~. + =done= :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
+ =effort (&optional effort-or-comparator effort)= :: Return non-nil if current heading's effort property matches arguments. The following forms are accepted: ~(effort DURATION)~: Matches if effort is ~DURATION~. ~(effort DURATION DURATION)~: Matches if effort is between DURATIONs, inclusive. ~(effort COMPARATOR DURATION)~: Matches if effort compares to ~DURATION~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~. ~DURATION~ should be an Org effort string, like =5= or =0:05=. + =effort (&optional effort-or-comparator effort)= :: Return non-nil if current heading's effort property matches arguments. The following forms are accepted: ~(effort DURATION)~: Matches if effort is ~DURATION~. ~(effort DURATION DURATION)~: Matches if effort is between DURATIONs, inclusive. ~(effort COMPARATOR DURATION)~: Matches if effort compares to ~DURATION~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~. ~DURATION~ should be an Org effort string, like =5= or =0:05=.
@ -542,7 +553,43 @@ 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.7-pre ** 0.8-pre
*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-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.)
*Compatibility*
+ 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.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* *Added*
+ Commands ~org-ql-find~, ~org-ql-find-heading~, and ~org-ql-find-path~, which jump to entries selected using Emacs's built-in completion facilities and Org QL queries (like ~helm-org-ql~, but doesn't require Helm.). + Commands ~org-ql-find~, ~org-ql-find-heading~, and ~org-ql-find-path~, which jump to entries selected using Emacs's built-in completion facilities and Org QL queries (like ~helm-org-ql~, but doesn't require Helm.).
@ -551,17 +598,23 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
+ Option ~org-ql-default-predicate~, applied to plain-string query tokens (before, the ~regexp~ predicate was always used, but now it may be customized). + Option ~org-ql-default-predicate~, applied to plain-string query tokens (before, the ~regexp~ predicate was always used, but now it may be customized).
+ Alias ~c~ for predicate ~category~. + 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 ~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* *Changed*
+ Give more useful error message for invalid queries. + Give more useful error message for invalid queries.
+ Predicate ~src~ now matches case-insensitively. + 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* *Fixed*
+ Predicate ~src~'s matching of begin/end block lines, normalization of arguments, and handling in non-sexp queries. + 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* *Internal*
+ Certain query predicates, when called multiple times in an ~and~ sub-expression, are optimized to a single call. + 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]].) + Use ~buffer-chars-modified-tick~ instead of ~buffer-modified-tick~. (Thanks to [[https://github.com/yantar92][Ihor Radchenko]].)
+ Implemented tests for ~src~ predicate.
*Credits* *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]]. + 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]].

10
helm-org-ql.el
View file

@ -59,8 +59,8 @@ Based on `helm-map'.")
(helm-make-source "Org QL Views" 'helm-source-sync (helm-make-source "Org QL Views" 'helm-source-sync
:candidates (lambda () :candidates (lambda ()
(->> org-ql-views (->> org-ql-views
(-map #'car) (-map #'car)
(-sort #'string<))) (-sort #'string<)))
:action (list (cons "Show view" #'org-ql-view))) :action (list (cons "Show view" #'org-ql-view)))
"Helm source for `org-ql-views'.") "Helm source for `org-ql-views'.")
@ -98,6 +98,8 @@ 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 indepenent
@ -209,8 +211,8 @@ WINDOW-WIDTH should be the width of the Helm window."
(width (- window-width (length prefix))) (width (- window-width (length prefix)))
(heading (org-get-heading t)) (heading (org-get-heading t))
(path (-> (org-get-outline-path) (path (-> (org-get-outline-path)
(org-format-outline-path width nil "") (org-format-outline-path width nil "")
(org-split-string ""))) (org-split-string "")))
(path (if helm-org-ql-reverse-paths (path (if helm-org-ql-reverse-paths
(concat heading "\\" (s-join "\\" (nreverse path))) (concat heading "\\" (s-join "\\" (nreverse path)))
(concat (s-join "/" path) "/" heading)))) (concat (s-join "/" path) "/" heading))))

BIN
images/dont-tread-on-emacs-150.png
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 5.5 KiB

322
org-ql-completing-read.el
View file

@ -73,14 +73,59 @@ For an experience like `org-rifle', use a newline."
(defface org-ql-completing-read-snippet '((t (:inherit font-lock-comment-face))) (defface org-ql-completing-read-snippet '((t (:inherit font-lock-comment-face)))
"Snippets.") "Snippets.")
(defvar org-ql-completing-read-input-regexp nil
"Current regexp for `org-ql-completing-read' input.
To be used in, e.g. annotation functions.")
;;;; Functions ;;;; Functions
(defun org-ql-completing-read-action ()
"Default action for `org-ql-completing-read'.
Returns (STRING . MARKER) cons for entry at point."
(font-lock-ensure (point-at-bol) (point-at-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--snippet-simple))))
(`t ;; Interrupted: return nil (which can be concatted).
nil)
(else else)))
(defun org-ql-completing-read-path (marker)
"Return formatted outline path for entry at MARKER."
(org-with-point-at marker
(let ((path (thread-first (org-get-outline-path nil t)
(org-format-outline-path (window-width) nil "")
(org-split-string ""))))
(if org-ql-completing-read-reverse-paths
(concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/"))))))
;;;;; Completing read ;;;;; Completing read
;;;###autoload ;;;###autoload
(cl-defun org-ql-completing-read (buffers-files &key query-prefix query-filter (cl-defun org-ql-completing-read
(prompt "Find entry: ")) (buffers-files &key query-prefix query-filter
"Return marker at Org entry in BUFFERS-FILES selected with `org-ql'. (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.
QUERY-PREFIX may be a string to prepend to the query entered by QUERY-PREFIX may be a string to prepend to the query entered by
the user (e.g. use \"heading:\" to only search headings, easily the user (e.g. use \"heading:\" to only search headings, easily
@ -93,105 +138,206 @@ with commas to turn multiple tokens, which would normally be
treated as multiple predicates, into multiple arguments to a treated as multiple predicates, into multiple arguments to a
single predicate)." single predicate)."
(declare (indent defun)) (declare (indent defun))
;; Emacs's completion API is not always easy to understand, ;; Emacs's completion API is not always easy to understand, especially when using "programmed
;; especially when using "programmed completion." This code was ;; completion." This code was made possible by the example Clemens Radermacher shared at
;; made possible by the example Clemens Radermacher shared at
;; <https://github.com/radian-software/selectrum/issues/114#issuecomment-744041532>. ;; <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)) (let ((table (make-hash-table :test #'equal))
(disambiguations (make-hash-table :test #'equal))
(window-width (window-width)) (window-width (window-width))
query-tokens snippet-regexp) last-input org-outline-path-cache query-tokens)
(cl-labels ((action (cl-labels (;; (debug-message
() (font-lock-ensure (point-at-bol) (point-at-eol)) ;; (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args))
(let* ((path (thread-first (org-get-outline-path t t) (action ()
(org-format-outline-path window-width nil "") (font-lock-ensure (point-at-bol) (point-at-eol))
(org-split-string ""))) ;; This function needs to handle multiple candidates per
(path (if org-ql-completing-read-reverse-paths ;; call, so we loop over a list of values by default.
(string-join (nreverse path) "\\") (pcase-dolist (`(,string . ,marker) (funcall action-filter (funcall action)))
(string-join path "/")))) (when string
(puthash path (point-marker) table) (if (string-empty-p string)
path)) ;; 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) (affix (completions)
(cl-loop for completion in completions ;; (debug-message "AFFIX:%S" completions)
for marker = (gethash completion table) (cl-loop for completion in completions
for todo-state = (if-let (it (org-entry-get marker "TODO")) for marker = (get-text-property 0 'org-marker completion)
(concat (propertize it for prefix = (todo marker)
'face (org-get-todo-face it)) for suffix = (concat (funcall path marker) " " (funcall snippet marker))
" ") collect (list completion prefix suffix)))
"")
for snippet = (if-let (it (snippet marker))
(propertize (concat " " it)
'face 'org-ql-completing-read-snippet)
"")
collect (list completion todo-state snippet)))
(annotate (candidate) (annotate (candidate)
(while-no-input ;; (debug-message "ANNOTATE:%S" candidate)
;; Using `while-no-input' here doesn't make it as (while-no-input
;; responsive as, e.g. Helm while typing, but it seems to ;; Using `while-no-input' here doesn't make it as responsive as,
;; help a little when using the org-rifle-style snippets. ;; e.g. Helm while typing, but it seems to help a little when using the
(or (snippet (gethash candidate table)) ""))) ;; org-rifle-style snippets.
(snippet (marker) (or (snippet (get-text-property 0 'org-marker candidate)) "")))
(org-with-point-at marker (snippet
(or (funcall org-ql-completing-read-snippet-function snippet-regexp) (marker) (when-let
(org-ql-completing-read--snippet-simple)))) ((snippet
(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)))))
(propertize (concat " " snippet)
'face 'org-ql-completing-read-snippet)))
(group (candidate transform) (group (candidate transform)
(pcase transform (pcase transform
(`nil (buffer-name (marker-buffer (gethash candidate table)))) (`nil (buffer-name (marker-buffer (get-text-property 0 'org-marker candidate))))
(_ candidate))) (_ candidate)))
(try (string _table _pred point &optional _metadata) (try (string _collection _pred point &optional _metadata)
(cons string point)) ;; (debug-message "TRY: STRING:%S" string)
(cons string point))
(all (string table pred _point) (all (string table pred _point)
(all-completions string table pred)) ;; (debug-message "all: STRING:%S" string)
(collection (str _pred flag) ;; (debug-message "all-completions RETURNS: %S" (all-completions string table pred))
(when query-prefix (all-completions string table pred))
(setf str (concat query-prefix str))) (collection (input _pred flag)
(pcase flag (pcase flag
('metadata (list 'metadata ('metadata (list 'metadata
(cons 'group-function #'group) (cons 'category 'org-heading)
(cons 'affixation-function #'affix) (cons 'group-function #'group)
(cons 'annotation-function #'annotate))) (cons 'affixation-function #'affix)
(`t (unless (string-empty-p str) (cons 'annotation-function #'annotate)
(when query-filter (cons 'display-sort-function
(setf str (funcall query-filter str))) (lambda (strings)
(pcase org-ql-completing-read-snippet-function (let ((quoted-tokens (mapcar #'regexp-quote query-tokens)))
('org-ql-completing-read--snippet-regexp (sort strings
(setf query-tokens (lambda (a b)
;; Remove any tokens that specify predicates or are too short. (cl-labels ((matches
(--select (not (or (string-match-p (rx bos (1+ (not (any ":"))) ":") it) (s) (cl-loop for token in quoted-tokens
(< (length it) org-ql-completing-read-snippet-minimum-token-length))) count (string-match-p token s))))
(split-string str nil t (rx space))) (> (matches a) (matches b))))))))))
snippet-regexp (`t
(when query-tokens ;; (debug-message "COLLECTION:t INPUT:%S KEYS:%S"
;; Limiting each context word to 15 characters ;; input (hash-table-keys table))
;; prevents excessively long, non-word strings ;; It's not ideal to call `run-query' unconditionally here, but due to
;; from ending up in snippets, which can ;; the complexity of the "Programmed Completion" API, it's basically
;; adversely affect performance. ;; necessary, and org-ql's caching should make it nearly free.
(rx-to-string `(seq (optional (repeat 1 3 (repeat 1 15 (not space)) (0+ space))) (run-query input)
bow (or ,@query-tokens) (0+ (not space)) (hash-table-keys table))
(optional (repeat 1 3 (0+ space) (repeat 1 15 (not space)))))))))) ('lambda
(org-ql-select buffers-files (org-ql--query-string-to-sexp str) ;; (debug-message "COLLECTION:lambda INPUT:%S KEYS:%S"
:action #'action)))))) ;; input (hash-table-keys table))
;; NOTE: It seems that the `completing-read' machinery can call, (if (not (hash-table-empty-p table))
;; abort, and re-call the collection function while the user is (when (gethash input table)
;; typing, which can interrupt the machinery Org uses to prepare t)
;; an Org buffer when an Org file is loaded. This results in, (run-query input)
;; e.g. the buffer being left in fundamental-mode, unprepared to (when (gethash input table)
;; be used as an Org buffer, which breaks many things and is ;; (debug-message "COLLECTION:lambda INPUT:%S FOUND" input)
;; very confusing for the user. Ideally, of course, we would t)))
;; solve this in `org-ql-select', and we already attempt to, but (`nil
;; that function is called by the `completing-read' machinery, ;; (debug-message "COLLECTION:nil INPUT:%S" input)
;; which interrupts it, so we must work around this problem by (if (not (hash-table-empty-p table))
;; ensuring all of the BUFFERS-FILES are loaded and initialized (when (gethash input table)
;; before calling `completing-read'. 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)
:action #'action))))
(unless (listp buffers-files) (unless (listp buffers-files)
;; Since we map across this argument, we ensure it's a list. ;; Since we map across this argument, we ensure it's a list.
(setf buffers-files (list buffers-files))) (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) (mapc #'org-ql--ensure-buffer buffers-files)
(let* ((completion-styles '(org-ql-completing-read)) (let* ((completion-styles '(org-ql-completing-read))
(completion-styles-alist (list (list 'org-ql-completing-read #'try #'all "Org QL Find"))) (completion-styles-alist (list (list 'org-ql-completing-read #'try #'all "Org QL Find")))
(selected (completing-read prompt #'collection nil))) (selected (completing-read prompt #'collection nil t)))
(gethash selected table))))) ;; (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 _regexp) (defun org-ql-completing-read--snippet-simple ()
"Return a snippet of the current entry. "Return a snippet of the current entry.
Returns up to `org-ql-completing-read-snippet-length' characters." Returns up to `org-ql-completing-read-snippet-length' characters."
(save-excursion (save-excursion

84
org-ql-find.el
View file

@ -41,6 +41,7 @@
(defcustom org-ql-find-goto-hook '(org-show-entry org-reveal) (defcustom org-ql-find-goto-hook '(org-show-entry org-reveal)
"Functions called when selecting an entry." "Functions called when selecting an entry."
;; TODO: Add common choices, including `org-tree-to-indirect-buffer'.
:type 'hook) :type 'hook)
(defcustom org-ql-find-display-buffer-action '(display-buffer-same-window) (defcustom org-ql-find-display-buffer-action '(display-buffer-same-window)
@ -54,8 +55,11 @@ See function `display-buffer'."
(cl-defun org-ql-find (buffers-files &key query-prefix query-filter (cl-defun org-ql-find (buffers-files &key query-prefix query-filter
(prompt "Find entry: ")) (prompt "Find entry: "))
"Go to an Org entry in BUFFERS-FILES selected by searching entries with `org-ql'. "Go to an Org entry in BUFFERS-FILES selected by searching entries with `org-ql'.
Interactively, with universal prefix, select multiple buffers to Interactively, search the buffers and files relevant to the
search with completion. 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.
QUERY-PREFIX may be a string to prepend to the query (e.g. use QUERY-PREFIX may be a string to prepend to the query (e.g. use
\"heading:\" to only search headings, easily creating a custom \"heading:\" to only search headings, easily creating a custom
@ -75,19 +79,19 @@ single predicate)."
when (eq 'org-mode (buffer-local-value 'major-mode buffer)) when (eq 'org-mode (buffer-local-value 'major-mode buffer))
collect (buffer-name buffer)) collect (buffer-name buffer))
nil t)) nil t))
(progn (cond ((derived-mode-p 'org-agenda-mode) (or org-ql-view-buffers-files
(unless (eq major-mode 'org-mode) org-agenda-contributing-files))
(user-error "This is not an Org buffer: %S" (current-buffer))) ((derived-mode-p 'org-mode) (current-buffer))
(current-buffer))))) (t (user-error "This is not an Org-related buffer: %S" (current-buffer)))))))
(let ((marker (org-ql-completing-read buffers-files (let ((marker (org-ql-completing-read buffers-files
:query-prefix query-prefix :query-prefix query-prefix
:query-filter query-filter :query-filter query-filter
:prompt prompt))) :prompt prompt)))
(with-current-buffer (marker-buffer marker) (set-buffer (marker-buffer marker))
(goto-char marker) (goto-char marker)
(display-buffer (current-buffer) org-ql-find-display-buffer-action) (display-buffer (current-buffer) org-ql-find-display-buffer-action)
(select-window (get-buffer-window (current-buffer))) (select-window (get-buffer-window (current-buffer)))
(run-hook-with-args 'org-ql-find-goto-hook)))) (run-hook-with-args 'org-ql-find-goto-hook)))
;;;###autoload ;;;###autoload
(defun org-ql-refile (marker) (defun org-ql-refile (marker)
@ -130,6 +134,64 @@ which see (but only the files are used)."
(interactive) (interactive)
(org-ql-find (org-ql-search-directories-files))) (org-ql-find (org-ql-search-directories-files)))
;;;###autoload
(defun org-ql-find-path ()
"Call `org-ql-find' to search outline paths in the current buffer."
(interactive)
(let ((org-ql-default-predicate 'outline-path))
(org-ql-find (current-buffer))))
;;;###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."
(interactive
;; FIXME: Factor this out.
(list (if current-prefix-arg
(mapcar #'get-buffer
(completing-read-multiple
"Buffers: "
(cl-loop for buffer in (buffer-list)
when (eq 'org-mode (buffer-local-value 'major-mode buffer))
collect (buffer-name buffer))
nil t))
(progn
(unless (eq major-mode 'org-mode)
(user-error "This is not an Org buffer: %S" (current-buffer)))
(current-buffer)))))
(let* ((marker (org-ql-completing-read buffers-files
:query-prefix query-prefix
:query-filter query-filter
:prompt prompt
: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))))
(provide 'org-ql-find) (provide 'org-ql-find)
;;; org-ql-find.el ends here ;;; org-ql-find.el ends here

74
org-ql-search.el
View file

@ -44,13 +44,22 @@
(cond ((fboundp 'org-link--normalize-string) #'org-link--normalize-string) (cond ((fboundp 'org-link--normalize-string) #'org-link--normalize-string)
((fboundp 'org-link-heading-search-string) #'org-link-heading-search-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) ((fboundp 'org-make-org-heading-search-string) #'org-make-org-heading-search-string)
(t (warn "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.") (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"))))
#'identity)))
(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"))))
;;;; 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
@ -84,8 +93,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
@ -93,7 +102,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
@ -101,8 +110,18 @@ 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-show-context 'occur-tree)
@ -138,7 +157,7 @@ SUPER-GROUPS: An `org-super-agenda' group set. See variable
selectors'. selectors'.
NARROW: When non-nil, don't widen buffers before NARROW: When non-nil, don't widen buffers before
searching. Interactively, with prefix, leave narrowed. searching. Interactively, with prefix, leave narrowed.
SORT: One or a list of `org-ql' sorting functions, like `date' or SORT: One or a list of `org-ql' sorting functions, like `date' or
`priority' (see Info node `(org-ql)Listing / acting-on results'). `priority' (see Info node `(org-ql)Listing / acting-on results').
@ -233,9 +252,9 @@ automatically from the query."
;; `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.
(->> 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
@ -277,13 +296,16 @@ 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))
(list ;; SAFETY: Query is in sexp form: ask for confirmation, because it could contain arbitrary code. (list ;; SAFETY: Query is in sexp form: ask for confirmation, because it could contain arbitrary code.
(org-ql--ask-unsafe-query query) (org-ql--ask-unsafe-query query)
query))) query)))
(columns (or columns '(heading todo (priority "P")))) (columns (or columns '(heading todo (priority "P"))))
@ -296,7 +318,7 @@ For example, an org-ql dynamic block header could look like:
(cons 'heading (lambda (element) (cons 'heading (lambda (element)
(let ((normalized-heading (let ((normalized-heading
(org-ql-search--link-heading-search-string (org-element-property :raw-value element)))) (org-ql-search--link-heading-search-string (org-element-property :raw-value element))))
(org-make-link-string normalized-heading (org-link-display-format normalized-heading))))) (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))))
@ -337,7 +359,7 @@ For example, an org-ql dynamic block header could look like:
columns) columns)
" | ") " | ")
" |" "\n") " |" "\n")
(insert "|- \n") ; Separator hline (insert "|- \n") ; Separator hline
(dolist (element elements) (dolist (element elements)
(insert "| " (format-element element) " |" "\n")) (insert "| " (format-element element) " |" "\n"))
(delete-char -1) (delete-char -1)
@ -345,18 +367,24 @@ 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
(list org-directory) (if (file-exists-p org-directory)
(user-error "Org-ql-search-directories-files: No DIRECTORIES given, and `org-directory' doesn't exist"))) (list org-directory)
(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
(--map (f-files it nil recurse)) (--map (f-files it nil recurse))
-flatten))) -flatten)))
(if regexp (if regexp
(--select (string-match regexp it) (--select (string-match regexp it)
files) files)

121
org-ql-view.el
View file

@ -40,10 +40,8 @@
(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)
(require 'dash) (require 'dash)
(require 's) (require 's)
@ -153,11 +151,11 @@ See info node `(elisp)Cyclic Window Ordering'."
(interactive) (interactive)
(let* ((ts (ts-now)) (let* ((ts (ts-now))
(beg-of-week (->> ts (beg-of-week (->> ts
(ts-adjust 'day (- (ts-dow (ts-now)))) (ts-adjust 'day (- (ts-dow (ts-now))))
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
(end-of-week (->> ts (end-of-week (->> ts
(ts-adjust 'day (- 6 (ts-dow (ts-now)))) (ts-adjust 'day (- 6 (ts-dow (ts-now))))
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
(org-ql-search (org-agenda-files) (org-ql-search (org-agenda-files)
`(ts-active :from ,beg-of-week `(ts-active :from ,beg-of-week
:to ,end-of-week) :to ,end-of-week)
@ -170,11 +168,11 @@ See info node `(elisp)Cyclic Window Ordering'."
(interactive) (interactive)
(let* ((ts (ts-adjust 'day 7 (ts-now))) (let* ((ts (ts-adjust 'day 7 (ts-now)))
(beg-of-week (->> ts (beg-of-week (->> ts
(ts-adjust 'day (- (ts-dow (ts-now)))) (ts-adjust 'day (- (ts-dow (ts-now))))
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
(end-of-week (->> ts (end-of-week (->> ts
(ts-adjust 'day (- 6 (ts-dow (ts-now)))) (ts-adjust 'day (- 6 (ts-dow (ts-now))))
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
(org-ql-search (org-agenda-files) (org-ql-search (org-agenda-files)
`(ts-active :from ,beg-of-week `(ts-active :from ,beg-of-week
:to ,end-of-week) :to ,end-of-week)
@ -272,8 +270,8 @@ TYPE may be `ts', `ts-active', `ts-inactive', `clocked', or
`closed'." `closed'."
(interactive (list :num-days (read-number "Days: ") (interactive (list :num-days (read-number "Days: ")
:type (->> '(ts ts-active ts-inactive clocked closed) :type (->> '(ts ts-active ts-inactive clocked closed)
(completing-read "Timestamp type: ") (completing-read "Timestamp type: ")
intern))) intern)))
;; It doesn't make much sense to use other date-based selectors to ;; It doesn't make much sense to use other date-based selectors to
;; look into the past, so to prevent confusion, we won't allow them. ;; look into the past, so to prevent confusion, we won't allow them.
(-let* ((query (pcase-exhaustive type (-let* ((query (pcase-exhaustive type
@ -288,7 +286,8 @@ TYPE may be `ts', `ts-active', `ts-inactive', `clocked', or
;;;###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
@ -353,7 +352,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)."
@ -363,7 +363,8 @@ 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."
@ -395,12 +396,12 @@ update search arguments."
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(erase-buffer) (erase-buffer)
(->> org-ql-views (->> org-ql-views
(-map #'car) (-map #'car)
(-sort (if org-ql-view-sidebar-sort-views (-sort (if org-ql-view-sidebar-sort-views
#'string< #'string<
#'ignore)) #'ignore))
(s-join "\n") (s-join "\n")
insert)) insert))
(current-buffer))) (current-buffer)))
(defvar bookmark-make-record-function) (defvar bookmark-make-record-function)
@ -469,8 +470,8 @@ If TITLE, prepend it to the header."
(format "%s" (org-ql-view--contract-buffers-files buffers-files)))) (format "%s" (org-ql-view--contract-buffers-files buffers-files))))
(buffers-files-formatted (when buffers-files-formatted (buffers-files-formatted (when buffers-files-formatted
(propertize (->> buffers-files-formatted (propertize (->> buffers-files-formatted
(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))))
(concat title (concat title
(when query (propertize "Query:" 'face 'transient-argument)) (when query (propertize "Query:" 'face 'transient-argument))
@ -672,7 +673,7 @@ When opened, the link searches the buffer it's opened from."
(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)))
@ -688,8 +689,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))))
@ -750,8 +750,8 @@ When opened, the link searches the buffer it's opened from."
(s-truncate (- (window-width) 15) (s-truncate (- (window-width) 15)
(concat (propertize key 'face 'transient-argument) ": " (concat (propertize key 'face 'transient-argument) ": "
(->> value (->> value
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)))))
(transient-define-infix 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.
@ -820,6 +820,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.
@ -829,6 +843,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
@ -850,8 +865,8 @@ 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))) (org-link-display-format it)))
(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 it)))
(tag-list (if org-use-tag-inheritance (tag-list (if org-use-tag-inheritance
@ -866,15 +881,14 @@ 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
(--> tag-list (--> tag-list
(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 (org-element-property :category element))
;; Org Agenda priorities are subtracted from `org-priority-lowest' ;; Org Agenda priorities are subtracted from `org-priority-lowest'
;; and multiplied by 1000, so do the same here. Also assume that <65 ;; and multiplied by 1000, so do the same here. Also assume that <65
@ -890,7 +904,8 @@ return an empty string."
(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)
@ -912,8 +927,8 @@ return an empty string."
(defun org-ql-view--add-faces (element) (defun org-ql-view--add-faces (element)
"Return ELEMENT with deadline and scheduled faces added." "Return ELEMENT with deadline and scheduled faces added."
(->> element (->> element
(org-ql-view--add-scheduled-face) (org-ql-view--add-scheduled-face)
(org-ql-view--add-deadline-face))) (org-ql-view--add-deadline-face)))
(defun org-ql-view--add-priority-face (string) (defun org-ql-view--add-priority-face (string)
"Return STRING with priority face added." "Return STRING with priority face added."
@ -970,11 +985,11 @@ return an empty string."
((> today-day-number scheduled-day-number) 'org-scheduled-previously) ((> today-day-number scheduled-day-number) 'org-scheduled-previously)
(t 'org-scheduled))) (t 'org-scheduled)))
(title (--> (org-element-property :raw-value element) (title (--> (org-element-property :raw-value element)
(org-add-props it nil (org-add-props it nil
'face face))) 'face face)))
(properties (--> (cadr element) (properties (--> (cadr element)
(plist-put it :title title) (plist-put it :title title)
(plist-put it :relative-due-date relative-due-date)))) (plist-put it :relative-due-date relative-due-date))))
(list (car element) (list (car element)
properties)) properties))
;; Not scheduled ;; Not scheduled
@ -996,16 +1011,16 @@ property."
;; FIXME: Unused for now: (done-p (member todo-keyword org-done-keywords)) ;; FIXME: Unused for now: (done-p (member todo-keyword org-done-keywords))
;; FIXME: Unused for now: (today-p (= today-day-number deadline-day-number)) ;; FIXME: Unused for now: (today-p (= today-day-number deadline-day-number))
(deadline-passed-fraction (--> (- deadline-day-number today-day-number) (deadline-passed-fraction (--> (- deadline-day-number today-day-number)
(float it) (float it)
(/ it (max org-deadline-warning-days 1)) (/ it (max org-deadline-warning-days 1))
(- 1 it))) (- 1 it)))
(face (org-agenda-deadline-face deadline-passed-fraction)) (face (org-agenda-deadline-face deadline-passed-fraction))
(title (--> (org-element-property :raw-value element) (title (--> (org-element-property :raw-value element)
(org-add-props it nil (org-add-props it nil
'face face))) 'face face)))
(properties (--> (cadr element) (properties (--> (cadr element)
(plist-put it :title title) (plist-put it :title title)
(plist-put it :relative-due-date relative-due-date)))) (plist-put it :relative-due-date relative-due-date))))
(list (car element) (list (car element)
properties)) properties))
;; No deadline ;; No deadline
@ -1024,10 +1039,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)
@ -1128,7 +1139,7 @@ The counterpart to `org-ql-view--contract-buffers-files'."
"todo") "todo")
nil nil (when org-ql-view-sort nil nil (when org-ql-view-sort
(prin1-to-string org-ql-view-sort))) (prin1-to-string org-ql-view-sort)))
(--remove (equal "buffer-order" it))))) (--remove (equal "buffer-order" it)))))
(pcase input (pcase input
('nil nil) ('nil nil)
((and (pred listp) sort) ((and (pred listp) sort)

251
org-ql.el
View file

@ -4,7 +4,7 @@
;; 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.7-pre ;; Version: 0.8-pre
;; Package-Requires: ((emacs "26.1") (dash "2.18.1") (f "0.17.2") (map "2.1") (org "9.0") (org-super-agenda "1.2") (ov "1.0.6") (peg "1.0.1") (s "1.12.0") (transient "0.1") (ts "0.2-pre")) ;; Package-Requires: ((emacs "26.1") (dash "2.18.1") (f "0.17.2") (map "2.1") (org "9.0") (org-super-agenda "1.2") (ov "1.0.6") (peg "1.0.1") (s "1.12.0") (transient "0.1") (ts "0.2-pre"))
;; Keywords: hypermedia, outlines, Org, agenda ;; Keywords: hypermedia, outlines, Org, agenda
@ -75,10 +75,11 @@ That is, \"CLOSED:\", \"DEADLINE:\", or \"SCHEDULED:\".")
Tags are stored in match group 1. Match group 2 stores the tags Tags are stored in match group 1. Match group 2 stores the tags
without the enclosing colons.") without the enclosing colons.")
(defconst org-ql-link-regexp (defvaralias 'org-ql-link-regexp
;; FIXME: `org-link-bracket-re' is void until `org-link-make-regexps' is called.
(if (bound-and-true-p org-link-bracket-re) (if (bound-and-true-p org-link-bracket-re)
org-link-bracket-re 'org-link-bracket-re
org-bracket-link-regexp) 'org-bracket-link-regexp)
"Regexp used to match Org bracket links. "Regexp used to match Org bracket links.
Necessary because of changes in Org 9.something.") Necessary because of changes in Org 9.something.")
@ -229,7 +230,8 @@ regexps.")
(group-n 1 (regexp ,org-ql-regexp-ts-inactive))) (group-n 1 (regexp ,org-ql-regexp-ts-inactive)))
(seq (or "DEADLINE" "SCHEDULED") ":" (0+ " ") (seq (or "DEADLINE" "SCHEDULED") ":" (0+ " ")
(group-n 1 (regexp ,org-ql-regexp-ts-active)))))) (group-n 1 (regexp ,org-ql-regexp-ts-active))))))
"Matches CLOSED, DEADLINE or SCHEDULED keyword with timestamp, with or without time.") "Matches CLOSED, DEADLINE or SCHEDULED keyword with timestamp.
Matches with or without time.")
(defvar org-ql-regexp-planning-with-time (defvar org-ql-regexp-planning-with-time
(rx-to-string `(seq bow (or (seq "CLOSED" ":" (0+ " ") (rx-to-string `(seq bow (or (seq "CLOSED" ":" (0+ " ")
@ -503,8 +505,14 @@ NARROW corresponds to the `org-ql-select' argument NARROW."
(cl-defun org-ql--select (&key preamble preamble-case-fold predicate action narrow (cl-defun org-ql--select (&key preamble preamble-case-fold predicate action narrow
&allow-other-keys) &allow-other-keys)
"Return results of mapping function ACTION across entries in current buffer matching function PREDICATE. "Return results for given arguments.
If NARROW is non-nil, buffer will not be widened." Return results of mapping function ACTION across entries in
current buffer matching function PREDICATE. If NARROW is
non-nil, buffer will not be widened.
PREAMBLE may be a regexp to search for before calling PREDICATE.
When doing so, `case-fold-search' is bound to
PREAMBLE-CASE-FOLD."
;; Since the mappings are stored in the variable `org-ql-predicates', macros like `flet' ;; Since the mappings are stored in the variable `org-ql-predicates', macros like `flet'
;; can't be used, so we do it manually (this is same as the equivalent `flet' expansion). ;; can't be used, so we do it manually (this is same as the equivalent `flet' expansion).
;; Mappings are stored in the variable because it allows predicates to be defined with a ;; Mappings are stored in the variable because it allows predicates to be defined with a
@ -584,7 +592,7 @@ Returns cons (INHERITED-TAGS . LOCAL-TAGS)."
(cond ((and (listp inherited) (cond ((and (listp inherited)
(listp local)) (listp local))
(->> (append inherited local) (->> (append inherited local)
-non-nil -uniq)) -non-nil -uniq))
((listp inherited) inherited) ((listp inherited) inherited)
((listp local) local))))) ((listp local) local)))))
(cl-typecase org-use-tag-inheritance (cl-typecase org-use-tag-inheritance
@ -616,9 +624,10 @@ Returns cons (INHERITED-TAGS . LOCAL-TAGS)."
"Return outline path for heading at point." "Return outline path for heading at point."
(save-excursion (save-excursion
(let ((heading (save-match-data (let ((heading (save-match-data
(if (looking-at org-complex-heading-regexp) (let (case-fold-search)
(or (match-string 4) "") (if (looking-at org-complex-heading-regexp)
"")))) (or (match-string-no-properties 4) "")
"")))))
(if (org-up-heading-safe) (if (org-up-heading-safe)
;; MAYBE: It seems wrong to call the cache function from ;; MAYBE: It seems wrong to call the cache function from
;; inside this function, like a violation of separation of ;; inside this function, like a violation of separation of
@ -680,8 +689,8 @@ from within ELEMENT's buffer."
;; time? I don't know, but for now, it seems that we have to use `copy-marker'. ;; time? I don't know, but for now, it seems that we have to use `copy-marker'.
(let* ((marker (copy-marker (org-element-property :begin element))) (let* ((marker (copy-marker (org-element-property :begin element)))
(properties (--> (cadr element) (properties (--> (cadr element)
(plist-put it :org-marker marker) (plist-put it :org-marker marker)
(plist-put it :org-hd-marker marker)))) (plist-put it :org-hd-marker marker))))
(setf (cadr element) properties) (setf (cadr element) properties)
element)) element))
@ -768,7 +777,7 @@ be coalesced."
"Signal error if any forms in FORM do not have preconditions met. "Signal error if any forms in FORM do not have preconditions met.
Or, when possible, fix the problem." Or, when possible, fix the problem."
(cl-flet ((check (symbol) (cl-flet ((check (symbol)
(cl-case symbol (pcase symbol
('done (unless org-done-keywords ('done (unless org-done-keywords
;; NOTE: This check needs to be done from within the Org buffer being checked. ;; NOTE: This check needs to be done from within the Org buffer being checked.
(error "Variable `org-done-keywords' is nil. Are you running this from an Org buffer?")))))) (error "Variable `org-done-keywords' is nil. Are you running this from an Org buffer?"))))))
@ -787,38 +796,43 @@ DESCRIPTION-OR-TARGET, match it in either description or target.
If DESCRIPTION, match it in the description. If TARGET, match it If DESCRIPTION, match it in the description. If TARGET, match it
in the target. If both DESCRIPTION and TARGET, match both, in the target. If both DESCRIPTION and TARGET, match both,
respectively." respectively."
(cl-labels ;; This `rx' part is borrowed from `org-make-link-regexps'. It matches the interior of an
((no-desc ;; Org link target (i.e. the parts between the brackets, including any escaped brackets).
(match) (rx-to-string `(seq (or bol (1+ blank)) (let ((link-target-part '(0+ (or (not (any "[]\\"))
"[[" (0+ (not (any "]"))) (regexp ,match) (0+ (not (any "]"))) (and "\\" (0+ "\\\\") (any "[]"))
"]]"))) (and (1+ "\\") (not (any "[]")))))))
(match-both (cl-labels
(description target) ((no-desc
(rx-to-string `(seq (or bol (1+ blank)) (match) (rx-to-string `(seq (or bol (1+ blank))
"[[" (0+ (not (any "]"))) (regexp ,target) (0+ (not (any "]"))) "[[" ,link-target-part (regexp ,match) ,link-target-part
"][" (0+ (not (any "]"))) (regexp ,description) (0+ (not (any "]"))) "]]")))
"]]"))) (match-both
;; Note that these actually allow empty descriptions (description target)
;; or targets, depending on what they are matching. (rx-to-string `(seq (or bol (1+ blank))
(match-desc "[[" ,link-target-part (regexp ,target) ,link-target-part
(match) (rx-to-string `(seq (or bol (1+ blank)) "][" (*? anything) (regexp ,description) (*? anything)
"[[" (0+ (not (any "]"))) "]]")))
"][" (0+ (not (any "]"))) (regexp ,match) (0+ (not (any "]"))) ;; Note that these actually allow empty descriptions
"]]"))) ;; or targets, depending on what they are matching.
(match-target (match-desc
(match) (rx-to-string `(seq (or bol (1+ blank)) (match) (rx-to-string `(seq (or bol (1+ blank))
"[[" (0+ (not (any "]"))) (regexp ,match) (0+ (not (any "]"))) "[[" ,link-target-part
"][" (0+ (not (any "]"))) "][" (*? anything) (regexp ,match) (*? anything)
"]]")))) "]]")))
(cond (description-or-target (match-target
(rx-to-string `(or (regexp ,(no-desc description-or-target)) (match) (rx-to-string `(seq (or bol (1+ blank))
(regexp ,(match-desc description-or-target)) "[[" ,link-target-part (regexp ,match) ,link-target-part
(regexp ,(match-target description-or-target))))) "][" (*? anything)
((and description target) "]]"))))
(match-both description target)) (cond (description-or-target
(description (match-desc description)) (rx-to-string `(or (regexp ,(no-desc description-or-target))
(target (rx-to-string `(or (regexp ,(no-desc target)) (regexp ,(match-desc description-or-target))
(regexp ,(match-target target)))))))) (regexp ,(match-target description-or-target)))))
((and description target)
(match-both description target))
(description (match-desc description))
(target (rx-to-string `(or (regexp ,(no-desc target))
(regexp ,(match-target target)))))))))
(defun org-ql--format-src-block-regexp (&optional lang) (defun org-ql--format-src-block-regexp (&optional lang)
"Return regexp equivalent to `org-babel-src-block-regexp' with LANG filled in." "Return regexp equivalent to `org-babel-src-block-regexp' with LANG filled in."
@ -922,17 +936,17 @@ value of `org-ql-predicates')."
(let* ((names (--map (symbol-name (plist-get (cdr it) :name)) (let* ((names (--map (symbol-name (plist-get (cdr it) :name))
predicates)) predicates))
(aliases (->> predicates (aliases (->> predicates
(--map (plist-get (cdr it) :aliases)) (--map (plist-get (cdr it) :aliases))
-non-nil -non-nil
-flatten -flatten
(-map #'symbol-name))) (-map #'symbol-name)))
(predicate-names (->> (append names aliases) (predicate-names (->> (append names aliases)
-uniq -uniq
;; Sort the keywords longest-first to work around what seems to be an ;; Sort the keywords longest-first to work around what seems to be an
;; obscure bug in `peg': when one keyword is a substring of another, ;; obscure bug in `peg': when one keyword is a substring of another,
;; and the shorter one is listed first, the shorter one fails to match. ;; and the shorter one is listed first, the shorter one fails to match.
(-sort (-on #'> #'length)))) (-sort (-on #'> #'length))))
(pexs `((query (+ (and term (* [blank])))) (pexs `((query (and (* [blank]) (+ (and term (* [blank])))))
(term (or (and negation (list positive-term) (term (or (and negation (list positive-term)
;; This is a bit confusing, but it seems to work. There's probably a better way. ;; This is a bit confusing, but it seems to work. There's probably a better way.
`(pred -- (list 'not (car pred)))) `(pred -- (list 'not (car pred))))
@ -1003,8 +1017,8 @@ manually; see the definition of `org-ql-defpred').")
"Define function `org-ql--normalize-query' for PREDICATES. "Define function `org-ql--normalize-query' for PREDICATES.
PREDICATES should be the value of `org-ql-predicates'." PREDICATES should be the value of `org-ql-predicates'."
(let ((normalizer-patterns (->> predicates (let ((normalizer-patterns (->> predicates
(--map (plist-get (cdr it) :normalizers)) (--map (plist-get (cdr it) :normalizers))
(-flatten-n 1)))) (-flatten-n 1))))
(fset 'org-ql--normalize-query (fset 'org-ql--normalize-query
(byte-compile (byte-compile
`(lambda (query) `(lambda (query)
@ -1273,34 +1287,40 @@ result form."
to on)) to on))
(when from (when from
(setq from (pcase from (setq from (pcase from
("-"
;; Ignore, because it means the user is typing a negative number.
nil)
((or 'today "today") (->> (ts-now) ((or 'today "today") (->> (ts-now)
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
((pred numberp) (->> (ts-now) ((pred numberp) (->> (ts-now)
(ts-adjust 'day from) (ts-adjust 'day from)
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
((and (pred stringp) ((and (pred stringp)
(guard (ignore-errors (cl-parse-integer from)))) (guard (ignore-errors (cl-parse-integer from))))
;; The `pcase' `let' pattern doesn't bind values in the ;; The `pcase' `let' pattern doesn't bind values in the
;; body forms, so we have to parse the integer again. ;; body forms, so we have to parse the integer again.
(->> (ts-now) (->> (ts-now)
(ts-adjust 'day (cl-parse-integer from)) (ts-adjust 'day (cl-parse-integer from))
(ts-apply :hour 0 :minute 0 :second 0))) (ts-apply :hour 0 :minute 0 :second 0)))
((pred stringp) (ts-parse-fill 'begin from)) ((pred stringp) (ts-parse-fill 'begin from))
((pred ts-p) from)))) ((pred ts-p) from))))
(when to (when to
(setq to (pcase to (setq to (pcase to
("-"
;; Ignore, because it means the user is typing a negative number.
nil)
((or 'today "today") (->> (ts-now) ((or 'today "today") (->> (ts-now)
(ts-apply :hour 23 :minute 59 :second 59))) (ts-apply :hour 23 :minute 59 :second 59)))
((pred numberp) (->> (ts-now) ((pred numberp) (->> (ts-now)
(ts-adjust 'day to) (ts-adjust 'day to)
(ts-apply :hour 23 :minute 59 :second 59))) (ts-apply :hour 23 :minute 59 :second 59)))
((and (pred stringp) ((and (pred stringp)
(guard (ignore-errors (cl-parse-integer to)))) (guard (ignore-errors (cl-parse-integer to))))
;; The `pcase' `let' pattern doesn't bind values in the ;; The `pcase' `let' pattern doesn't bind values in the
;; body forms, so we have to parse the integer again. ;; body forms, so we have to parse the integer again.
(->> (ts-now) (->> (ts-now)
(ts-adjust 'day (cl-parse-integer to)) (ts-adjust 'day (cl-parse-integer to))
(ts-apply :hour 23 :minute 59 :second 59))) (ts-apply :hour 23 :minute 59 :second 59)))
((pred stringp) (ts-parse-fill 'end to)) ((pred stringp) (ts-parse-fill 'end to))
((pred ts-p) to)))) ((pred ts-p) to))))
(setf result (progn ,@body)) (setf result (progn ,@body))
@ -1326,8 +1346,13 @@ result form."
;; redefinitions until all of the predicates have been defined. ;; redefinitions until all of the predicates have been defined.
(setf org-ql-defpred-defer t) (setf org-ql-defpred-defer t)
(org-ql-defpred blocked ()
"Return non-nil if entry is blocked.
Calls `org-entry-blocked-p', which see."
:body (org-entry-blocked-p))
(org-ql-defpred (category c) (&rest categories) (org-ql-defpred (category c) (&rest categories)
"Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)." "Return non-nil if current heading is in one or more of CATEGORIES."
:normalizers ((`(,predicate-names . ,rest) :normalizers ((`(,predicate-names . ,rest)
`(category ,@rest))) `(category ,@rest)))
:body (when-let ((category (org-get-category (point)))) :body (when-let ((category (org-get-category (point))))
@ -1340,18 +1365,16 @@ result form."
;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again. ;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again.
:body (or (apply #'org-ql--predicate-todo org-done-keywords))) :body (or (apply #'org-ql--predicate-todo org-done-keywords)))
(defun org-ql--duration-to-minutes (duration) (defalias 'org-ql--duration-to-minutes
;; TODO: Remove when compatibility with Org 9.0 is dropped.
(cond ((fboundp 'org-duration-to-minutes) #'org-duration-to-minutes)
((fboundp 'org-duration-string-to-minutes) #'org-duration-string-to-minutes)
(t (error "org-ql: Unable to define alias `org-ql-search--link-heading-search-string'. Please report this as a bug")))
"Return DURATION string as a number of minutes. "Return DURATION string as a number of minutes.
For compatibility, since Org 9.1 deprecated For compatibility, since Org 9.1 deprecated
`org-duration-string-to-minutes', replacing it with `org-duration-string-to-minutes', replacing it with
`org-duration-to-minutes', which seems to return floats instead `org-duration-to-minutes', which seems to return floats instead
of integers." of integers.")
;; FIXME: Define this as an alias instead.
;; MAYBE: Remove if compatibility with Org 9.0 is dropped.
(funcall (if (fboundp 'org-duration-to-minutes)
#'org-duration-to-minutes
#'org-duration-string-to-minutes)
duration))
(org-ql-defpred effort (&optional effort-or-comparator effort) (org-ql-defpred effort (&optional effort-or-comparator effort)
"Return non-nil if current heading's effort property matches arguments. "Return non-nil if current heading's effort property matches arguments.
@ -1359,7 +1382,8 @@ The following forms are accepted:
(effort DURATION): Matches if effort is DURATION. (effort DURATION): Matches if effort is DURATION.
(effort DURATION DURATION): Matches if effort is between DURATIONs, inclusive. (effort DURATION DURATION): Matches if effort is between DURATIONs, inclusive.
(effort COMPARATOR DURATION): Matches if effort compares to DURATION with COMPARATOR. (effort COMPARATOR DURATION): Matches if effort compares to DURATION with
COMPARATOR.
COMPARATOR may be `<', `<=', `>', or `>='. DURATION should be an COMPARATOR may be `<', `<=', `>', or `>='. DURATION should be an
Org effort string, like \"5\" or \"0:05\"." Org effort string, like \"5\" or \"0:05\"."
@ -1492,8 +1516,10 @@ Matching is done case-insensitively."
The following forms are accepted: The following forms are accepted:
(level NUMBER): Matches if heading level is NUMBER. (level NUMBER): Matches if heading level is NUMBER.
(level NUMBER NUMBER): Matches if heading level is equal to or between NUMBERs. (level NUMBER NUMBER): Matches if heading level is equal to or between
(level COMPARATOR NUMBER): Matches if heading level compares to NUMBER with COMPARATOR. NUMBERs.
(level COMPARATOR NUMBER): Matches if heading level compares to NUMBER with
COMPARATOR.
COMPARATOR may be `<', `<=', `>', or `>='." COMPARATOR may be `<', `<=', `>', or `>='."
:normalizers ((`(,predicate-names . ,args) :normalizers ((`(,predicate-names . ,args)
@ -1550,12 +1576,8 @@ any link is found."
;; enabled nearly all of the time, in which case this function won't be called anyway, it's ;; enabled nearly all of the time, in which case this function won't be called anyway, it's
;; probably not worth rewriting code all over the place to fix this. ;; probably not worth rewriting code all over the place to fix this.
:preambles ((`(,predicate-names) :preambles ((`(,predicate-names)
(list :regexp ;; Match a link with a target and optionally a description. ;; Match a link with a target and optionally a description.
(rx (or bol (1+ blank)) (list :regexp (org-ql--link-regexp :target ".*")))
"[[" (1+ (not (any "]"))) "]"
(optional (seq "[" (0+ (not (any "]"))) "]"))
"]"
(or eol blank))))
(`(,predicate-names ,(and description-or-target (`(,predicate-names ,(and description-or-target
(guard (not (keywordp description-or-target)))) (guard (not (keywordp description-or-target))))
. ,plist) . ,plist)
@ -1610,7 +1632,7 @@ any link is found."
(match-string org-ql-link-description-group))))))))) (match-string org-ql-link-description-group)))))))))
(org-ql-defpred (rifle smart) (&rest strings) (org-ql-defpred (rifle smart) (&rest strings)
"Return non-nil if each string argument is found in either the entry or its outline path. "Return non-nil if each of strings is found in the entry or its outline path.
Works like `org-rifle'. This is probably the most useful, Works like `org-rifle'. This is probably the most useful,
intuitive, general-purpose predicate." intuitive, general-purpose predicate."
;; NOTE: This predicate advertises that it takes strings, but they ;; NOTE: This predicate advertises that it takes strings, but they
@ -1677,7 +1699,7 @@ contiguous segment of the outline path:
:body (org-ql--infix-p regexps (org-ql--value-at (point) #'org-ql--outline-path))) :body (org-ql--infix-p regexps (org-ql--value-at (point) #'org-ql--outline-path)))
(org-ql-defpred path (&rest regexps) (org-ql-defpred path (&rest regexps)
"Return non-nil if current heading's buffer's filename path matches any of REGEXPS (regexp strings). "Return non-nil if current heading's buffer's file path matches any of REGEXPS.
Without arguments, return non-nil if buffer is file-backed." Without arguments, return non-nil if buffer is file-backed."
;; FIXME: This should AND the regexps together, not OR them. ;; FIXME: This should AND the regexps together, not OR them.
:body (when (buffer-file-name) :body (when (buffer-file-name)
@ -1764,7 +1786,7 @@ priority B)."
thereis (= item-priority (* 1000 (- org-lowest-priority (string-to-char priority-arg))))))))) thereis (= item-priority (* 1000 (- org-lowest-priority (string-to-char priority-arg)))))))))
(org-ql-defpred property (property &optional value &key inherit) (org-ql-defpred property (property &optional value &key inherit)
"Return non-nil if current entry has PROPERTY (a string), and optionally VALUE (a string). "Return non-nil if current entry has PROPERTY, and optionally VALUE.
If INHERIT is nil, only match entries with PROPERTY set on the If INHERIT is nil, only match entries with PROPERTY set on the
entry; if t, also match entries with inheritance. If INHERIT is entry; if t, also match entries with inheritance. If INHERIT is
not specified, use the Boolean value of not specified, use the Boolean value of
@ -1856,7 +1878,7 @@ interpreted as nil or non-nil)."
(re-search-forward regexp end t)))))) (re-search-forward regexp end t))))))
(org-ql-defpred src (&key regexps lang) (org-ql-defpred src (&key regexps lang)
"Return non-nil if current entry contains an Org source block matching all of REGEXPS. "Return non-nil if current entry has an Org source block matching all REGEXPS.
If keyword argument LANG is non-nil, the block must be in that If keyword argument LANG is non-nil, the block must be in that
language. Matching is done case-insensitively." language. Matching is done case-insensitively."
:coalesce (lambda (coalesced-args current-args) :coalesce (lambda (coalesced-args current-args)
@ -1925,26 +1947,22 @@ language. Matching is done case-insensitively."
;; Always check contents with predicate. ;; Always check contents with predicate.
:query query))) :query query)))
:body :body
(catch 'return (save-excursion
(save-excursion (save-match-data
(save-match-data (cl-loop while (re-search-forward org-babel-src-block-regexp (org-entry-end-position) t)
(when (re-search-forward org-babel-src-block-regexp (org-entry-end-position) t) thereis (when (or (not lang) (equal lang (match-string 2)))
(when lang (or (not regexps)
(unless (string= lang (match-string 2)) (save-excursion
(throw 'return nil))) (let ((contents-beg (progn
(if regexps (goto-char (match-beginning 0))
(let ((contents-beg (progn (forward-line 1)
(goto-char (match-beginning 0)) (point)))
(forward-line 1) (contents-end (progn
(point))) (goto-char (match-end 0))
(contents-end (progn (point-at-bol))))
(goto-char (match-end 0)) (cl-loop for re in regexps
(point-at-bol)))) do (goto-char contents-beg)
(cl-loop for re in regexps always (re-search-forward re contents-end t))))))))))
do (goto-char contents-beg)
always (re-search-forward re contents-end t)))
;; No regexps to check: return non-nil.
t))))))
(org-ql-defpred (tags) (&rest tags) (org-ql-defpred (tags) (&rest tags)
"Return non-nil if current heading has one or more of TAGS (a list of strings). "Return non-nil if current heading has one or more of TAGS (a list of strings).
@ -1972,7 +1990,7 @@ Tests both inherited and local tags."
:body (apply #'org-ql--predicate-tags tags)) :body (apply #'org-ql--predicate-tags tags))
(org-ql-defpred (tags-inherited inherited-tags tags-i itags) (&rest tags) (org-ql-defpred (tags-inherited inherited-tags tags-i itags) (&rest tags)
"Return non-nil if current heading's inherited tags include one or more of TAGS (a list of strings). "Return non-nil if current heading's inherited tags include any of TAGS.
If TAGS is nil, return non-nil if heading has any inherited tags." If TAGS is nil, return non-nil if heading has any inherited tags."
:normalizers ((`(,predicate-names . ,tags) :normalizers ((`(,predicate-names . ,tags)
`(tags-inherited ,@tags))) `(tags-inherited ,@tags)))
@ -1986,7 +2004,7 @@ If TAGS is nil, return non-nil if heading has any inherited tags."
(seq-intersection tags inherited))))))) (seq-intersection tags inherited)))))))
(org-ql-defpred (tags-local local-tags tags-l ltags) (&rest tags) (org-ql-defpred (tags-local local-tags tags-l ltags) (&rest tags)
"Return non-nil if current heading's local tags include one or more of TAGS (a list of strings). "Return non-nil if current heading's local tags include any of TAGS.
If TAGS is nil, return non-nil if heading has any local tags." If TAGS is nil, return non-nil if heading has any local tags."
:normalizers ((`(,predicate-names . ,tags) :normalizers ((`(,predicate-names . ,tags)
`(tags-local ,@tags))) `(tags-local ,@tags)))
@ -2029,7 +2047,7 @@ Tests both inherited and local tags."
(org-ql-defpred todo (&rest keywords) (org-ql-defpred todo (&rest keywords)
"Return non-nil if current heading is a TODO item. "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)." With KEYWORDS, return non-nil if its keyword is one of KEYWORDS."
;; TODO: Can we make a preamble for plain (todo) queries? ;; TODO: Can we make a preamble for plain (todo) queries?
:preambles ((`(,predicate-names . ,(and todo-keywords (guard todo-keywords))) :preambles ((`(,predicate-names . ,(and todo-keywords (guard todo-keywords)))
(list :case-fold nil :regexp (rx-to-string `(seq bol (1+ "*") (1+ space) (or ,@todo-keywords) (or " " eol)) t)))) (list :case-fold nil :regexp (rx-to-string `(seq bol (1+ "*") (1+ space) (or ,@todo-keywords) (or " " eol)) t))))
@ -2219,8 +2237,8 @@ non-nil if entry has a deadline."
:normalizers ((`(,predicate-names auto . ,rest) :normalizers ((`(,predicate-names auto . ,rest)
;; Use `org-deadline-warning-days' as the :to arg. ;; Use `org-deadline-warning-days' as the :to arg.
(let ((ts (->> (ts-now) (let ((ts (->> (ts-now)
(ts-adjust 'day org-deadline-warning-days) (ts-adjust 'day org-deadline-warning-days)
(ts-apply :hour 23 :minute 59 :second 59)))) (ts-apply :hour 23 :minute 59 :second 59))))
`(deadline-warning :to ,ts ,@rest))) `(deadline-warning :to ,ts ,@rest)))
(`(,predicate-names . ,(and rest (guard (numberp (car rest))))) (`(,predicate-names . ,(and rest (guard (numberp (car rest)))))
(org-ql--normalize-from-to-on (org-ql--normalize-from-to-on
@ -2243,7 +2261,8 @@ non-nil if entry has a deadline."
(org-ql-defpred deadline-warning (&key from to) (org-ql-defpred deadline-warning (&key from to)
;; TODO: Should this also accept a WITH-TIME argument? ;; TODO: Should this also accept a WITH-TIME argument?
;; MAYBE: Use the new org-ql-regexps? ;; MAYBE: Use the new org-ql-regexps?
"Internal predicate used to handle `org-deadline-warning-days' and deadlines with warning periods." "Internal predicate.
Used to handle `org-deadline-warning-days' and deadlines with warning periods."
:preambles ((`(,predicate-names . ,_) :preambles ((`(,predicate-names . ,_)
(list :regexp org-deadline-time-regexp :query query))) (list :regexp org-deadline-time-regexp :query query)))
:body :body

375
org-ql.info
View file

@ -1,4 +1,4 @@
This is README.info, produced by makeinfo version 5.2 from README.texi. This is README.info, produced by makeinfo version 6.7 from README.texi.
INFO-DIR-SECTION Emacs INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY START-INFO-DIR-ENTRY
@ -48,6 +48,7 @@ Usage
Commands Commands
* org-ql-find:: * org-ql-find::
* org-ql-open-link::
* org-ql-refile:: * org-ql-refile::
* org-ql-search:: * org-ql-search::
* helm-org-ql:: * helm-org-ql::
@ -71,7 +72,11 @@ Functions / Macros
Changelog Changelog
* 0.7-pre: 07-pre. * 0.8-pre: 08-pre.
* 0.7.3: 073.
* 0.7.2: 072.
* 0.7.1: 071.
* 0.7: 07.
* 0.6.3: 063. * 0.6.3: 063.
* 0.6.2: 062. * 0.6.2: 062.
* 0.6.1: 061. * 0.6.1: 061.
@ -203,6 +208,7 @@ File: README.info, Node: Commands, Next: Queries, Up: Usage
* Menu: * Menu:
* org-ql-find:: * org-ql-find::
* org-ql-open-link::
* org-ql-refile:: * org-ql-refile::
* org-ql-search:: * org-ql-search::
* helm-org-ql:: * helm-org-ql::
@ -212,7 +218,7 @@ File: README.info, Node: Commands, Next: Queries, Up: Usage
* org-ql-sparse-tree:: * org-ql-sparse-tree::
 
File: README.info, Node: org-ql-find, Next: org-ql-refile, Up: Commands File: README.info, Node: org-ql-find, Next: org-ql-open-link, Up: Commands
4.1.1 org-ql-find 4.1.1 org-ql-find
----------------- -----------------
@ -223,13 +229,38 @@ _Note: These commands use ._
completion facilities with an Org QL query: completion facilities with an Org QL query:
• ‘org-ql-find’ searches in the current buffer. • ‘org-ql-find’ searches in the current buffer.
• ‘org-ql-find-path’ searches outline paths in the current buffer.
• ‘org-ql-find-in-agenda’ searches in ‘(org-agenda-files)’. • ‘org-ql-find-in-agenda’ searches in ‘(org-agenda-files)’.
• ‘org-ql-find-in-org-directory’ searches in ‘org-directory’. • ‘org-ql-find-in-org-directory’ searches in ‘org-directory’.
 Note that these commands are compatible with Embark
File: README.info, Node: org-ql-refile, Next: org-ql-search, Prev: org-ql-find, Up: Commands (https://github.com/oantolin/embark): the ‘embark-act’ command can be
called on a completion candidate (i.e. a search result) to act on it
immediately, without having to visit the entry in its source Org buffer.
4.1.2 org-ql-refile 
File: README.info, Node: org-ql-open-link, Next: org-ql-refile, Prev: org-ql-find, Up: Commands
4.1.2 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.

File: README.info, Node: org-ql-refile, Next: org-ql-search, Prev: org-ql-open-link, Up: Commands
4.1.3 org-ql-refile
------------------- -------------------
This command refiles the current Org entry to one selected by searching This command refiles the current Org entry to one selected by searching
@ -239,7 +270,7 @@ with Org QL completion. It searches files listed in
 
File: README.info, Node: org-ql-search, Next: helm-org-ql, Prev: org-ql-refile, Up: Commands File: README.info, Node: org-ql-search, Next: helm-org-ql, Prev: org-ql-refile, Up: Commands
4.1.3 org-ql-search 4.1.4 org-ql-search
------------------- -------------------
_Note: This command supports both sexp queries and ._ _Note: This command supports both sexp queries and ._
@ -279,10 +310,15 @@ This feature is experimental and not guaranteed to work correctly with
all commands. (It works to the extent it does because the appropriate all commands. (It works to the extent it does because the appropriate
text properties are placed on each item, imitating an Agenda buffer.) text properties are placed on each item, imitating an Agenda buffer.)
*Note:* Also, this buffer is compatible with Embark
(https://github.com/oantolin/embark): the ‘embark-act’ command can be
called on an entry to act on it immediately, without having to visit the
entry in its source Org buffer.
 
File: README.info, Node: helm-org-ql, Next: org-ql-view, Prev: org-ql-search, Up: Commands File: README.info, Node: helm-org-ql, Next: org-ql-view, Prev: org-ql-search, Up: Commands
4.1.4 helm-org-ql 4.1.5 helm-org-ql
----------------- -----------------
_Note: This command uses . It is available separately in the package _Note: This command uses . It is available separately in the package
@ -296,7 +332,7 @@ _Note: This command uses . It is available separately in the package
 
File: README.info, Node: org-ql-view, Next: org-ql-view-sidebar, Prev: helm-org-ql, Up: Commands File: README.info, Node: org-ql-view, Next: org-ql-view-sidebar, Prev: helm-org-ql, Up: Commands
4.1.5 org-ql-view 4.1.6 org-ql-view
----------------- -----------------
Choose and display a view stored in ‘org-ql-views’. Choose and display a view stored in ‘org-ql-views’.
@ -311,7 +347,7 @@ Choose and display a view stored in ‘org-ql-views’.
 
File: README.info, Node: org-ql-view-sidebar, Next: org-ql-view-recent-items, Prev: org-ql-view, Up: Commands File: README.info, Node: org-ql-view-sidebar, Next: org-ql-view-recent-items, Prev: org-ql-view, Up: Commands
4.1.6 org-ql-view-sidebar 4.1.7 org-ql-view-sidebar
------------------------- -------------------------
Show a sidebar window listing views stored in ‘org-ql-views’ for easy Show a sidebar window listing views stored in ‘org-ql-views’ for easy
@ -321,7 +357,7 @@ point, and press ‘c’ to customize the view at point.
 
File: README.info, Node: org-ql-view-recent-items, Next: org-ql-sparse-tree, Prev: org-ql-view-sidebar, Up: Commands File: README.info, Node: org-ql-view-recent-items, Next: org-ql-sparse-tree, Prev: org-ql-view-sidebar, Up: Commands
4.1.7 org-ql-view-recent-items 4.1.8 org-ql-view-recent-items
------------------------------ ------------------------------
Show items in ‘FILES’ from last ‘DAYS’ days with timestamps of ‘TYPE’. Show items in ‘FILES’ from last ‘DAYS’ days with timestamps of ‘TYPE’.
@ -332,7 +368,7 @@ returned by the function ‘org-agenda-files’.
 
File: README.info, Node: org-ql-sparse-tree, Prev: org-ql-view-recent-items, Up: Commands File: README.info, Node: org-ql-sparse-tree, Prev: org-ql-view-recent-items, Up: Commands
4.1.8 org-ql-sparse-tree 4.1.9 org-ql-sparse-tree
------------------------ ------------------------
Arguments: ‘(query &key keep-previous (buffer (current-buffer)))’ Arguments: ‘(query &key keep-previous (buffer (current-buffer)))’
@ -415,6 +451,9 @@ File: README.info, Node: General predicates, Next: Ancestor/descendant predica
Arguments are listed next to predicate names, where applicable. Arguments are listed next to predicate names, where applicable.
‘blocked’
Return non-nil if current heading is blocked. Calls
‘org-entry-blocked-p’, which see.
‘category (&optional categories)’ ‘category (&optional categories)’
Return non-nil if current heading is in one or more of ‘CATEGORIES’ Return non-nil if current heading is in one or more of ‘CATEGORIES’
(a list of strings). (a list of strings).
@ -987,7 +1026,11 @@ releases.
* Menu: * Menu:
* 0.7-pre: 07-pre. * 0.8-pre: 08-pre.
* 0.7.3: 073.
* 0.7.2: 072.
* 0.7.1: 071.
* 0.7: 07.
* 0.6.3: 063. * 0.6.3: 063.
* 0.6.2: 062. * 0.6.2: 062.
* 0.6.1: 061. * 0.6.1: 061.
@ -1015,11 +1058,107 @@ releases.
* 0.1: 01. * 0.1: 01.
 
File: README.info, Node: 07-pre, Next: 063, Up: Changelog File: README.info, Node: 08-pre, Next: 073, Up: Changelog
5.1 0.7-pre 5.1 0.8-pre
=========== ===========
*Additions*
• Function ‘org-ql-completing-read’, used by command ‘org-ql-find’,
now specifies the completion category as ‘org-heading’, providing
compatibility with Embark (https://github.com/oantolin/embark).
(This is a powerful feature, as it means any ‘org-ql-find’ result
can be acted on from inside the search results with Embark, which
provides common actions from Org Agenda and Org speed keys
bindings.) (#299 (https://github.com/alphapapa/org-ql/issues/299).
Thanks to Omar Antolín Camarena (https://github.com/oantolin),
Daniel Mendler (https://github.com/minad), and Akira Komamura
(https://github.com/akirak).)
• Command ‘org-ql-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.)
*Compatibility*
• Org v9.7’s ‘org-element’ API changes required some adjustments.
(#364 (https://github.com/alphapapa/org-ql/issues/364). Thanks to
several users for reporting, and to Ihor Radchenko
(https://github.com/yantar92) for his feedback.)

File: README.info, Node: 073, Next: 072, Prev: 08-pre, Up: Changelog
5.2 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. (#378
(https://github.com/alphapapa/org-ql/issues/378). Thanks to
Pentaquark1 (https://github.com/Pentaquark1) for reporting.)
• Command ‘org-ql-find’ didn’t move point to the selected entry.
(#380 (https://github.com/alphapapa/org-ql/issues/380). Thanks to
Omar Antolín Camarena (https://github.com/oantolin) for reporting.)

File: README.info, Node: 072, Next: 071, Prev: 073, Up: Changelog
5.3 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. (#351
(https://github.com/alphapapa/org-ql/issues/351). Thanks to Daniel
Fleischer (https://github.com/danielfleischer) 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).

File: README.info, Node: 071, Next: 07, Prev: 072, Up: Changelog
5.4 0.7.1
=========
*Fixes*
• Function ‘org-ql-completing-read’ is more compatible with default
Emacs completion. (See #338
(https://github.com/alphapapa/org-ql/issues/338). Thanks to
arozbiz (https://github.com/arozbiz) for reporting.)
• Function ‘org-ql-completing-read’ would sometimes stop updating
with changes in input. (See #350
(https://github.com/alphapapa/org-ql/issues/350). Thanks to Ankit
Raj Pandey (https://github.com/anpandey) for reporting and fixing,
and to Daniel Mendler (https://github.com/minad) for advising.)
• In ‘org-ql-completing-read’, format links for display, and use
‘org-entry-get’ internally rather than ‘org-get-heading’.

File: README.info, Node: 07, Next: 063, Prev: 071, Up: Changelog
5.5 0.7
=======
*Added* *Added*
• Commands ‘org-ql-find’, ‘org-ql-find-heading’, and • Commands ‘org-ql-find’, ‘org-ql-find-heading’, and
‘org-ql-find-path’, which jump to entries selected using Emacs’s ‘org-ql-find-path’, which jump to entries selected using Emacs’s
@ -1042,20 +1181,31 @@ File: README.info, Node: 07-pre, Next: 063, Up: Changelog
entries with property inheritance, and when unspecified, the option entries with property inheritance, and when unspecified, the option
‘org-use-property-inheritance’ controls whether inheritance is ‘org-use-property-inheritance’ controls whether inheritance is
used. used.
• Predicate ‘blocked’. (Thanks to Akira Komamura
(https://github.com/akirak).)
*Changed* *Changed*
• Give more useful error message for invalid queries. • Give more useful error message for invalid queries.
• Predicate ‘src’ now matches case-insensitively. • Predicate ‘src’ now matches case-insensitively.
• Command ‘org-ql-sparse-tree’ accepts both string and sexp queries.
(Thanks to Akira Komamura (https://github.com/akirak).)
*Fixed* *Fixed*
• Predicate ‘link’ matches links whose descriptions contain escaped
brackets (changed in Org 9.3). (Thanks to Daniel Borchmann
(https://github.com/exot) for reporting.)
• Predicate ‘src’’s matching of begin/end block lines, normalization • Predicate ‘src’’s matching of begin/end block lines, normalization
of arguments, and handling in non-sexp queries. of arguments, and handling in non-sexp queries. (Thanks to Akira
Komamura (https://github.com/akirak) for reporting.)
• Predicate ‘src’’s behavior with various arguments.
• Various compilation warnings.
*Internal* *Internal*
• Certain query predicates, when called multiple times in an ‘and’ • Certain query predicates, when called multiple times in an ‘and’
sub-expression, are optimized to a single call. sub-expression, are optimized to a single call.
• Use ‘buffer-chars-modified-tick’ instead of ‘buffer-modified-tick’. • Use ‘buffer-chars-modified-tick’ instead of ‘buffer-modified-tick’.
(Thanks to Ihor Radchenko (https://github.com/yantar92).) (Thanks to Ihor Radchenko (https://github.com/yantar92).)
• Implemented tests for ‘src’ predicate.
*Credits* *Credits*
• Thanks to Caleb Chase (https://github.com/chasecaleb) for help with • Thanks to Caleb Chase (https://github.com/chasecaleb) for help with
@ -1064,9 +1214,9 @@ File: README.info, Node: 07-pre, Next: 063, Up: Changelog
(https://github.com/alphapapa/org-ql/commit/91908186fcca4b5fd2e9d26da5bc0375c2b41acf). (https://github.com/alphapapa/org-ql/commit/91908186fcca4b5fd2e9d26da5bc0375c2b41acf).
 
File: README.info, Node: 063, Next: 062, Prev: 07-pre, Up: Changelog File: README.info, Node: 063, Next: 062, Prev: 07, Up: Changelog
5.2 0.6.3 5.6 0.6.3
========= =========
*Fixed* *Fixed*
@ -1082,7 +1232,7 @@ File: README.info, Node: 063, Next: 062, Prev: 07-pre, Up: Changelog
 
File: README.info, Node: 062, Next: 061, Prev: 063, Up: Changelog File: README.info, Node: 062, Next: 061, Prev: 063, Up: Changelog
5.3 0.6.2 5.7 0.6.2
========= =========
*Fixed* *Fixed*
@ -1093,7 +1243,7 @@ File: README.info, Node: 062, Next: 061, Prev: 063, Up: Changelog
 
File: README.info, Node: 061, Next: 06, Prev: 062, Up: Changelog File: README.info, Node: 061, Next: 06, Prev: 062, Up: Changelog
5.4 0.6.1 5.8 0.6.1
========= =========
*Fixed* *Fixed*
@ -1111,7 +1261,7 @@ File: README.info, Node: 061, Next: 06, Prev: 062, Up: Changelog
 
File: README.info, Node: 06, Next: 052, Prev: 061, Up: Changelog File: README.info, Node: 06, Next: 052, Prev: 061, Up: Changelog
5.5 0.6 5.9 0.6
======= =======
*Added* *Added*
@ -1178,8 +1328,8 @@ File: README.info, Node: 06, Next: 052, Prev: 061, Up: Changelog
 
File: README.info, Node: 052, Next: 051, Prev: 06, Up: Changelog File: README.info, Node: 052, Next: 051, Prev: 06, Up: Changelog
5.6 0.5.2 5.10 0.5.2
========= ==========
*Fixed* *Fixed*
• Predicate ‘link’’s ‘:target’ and ‘:regexp-p’ arguments. (#220 • Predicate ‘link’’s ‘:target’ and ‘:regexp-p’ arguments. (#220
@ -1189,8 +1339,8 @@ File: README.info, Node: 052, Next: 051, Prev: 06, Up: Changelog
 
File: README.info, Node: 051, Next: 05, Prev: 052, Up: Changelog File: README.info, Node: 051, Next: 05, Prev: 052, Up: Changelog
5.7 0.5.1 5.11 0.5.1
========= ==========
*Fixed* *Fixed*
• Custom sorting functions could corrupt the cache, causing items to • Custom sorting functions could corrupt the cache, causing items to
@ -1202,8 +1352,8 @@ File: README.info, Node: 051, Next: 05, Prev: 052, Up: Changelog
 
File: README.info, Node: 05, Next: 049, Prev: 051, Up: Changelog File: README.info, Node: 05, Next: 049, Prev: 051, Up: Changelog
5.8 0.5 5.12 0.5
======= ========
*Added* *Added*
• View dispatcher using ‘transient.el’ (like Magit), bound to ‘v’ in • View dispatcher using ‘transient.el’ (like Magit), bound to ‘v’ in
@ -1243,8 +1393,8 @@ File: README.info, Node: 05, Next: 049, Prev: 051, Up: Changelog
 
File: README.info, Node: 049, Next: 048, Prev: 05, Up: Changelog File: README.info, Node: 049, Next: 048, Prev: 05, Up: Changelog
5.9 0.4.9 5.13 0.4.9
========= ==========
*Fixed* *Fixed*
• Agenda restriction in ‘org-ql-block’. (Fixes #84 • Agenda restriction in ‘org-ql-block’. (Fixes #84
@ -1254,7 +1404,7 @@ File: README.info, Node: 049, Next: 048, Prev: 05, Up: Changelog
 
File: README.info, Node: 048, Next: 047, Prev: 049, Up: Changelog File: README.info, Node: 048, Next: 047, Prev: 049, Up: Changelog
5.10 0.4.8 5.14 0.4.8
========== ==========
*Fixed* *Fixed*
@ -1266,7 +1416,7 @@ File: README.info, Node: 048, Next: 047, Prev: 049, Up: Changelog
 
File: README.info, Node: 047, Next: 046, Prev: 048, Up: Changelog File: README.info, Node: 047, Next: 046, Prev: 048, Up: Changelog
5.11 0.4.7 5.15 0.4.7
========== ==========
*Fixed* *Fixed*
@ -1279,7 +1429,7 @@ File: README.info, Node: 047, Next: 046, Prev: 048, Up: Changelog
 
File: README.info, Node: 046, Next: 045, Prev: 047, Up: Changelog File: README.info, Node: 046, Next: 045, Prev: 047, Up: Changelog
5.12 0.4.6 5.16 0.4.6
========== ==========
*Fixed* *Fixed*
@ -1292,7 +1442,7 @@ File: README.info, Node: 046, Next: 045, Prev: 047, Up: Changelog
 
File: README.info, Node: 045, Next: 044, Prev: 046, Up: Changelog File: README.info, Node: 045, Next: 044, Prev: 046, Up: Changelog
5.13 0.4.5 5.17 0.4.5
========== ==========
*Fixed* *Fixed*
@ -1304,7 +1454,7 @@ File: README.info, Node: 045, Next: 044, Prev: 046, Up: Changelog
 
File: README.info, Node: 044, Next: 043, Prev: 045, Up: Changelog File: README.info, Node: 044, Next: 043, Prev: 045, Up: Changelog
5.14 0.4.4 5.18 0.4.4
========== ==========
*Fixed* *Fixed*
@ -1316,7 +1466,7 @@ File: README.info, Node: 044, Next: 043, Prev: 045, Up: Changelog
 
File: README.info, Node: 043, Next: 042, Prev: 044, Up: Changelog File: README.info, Node: 043, Next: 042, Prev: 044, Up: Changelog
5.15 0.4.3 5.19 0.4.3
========== ==========
*Fixed* *Fixed*
@ -1326,7 +1476,7 @@ File: README.info, Node: 043, Next: 042, Prev: 044, Up: Changelog
 
File: README.info, Node: 042, Next: 041, Prev: 043, Up: Changelog File: README.info, Node: 042, Next: 041, Prev: 043, Up: Changelog
5.16 0.4.2 5.20 0.4.2
========== ==========
*Fixed* *Fixed*
@ -1335,7 +1485,7 @@ File: README.info, Node: 042, Next: 041, Prev: 043, Up: Changelog
 
File: README.info, Node: 041, Next: 04, Prev: 042, Up: Changelog File: README.info, Node: 041, Next: 04, Prev: 042, Up: Changelog
5.17 0.4.1 5.21 0.4.1
========== ==========
*Fixed* *Fixed*
@ -1345,7 +1495,7 @@ File: README.info, Node: 041, Next: 04, Prev: 042, Up: Changelog
 
File: README.info, Node: 04, Next: 032, Prev: 041, Up: Changelog File: README.info, Node: 04, Next: 032, Prev: 041, Up: Changelog
5.18 0.4 5.22 0.4
======== ========
_Note:_ The next release, 0.5, may include changes which will require _Note:_ The next release, 0.5, may include changes which will require
@ -1426,7 +1576,7 @@ automatically, as they will be pushed to the ‘master’ branch when ready.
 
File: README.info, Node: 032, Next: 031, Prev: 04, Up: Changelog File: README.info, Node: 032, Next: 031, Prev: 04, Up: Changelog
5.19 0.3.2 5.23 0.3.2
========== ==========
*Fixed* *Fixed*
@ -1439,7 +1589,7 @@ File: README.info, Node: 032, Next: 031, Prev: 04, Up: Changelog
 
File: README.info, Node: 031, Next: 03, Prev: 032, Up: Changelog File: README.info, Node: 031, Next: 03, Prev: 032, Up: Changelog
5.20 0.3.1 5.24 0.3.1
========== ==========
*Fixed* *Fixed*
@ -1449,7 +1599,7 @@ File: README.info, Node: 031, Next: 03, Prev: 032, Up: Changelog
 
File: README.info, Node: 03, Next: 023, Prev: 031, Up: Changelog File: README.info, Node: 03, Next: 023, Prev: 031, Up: Changelog
5.21 0.3 5.25 0.3
======== ========
*Added* *Added*
@ -1517,7 +1667,7 @@ File: README.info, Node: 03, Next: 023, Prev: 031, Up: Changelog
 
File: README.info, Node: 023, Next: 022, Prev: 03, Up: Changelog File: README.info, Node: 023, Next: 022, Prev: 03, Up: Changelog
5.22 0.2.3 5.26 0.2.3
========== ==========
*Fixed* *Fixed*
@ -1527,7 +1677,7 @@ File: README.info, Node: 023, Next: 022, Prev: 03, Up: Changelog
 
File: README.info, Node: 022, Next: 021, Prev: 023, Up: Changelog File: README.info, Node: 022, Next: 021, Prev: 023, Up: Changelog
5.23 0.2.2 5.27 0.2.2
========== ==========
*Fixed* *Fixed*
@ -1538,7 +1688,7 @@ File: README.info, Node: 022, Next: 021, Prev: 023, Up: Changelog
 
File: README.info, Node: 021, Next: 02, Prev: 022, Up: Changelog File: README.info, Node: 021, Next: 02, Prev: 022, Up: Changelog
5.24 0.2.1 5.28 0.2.1
========== ==========
*Fixed* *Fixed*
@ -1548,7 +1698,7 @@ File: README.info, Node: 021, Next: 02, Prev: 022, Up: Changelog
 
File: README.info, Node: 02, Next: 01, Prev: 021, Up: Changelog File: README.info, Node: 02, Next: 01, Prev: 021, Up: Changelog
5.25 0.2 5.29 0.2
======== ========
*Added* *Added*
@ -1631,7 +1781,7 @@ File: README.info, Node: 02, Next: 01, Prev: 021, Up: Changelog
 
File: README.info, Node: 01, Prev: 02, Up: Changelog File: README.info, Node: 01, Prev: 02, Up: Changelog
5.26 0.1 5.30 0.1
======== ========
First tagged release. First tagged release.
@ -1689,70 +1839,75 @@ GPLv3
 
Tag Table: Tag Table:
Node: Top225 Node: Top225
Node: Contents1797 Node: Contents1845
Node: Screenshots1920 Node: Screenshots1968
Node: Installation2038 Node: Installation2086
Node: Quelpa2552 Node: Quelpa2600
Node: Helm support3080 Node: Helm support3128
Node: Usage3483 Node: Usage3531
Node: Commands3881 Node: Commands3929
Node: org-ql-find4325 Node: org-ql-find4394
Node: org-ql-refile4791 Node: org-ql-open-link5212
Node: org-ql-search5114 Node: org-ql-refile6067
Node: helm-org-ql6810 Node: org-ql-search6395
Node: org-ql-view7188 Node: helm-org-ql8326
Node: org-ql-view-sidebar7718 Node: org-ql-view8704
Node: org-ql-view-recent-items8098 Node: org-ql-view-sidebar9234
Node: org-ql-sparse-tree8594 Node: org-ql-view-recent-items9614
Node: Queries9394 Node: org-ql-sparse-tree10110
Node: Non-sexp query syntax10511 Node: Queries10910
Node: General predicates12270 Node: Non-sexp query syntax12027
Node: Ancestor/descendant predicates19142 Node: General predicates13786
Node: Date/time predicates20270 Node: Ancestor/descendant predicates20773
Node: Functions / Macros23394 Node: Date/time predicates21901
Node: Agenda-like views23692 Node: Functions / Macros25025
Ref: Function ‘org-ql-block’23854 Node: Agenda-like views25323
Node: Listing / acting-on results25115 Ref: Function org-ql-block25485
Ref: Caching25323 Node: Listing / acting-on results26746
Ref: Function ‘org-ql-select’26236 Ref: Caching26954
Ref: Function ‘org-ql-query’28662 Ref: Function org-ql-select27867
Ref: Macro ‘org-ql’ (deprecated)30436 Ref: Function org-ql-query30293
Node: Custom predicates30751 Ref: Macro org-ql (deprecated)32067
Ref: Macro ‘org-ql-defpred’30975 Node: Custom predicates32382
Node: Dynamic block34416 Ref: Macro org-ql-defpred32606
Node: Links37140 Node: Dynamic block36047
Node: Tips37827 Node: Links38771
Node: Changelog38151 Node: Tips39458
Node: 07-pre38934 Node: Changelog39782
Node: 06341209 Node: 08-pre40592
Node: 06241744 Node: 07342357
Node: 06142049 Node: 07243092
Node: 0642617 Node: 07144011
Node: 05245671 Node: 0744820
Node: 05145971 Node: 06347744
Node: 0546394 Node: 06248275
Node: 04947923 Node: 06148580
Node: 04848203 Node: 0649148
Node: 04748552 Node: 05252202
Node: 04648961 Node: 05152504
Node: 04549369 Node: 0552929
Node: 04449730 Node: 04954460
Node: 04350089 Node: 04854742
Node: 04250292 Node: 04755091
Node: 04150453 Node: 04655500
Node: 0450700 Node: 04555908
Node: 03254801 Node: 04456269
Node: 03155204 Node: 04356628
Node: 0355401 Node: 04256831
Node: 02358701 Node: 04156992
Node: 02258935 Node: 0457239
Node: 02159215 Node: 03261340
Node: 0259420 Node: 03161743
Node: 0163498 Node: 0361940
Node: Notes63599 Node: 02365240
Node: Comparison with Org Agenda searches63761 Node: 02265474
Node: org-sidebar64650 Node: 02165754
Node: License64929 Node: 0265959
Node: 0170037
Node: Notes70138
Node: Comparison with Org Agenda searches70300
Node: org-sidebar71189
Node: License71468
 
End Tag Table End Tag Table

0
tests/data2.org → tests/data-file-tags.org
View file

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.

141
tests/test-org-ql.el
View file

@ -30,8 +30,11 @@
(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)
;;;; Variables ;;;; Variables
(defvar org-ql-test-buffer nil (defvar org-ql-test-buffer nil
@ -105,27 +108,24 @@ Set at runtime by test suite.")
"Return buffer visiting FILENAME. "Return buffer visiting FILENAME.
FILENAME should be a file in the \"tests\" directory." FILENAME should be a file in the \"tests\" directory."
(->> (locate-dominating-file default-directory ".git") (->> (locate-dominating-file default-directory ".git")
(expand-file-name "tests") (expand-file-name "tests")
(expand-file-name filename) (expand-file-name filename)
find-file-noselect)) find-file-noselect))
;;;; 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 (it ,(concat description " (preamble) ")
(buttercup-it ,(concat description " (preamble) ") ,(when body
(lambda () `(let ((org-ql-use-preamble t))
(let ((org-ql-use-preamble t)) ,@body)))
,@body))) (it ,(concat description " (no preamble) ")
(buttercup-it ,(concat description " (no preamble)") ,(when body
(lambda () `(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 +164,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,7 +203,7 @@ 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 pre-processing" (describe "Query pre-processing"
@ -327,11 +328,17 @@ with keyword arg NOW in PLIST."
(it "normalizes non-keyword args with a :lang keyword arg to keywords" (it "normalizes non-keyword args with a :lang keyword arg to keywords"
(expect (org-ql--normalize-query '(src "foo" "bar" :lang "baz")) (expect (org-ql--normalize-query '(src "foo" "bar" :lang "baz"))
:to-equal '(src :lang "baz" :regexps '("foo" "bar")))) :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" (it "normalizes all-keyword args without looping"
(expect (org-ql--normalize-query '(src :regexps ("foo") :lang "bar")) (expect (org-ql--normalize-query '(src :regexps ("foo") :lang "bar"))
:to-equal '(src :lang "bar" :regexps '("foo"))) :to-equal '(src :lang "bar" :regexps '("foo")))
(expect (org-ql--normalize-query '(src :regexps ("foo") :lang)) (expect (org-ql--normalize-query '(src :regexps ("foo") :lang))
:to-equal '(src :regexps '("foo"))))) :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" (it "handles 0 arguments"
@ -1136,7 +1143,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"
@ -1366,9 +1407,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"
@ -1409,10 +1486,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)"
@ -1440,10 +1517,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)"
@ -1470,10 +1547,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&)"
@ -1486,7 +1563,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*)"
@ -1511,10 +1588,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)"