From ecde3a0420c305bb971ad3ae7f7ab39c33370d00 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 9 Dec 2022 19:38:34 -0600 Subject: [PATCH] Change/Fix: (src) Normalization, case-insensitivity --- README.org | 6 ++- org-ql.el | 50 ++++++++++++++++++---- org-ql.info | 98 +++++++++++++++++++++++--------------------- tests/test-org-ql.el | 20 ++++----- 4 files changed, 108 insertions(+), 66 deletions(-) diff --git a/README.org b/README.org index 4680d74..aa0fa6f 100644 --- a/README.org +++ b/README.org @@ -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. - 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~. -+ ~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-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~. @@ -554,6 +554,10 @@ Simple links may also be written manually in either sexp or non-sexp form, like: *Changed* + 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* + Certain query predicates, when called multiple times in an ~and~ sub-expression, are optimized to a single call. diff --git a/org-ql.el b/org-ql.el index a36250f..5020d4c 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1813,7 +1813,7 @@ interpreted as nil or non-nil)." (org-ql-defpred src (&key regexps lang) "Return non-nil if current entry contains an Org source block matching all of REGEXPS. If keyword argument LANG is non-nil, the block must be in that -language." +language. Matching is done case-insensitively." :coalesce (lambda (coalesced-args current-args) (when (or (not coalesced-args) (equal (plist-get current-args :lang) @@ -1821,13 +1821,28 @@ language." (setf coalesced-args (plist-put coalesced-args :lang (plist-get current-args :lang))) (setf coalesced-args - (plist-put coalesced-args :regexps (append (plist-get coalesced-args :regexps) - (plist-get current-args :regexps)))))) - :normalizers ((`(,predicate-names . ,args) + (plist-put coalesced-args + :regexps (list 'quote + (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. (cond ((cl-every #'stringp args) ;; No keywords, only regexps. - `(src :regexps ,args)) + `(src :regexps ',args)) ((and (stringp (car args)) (cl-some #'keywordp args)) ;; Regexp as first arg with keyword later. (let* ((keyword-pos (cl-position :lang args)) @@ -1835,16 +1850,33 @@ language." ;; We assume that if :lang is given, the string argument follows. (lang (nth (1+ (cl-position :lang args)) args))) `(src :lang ,lang - :regexps ,regexps))) + :regexps ',regexps))) ((keywordp (car args)) ;; All plist args. `(src ,@(delq nil (append (when (plist-get args :lang) (list :lang (plist-get args :lang))) - (when (plist-get args :regexps) - (list :regexps (plist-get args :regexps)))))))))) - :preambles ((`(,predicate-names . ,args) + (pcase (plist-get args :regexps) + (`(quote . ,_) + ;; 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)) + :case-fold t ;; Always check contents with predicate. :query query))) :body diff --git a/org-ql.info b/org-ql.info index 8d20584..811d918 100644 --- a/org-ql.info +++ b/org-ql.info @@ -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. 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. @@ -1044,6 +1045,11 @@ File: README.info, Node: 07-pre, Next: 063, Up: Changelog *Changed* • 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* • Certain query predicates, when called multiple times in an ‘and’ @@ -1695,52 +1701,52 @@ Node: org-ql-sparse-tree8594 Node: Queries9394 Node: Non-sexp query syntax10511 Node: General predicates12270 -Node: Ancestor/descendant predicates19100 -Node: Date/time predicates20228 -Node: Functions / Macros23352 -Node: Agenda-like views23650 -Ref: Function ‘org-ql-block’23812 -Node: Listing / acting-on results25073 -Ref: Caching25281 -Ref: Function ‘org-ql-select’26194 -Ref: Function ‘org-ql-query’28620 -Ref: Macro ‘org-ql’ (deprecated)30394 -Node: Custom predicates30709 -Ref: Macro ‘org-ql-defpred’30933 -Node: Dynamic block34374 -Node: Links37098 -Node: Tips37785 -Node: Changelog38109 -Node: 07-pre38892 -Node: 06340702 -Node: 06241237 -Node: 06141542 -Node: 0642110 -Node: 05245164 -Node: 05145464 -Node: 0545887 -Node: 04947416 -Node: 04847696 -Node: 04748045 -Node: 04648454 -Node: 04548862 -Node: 04449223 -Node: 04349582 -Node: 04249785 -Node: 04149946 -Node: 0450193 -Node: 03254294 -Node: 03154697 -Node: 0354894 -Node: 02358194 -Node: 02258428 -Node: 02158708 -Node: 0258913 -Node: 0162991 -Node: Notes63092 -Node: Comparison with Org Agenda searches63254 -Node: org-sidebar64143 -Node: License64422 +Node: Ancestor/descendant predicates19142 +Node: Date/time predicates20270 +Node: Functions / Macros23394 +Node: Agenda-like views23692 +Ref: Function ‘org-ql-block’23854 +Node: Listing / acting-on results25115 +Ref: Caching25323 +Ref: Function ‘org-ql-select’26236 +Ref: Function ‘org-ql-query’28662 +Ref: Macro ‘org-ql’ (deprecated)30436 +Node: Custom predicates30751 +Ref: Macro ‘org-ql-defpred’30975 +Node: Dynamic block34416 +Node: Links37140 +Node: Tips37827 +Node: Changelog38151 +Node: 07-pre38934 +Node: 06340948 +Node: 06241483 +Node: 06141788 +Node: 0642356 +Node: 05245410 +Node: 05145710 +Node: 0546133 +Node: 04947662 +Node: 04847942 +Node: 04748291 +Node: 04648700 +Node: 04549108 +Node: 04449469 +Node: 04349828 +Node: 04250031 +Node: 04150192 +Node: 0450439 +Node: 03254540 +Node: 03154943 +Node: 0355140 +Node: 02358440 +Node: 02258674 +Node: 02158954 +Node: 0259159 +Node: 0163237 +Node: Notes63338 +Node: Comparison with Org Agenda searches63500 +Node: org-sidebar64389 +Node: License64668  End Tag Table diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 41ba1f6..25ac617 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -231,17 +231,17 @@ with keyword arg NOW in PLIST." :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" (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"))) - :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" (expect (org-ql--normalize-query '(and (src "foo" :lang "elisp") (src "bar"))) ;; NOTE: The current implementation of `org-ql--normalize-query' ;; reorders clauses in this case. Fixing that would probably ;; 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"))) - :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" @@ -317,21 +317,21 @@ with keyword arg NOW in PLIST." (describe "(src)" (it "normalizes a non-keyword arg to keywords" (expect (org-ql--normalize-query '(src "foo")) - :to-equal '(src :regexps ("foo")))) + :to-equal '(src :regexps '("foo")))) (it "normalizes non-keyword args to keywords" (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" (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" (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" (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)) - :to-equal '(src :regexps ("foo"))))) + :to-equal '(src :regexps '("foo"))))) (describe "(tags-inherited)" (it "handles 0 arguments"