Fix: (src) Rewrite body

Fixes #304.  Thanks to @johanwk for reporting.
This commit is contained in:
Adam Porter 2023-03-09 01:41:01 -06:00
parent 0304a2c9dc
commit 1996969920
2 changed files with 17 additions and 20 deletions

View file

@ -558,6 +558,7 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
*Fixed* *Fixed*
+ Predicate ~src~'s matching of begin/end block lines, normalization of arguments, and handling in non-sexp queries. + Predicate ~src~'s matching of begin/end block lines, normalization of arguments, and handling in non-sexp queries.
+ Predicate ~src~'s behavior with various arguments.
*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

@ -1925,26 +1925,22 @@ language. Matching is done case-insensitively."
;; Always check contents with predicate. ;; Always check contents with predicate.
:query query))) :query query)))
:body :body
(catch 'return (save-excursion
(save-excursion (save-match-data
(save-match-data (cl-loop while (re-search-forward org-babel-src-block-regexp (org-entry-end-position) t)
(when (re-search-forward org-babel-src-block-regexp (org-entry-end-position) t) thereis (when (or (not lang) (equal lang (match-string 2)))
(when lang (or (not regexps)
(unless (string= lang (match-string 2)) (save-excursion
(throw 'return nil))) (let ((contents-beg (progn
(if regexps (goto-char (match-beginning 0))
(let ((contents-beg (progn (forward-line 1)
(goto-char (match-beginning 0)) (point)))
(forward-line 1) (contents-end (progn
(point))) (goto-char (match-end 0))
(contents-end (progn (point-at-bol))))
(goto-char (match-end 0)) (cl-loop for re in regexps
(point-at-bol)))) do (goto-char contents-beg)
(cl-loop for re in regexps always (re-search-forward re contents-end t))))))))))
do (goto-char contents-beg)
always (re-search-forward re contents-end t)))
;; No regexps to check: return non-nil.
t))))))
(org-ql-defpred (tags) (&rest tags) (org-ql-defpred (tags) (&rest tags)
"Return non-nil if current heading has one or more of TAGS (a list of strings). "Return non-nil if current heading has one or more of TAGS (a list of strings).