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

2022-12-09 19:38:34 -06:00 · 2022-12-09 19:38:34 -06:00 · ecde3a0420
commit ecde3a0420
parent 6e3a5eebe7
4 changed files with 108 additions and 66 deletions
--- 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.
--- 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
--- 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

--- 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"