Add: src predicate

This commit is contained in:
Adam Porter 2019-10-09 13:10:40 -05:00
parent a60c238417
commit 37ba30c969
4 changed files with 80 additions and 16 deletions

View file

@ -189,6 +189,7 @@ Arguments are listed next to predicate names, where applicable.
+ =priority (&optional comparator-or-priority priority)= :: Return non-nil if current heading has a certain priority. ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator). If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string. If both arguments are nil, return non-nil if heading has any defined priority.
+ =property (property &optional value)= :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string). Note that property inheritance is currently /not/ enabled for this predicate. If you need to test with inheritance, you could use a custom predicate form, like ~(org-entry-get (point) "PROPERTY" 'inherit)~.
+ =regexp (&rest regexps)= :: Return non-nil if current entry matches all of ~REGEXPS~ (regexp strings). Matches against entire entry, from beginning of its heading to the next heading.
+ ~src (&optional lang regexps)~ :: Return non-nil if current entry contains an Org Babel source block. If ~LANG~ is non-nil, match blocks of that language. If ~REGEXPS~ is non-nil, require that block's contents match all regexps.
+ =tags (&optional tags)= :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). Tests both inherited and local tags.
+ =tags-inherited (&optional tags)= :: Return non-nil if current heading's inherited tags include one or more of ~TAGS~ (a list of strings). If ~TAGS~ is nil, return non-nil if heading has any inherited tags.
- Aliases: ~inherited-tags~, ~tags-i~, ~itags~.
@ -379,6 +380,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience
+ Command ~org-ql-view-refresh~ can be called with a prefix argument to adjust search parameters.
+ Function ~helm-org-ql-source~, which returns a Helm source that searches given buffers/files with ~helm-org-ql~. It can be used for custom Helm commands that search certain files.
+ Command ~helm-org-ql-views~, which shows one of ~org-ql-views~ selected with Helm.
+ Predicate ~src~, which matches Org Babel source blocks.
*Internal*
+ Added generic node data cache to speed up recursive, tree-based queries.

View file

@ -747,6 +747,13 @@ replace the clause with a preamble."
;; (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":" (1+ (not (or space ":"))) ":"
;; (1+ space) (minimal-match (1+ not-newline)) eol)))
;; element)
;; Src blocks.
(`(src ,lang . ,_)
(setq org-ql-preamble (org-ql--format-src-block-regexp lang))
;; Always check contents with predicate.
element)
(`(scheduled . ,_)
(setq org-ql-preamble org-scheduled-time-regexp)
;; Return element, because the predicate still needs testing.
@ -781,6 +788,29 @@ replace the clause with a preamble."
(query (-flatten-n 1 query))))
(list :query query :preamble org-ql-preamble :preamble-case-fold preamble-case-fold))))))
(defun org-ql--format-src-block-regexp (&optional lang)
"Return regexp equivalent to `org-babel-src-block-regexp' with LANG filled in."
;; I couldn't find a way to match block contents without the regexp
;; also matching past the end of the block and into later blocks. Even
;; using `minimal-match' in several different combinations didn't work.
;; So matching contents will have to be done with the predicate.
(rx-to-string `(seq bol (group (zero-or-more (any " ")))
"#+begin_src"
(one-or-more (any " "))
,lang
(zero-or-more (any " "))
(group (or (seq (zero-or-more (not (any "\n\":")))
"\""
(zero-or-more (not (any "\n\"*")))
"\""
(zero-or-more (not (any "\n\":"))))
(zero-or-more (not (any "\n\":")))))
(group (zero-or-more (not (any "\n")))) "\n"
(63 (group (*\? (not (any ""))) "\n"))
(zero-or-more (any " "))
"#+end_src")
t))
(defmacro org-ql--from-to-on ()
"For internal use.
Expands into a form that processes arguments to timestamp-related
@ -1102,6 +1132,30 @@ priority B)."
;; Check that PROPERTY has VALUE
(string-equal value (org-entry-get (point) property 'selective)))))))
(org-ql--defpred src (&optional lang &rest regexps)
"Return non-nil if current entry contains an Org source block matching all of REGEXPS.
If LANG is non-nil, the block must be in that language."
(catch 'return
(save-excursion
(save-match-data
(when (re-search-forward org-babel-src-block-regexp (org-entry-end-position) t)
(when lang
(unless (string= lang (match-string 2))
(throw 'return nil)))
(if regexps
(let ((contents-beg (progn
(goto-char (match-beginning 0))
(forward-line 1)
(point)))
(contents-end (progn
(goto-char (match-end 0))
(point-at-bol))))
(cl-loop for re in regexps
do (goto-char contents-beg)
always (re-search-forward re contents-end t)))
;; No regexps to check: return non-nil.
t))))))
;;;;;; Timestamps
;; TODO: Remove the _on vars from these arg lists. I think they're not

View file

@ -410,6 +410,10 @@ Arguments are listed next to predicate names, where applicable.
Return non-nil if current entry matches all of REGEXPS (regexp
strings). Matches against entire entry, from beginning of its
heading to the next heading.
src (&optional lang regexps)
Return non-nil if current entry contains an Org Babel source block.
If LANG is non-nil, match blocks of that language. If REGEXPS
is non-nil, require that blocks contents match all regexps.
tags (&optional tags)
Return non-nil if current heading has one or more of TAGS (a list
of strings). Tests both inherited and local tags.
@ -700,6 +704,7 @@ File: README.info, Node: 04-pre, Next: 03, Up: Changelog
for custom Helm commands that search certain files.
• Command helm-org-ql-views, which shows one of org-ql-views
selected with Helm.
• Predicate src, which matches Org Babel source blocks.
*Internal*
• Added generic node data cache to speed up recursive, tree-based
@ -963,22 +968,22 @@ Node: org-ql-sparse-tree6921
Node: Queries7721
Node: Non-sexp query syntax8563
Node: Predicates10063
Node: Date/time predicates14920
Node: Functions / Macros17555
Node: Agenda-like views17742
Node: Listing / acting-on results19147
Node: Changelog23749
Node: 04-pre24256
Node: 0325132
Node: 02328108
Node: 02228334
Node: 02128600
Node: 0228797
Node: 0132830
Node: Notes32929
Node: Comparison with Org Agenda searches33091
Node: org-sidebar33962
Node: License34241
Node: Date/time predicates15182
Node: Functions / Macros17817
Node: Agenda-like views18004
Node: Listing / acting-on results19409
Node: Changelog24011
Node: 04-pre24518
Node: 0325461
Node: 02328437
Node: 02228663
Node: 02128929
Node: 0229126
Node: 0133159
Node: Notes33258
Node: Comparison with Org Agenda searches33420
Node: org-sidebar34291
Node: License34570

End Tag Table

View file

@ -656,6 +656,9 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((scheduled :to today))
'("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")))))
;; TODO: Test (src) predicate. That will require modifying test data, which will be a
;; significant hassle. Manual testing shows that the predicate appears to work properly.
(describe "(todo)"
(org-ql-it "without arguments"