jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

50
org-ql.el
View file

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