From 26c58c6c77d5e84b14e5e4890d86b47c222376ed Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 18 Jun 2021 23:55:42 -0500 Subject: [PATCH] WIP --- org-ql.el | 146 ++++++++++++++++++++++++++++++------------- tests/data.org | 2 +- tests/test-org-ql.el | 22 ++++--- 3 files changed, 118 insertions(+), 52 deletions(-) diff --git a/org-ql.el b/org-ql.el index 01733f1..24605cb 100644 --- a/org-ql.el +++ b/org-ql.el @@ -146,12 +146,16 @@ This list should not contain any duplicates.")) (defvar org-ql-regexp-part-ts-date (rx (repeat 4 digit) "-" (repeat 2 digit) "-" (repeat 2 digit) ;; Day of week - (optional " " (1+ alpha)) - ;; Repeaters (not sure if the colon is necessary, but it's in the org.el one) - (optional (repeat 1 2 (seq " " (repeat 1 2 (any "-+:")) (1+ digit) (any "hdwmy"))))) + (optional " " (1+ alpha))) "Matches the inner, date part of an Org timestamp, both active and inactive. -Also matches optional day-of-week and repeaters. Used to build -other timestamp regexps.") +Also matches optional day-of-week. Used to build other timestamp +regexps.") + +(defvar org-ql-regexp-part-ts-repeaters + ;; Repeaters (not sure if the colon is necessary, but it's in the org.el one) + (rx (repeat 1 2 (seq " " (repeat 1 2 (any "-+:")) (1+ digit) (any "hdwmy")))) + "Matches the repeater part of an Org timestamp. +Includes leading space character.") (defvar org-ql-regexp-part-ts-time (rx " " (repeat 1 2 digit) ":" (repeat 2 digit)) @@ -159,40 +163,57 @@ other timestamp regexps.") Includes leading space character. Used to build other timestamp regexps.") +;; NOTE: The inactive timestamp regexps don't allow repeaters. I don't know if this is +;; officially correct, but it seems to make sense, and would be easy to change if necessary. + (defvar org-ql-regexp-ts-both (rx-to-string - `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) (optional (regexp ,org-ql-regexp-part-ts-time)) ">") - (seq "[" (regexp ,org-ql-regexp-part-ts-date) (optional (regexp ,org-ql-regexp-part-ts-time)) "]"))) + `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) + (optional (regexp ,org-ql-regexp-part-ts-time)) + (optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">") + (seq "[" (regexp ,org-ql-regexp-part-ts-date) + (optional (regexp ,org-ql-regexp-part-ts-time))))) "Matches both active and inactive Org timestamps, with or without time.") (defvar org-ql-regexp-ts-both-with-time - (rx-to-string `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) (regexp ,org-ql-regexp-part-ts-time) ">") - (seq "[" (regexp ,org-ql-regexp-part-ts-date) (regexp ,org-ql-regexp-part-ts-time) "]"))) + (rx-to-string `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) + (regexp ,org-ql-regexp-part-ts-time) + (optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">") + (seq "[" (regexp ,org-ql-regexp-part-ts-date) + (regexp ,org-ql-regexp-part-ts-time) "]"))) "Matches both active and inactive Org timestamps, with time.") (defvar org-ql-regexp-ts-both-without-time - (rx-to-string `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) ">") + (rx-to-string `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) + (optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">") (seq "[" (regexp ,org-ql-regexp-part-ts-date) "]"))) "Matches both active and inactive Org timestamps, without time.") (defvar org-ql-regexp-ts-active - (rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) (optional (regexp ,org-ql-regexp-part-ts-time)) ">")) + (rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) + (optional (regexp ,org-ql-regexp-part-ts-time)) + (optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">")) "Matches active Org timestamps, with or without time.") (defvar org-ql-regexp-ts-active-with-time - (rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) (regexp ,org-ql-regexp-part-ts-time) ">")) + (rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) + (regexp ,org-ql-regexp-part-ts-time) + (optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">")) "Matches active Org timestamps, with time.") (defvar org-ql-regexp-ts-active-without-time - (rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) ">")) + (rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) + (optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">")) "Matches active Org timestamps, without time.") (defvar org-ql-regexp-ts-inactive - (rx-to-string `(seq "[" (regexp ,org-ql-regexp-part-ts-date) (optional (regexp ,org-ql-regexp-part-ts-time)) "]")) + (rx-to-string `(seq "[" (regexp ,org-ql-regexp-part-ts-date) + (optional (regexp ,org-ql-regexp-part-ts-time))"]")) "Matches inactive Org timestamps, with or without time.") (defvar org-ql-regexp-ts-inactive-with-time - (rx-to-string `(seq "[" (regexp ,org-ql-regexp-part-ts-date) (regexp ,org-ql-regexp-part-ts-time) "]")) + (rx-to-string `(seq "[" (regexp ,org-ql-regexp-part-ts-date) + (regexp ,org-ql-regexp-part-ts-time)"]")) "Matches inactive Org timestamps, with time.") (defvar org-ql-regexp-ts-inactive-without-time @@ -200,33 +221,54 @@ regexps.") "Matches inactive Org timestamps, without time.") (defvar org-ql-regexp-planning - (rx-to-string `(seq bow (or "CLOSED" "SCHEDULED" "DEADLINE") ":" (0+ " ") - (group (regexp ,org-ql-regexp-ts-both)))) - "Matches DEADLINE or SCHEDULED keyword with timestamp, with or without time.") + (rx-to-string `(seq bow (or (seq "CLOSED" ":" (0+ " ") + (group-n 1 (regexp ,org-ql-regexp-ts-inactive))) + (seq (or "DEADLINE" "SCHEDULED") ":" (0+ " ") + (group-n 1 (regexp ,org-ql-regexp-ts-active)))))) + "Matches CLOSED, DEADLINE or SCHEDULED keyword with timestamp, with or without time.") (defvar org-ql-regexp-planning-with-time - (rx-to-string `(seq bow (or "CLOSED" "SCHEDULED" "DEADLINE") ":" (0+ " ") - (group (regexp ,org-ql-regexp-ts-both-with-time)))) - "Matches DEADLINE or SCHEDULED keyword with timestamp, with time.") + (rx-to-string `(seq bow (or (seq "CLOSED" ":" (0+ " ") + (group-n 1 (regexp ,org-ql-regexp-ts-inactive-with-time))) + (seq (or "DEADLINE" "SCHEDULED") ":" (0+ " ") + (group-n 1 (regexp ,org-ql-regexp-ts-active-with-time)))))) + "Matches CLOSED, DEADLINE or SCHEDULED keyword with timestamp, with time.") (defvar org-ql-regexp-planning-without-time - (rx-to-string `(seq bow (or "CLOSED" "SCHEDULED" "DEADLINE") ":" (0+ " ") - (group (regexp ,org-ql-regexp-ts-both-without-time)))) - "Matches DEADLINE or SCHEDULED keyword with timestamp, without time.") + (rx-to-string `(seq bow (or (seq "CLOSED" ":" (0+ " ") + (group-n 1 (regexp ,org-ql-regexp-ts-inactive-without-time))) + (seq (or "DEADLINE" "SCHEDULED") ":" (0+ " ") + (group-n 1 (regexp ,org-ql-regexp-ts-active-without-time)))))) + "Matches CLOSED, DEADLINE or SCHEDULED keyword with timestamp, without time.") + +(defvar org-ql-regexp-deadline + (rx-to-string `(seq bow "DEADLINE" ":" (0+ " ") + (group (regexp ,org-ql-regexp-ts-active)))) + "Matches DEADLINE keyword with a time-and-hour stamp, with or without time.") + +(defvar org-ql-regexp-deadline-with-time + (rx-to-string `(seq bow "DEADLINE" ":" (0+ " ") + (group (regexp ,org-ql-regexp-ts-active-with-time)))) + "Matches DEADLINE keyword with a time-and-hour stamp, with time.") + +(defvar org-ql-regexp-deadline-without-time + (rx-to-string `(seq bow "DEADLINE" ":" (0+ " ") + (group (regexp ,org-ql-regexp-ts-active-without-time)))) + "Matches DEADLINE keyword with a time-and-hour stamp, without time.") (defvar org-ql-regexp-scheduled (rx-to-string `(seq bow "SCHEDULED" ":" (0+ " ") - (group (regexp ,org-ql-regexp-ts-both)))) + (group (regexp ,org-ql-regexp-ts-active)))) "Matches SCHEDULED keyword with a time-and-hour stamp, with or without time.") (defvar org-ql-regexp-scheduled-with-time (rx-to-string `(seq bow "SCHEDULED" ":" (0+ " ") - (group (regexp ,org-ql-regexp-ts-both-with-time)))) + (group (regexp ,org-ql-regexp-ts-active-with-time)))) "Matches SCHEDULED keyword with a time-and-hour stamp, with time.") (defvar org-ql-regexp-scheduled-without-time (rx-to-string `(seq bow "SCHEDULED" ":" (0+ " ") - (group (regexp ,org-ql-regexp-ts-both-without-time)))) + (group (regexp ,org-ql-regexp-ts-active-without-time)))) "Matches SCHEDULED keyword with a time-and-hour stamp, without time.") ;;;; Customization @@ -742,29 +784,38 @@ Arguments STRING, POS, FILL, and LEVEL are according to (let ((byte-compile-log-warning-function #'org-ql--byte-compile-warning)) (byte-compile `(lambda () + ;; NOTE: `clocked' and `closed' don't have WITH-TIME args, because they should always have a time. + ;; TODO: If possible, all of this argument processing should be done in each predicate's normalizers. (cl-macrolet ((clocked (&key from to on) (org-ql--from-to-on) `(org-ql--predicate-clocked :from ,from :to ,to)) (closed (&key from to on (with-time 'not-found)) (org-ql--from-to-on) - `(org-ql--predicate-closed :from ,from :to ,to :with-time ,with-time)) + `(org-ql--predicate-closed :from ,from :to ,to)) (deadline (&key from to on (with-time 'not-found)) (org-ql--from-to-on) - `(org-ql--predicate-deadline :from ,from :to ,to :with-time ,with-time)) + `(org-ql--predicate-deadline + :from ,from :to ,to :with-time ',with-time + :regexp ,(pcase-exhaustive with-time + ('t org-ql-regexp-deadline-with-time) + ('nil org-ql-regexp-deadline-without-time) + ('not-found org-ql-regexp-deadline)))) (planning (&key from to on (with-time 'not-found)) (org-ql--from-to-on) - `(org-ql--predicate-planning :from ,from :to ,to :with-time ',with-time - :regexp ,(pcase-exhaustive with-time - ('t org-ql-regexp-planning-with-time) - ('nil org-ql-regexp-planning-without-time) - ('not-found org-ql-regexp-planning)))) + `(org-ql--predicate-planning + :from ,from :to ,to :with-time ',with-time + :regexp ,(pcase-exhaustive with-time + ('t org-ql-regexp-planning-with-time) + ('nil org-ql-regexp-planning-without-time) + ('not-found org-ql-regexp-planning)))) (scheduled (&key from to on (with-time 'not-found)) (org-ql--from-to-on) - `(org-ql--predicate-scheduled :from ,from :to ,to :with-time ',with-time - :regexp ,(pcase-exhaustive with-time - ('t org-ql-regexp-scheduled-with-time) - ('nil org-ql-regexp-scheduled-without-time) - ('not-found org-ql-regexp-scheduled)))) + `(org-ql--predicate-scheduled + :from ,from :to ,to :with-time ',with-time + :regexp ,(pcase-exhaustive with-time + ('t org-ql-regexp-scheduled-with-time) + ('nil org-ql-regexp-scheduled-without-time) + ('not-found org-ql-regexp-scheduled)))) (ts (&key from to on (type 'both) (with-time 'not-found)) (org-ql--from-to-on) `(org-ql--predicate-ts @@ -1837,6 +1888,7 @@ parseable by `parse-time-string' which may omit the time value." (org-ql--predicate-ts :from from :to to :regexp org-ql-clock-regexp :match-group 1)) (org-ql-defpred closed (&key from to _on) + ;; TODO: Should this use the new org-ql-regexps? ;; The underscore before `on' prevents "unused lexical variable" ;; warnings, because we pre-process that argument in a macro before ;; this function is called. @@ -1866,7 +1918,7 @@ parseable by `parse-time-string' which may omit the time value." (org-ql--predicate-ts :from from :to to :regexp org-closed-time-regexp :match-group 1 :limit (line-end-position 2))) -(org-ql-defpred deadline (&key from to _on) +(org-ql-defpred deadline (&key from to _on regexp _with-time) ;; The underscore before `on' prevents "unused lexical variable" ;; warnings, because we pre-process that argument in a macro before ;; this function is called. @@ -1895,13 +1947,19 @@ parseable by `parse-time-string' which may omit the time value." (ts-apply :hour 23 :minute 59 :second 59)))) `(deadline :to ,to)))) ;; NOTE: Does this normalizer cause the preamble to not be used? (Adding one to the deadline-warning definition to be sure.) - :preambles ((`(,predicate-names . ,_) - (list :regexp org-deadline-time-regexp :query query))) + :preambles ((`(,predicate-names . ,rest) + (list :query query + :regexp (pcase-exhaustive (org-ql--plist-get* rest :with-time) + ('t org-ql-regexp-deadline-with-time) + ('nil org-ql-regexp-deadline-without-time) + ('not-found org-ql-regexp-deadline))))) :body - (org-ql--predicate-ts :from from :to to :regexp org-deadline-time-regexp :match-group 1 + (org-ql--predicate-ts :from from :to to :regexp regexp :match-group 1 :limit (line-end-position 2))) (org-ql-defpred deadline-warning (&key from to) + ;; TODO: Should this also accept a WITH-TIME argument? + ;; TODO: Should this use the new org-ql-regexps? "Internal selector used to handle `org-deadline-warning-days' and deadlines with warning periods." :preambles ((`(,predicate-names . ,_) (list :regexp org-deadline-time-regexp :query query))) @@ -1964,7 +2022,7 @@ parseable by `parse-time-string' which may omit the time value." (org-ql--predicate-ts :from from :to to :match-group 1 :limit (line-end-position 2) :regexp regexp)) -(org-ql-defpred scheduled (&key from to _on regexp with-time) +(org-ql-defpred scheduled (&key from to _on regexp _with-time) ;; The underscore before `on' prevents "unused lexical variable" ;; warnings, because we pre-process that argument in a macro before ;; this function is called. diff --git a/tests/data.org b/tests/data.org index 99875d8..fdca591 100644 --- a/tests/data.org +++ b/tests/data.org @@ -43,7 +43,7 @@ SCHEDULED: <2017-07-05 Wed +2d> :END: ** TODO [#B] Renew membership in supervillain club -DEADLINE: <2017-07-10 Mon -1w> +DEADLINE: <2017-07-10 Mon 23:59 -1w> ** DONE [#B] Learn universal sign language CLOSED: [2017-07-05 Wed 03:02] diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index cbb61a6..7247f73 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -637,7 +637,15 @@ RESULTS should be a list of strings as returned by '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) (org-ql-then (org-ql-expect ('(deadline :to today)) - '("/r/emacs"))))) + '("/r/emacs")))) + + (org-ql-it ":with-time" + (org-ql-expect ('(deadline :with-time nil)) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Internet" "Spaceship lease" "/r/emacs")) + (org-ql-expect ('(deadline :with-time t)) + '("Renew membership in supervillain club")) + (org-ql-expect ('(deadline :to "2017-07-10" :with-time t)) + '("Renew membership in supervillain club")))) (org-ql-it "(done)" (org-ql-expect ('(done)) @@ -835,9 +843,9 @@ RESULTS should be a list of strings as returned by (org-ql-it ":with-time" (org-ql-expect ('(planning :with-time nil)) - '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) (org-ql-expect ('(planning :with-time t)) - '("Skype with president of Antarctica" "Learn universal sign language" "Order a pizza")) + '("Skype with president of Antarctica" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza")) (org-ql-expect ('(planning :to "2017-07-04" :with-time t)) '("Skype with president of Antarctica")))) @@ -1158,9 +1166,9 @@ RESULTS should be a list of strings as returned by (org-ql-it ":with-time" (org-ql-expect ('(ts-active :with-time nil)) - '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) (org-ql-expect ('(ts-active :with-time t)) - '("Skype with president of Antarctica" "Order a pizza")) + '("Skype with president of Antarctica" "Renew membership in supervillain club" "Order a pizza")) (org-ql-expect ('(ts-active :to "2017-07-04" :with-time t)) '("Skype with president of Antarctica")))) @@ -1284,9 +1292,9 @@ RESULTS should be a list of strings as returned by (org-ql-it ":with-time" (org-ql-expect ('(ts :with-time nil)) - '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) + '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) (org-ql-expect ('(ts :with-time t)) - '("Skype with president of Antarctica" "Visit the moon" "Learn universal sign language" "Order a pizza" "Rewrite Emacs in Common Lisp")) + '("Skype with president of Antarctica" "Visit the moon" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Rewrite Emacs in Common Lisp")) (org-ql-expect ('(ts :to "2017-07-04" :with-time t)) '("Skype with president of Antarctica")))))