Change/Fix: (src) Normalization, case-insensitivity

This commit is contained in:
Adam Porter 2022-12-09 19:38:34 -06:00
parent 6e3a5eebe7
commit ecde3a0420
4 changed files with 108 additions and 66 deletions

View file

@ -243,7 +243,7 @@ Arguments are listed next to predicate names, where applicable.
+ =rifle (&rest strings)= :: Return non-nil if each string is found in either the entry or its outline path. Works like =org-rifle=. This is probably the most useful, intuitive, general-purpose predicate. + =rifle (&rest strings)= :: Return non-nil if each string is found in either the entry or its outline path. Works like =org-rifle=. This is probably the most useful, intuitive, general-purpose predicate.
- Aliases: ~smart~. - Aliases: ~smart~.
- *Note:* By default, this is the default predicate used for plain-string query tokens (i.e. given without a specified predicate). This can be customized with the option ~org-ql-default-predicate~. - *Note:* By default, this is the default predicate used for plain-string query tokens (i.e. given without a specified predicate). This can be customized with the option ~org-ql-default-predicate~.
+ ~src (&key lang regexps)~ :: Return non-nil if current entry contains an Org Babel source block. If ~LANG~ is non-nil, match blocks of that language. If ~REGEXPS~ is non-nil, require that block's contents match all regexps. + ~src (&key lang regexps)~ :: Return non-nil if current entry contains an Org Babel source block. If ~LANG~ is non-nil, match blocks of that language. If ~REGEXPS~ is non-nil, require that block's contents match all regexps. Matching is done case-insensitively.
+ =tags (&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~.
@ -554,6 +554,10 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
*Changed* *Changed*
+ Give more useful error message for invalid queries. + Give more useful error message for invalid queries.
+ Predicate ~src~ now matches case-insensitively.
*Fixed*
+ Predicate ~src~'s matching of begin/end block lines, normalization of arguments, and handling in non-sexp queries.
*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.

View file

@ -1813,7 +1813,7 @@ interpreted as nil or non-nil)."
(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 contains an Org source block matching all of 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." language. Matching is done case-insensitively."
:coalesce (lambda (coalesced-args current-args) :coalesce (lambda (coalesced-args current-args)
(when (or (not coalesced-args) (when (or (not coalesced-args)
(equal (plist-get current-args :lang) (equal (plist-get current-args :lang)
@ -1821,13 +1821,28 @@ language."
(setf coalesced-args (setf coalesced-args
(plist-put coalesced-args :lang (plist-get current-args :lang))) (plist-put coalesced-args :lang (plist-get current-args :lang)))
(setf coalesced-args (setf coalesced-args
(plist-put coalesced-args :regexps (append (plist-get coalesced-args :regexps) (plist-put coalesced-args
(plist-get current-args :regexps)))))) :regexps (list 'quote
:normalizers ((`(,predicate-names . ,args) (append (car (delq 'quote (plist-get coalesced-args :regexps)))
;; A bit awkward, but necessary.
(car (delq 'quote (plist-get current-args :regexps)))))))))
:normalizers ((`(,predicate-names)
;; This clause protects against the case in which the
;; arguments are nil, which would cause an error in
;; `rx-to-string' in other clauses. This can happen
;; with `org-ql-completing-read', e.g. when the input
;; is "src:" while the user is typing.
(list 'src))
;; NOTE: The :regexps argument is a quoted list,
;; because we call the byte-compiler at runtime, and
;; without quoting, it would interpret it as a
;; function call. This requires some awkwardness in
;; other places to deal with the quoting.
(`(,predicate-names . ,args)
;; Rewrite to use keyword args. ;; Rewrite to use keyword args.
(cond ((cl-every #'stringp args) (cond ((cl-every #'stringp args)
;; No keywords, only regexps. ;; No keywords, only regexps.
`(src :regexps ,args)) `(src :regexps ',args))
((and (stringp (car args)) (cl-some #'keywordp args)) ((and (stringp (car args)) (cl-some #'keywordp args))
;; Regexp as first arg with keyword later. ;; Regexp as first arg with keyword later.
(let* ((keyword-pos (cl-position :lang args)) (let* ((keyword-pos (cl-position :lang args))
@ -1835,16 +1850,33 @@ language."
;; We assume that if :lang is given, the string argument follows. ;; We assume that if :lang is given, the string argument follows.
(lang (nth (1+ (cl-position :lang args)) args))) (lang (nth (1+ (cl-position :lang args)) args)))
`(src :lang ,lang `(src :lang ,lang
:regexps ,regexps))) :regexps ',regexps)))
((keywordp (car args)) ((keywordp (car args))
;; All plist args. ;; All plist args.
`(src ,@(delq nil `(src ,@(delq nil
(append (when (plist-get args :lang) (append (when (plist-get args :lang)
(list :lang (plist-get args :lang))) (list :lang (plist-get args :lang)))
(when (plist-get args :regexps) (pcase (plist-get args :regexps)
(list :regexps (plist-get args :regexps)))))))))) (`(quote . ,_)
:preambles ((`(,predicate-names . ,args) ;; Already quoted: return as-is to stop further normalization.
(list :regexps (plist-get args :regexps)))
(_ (list :regexps `(quote ,(plist-get args :regexps))))))))))))
;; NOTE: We match case-insensitively since the
;; "#+BEGIN_SRC/#+END_SRC" lines could be either upper- or
;; lowercase, as well as the language name.
:preambles ((`(,predicate-names)
;; This clause protects against the case in which the
;; arguments are nil, which would cause an error in
;; `rx-to-string' in other clauses. This can happen
;; with `org-ql-completing-read', e.g. when the input
;; is "src:" while the user is typing.
(list :regexp (org-ql--format-src-block-regexp)
:case-fold t
;; Always check contents with predicate.
:query query))
(`(,predicate-names . ,args)
(list :regexp (org-ql--format-src-block-regexp (plist-get args :lang)) (list :regexp (org-ql--format-src-block-regexp (plist-get args :lang))
:case-fold t
;; Always check contents with predicate. ;; Always check contents with predicate.
:query query))) :query query)))
:body :body

View file

@ -502,6 +502,7 @@ Arguments are listed next to predicate names, where applicable.
Return non-nil if current entry contains an Org Babel source block. Return non-nil if current entry contains an Org Babel source block.
If LANG is non-nil, match blocks of that language. If REGEXPS If LANG is non-nil, match blocks of that language. If REGEXPS
is non-nil, require that blocks contents match all regexps. is non-nil, require that blocks contents match all regexps.
Matching is done case-insensitively.
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.
@ -1044,6 +1045,11 @@ File: README.info, Node: 07-pre, Next: 063, Up: Changelog
*Changed* *Changed*
• Give more useful error message for invalid queries. • Give more useful error message for invalid queries.
• Predicate src now matches case-insensitively.
*Fixed*
• Predicate srcs matching of begin/end block lines, normalization
of arguments, and handling in non-sexp queries.
*Internal* *Internal*
• Certain query predicates, when called multiple times in an and • Certain query predicates, when called multiple times in an and
@ -1695,52 +1701,52 @@ Node: org-ql-sparse-tree8594
Node: Queries9394 Node: Queries9394
Node: Non-sexp query syntax10511 Node: Non-sexp query syntax10511
Node: General predicates12270 Node: General predicates12270
Node: Ancestor/descendant predicates19100 Node: Ancestor/descendant predicates19142
Node: Date/time predicates20228 Node: Date/time predicates20270
Node: Functions / Macros23352 Node: Functions / Macros23394
Node: Agenda-like views23650 Node: Agenda-like views23692
Ref: Function org-ql-block23812 Ref: Function org-ql-block23854
Node: Listing / acting-on results25073 Node: Listing / acting-on results25115
Ref: Caching25281 Ref: Caching25323
Ref: Function org-ql-select26194 Ref: Function org-ql-select26236
Ref: Function org-ql-query28620 Ref: Function org-ql-query28662
Ref: Macro org-ql (deprecated)30394 Ref: Macro org-ql (deprecated)30436
Node: Custom predicates30709 Node: Custom predicates30751
Ref: Macro org-ql-defpred30933 Ref: Macro org-ql-defpred30975
Node: Dynamic block34374 Node: Dynamic block34416
Node: Links37098 Node: Links37140
Node: Tips37785 Node: Tips37827
Node: Changelog38109 Node: Changelog38151
Node: 07-pre38892 Node: 07-pre38934
Node: 06340702 Node: 06340948
Node: 06241237 Node: 06241483
Node: 06141542 Node: 06141788
Node: 0642110 Node: 0642356
Node: 05245164 Node: 05245410
Node: 05145464 Node: 05145710
Node: 0545887 Node: 0546133
Node: 04947416 Node: 04947662
Node: 04847696 Node: 04847942
Node: 04748045 Node: 04748291
Node: 04648454 Node: 04648700
Node: 04548862 Node: 04549108
Node: 04449223 Node: 04449469
Node: 04349582 Node: 04349828
Node: 04249785 Node: 04250031
Node: 04149946 Node: 04150192
Node: 0450193 Node: 0450439
Node: 03254294 Node: 03254540
Node: 03154697 Node: 03154943
Node: 0354894 Node: 0355140
Node: 02358194 Node: 02358440
Node: 02258428 Node: 02258674
Node: 02158708 Node: 02158954
Node: 0258913 Node: 0259159
Node: 0162991 Node: 0163237
Node: Notes63092 Node: Notes63338
Node: Comparison with Org Agenda searches63254 Node: Comparison with Org Agenda searches63500
Node: org-sidebar64143 Node: org-sidebar64389
Node: License64422 Node: License64668
 
End Tag Table End Tag Table

View file

@ -231,17 +231,17 @@ with keyword arg NOW in PLIST."
:to-equal '(or (and (rifle :regexps '("foo" "bar"))) (and (rifle :regexps '("baz" "buz")))))) :to-equal '(or (and (rifle :regexps '("foo" "bar"))) (and (rifle :regexps '("baz" "buz"))))))
(it "coalesces arguments to predicates which use coalescing functions and whose calls are eligible for coalescing" (it "coalesces arguments to predicates which use coalescing functions and whose calls are eligible for coalescing"
(expect (org-ql--normalize-query '(and (src "foo") (src "bar"))) (expect (org-ql--normalize-query '(and (src "foo") (src "bar")))
:to-equal '(and (src :lang nil :regexps ("foo" "bar")))) :to-equal '(and (src :lang nil :regexps '("foo" "bar"))))
(expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar" :lang "elisp"))) (expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar" :lang "elisp")))
:to-equal '(and (src :lang "elisp" :regexps ("foo" "bar"))))) :to-equal '(and (src :lang "elisp" :regexps '("foo" "bar")))))
(it "does not coalesce arguments to predicates which use coalescing functions and whose calls are ineligible for coalescing" (it "does not coalesce arguments to predicates which use coalescing functions and whose calls are ineligible for coalescing"
(expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar"))) (expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar")))
;; NOTE: The current implementation of `org-ql--normalize-query' ;; NOTE: The current implementation of `org-ql--normalize-query'
;; reorders clauses in this case. Fixing that would probably ;; reorders clauses in this case. Fixing that would probably
;; not be worth the effort in code or runtime. ;; not be worth the effort in code or runtime.
:to-equal '(and (src :regexps ("bar")) (src :lang "elisp" :regexps ("foo")))) :to-equal '(and (src :regexps '("bar")) (src :lang "elisp" :regexps '("foo"))))
(expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar" :lang "python"))) (expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar" :lang "python")))
:to-equal '(and (src :lang "python" :regexps ("bar")) (src :lang "elisp" :regexps ("foo")))))) :to-equal '(and (src :lang "python" :regexps '("bar")) (src :lang "elisp" :regexps '("foo"))))))
(describe "Normalization" (describe "Normalization"
@ -317,21 +317,21 @@ with keyword arg NOW in PLIST."
(describe "(src)" (describe "(src)"
(it "normalizes a non-keyword arg to keywords" (it "normalizes a non-keyword arg to keywords"
(expect (org-ql--normalize-query '(src "foo")) (expect (org-ql--normalize-query '(src "foo"))
:to-equal '(src :regexps ("foo")))) :to-equal '(src :regexps '("foo"))))
(it "normalizes non-keyword args to keywords" (it "normalizes non-keyword args to keywords"
(expect (org-ql--normalize-query '(src "foo" "bar")) (expect (org-ql--normalize-query '(src "foo" "bar"))
:to-equal '(src :regexps ("foo" "bar")))) :to-equal '(src :regexps '("foo" "bar"))))
(it "normalizes a non-keyword arg with a :lang keyword arg to keywords" (it "normalizes a non-keyword arg with a :lang keyword arg to keywords"
(expect (org-ql--normalize-query '(src "foo" :lang "bar")) (expect (org-ql--normalize-query '(src "foo" :lang "bar"))
:to-equal '(src :lang "bar" :regexps ("foo")))) :to-equal '(src :lang "bar" :regexps '("foo"))))
(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 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")))))
(describe "(tags-inherited)" (describe "(tags-inherited)"
(it "handles 0 arguments" (it "handles 0 arguments"