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. + =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)~. + =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. + =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 (&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. + =tags-inherited (&optional tags)= :: Return non-nil if current heading's inherited tags include one or more of ~TAGS~ (a list of strings). If ~TAGS~ is nil, return non-nil if heading has any inherited tags.
- Aliases: ~inherited-tags~, ~tags-i~, ~itags~. - Aliases: ~inherited-tags~, ~tags-i~, ~itags~.
@ -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. + 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. + 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. + Command ~helm-org-ql-views~, which shows one of ~org-ql-views~ selected with Helm.
+ Predicate ~src~, which matches Org Babel source blocks.
*Internal* *Internal*
+ Added generic node data cache to speed up recursive, tree-based queries. + 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 ":"))) ":" ;; (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":" (1+ (not (or space ":"))) ":"
;; (1+ space) (minimal-match (1+ not-newline)) eol))) ;; (1+ space) (minimal-match (1+ not-newline)) eol)))
;; element) ;; element)
;; Src blocks.
(`(src ,lang . ,_)
(setq org-ql-preamble (org-ql--format-src-block-regexp lang))
;; Always check contents with predicate.
element)
(`(scheduled . ,_) (`(scheduled . ,_)
(setq org-ql-preamble org-scheduled-time-regexp) (setq org-ql-preamble org-scheduled-time-regexp)
;; Return element, because the predicate still needs testing. ;; Return element, because the predicate still needs testing.
@ -781,6 +788,29 @@ replace the clause with a preamble."
(query (-flatten-n 1 query)))) (query (-flatten-n 1 query))))
(list :query query :preamble org-ql-preamble :preamble-case-fold preamble-case-fold)))))) (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 () (defmacro org-ql--from-to-on ()
"For internal use. "For internal use.
Expands into a form that processes arguments to timestamp-related Expands into a form that processes arguments to timestamp-related
@ -1102,6 +1132,30 @@ priority B)."
;; Check that PROPERTY has VALUE ;; Check that PROPERTY has VALUE
(string-equal value (org-entry-get (point) property 'selective))))))) (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 ;;;;;; Timestamps
;; TODO: Remove the _on vars from these arg lists. I think they're not ;; 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 Return non-nil if current entry matches all of REGEXPS (regexp
strings). Matches against entire entry, from beginning of its strings). Matches against entire entry, from beginning of its
heading to the next heading. 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) tags (&optional tags)
Return non-nil if current heading has one or more of TAGS (a list Return non-nil if current heading has one or more of TAGS (a list
of strings). Tests both inherited and local tags. 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. for custom Helm commands that search certain files.
• Command helm-org-ql-views, which shows one of org-ql-views • Command helm-org-ql-views, which shows one of org-ql-views
selected with Helm. selected with Helm.
• Predicate src, which matches Org Babel source blocks.
*Internal* *Internal*
• Added generic node data cache to speed up recursive, tree-based • Added generic node data cache to speed up recursive, tree-based
@ -963,22 +968,22 @@ Node: org-ql-sparse-tree6921
Node: Queries7721 Node: Queries7721
Node: Non-sexp query syntax8563 Node: Non-sexp query syntax8563
Node: Predicates10063 Node: Predicates10063
Node: Date/time predicates14920 Node: Date/time predicates15182
Node: Functions / Macros17555 Node: Functions / Macros17817
Node: Agenda-like views17742 Node: Agenda-like views18004
Node: Listing / acting-on results19147 Node: Listing / acting-on results19409
Node: Changelog23749 Node: Changelog24011
Node: 04-pre24256 Node: 04-pre24518
Node: 0325132 Node: 0325461
Node: 02328108 Node: 02328437
Node: 02228334 Node: 02228663
Node: 02128600 Node: 02128929
Node: 0228797 Node: 0229126
Node: 0132830 Node: 0133159
Node: Notes32929 Node: Notes33258
Node: Comparison with Org Agenda searches33091 Node: Comparison with Org Agenda searches33420
Node: org-sidebar33962 Node: org-sidebar34291
Node: License34241 Node: License34570
 
End Tag Table 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)) (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"))))) '("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)" (describe "(todo)"
(org-ql-it "without arguments" (org-ql-it "without arguments"