Add: src predicate

Author: alphapapa

README.org

@@ -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.

org-ql.el

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

org-ql.info

@@ -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 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.
@@ -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
 

tests/test-org-ql.el

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