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

Revert "Use human-readable recursive function name for normalizers and preambles"

Browse source 
This reverts commit b4ff5cc423.
This commit is contained in:
Ihor Radchenko 2021-08-14 13:24:28 +08:00
parent 567c4c4e42
commit 41821ccc76
No known key found for this signature in database
GPG key ID: 6470762A7DA11D8B
1 changed files with 21 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

57
org-ql.el
View file

@ -951,7 +951,7 @@ PREDICATES should be the value of `org-ql-predicates'."
This function is defined by calling This function is defined by calling
`org-ql--define-normalize-query-fn', which uses normalizer forms `org-ql--define-normalize-query-fn', which uses normalizer forms
defined in `org-ql-predicates' by calling `org-ql-defpred'." defined in `org-ql-predicates' by calling `org-ql-defpred'."
(cl-labels ((org-ql-normalize-query (element) (cl-labels ((rec (element)
(pcase element (pcase element
((pred stringp) `(regexp ,element)) ((pred stringp) `(regexp ,element))
,@normalizer-patterns ,@normalizer-patterns
@ -959,7 +959,7 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'."
(_ element)))) (_ element))))
;; Repeat normalization until result doesn't change (limiting to 10 in case of an infinite-loop bug). ;; Repeat normalization until result doesn't change (limiting to 10 in case of an infinite-loop bug).
(cl-loop with limit = 10 and count = 0 (cl-loop with limit = 10 and count = 0
for new-query = (org-ql-normalize-query query) for new-query = (rec query)
until (equal new-query query) until (equal new-query query)
do (progn do (progn
(setf query new-query) (setf query new-query)
@ -1001,11 +1001,11 @@ This function is defined by calling
defined in `org-ql-predicates' by calling `org-ql-defpred'." defined in `org-ql-predicates' by calling `org-ql-defpred'."
(pcase org-ql-use-preamble (pcase org-ql-use-preamble
('nil (list :query query :preamble nil)) ('nil (list :query query :preamble nil))
(_ (cl-labels ((org-ql-query-preamble (element) (_ (cl-labels ((rec (element)
(pcase element (pcase element
,@preamble-patterns ,@preamble-patterns
(_ (list :query element))))) (_ (list :query element)))))
(-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble query))) (-let* (((&plist :regexp :case-fold :query) (funcall #'rec query)))
(setq query (pcase query (setq query (pcase query
((or `nil ((or `nil
`(nil) `(nil)
@ -1090,28 +1090,7 @@ Then if NORMALIZERS were:
It would be expanded to: It would be expanded to:
((`(,(or 'heading 'h) . ,args) ((`(,(or 'heading 'h) . ,args)
`(heading ,@args))) `(heading ,@args)))"
Also, `org-ql-normalize-query' and `org-ql-query-preamble' are defined
locally inside (respectively) normalizer and preamble forms. They can
be used to perform normalization or generate preambles recursively.
Example:
The following naive definition will not normalize QUERIES passed to
the predicate.
(org-ql-defpred myxor (&rest _)
\"Apply boolean xor operation.\"
:normalizers ((`(,predicate-names . ,queries)
`(xor ,@queries))))
More optimal definition would be:
(org-ql-defpred myxor (&rest _)
\"Apply boolean xor operation.\"
:normalizers ((`(,predicate-names . ,queries)
`(xor ,@(mapcar #'org-ql-normalize-query queiries)))))"
;; NOTE: The debug form works, completely! For example, use `edebug-defun' ;; NOTE: The debug form works, completely! For example, use `edebug-defun'
;; on the `heading' predicate, then evaluate this form: ;; on the `heading' predicate, then evaluate this form:
;; (let* ((query '(heading "HEADING")) ;; (let* ((query '(heading "HEADING"))
@ -1238,9 +1217,9 @@ result form."
:normalizers ((`(and) :normalizers ((`(and)
nil) nil)
(`(and . ,clauses) (`(and . ,clauses)
`(and ,@(mapcar #'org-ql-normalize-query clauses)))) `(and ,@(mapcar #'rec clauses))))
:preambles ((`(and . ,clauses) :preambles ((`(and . ,clauses)
(let ((preambles (mapcar #'org-ql-query-preamble clauses)) (let ((preambles (mapcar #'rec clauses))
regexps regexp-max case-fold-max queries) regexps regexp-max case-fold-max queries)
(cl-loop for preamble in preambles (cl-loop for preamble in preambles
for clause in clauses for clause in clauses
@ -1265,9 +1244,9 @@ result form."
:normalizers ((`(or) :normalizers ((`(or)
nil) nil)
(`(or . ,clauses) (`(or . ,clauses)
`(or ,@(mapcar #'org-ql-normalize-query clauses)))) `(or ,@(mapcar #'rec clauses))))
:preambles ((`(or . ,clauses) :preambles ((`(or . ,clauses)
(let ((preambles (mapcar #'org-ql-query-preamble clauses)) (let ((preambles (mapcar #'rec clauses))
regexps regexp-null-p queries) regexps regexp-null-p queries)
(cl-loop for preamble in preambles (cl-loop for preamble in preambles
for clause in clauses for clause in clauses
@ -1292,11 +1271,11 @@ result form."
"Normalizers and preambles for (when ...) query." "Normalizers and preambles for (when ...) query."
:normalizers :normalizers
((`(when ,condition . ,clauses) ((`(when ,condition . ,clauses)
`(when ,(org-ql-normalize-query condition) `(when ,(rec condition)
,@(mapcar #'org-ql-normalize-query clauses)))) ,@(mapcar #'rec clauses))))
:preambles :preambles
((`(when ,condition . ,clauses) ((`(when ,condition . ,clauses)
(-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble `(and ,condition ,(car (last clauses)))))) (-let* (((&plist :regexp :case-fold :query) (rec `(and ,condition ,(car (last clauses))))))
(list :regexp regexp (list :regexp regexp
:case-fold case-fold :case-fold case-fold
:query `(when ,condition ,@clauses)))))) :query `(when ,condition ,@clauses))))))
@ -1305,11 +1284,11 @@ result form."
"Normalizers and preambles for (unless ...) query." "Normalizers and preambles for (unless ...) query."
:normalizers :normalizers
((`(unless ,condition . ,clauses) ((`(unless ,condition . ,clauses)
`(unless ,(org-ql-normalize-query condition) `(unless (save-excursion ,(rec condition))
,@(mapcar #'org-ql-normalize-query clauses)))) ,@(mapcar #'rec clauses))))
:preambles :preambles
((`(unless ,condition . ,clauses) ((`(unless ,condition . ,clauses)
(-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble (car (last clauses))))) (-let* (((&plist :regexp :case-fold :query) (rec ,(car (last clauses)))))
(list :regexp regexp (list :regexp regexp
:case-fold case-fold :case-fold case-fold
:query `(unless ,condition ,@clauses)))))) :query `(unless ,condition ,@clauses))))))
@ -1318,7 +1297,7 @@ result form."
"Normalizers and preambles for (not ...) query." "Normalizers and preambles for (not ...) query."
:normalizers :normalizers
((`(not . ,clauses) ((`(not . ,clauses)
`(not ,@(mapcar #'org-ql-normalize-query clauses))))) `(save-excursion (not ,@(mapcar #'rec clauses))))))
(org-ql-defpred category (&rest categories) (org-ql-defpred category (&rest categories)
"Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)." "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)."
@ -1927,7 +1906,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin
:normalizers ((`(,predicate-names :normalizers ((`(,predicate-names
;; Avoid infinitely compiling already-compiled functions. ;; Avoid infinitely compiling already-compiled functions.
,(and query (guard (not (byte-code-function-p query))))) ,(and query (guard (not (byte-code-function-p query)))))
`(ancestors ,(org-ql--query-predicate (org-ql-normalize-query query)))) `(ancestors ,(org-ql--query-predicate (rec query))))
(`(,predicate-names) '(ancestors (lambda () t)))) (`(,predicate-names) '(ancestors (lambda () t))))
:body :body
(org-with-wide-buffer (org-with-wide-buffer
@ -1939,7 +1918,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin
:normalizers ((`(,predicate-names :normalizers ((`(,predicate-names
;; Avoid infinitely compiling already-compiled functions. ;; Avoid infinitely compiling already-compiled functions.
,(and query (guard (not (byte-code-function-p query))))) ,(and query (guard (not (byte-code-function-p query)))))
`(parent ,(org-ql--query-predicate (org-ql-normalize-query query)))) `(parent ,(org-ql--query-predicate (rec query))))
(`(,predicate-names) '(parent (lambda () t)))) (`(,predicate-names) '(parent (lambda () t))))
:body :body
(org-with-wide-buffer (org-with-wide-buffer