From 1b794a5083ec60f6496a44d6993b8d075336a525 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Mon, 5 Apr 2021 14:13:22 +0800 Subject: [PATCH 01/16] Implement boolean preambles --- org-ql.el | 120 ++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 84 insertions(+), 36 deletions(-) diff --git a/org-ql.el b/org-ql.el index ac2e5418..d9c15a56 100644 --- a/org-ql.el +++ b/org-ql.el @@ -515,7 +515,8 @@ If NARROW is non-nil, buffer will not be widened." (unless narrow (widen)) (goto-char (point-min)) - (when (org-before-first-heading-p) + (when (and (org-before-first-heading-p) + (not (org-at-heading-p))) (outline-next-heading)) (if (not (org-at-heading-p)) (progn @@ -951,18 +952,8 @@ This function is defined by calling defined in `org-ql-predicates' by calling `org-ql-defpred'." (cl-labels ((rec (element) (pcase element - (`(or . ,clauses) `(or ,@(mapcar #'rec clauses))) - (`(and . ,clauses) `(and ,@(mapcar #'rec clauses))) - (`(not . ,clauses) `(not ,@(mapcar #'rec clauses))) - (`(when ,condition . ,clauses) `(when ,(rec condition) - ,@(mapcar #'rec clauses))) - (`(unless ,condition . ,clauses) `(unless ,(rec condition) - ,@(mapcar #'rec clauses))) - ;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND). ((pred stringp) `(regexp ,element)) - ,@normalizer-patterns - ;; Any other form: passed through unchanged. (_ element)))) ;; Repeat normalization until result doesn't change (limiting to 10 in case of an infinite-loop bug). @@ -984,12 +975,7 @@ PREDICATES should be the value of `org-ql-predicates'." ;; NOTE: Using -let instead of pcase-let here because I can't make map 2.1 install in the test sandbox. (--map (-let* (((&plist :preambles) (cdr it))) (--map (pcase-let* ((`(,pattern ,exp) it)) - `(,pattern - (-let* (((&plist :regexp :case-fold :query) ,exp)) - (setf org-ql-preamble regexp - preamble-case-fold case-fold) - ;; NOTE: Even when `predicate' is nil, it must be returned in the pcase form. - query))) + `(,pattern ,exp)) preambles)) predicates))))) (fset 'org-ql--query-preamble @@ -1014,30 +1000,21 @@ This function is defined by calling defined in `org-ql-predicates' by calling `org-ql-defpred'." (pcase org-ql-use-preamble ('nil (list :query query :preamble nil)) - (_ (let ((preamble-case-fold t) - org-ql-preamble) - (cl-labels ((rec (element) - (or (when org-ql-preamble - ;; Only one preamble is allowed - element) - (pcase element - (`(or _) element) - - ,@preamble-patterns - - (`(and . ,rest) - (let ((clauses (mapcar #'rec rest))) - `(and ,@(-non-nil clauses)))) - (_ element))))) - (setq query (pcase (mapcar #'rec (list query)) - ((or `(nil) + (_ (cl-labels ((rec (element) + (pcase element + ,@preamble-patterns + (_ (list :query element))))) + (-let* (((&plist :regexp :case-fold :query) (funcall #'rec query))) + (setq query (pcase query + ((or `nil + `(nil) `((nil)) `((and)) `((or))) t) (`(t) t) - (query (-flatten-n 1 query)))) - (list :query query :preamble org-ql-preamble :preamble-case-fold preamble-case-fold))))))) + (_ query))) + (list :query query :preamble regexp :preamble-case-fold case-fold))))))) ;; For some reason, byte-compiling the backquoted lambda form directly causes a warning ;; that `query' refers to an unbound variable, even though that's not the case, and the ;; function still works. But to avoid the warning, we byte-compile it afterward. @@ -1234,6 +1211,77 @@ result form." ;; redefinitions until all of the predicates have been defined. (setf org-ql-defpred-defer t) +(org-ql-defpred org-ql--and (&rest clauses) + "Return non-nil if all the clauses match." + :normalizers ((`(and) + nil) + (`(and . ,clauses) + `(and ,@(mapcar #'rec clauses)))) + :preambles ((`(and . ,clauses) + (let ((preambles (mapcar #'rec clauses)) + regexps regexp-max case-fold-max) + (dolist (preamble preambles) + (-let* (((&plist :regexp :case-fold :query) preamble)) + ;; Take the longest regexp. It should be hardest to match. + (when (length> regexp (length regexp-max)) + (setq regexp-max regexp) + (setq case-fold-max case-fold)))) + (list :regexp regexp-max + :case-fold case-fold-max + :query `(and ,@clauses)))))) + +(org-ql-defpred org-ql--or (&rest clauses) + "Return non-nil if any of the clauses match." + :normalizers ((`(or) + nil) + (`(or . ,clauses) + `(or ,@(mapcar #'rec clauses)))) + :preambles ((`(or . ,clauses) + (let ((preambles (mapcar #'rec clauses)) + regexps regexp-null-p) + (dolist (preamble preambles) + (-let* (((&plist :regexp :case-fold :query) preamble)) + ;; Collect regexps for combining. + (if regexp (push regexp regexps) + (setq regexp-null-p t)))) + (list :regexp (unless regexp-null-p + (and regexps + (rx-to-string `(or ,@(mapcar (lambda (re) `(regex ,re)) regexps))))) + :case-fold t + :query `(save-excursion (or ,@clauses))))))) + +(org-ql-defpred org-ql--when (condition &rest clauses) + "Return values of CLAUSES when CONDITION is non-nil." + :normalizers + ((`(when ,condition . ,clauses) + `(when ,(rec condition) + ,@(mapcar #'rec clauses)))) + :preambles + ((`(when ,condition . ,clauses) + (-let* (((&plist :regexp :case-fold :query) (rec `(and ,condition ,(last clauses))))) + (list :regexp regexp + :case-fold case-fold + :query `(when ,condition ,@clauses)))))) + +(org-ql-defpred org-ql--unless (condition &rest clauses) + "Return values of CLAUSES unless CONDITION is non-nil." + :normalizers + ((`(unless ,condition . ,clauses) + `(unless (save-excursion ,(rec condition)) + ,@(mapcar #'rec clauses)))) + :preambles + ((`(unless ,condition . ,clauses) + (-let* (((&plist :regexp :case-fold :query) (rec ,(last clauses)))) + (list :regexp regexp + :case-fold case-fold + :query `(unless ,condition ,@clauses)))))) + +(org-ql-defpred org-ql--not (clauses) + "Match when CLAUSES don't match." + :normalizers + ((`(not . ,clauses) + `(save-excursion (not ,@(mapcar #'rec clauses)))))) + (org-ql-defpred category (&rest categories) "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)." :body (when-let ((category (org-get-category (point)))) From e1a464fb2c7334bd49b28dcb63fb0f9b5c32a72b Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Mon, 5 Apr 2021 17:33:28 +0800 Subject: [PATCH 02/16] Update clauses in boolean preambles --- org-ql.el | 52 +++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 37 insertions(+), 15 deletions(-) diff --git a/org-ql.el b/org-ql.el index d9c15a56..f99e2607 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1219,16 +1219,26 @@ result form." `(and ,@(mapcar #'rec clauses)))) :preambles ((`(and . ,clauses) (let ((preambles (mapcar #'rec clauses)) - regexps regexp-max case-fold-max) - (dolist (preamble preambles) - (-let* (((&plist :regexp :case-fold :query) preamble)) - ;; Take the longest regexp. It should be hardest to match. - (when (length> regexp (length regexp-max)) - (setq regexp-max regexp) - (setq case-fold-max case-fold)))) + regexps regexp-max case-fold-max queries) + (cl-loop for preamble in preambles + for clause in clauses + do + (-let* (((&plist :regexp :case-fold :query) preamble)) + (if regexp + (cond + ((eq query t) (setq query `(regexp ,regexp))) + ((not query) (setq query `(regexp ,regexp))) + (t nil)) + (setq query clause)) + (push query queries) + ;; Take the longest regexp. It should be hardest to match. + (when (length> regexp (length regexp-max)) + (setq regexp-max regexp) + (setq case-fold-max case-fold)))) + (setq queries (reverse queries)) (list :regexp regexp-max :case-fold case-fold-max - :query `(and ,@clauses)))))) + :query `(and ,@queries)))))) (org-ql-defpred org-ql--or (&rest clauses) "Return non-nil if any of the clauses match." @@ -1238,17 +1248,29 @@ result form." `(or ,@(mapcar #'rec clauses)))) :preambles ((`(or . ,clauses) (let ((preambles (mapcar #'rec clauses)) - regexps regexp-null-p) - (dolist (preamble preambles) - (-let* (((&plist :regexp :case-fold :query) preamble)) - ;; Collect regexps for combining. - (if regexp (push regexp regexps) - (setq regexp-null-p t)))) + regexps regexp-null-p queries) + (cl-loop for preamble in preambles + for clause in clauses + do + (-let* (((&plist :regexp :case-fold :query) preamble)) + (if regexp + (cond + ((eq query t) (setq query `(regexp ,regexp))) + ((not query) (setq query `(regexp ,regexp))) + (t nil)) + (setq query clause)) + (push query queries) + ;; Collect regexps for combining. + (if regexp (push regexp regexps) + (setq regexp-null-p t)))) + (setq queries (reverse queries)) (list :regexp (unless regexp-null-p (and regexps (rx-to-string `(or ,@(mapcar (lambda (re) `(regex ,re)) regexps))))) :case-fold t - :query `(save-excursion (or ,@clauses))))))) + :query (if regexp-null-p + `(save-excursion (or ,@clauses)) + `(save-excursion (or ,@queries)))))))) (org-ql-defpred org-ql--when (condition &rest clauses) "Return values of CLAUSES when CONDITION is non-nil." From 9b30c4139b7ff3cea7e8315cacb4a99257a6a804 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Mon, 5 Apr 2021 18:47:56 +0800 Subject: [PATCH 03/16] Take clauses from preambles when possible --- org-ql.el | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/org-ql.el b/org-ql.el index f99e2607..dbe689f3 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1229,7 +1229,7 @@ result form." ((eq query t) (setq query `(regexp ,regexp))) ((not query) (setq query `(regexp ,regexp))) (t nil)) - (setq query clause)) + (unless query (setq query clause))) (push query queries) ;; Take the longest regexp. It should be hardest to match. (when (length> regexp (length regexp-max)) @@ -1256,9 +1256,8 @@ result form." (if regexp (cond ((eq query t) (setq query `(regexp ,regexp))) - ((not query) (setq query `(regexp ,regexp))) - (t nil)) - (setq query clause)) + ((not query) (setq query `(regexp ,regexp)))) + (unless query (setq query clause))) (push query queries) ;; Collect regexps for combining. (if regexp (push regexp regexps) @@ -1268,9 +1267,7 @@ result form." (and regexps (rx-to-string `(or ,@(mapcar (lambda (re) `(regex ,re)) regexps))))) :case-fold t - :query (if regexp-null-p - `(save-excursion (or ,@clauses)) - `(save-excursion (or ,@queries)))))))) + :query `(or ,@(mapcar (lambda (clause) `(save-excursion ,clause)) queries))))))) (org-ql-defpred org-ql--when (condition &rest clauses) "Return values of CLAUSES when CONDITION is non-nil." @@ -1283,7 +1280,7 @@ result form." (-let* (((&plist :regexp :case-fold :query) (rec `(and ,condition ,(last clauses))))) (list :regexp regexp :case-fold case-fold - :query `(when ,condition ,@clauses)))))) + :query `(when ,condition ,@(mapcar (lambda (clause) `(save-excursion ,clause)) (butlast clauses)) ,(last clauses))))))) (org-ql-defpred org-ql--unless (condition &rest clauses) "Return values of CLAUSES unless CONDITION is non-nil." @@ -1296,7 +1293,7 @@ result form." (-let* (((&plist :regexp :case-fold :query) (rec ,(last clauses)))) (list :regexp regexp :case-fold case-fold - :query `(unless ,condition ,@clauses)))))) + :query `(unless (save-excursion ,condition) ,@(mapcar (lambda (clause) `(save-excursion ,clause)) (butlast clauses)) ,(last clauses))))))) (org-ql-defpred org-ql--not (clauses) "Match when CLAUSES don't match." From 3e6818d819fb6eb1d3db95a95dcd0c88d901629d Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Mon, 5 Apr 2021 21:11:46 +0800 Subject: [PATCH 04/16] Bypass narrowing when calculating inherited tags in narrowed buffer Otherwise, children queries may generate wrong tags and pollute tag cache. --- org-ql.el | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/org-ql.el b/org-ql.el index dbe689f3..efedf97b 100644 --- a/org-ql.el +++ b/org-ql.el @@ -565,25 +565,26 @@ Returns cons (INHERITED-TAGS . LOCAL-TAGS)." 'org-ql-nil)) (inherited-tags (or (when org-use-tag-inheritance (save-excursion - (if (org-up-heading-safe) - ;; Return parent heading's tags. - (-let* (((inherited local) (org-ql--tags-at (point))) - (tags (when (or inherited local) - (cond ((and (listp inherited) - (listp local)) - (->> (append inherited local) - -non-nil -uniq)) - ((listp inherited) inherited) - ((listp local) local))))) - (cl-typecase org-use-tag-inheritance - (list (setf tags (-intersection tags org-use-tag-inheritance))) - (string (setf tags (--select (string-match org-use-tag-inheritance it) - tags)))) - (pcase org-tags-exclude-from-inheritance - ('nil tags) - (_ (-difference tags org-tags-exclude-from-inheritance)))) - ;; Top-level heading: use file tags. - org-file-tags))) + (org-with-wide-buffer + (if (org-up-heading-safe) + ;; Return parent heading's tags. + (-let* (((inherited local) (org-ql--tags-at (point))) + (tags (when (or inherited local) + (cond ((and (listp inherited) + (listp local)) + (->> (append inherited local) + -non-nil -uniq)) + ((listp inherited) inherited) + ((listp local) local))))) + (cl-typecase org-use-tag-inheritance + (list (setf tags (-intersection tags org-use-tag-inheritance))) + (string (setf tags (--select (string-match org-use-tag-inheritance it) + tags)))) + (pcase org-tags-exclude-from-inheritance + ('nil tags) + (_ (-difference tags org-tags-exclude-from-inheritance)))) + ;; Top-level heading: use file tags. + org-file-tags)))) 'org-ql-nil)) (all-tags (list inherited-tags local-tags))) ;; Check caches again, because they may have been set now. From dc6f2d2501f44a115d71434d76c46a88fa66daf4 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 6 Apr 2021 21:54:29 +0800 Subject: [PATCH 05/16] Avoid compiler warnings when defining predicate without body --- org-ql.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index efedf97b..5acd8173 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1117,7 +1117,7 @@ It would be expanded to: (preambles (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names)))) preambles))) `(progn - (cl-defun ,fn-name ,args ,docstring ,body) + (cl-defun ,fn-name ,(if body args '(&rest _)) ,docstring ,body) ;; SOMEDAY: Use `map-elt' here, after map 2.1 can be automatically installed in CI sandbox... (setf (alist-get ',predicate-name org-ql-predicates) `(:name ,',name :aliases ,',aliases :fn ,',fn-name :docstring ,(\, docstring) :args ,',args From e3f45f36e000149d963ba6582ce8a3b5538ed6f0 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 6 Apr 2021 22:43:34 +0800 Subject: [PATCH 06/16] Use alternative way to suppress warnings --- org-ql.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/org-ql.el b/org-ql.el index 5acd8173..05b246d0 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1117,7 +1117,7 @@ It would be expanded to: (preambles (cl-sublis (list (cons 'predicate-names (cons 'or (--map (list 'quote it) predicate-names)))) preambles))) `(progn - (cl-defun ,fn-name ,(if body args '(&rest _)) ,docstring ,body) + (cl-defun ,fn-name ,args ,docstring ,body) ;; SOMEDAY: Use `map-elt' here, after map 2.1 can be automatically installed in CI sandbox... (setf (alist-get ',predicate-name org-ql-predicates) `(:name ,',name :aliases ,',aliases :fn ,',fn-name :docstring ,(\, docstring) :args ,',args @@ -1212,7 +1212,7 @@ result form." ;; redefinitions until all of the predicates have been defined. (setf org-ql-defpred-defer t) -(org-ql-defpred org-ql--and (&rest clauses) +(org-ql-defpred org-ql--and (&rest _) "Return non-nil if all the clauses match." :normalizers ((`(and) nil) @@ -1241,7 +1241,7 @@ result form." :case-fold case-fold-max :query `(and ,@queries)))))) -(org-ql-defpred org-ql--or (&rest clauses) +(org-ql-defpred org-ql--or (&rest _) "Return non-nil if any of the clauses match." :normalizers ((`(or) nil) @@ -1270,7 +1270,7 @@ result form." :case-fold t :query `(or ,@(mapcar (lambda (clause) `(save-excursion ,clause)) queries))))))) -(org-ql-defpred org-ql--when (condition &rest clauses) +(org-ql-defpred org-ql--when (_ &rest _) "Return values of CLAUSES when CONDITION is non-nil." :normalizers ((`(when ,condition . ,clauses) @@ -1283,7 +1283,7 @@ result form." :case-fold case-fold :query `(when ,condition ,@(mapcar (lambda (clause) `(save-excursion ,clause)) (butlast clauses)) ,(last clauses))))))) -(org-ql-defpred org-ql--unless (condition &rest clauses) +(org-ql-defpred org-ql--unless (_ &rest _) "Return values of CLAUSES unless CONDITION is non-nil." :normalizers ((`(unless ,condition . ,clauses) @@ -1296,7 +1296,7 @@ result form." :case-fold case-fold :query `(unless (save-excursion ,condition) ,@(mapcar (lambda (clause) `(save-excursion ,clause)) (butlast clauses)) ,(last clauses))))))) -(org-ql-defpred org-ql--not (clauses) +(org-ql-defpred org-ql--not (_) "Match when CLAUSES don't match." :normalizers ((`(not . ,clauses) From b4ff5cc423ffaf9e8b2548e1cd8e1f57b8736347 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 6 Apr 2021 22:44:08 +0800 Subject: [PATCH 07/16] Use human-readable recursive function name for normalizers and preambles --- org-ql.el | 63 ++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 42 insertions(+), 21 deletions(-) diff --git a/org-ql.el b/org-ql.el index 05b246d0..81c91d60 100644 --- a/org-ql.el +++ b/org-ql.el @@ -951,7 +951,7 @@ PREDICATES should be the value of `org-ql-predicates'." This function is defined by calling `org-ql--define-normalize-query-fn', which uses normalizer forms defined in `org-ql-predicates' by calling `org-ql-defpred'." - (cl-labels ((rec (element) + (cl-labels ((org-ql-normalize-query (element) (pcase element ((pred stringp) `(regexp ,element)) ,@normalizer-patterns @@ -959,7 +959,7 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'." (_ element)))) ;; 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 - for new-query = (rec query) + for new-query = (org-ql-normalize-query query) until (equal new-query query) do (progn (setf query new-query) @@ -1001,11 +1001,11 @@ This function is defined by calling defined in `org-ql-predicates' by calling `org-ql-defpred'." (pcase org-ql-use-preamble ('nil (list :query query :preamble nil)) - (_ (cl-labels ((rec (element) - (pcase element - ,@preamble-patterns - (_ (list :query element))))) - (-let* (((&plist :regexp :case-fold :query) (funcall #'rec query))) + (_ (cl-labels ((org-ql-query-preamble (element) + (pcase element + ,@preamble-patterns + (_ (list :query element))))) + (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble query))) (setq query (pcase query ((or `nil `(nil) @@ -1090,7 +1090,28 @@ Then if NORMALIZERS were: It would be expanded to: ((`(,(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' ;; on the `heading' predicate, then evaluate this form: ;; (let* ((query '(heading "HEADING")) @@ -1217,9 +1238,9 @@ result form." :normalizers ((`(and) nil) (`(and . ,clauses) - `(and ,@(mapcar #'rec clauses)))) + `(and ,@(mapcar #'org-ql-normalize-query clauses)))) :preambles ((`(and . ,clauses) - (let ((preambles (mapcar #'rec clauses)) + (let ((preambles (mapcar #'org-ql-query-preamble clauses)) regexps regexp-max case-fold-max queries) (cl-loop for preamble in preambles for clause in clauses @@ -1246,9 +1267,9 @@ result form." :normalizers ((`(or) nil) (`(or . ,clauses) - `(or ,@(mapcar #'rec clauses)))) + `(or ,@(mapcar #'org-ql-normalize-query clauses)))) :preambles ((`(or . ,clauses) - (let ((preambles (mapcar #'rec clauses)) + (let ((preambles (mapcar #'org-ql-query-preamble clauses)) regexps regexp-null-p queries) (cl-loop for preamble in preambles for clause in clauses @@ -1274,11 +1295,11 @@ result form." "Return values of CLAUSES when CONDITION is non-nil." :normalizers ((`(when ,condition . ,clauses) - `(when ,(rec condition) - ,@(mapcar #'rec clauses)))) + `(when ,(org-ql-normalize-query condition) + ,@(mapcar #'org-ql-normalize-query clauses)))) :preambles ((`(when ,condition . ,clauses) - (-let* (((&plist :regexp :case-fold :query) (rec `(and ,condition ,(last clauses))))) + (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble `(and ,condition ,(last clauses))))) (list :regexp regexp :case-fold case-fold :query `(when ,condition ,@(mapcar (lambda (clause) `(save-excursion ,clause)) (butlast clauses)) ,(last clauses))))))) @@ -1287,11 +1308,11 @@ result form." "Return values of CLAUSES unless CONDITION is non-nil." :normalizers ((`(unless ,condition . ,clauses) - `(unless (save-excursion ,(rec condition)) - ,@(mapcar #'rec clauses)))) + `(unless (save-excursion ,(org-ql-normalize-query condition)) + ,@(mapcar #'org-ql-normalize-query clauses)))) :preambles ((`(unless ,condition . ,clauses) - (-let* (((&plist :regexp :case-fold :query) (rec ,(last clauses)))) + (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble ,(last clauses)))) (list :regexp regexp :case-fold case-fold :query `(unless (save-excursion ,condition) ,@(mapcar (lambda (clause) `(save-excursion ,clause)) (butlast clauses)) ,(last clauses))))))) @@ -1300,7 +1321,7 @@ result form." "Match when CLAUSES don't match." :normalizers ((`(not . ,clauses) - `(save-excursion (not ,@(mapcar #'rec clauses)))))) + `(save-excursion (not ,@(mapcar #'org-ql-normalize-query clauses)))))) (org-ql-defpred category (&rest categories) "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)." @@ -1909,7 +1930,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin :normalizers ((`(,predicate-names ;; Avoid infinitely compiling already-compiled functions. ,(and query (guard (not (byte-code-function-p query))))) - `(ancestors ,(org-ql--query-predicate (rec query)))) + `(ancestors ,(org-ql--query-predicate (org-ql-normalize-query query)))) (`(,predicate-names) '(ancestors (lambda () t)))) :body (org-with-wide-buffer @@ -1921,7 +1942,7 @@ With KEYWORDS, return non-nil if its keyword is one of KEYWORDS (a list of strin :normalizers ((`(,predicate-names ;; Avoid infinitely compiling already-compiled functions. ,(and query (guard (not (byte-code-function-p query))))) - `(parent ,(org-ql--query-predicate (rec query)))) + `(parent ,(org-ql--query-predicate (org-ql-normalize-query query)))) (`(,predicate-names) '(parent (lambda () t)))) :body (org-with-wide-buffer From 3c1550e5d1aaa129ea1576be7bd1890ccbb363e5 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 6 Apr 2021 22:51:54 +0800 Subject: [PATCH 08/16] Remove unnecessary save-excursion --- org-ql.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/org-ql.el b/org-ql.el index 81c91d60..8c8d9e5c 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1289,7 +1289,7 @@ result form." (and regexps (rx-to-string `(or ,@(mapcar (lambda (re) `(regex ,re)) regexps))))) :case-fold t - :query `(or ,@(mapcar (lambda (clause) `(save-excursion ,clause)) queries))))))) + :query `(or ,@queries)))))) (org-ql-defpred org-ql--when (_ &rest _) "Return values of CLAUSES when CONDITION is non-nil." @@ -1302,7 +1302,7 @@ result form." (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble `(and ,condition ,(last clauses))))) (list :regexp regexp :case-fold case-fold - :query `(when ,condition ,@(mapcar (lambda (clause) `(save-excursion ,clause)) (butlast clauses)) ,(last clauses))))))) + :query `(when ,condition ,@clauses)))))) (org-ql-defpred org-ql--unless (_ &rest _) "Return values of CLAUSES unless CONDITION is non-nil." @@ -1315,13 +1315,13 @@ result form." (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble ,(last clauses)))) (list :regexp regexp :case-fold case-fold - :query `(unless (save-excursion ,condition) ,@(mapcar (lambda (clause) `(save-excursion ,clause)) (butlast clauses)) ,(last clauses))))))) + :query `(unless ,condition ,@clauses)))))) (org-ql-defpred org-ql--not (_) "Match when CLAUSES don't match." :normalizers ((`(not . ,clauses) - `(save-excursion (not ,@(mapcar #'org-ql-normalize-query clauses)))))) + `(not ,@(mapcar #'org-ql-normalize-query clauses))))) (org-ql-defpred category (&rest categories) "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)." From f05ae553716bb1f973cb2bfc03bebff3afc60df5 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 6 Apr 2021 22:58:57 +0800 Subject: [PATCH 09/16] fixup! Remove unnecessary save-excursion --- org-ql.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql.el b/org-ql.el index 8c8d9e5c..d861cf87 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1308,7 +1308,7 @@ result form." "Return values of CLAUSES unless CONDITION is non-nil." :normalizers ((`(unless ,condition . ,clauses) - `(unless (save-excursion ,(org-ql-normalize-query condition)) + `(unless ,(org-ql-normalize-query condition) ,@(mapcar #'org-ql-normalize-query clauses)))) :preambles ((`(unless ,condition . ,clauses) From 387594ed368f3ae4fd81c13da6300d978f2f0c34 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 6 Apr 2021 23:02:29 +0800 Subject: [PATCH 10/16] Update docstrings --- org-ql.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/org-ql.el b/org-ql.el index d861cf87..92a3b2d9 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1234,7 +1234,7 @@ result form." (setf org-ql-defpred-defer t) (org-ql-defpred org-ql--and (&rest _) - "Return non-nil if all the clauses match." + "Normalizers and preambles for boolean (and ...) query." :normalizers ((`(and) nil) (`(and . ,clauses) @@ -1263,7 +1263,7 @@ result form." :query `(and ,@queries)))))) (org-ql-defpred org-ql--or (&rest _) - "Return non-nil if any of the clauses match." + "Normalizers and preambles for boolean (or ...) query." :normalizers ((`(or) nil) (`(or . ,clauses) @@ -1291,8 +1291,8 @@ result form." :case-fold t :query `(or ,@queries)))))) -(org-ql-defpred org-ql--when (_ &rest _) - "Return values of CLAUSES when CONDITION is non-nil." +(org-ql-defpred org-ql--when (&rest _) + "Normalizers and preambles for (when ...) query." :normalizers ((`(when ,condition . ,clauses) `(when ,(org-ql-normalize-query condition) @@ -1304,8 +1304,8 @@ result form." :case-fold case-fold :query `(when ,condition ,@clauses)))))) -(org-ql-defpred org-ql--unless (_ &rest _) - "Return values of CLAUSES unless CONDITION is non-nil." +(org-ql-defpred org-ql--unless (&rest _) + "Normalizers and preambles for (unless ...) query." :normalizers ((`(unless ,condition . ,clauses) `(unless ,(org-ql-normalize-query condition) @@ -1318,7 +1318,7 @@ result form." :query `(unless ,condition ,@clauses)))))) (org-ql-defpred org-ql--not (_) - "Match when CLAUSES don't match." + "Normalizers and preambles for (not ...) query." :normalizers ((`(not . ,clauses) `(not ,@(mapcar #'org-ql-normalize-query clauses))))) From 204e2d239eb492ea37e2768c2d6bb3feb1330e74 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Tue, 6 Apr 2021 22:44:27 +0800 Subject: [PATCH 11/16] Fix shadowed pcase clause --- org-ql.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/org-ql.el b/org-ql.el index 92a3b2d9..9b3105cf 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1839,10 +1839,10 @@ Tests both inherited and local tags." (org-ql-defpred (tags-inherited inherited-tags tags-i itags) (&rest 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." - :normalizers ((`(,predicate-names . ,tags) - `(tags-inherited ,@tags)) - (`(,predicate-names) - `(tags-inherited))) + :normalizers ((`(,predicate-names) + `(tags-inherited)) + (`(,predicate-names . ,tags) + `(tags-inherited ,@tags))) :body (cl-macrolet ((tags-p (tags) `(and ,tags (not (eq 'org-ql-nil ,tags))))) From 93a7f5c8ddfc8efc39d24a54db20e2b1efc12c71 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 14 Apr 2021 20:40:32 +0800 Subject: [PATCH 12/16] Simplify code --- org-ql.el | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/org-ql.el b/org-ql.el index 9b3105cf..4808ca88 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1247,10 +1247,8 @@ result form." do (-let* (((&plist :regexp :case-fold :query) preamble)) (if regexp - (cond - ((eq query t) (setq query `(regexp ,regexp))) - ((not query) (setq query `(regexp ,regexp))) - (t nil)) + (when (or (not query) (eq query t)) + (setq query `(regexp ,regexp))) (unless query (setq query clause))) (push query queries) ;; Take the longest regexp. It should be hardest to match. @@ -1276,9 +1274,8 @@ result form." do (-let* (((&plist :regexp :case-fold :query) preamble)) (if regexp - (cond - ((eq query t) (setq query `(regexp ,regexp))) - ((not query) (setq query `(regexp ,regexp)))) + (when (or (not query) (eq query t)) + (setq query `(regexp ,regexp))) (unless query (setq query clause))) (push query queries) ;; Collect regexps for combining. From 60c67b4cd349ba7e5285e1229144ab42690df9cc Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 14 Apr 2021 20:48:46 +0800 Subject: [PATCH 13/16] Fix preamble for body in when and unless predicates --- org-ql.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/org-ql.el b/org-ql.el index 4808ca88..02abc84e 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1296,7 +1296,7 @@ result form." ,@(mapcar #'org-ql-normalize-query clauses)))) :preambles ((`(when ,condition . ,clauses) - (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble `(and ,condition ,(last clauses))))) + (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble `(and ,condition ,(car (last clauses)))))) (list :regexp regexp :case-fold case-fold :query `(when ,condition ,@clauses)))))) @@ -1309,7 +1309,7 @@ result form." ,@(mapcar #'org-ql-normalize-query clauses)))) :preambles ((`(unless ,condition . ,clauses) - (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble ,(last clauses)))) + (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble (car (last clauses))))) (list :regexp regexp :case-fold case-fold :query `(unless ,condition ,@clauses)))))) From 67618c45cfc1daed76a792352d483b3b7d769f91 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 17 Apr 2021 16:21:59 +0800 Subject: [PATCH 14/16] Add tests --- tests/test-org-ql.el | 75 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 75 insertions(+) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index cd0a846a..8214625f 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -469,6 +469,11 @@ with keyword arg NOW in PLIST." (expect (org-ql--normalize-query '(and (todo "TODO") (or "string1" "string2"))) :to-equal '(and (todo "TODO") (or (regexp "string1") (regexp "string2")))) + (expect (org-ql--normalize-query '(or (todo "TODO") + (or "string1" "string2"))) + :to-equal '(or (todo "TODO") (or (regexp "string1") (regexp "string2")))) + (expect (org-ql--normalize-query '(not (or "string1" "string2"))) + :to-equal '(not (or (regexp "string1") (regexp "string2")))) (expect (org-ql--normalize-query '(when (todo "TODO") (or "string1" "string2"))) :to-equal '(when (todo "TODO") (or (regexp "string1") (regexp "string2")))) @@ -517,6 +522,76 @@ with keyword arg NOW in PLIST." ;; TODO: Other predicates. + (describe "(and)" + (it "all clauses have preambles" + (expect (org-ql--query-preamble '(and (regexp "a") (regexp "b"))) + :to-equal (list :query '(and (regexp "a") (regexp "b")) + :preamble "a" + :preamble-case-fold t))) + (it "some clauses miss preambles" + (expect (org-ql--query-preamble '(and (regexp "a") (+ 1 1))) + :to-equal (list :query '(and (regexp "a") (+ 1 1)) + :preamble "a" + :preamble-case-fold t))) + (it "all clauses don't have preambles" + (expect (org-ql--query-preamble '(and t (+ 1 1))) + :to-equal (list :query '(and t (+ 1 1)) + :preamble nil + :preamble-case-fold nil)))) + + (describe "(or)" + (it "all clauses have preambles" + (expect (org-ql--query-preamble '(or (regexp "a") (regexp "b"))) + :to-equal (list :query '(or (regexp "a") (regexp "b")) + :preamble (rx-to-string `(or (regexp "a") (regexp "b"))) + :preamble-case-fold t))) + (it "some clauses miss preambles" + (expect (org-ql--query-preamble '(or (regexp "a") (+ 1 1))) + :to-equal (list :query '(or (regexp "a") (+ 1 1)) + :preamble nil + :preamble-case-fold t))) + (it "all clauses don't have preambles" + (expect (org-ql--query-preamble '(or t (+ 1 1))) + :to-equal (list :query '(or t (+ 1 1)) + :preamble nil + :preamble-case-fold t)))) + + (describe "(when)" + (it "simple query" + (expect (org-ql--query-preamble '(when (regexp "a") (regexp "b"))) + :to-equal (list :query '(when (regexp "a") (regexp "b")) + :preamble "a" + :preamble-case-fold t))) + (it "multiple clauses after when" + (expect (org-ql--query-preamble '(when (regexp "a") (+ 1 1) (regexp "b"))) + :to-equal (list :query '(when (regexp "a") (+ 1 1) (regexp "b")) + :preamble "a" + :preamble-case-fold t))) + (it "no preambles in clauses" + (expect (org-ql--query-preamble '(when t (+ 1 1))) + :to-equal (list :query '(when t (+ 1 1)) + :preamble nil + :preamble-case-fold nil)))) + + (describe "(unless)" + (it "simple query" + (expect (org-ql--query-preamble '(unless (regexp "a") (regexp "b"))) + :to-equal (list :query '(unless (regexp "a") (regexp "b")) + :preamble "b" + :preamble-case-fold t))) + (it "no predicate in last clause" + (expect (org-ql--query-preamble '(unless (regexp "a") (regexp "b") (+ 1 1))) + :to-equal (list :query '(unless (regexp "a") (regexp "b") (+ 1 1)) + :preamble nil + :preamble-case-fold nil)))) + + (describe "(not)" + (it "simple query" + (expect (org-ql--query-preamble '(not (regexp "a"))) + :to-equal (list :query '(not (regexp "a")) + :preamble nil + :preamble-case-fold nil)))) + (describe "(clocked)" (it "without arguments" (expect (org-ql--query-preamble '(clocked)) From 567c4c4e42ec22c009ab1071562faa99f21df5b1 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 17 Apr 2021 16:27:12 +0800 Subject: [PATCH 15/16] Fix test --- tests/test-org-ql.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 8214625f..6e5bd7a6 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -543,7 +543,7 @@ with keyword arg NOW in PLIST." (it "all clauses have preambles" (expect (org-ql--query-preamble '(or (regexp "a") (regexp "b"))) :to-equal (list :query '(or (regexp "a") (regexp "b")) - :preamble (rx-to-string `(or (regexp "a") (regexp "b"))) + :preamble (rx-to-string `(or (regexp "b") (regexp "a"))) :preamble-case-fold t))) (it "some clauses miss preambles" (expect (org-ql--query-preamble '(or (regexp "a") (+ 1 1))) From 41821ccc76fff90da325d8fdb24782987a567779 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 14 Aug 2021 13:24:28 +0800 Subject: [PATCH 16/16] Revert "Use human-readable recursive function name for normalizers and preambles" This reverts commit b4ff5cc423ffaf9e8b2548e1cd8e1f57b8736347. --- org-ql.el | 63 +++++++++++++++++++------------------------------------ 1 file changed, 21 insertions(+), 42 deletions(-) diff --git a/org-ql.el b/org-ql.el index 02abc84e..26d31db1 100644 --- a/org-ql.el +++ b/org-ql.el @@ -951,7 +951,7 @@ PREDICATES should be the value of `org-ql-predicates'." This function is defined by calling `org-ql--define-normalize-query-fn', which uses normalizer forms defined in `org-ql-predicates' by calling `org-ql-defpred'." - (cl-labels ((org-ql-normalize-query (element) + (cl-labels ((rec (element) (pcase element ((pred stringp) `(regexp ,element)) ,@normalizer-patterns @@ -959,7 +959,7 @@ defined in `org-ql-predicates' by calling `org-ql-defpred'." (_ element)))) ;; 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 - for new-query = (org-ql-normalize-query query) + for new-query = (rec query) until (equal new-query query) do (progn (setf query new-query) @@ -1001,11 +1001,11 @@ This function is defined by calling defined in `org-ql-predicates' by calling `org-ql-defpred'." (pcase org-ql-use-preamble ('nil (list :query query :preamble nil)) - (_ (cl-labels ((org-ql-query-preamble (element) - (pcase element - ,@preamble-patterns - (_ (list :query element))))) - (-let* (((&plist :regexp :case-fold :query) (org-ql-query-preamble query))) + (_ (cl-labels ((rec (element) + (pcase element + ,@preamble-patterns + (_ (list :query element))))) + (-let* (((&plist :regexp :case-fold :query) (funcall #'rec query))) (setq query (pcase query ((or `nil `(nil) @@ -1090,28 +1090,7 @@ Then if NORMALIZERS were: It would be expanded to: ((`(,(or 'heading 'h) . ,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)))))" + `(heading ,@args)))" ;; NOTE: The debug form works, completely! For example, use `edebug-defun' ;; on the `heading' predicate, then evaluate this form: ;; (let* ((query '(heading "HEADING")) @@ -1238,9 +1217,9 @@ result form." :normalizers ((`(and) nil) (`(and . ,clauses) - `(and ,@(mapcar #'org-ql-normalize-query clauses)))) + `(and ,@(mapcar #'rec clauses)))) :preambles ((`(and . ,clauses) - (let ((preambles (mapcar #'org-ql-query-preamble clauses)) + (let ((preambles (mapcar #'rec clauses)) regexps regexp-max case-fold-max queries) (cl-loop for preamble in preambles for clause in clauses @@ -1265,9 +1244,9 @@ result form." :normalizers ((`(or) nil) (`(or . ,clauses) - `(or ,@(mapcar #'org-ql-normalize-query clauses)))) + `(or ,@(mapcar #'rec clauses)))) :preambles ((`(or . ,clauses) - (let ((preambles (mapcar #'org-ql-query-preamble clauses)) + (let ((preambles (mapcar #'rec clauses)) regexps regexp-null-p queries) (cl-loop for preamble in preambles for clause in clauses @@ -1292,11 +1271,11 @@ result form." "Normalizers and preambles for (when ...) query." :normalizers ((`(when ,condition . ,clauses) - `(when ,(org-ql-normalize-query condition) - ,@(mapcar #'org-ql-normalize-query clauses)))) + `(when ,(rec condition) + ,@(mapcar #'rec clauses)))) :preambles ((`(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 :case-fold case-fold :query `(when ,condition ,@clauses)))))) @@ -1305,11 +1284,11 @@ result form." "Normalizers and preambles for (unless ...) query." :normalizers ((`(unless ,condition . ,clauses) - `(unless ,(org-ql-normalize-query condition) - ,@(mapcar #'org-ql-normalize-query clauses)))) + `(unless (save-excursion ,(rec condition)) + ,@(mapcar #'rec clauses)))) :preambles ((`(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 :case-fold case-fold :query `(unless ,condition ,@clauses)))))) @@ -1318,7 +1297,7 @@ result form." "Normalizers and preambles for (not ...) query." :normalizers ((`(not . ,clauses) - `(not ,@(mapcar #'org-ql-normalize-query clauses))))) + `(save-excursion (not ,@(mapcar #'rec clauses)))))) (org-ql-defpred category (&rest categories) "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 ;; Avoid infinitely compiling already-compiled functions. ,(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)))) :body (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 ;; Avoid infinitely compiling already-compiled functions. ,(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)))) :body (org-with-wide-buffer