diff --git a/org-ql.el b/org-ql.el index 89e5f52..7d0fc2b 100644 --- a/org-ql.el +++ b/org-ql.el @@ -635,6 +635,12 @@ returns nil." query-string " Execute it? ")) (user-error "Query aborted by user"))))) +(defun org-ql--plist-get* (plist property) + "Return the value of PROPERTY in PLIST, or `not-found' if the property is missing." + (if-let ((pair (plist-member plist property))) + (cadr pair) + 'not-found)) + ;;;;; Query processing ;; Processing, compiling, etc. for queries. @@ -739,25 +745,35 @@ Arguments STRING, POS, FILL, and LEVEL are according to (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) + (closed (&key from to on (with-time 'not-found)) (org-ql--from-to-on) - `(org-ql--predicate-closed :from ,from :to ,to)) - (deadline (&key from to on with-time) + `(org-ql--predicate-closed :from ,from :to ,to :with-time ,with-time)) + (deadline (&key from to on (with-time 'not-found)) (org-ql--from-to-on) - `(org-ql--predicate-deadline :from ,from :to ,to)) - (planning (&key from to on with-time) + `(org-ql--predicate-deadline :from ,from :to ,to :with-time ,with-time)) + (planning (&key from to on (with-time 'not-found)) (org-ql--from-to-on) - `(org-ql--predicate-planning :from ,from :to ,to)) - (scheduled (&key from to on with-time) + `(org-ql--predicate-planning :from ,from :to ,to :with-time ,with-time)) + (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)) - (ts (&key from to on (type 'both) with-time) + (ts (&key from to on (type 'both) (with-time 'not-found)) (org-ql--from-to-on) - `(org-ql--predicate-ts :from ,from :to ,to - :regexp ,(pcase type - ('both org-tsr-regexp-both) - ('active org-tsr-regexp) - ('inactive org-ql-tsr-regexp-inactive))))) + `(org-ql--predicate-ts + :from ,from :to ,to :with-time ',with-time + :regexp ,(pcase type + ((or 'nil 'both) (pcase-exhaustive with-time + ('t org-ql-regexp-ts-both-with-time) + ('nil org-ql-regexp-ts-both-without-time) + ('not-found org-ql-regexp-ts-both))) + ('active (pcase-exhaustive with-time + ('t org-ql-regexp-ts-active-with-time) + ('nil org-ql-regexp-ts-active-without-time) + ('not-found org-ql-regexp-ts-active))) + ('inactive (pcase-exhaustive with-time + ('t org-ql-regexp-ts-inactive-with-time) + ('nil org-ql-regexp-ts-inactive-without-time) + ('not-found org-ql-regexp-ts-inactive))))))) ,query))))) ;;;;; String query parsing @@ -1122,6 +1138,7 @@ For compatibility, since Org 9.1 deprecated `org-duration-string-to-minutes', replacing it with `org-duration-to-minutes', which seems to return floats instead of integers." + ;; FIXME: Define this as an alias instead. ;; MAYBE: Remove if compatibility with Org 9.0 is dropped. (funcall (if (fboundp 'org-duration-to-minutes) #'org-duration-to-minutes @@ -1944,14 +1961,6 @@ parseable by `parse-time-string' which may omit the time value." org-ql-planning-time-hour-regexp org-ql-planning-regexp))) -(defun org-ql--plist-get (plist property) - "Like `plist-get', but for \"improper\" plists. -\"Improper\" meaning that the first element of PLIST need not be -a keyword; the PROPERTY may appear anywhere in PLIST, and the -subsequent element is is value." - (when-let ((pos (cl-position property plist))) - (elt plist (1+ pos)))) - (org-ql-defpred scheduled (&key from to _on with-time) ;; The underscore before `on' prevents "unused lexical variable" ;; warnings, because we pre-process that argument in a macro before @@ -1977,7 +1986,7 @@ parseable by `parse-time-string' which may omit the time value." `(scheduled :to ,to)))) :preambles ((`(,predicate-names . ,rest) (list :query query - :regexp (if (org-ql--plist-get rest :with-time) + :regexp (if (plist-get rest :with-time) org-scheduled-time-hour-regexp org-scheduled-time-regexp)))) :body @@ -1988,7 +1997,7 @@ parseable by `parse-time-string' which may omit the time value." :match-group 1 :limit (line-end-position 2))) -(org-ql-defpred (ts ts-active ts-a ts-inactive ts-i) +(org-ql-defpred (ts ts-active ts-a ts-inactive ts-i _with-time) (&key from to _on regexp with-time (match-group 0) (limit (org-entry-end-position))) ;; NOTE: Arguments to this predicate are pre-processed in `org-ql--normalize-query'. ;; The underscore before `on' prevents "unused lexical variable" warnings due to the @@ -2023,9 +2032,18 @@ of the line after the heading." (`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))) :preambles ((`(,predicate-names . ,rest) (list :regexp (pcase (plist-get rest :type) - ((or 'nil 'both) org-tsr-regexp-both) - ('active org-tsr-regexp) - ('inactive org-ql-tsr-regexp-inactive)) + ((or 'nil 'both) (pcase-exhaustive (org-ql--plist-get* rest :with-time) + ('t org-ql-regexp-ts-both-with-time) + ('nil org-ql-regexp-ts-both-without-time) + ('not-found org-ql-regexp-ts-both))) + ('active (pcase-exhaustive (org-ql--plist-get* rest :with-time) + ('t org-ql-regexp-ts-active-with-time) + ('nil org-ql-regexp-ts-active-without-time) + ('not-found org-ql-regexp-ts-active))) + ('inactive (pcase-exhaustive (org-ql--plist-get* rest :with-time) + ('t org-ql-regexp-ts-inactive-with-time) + ('nil org-ql-regexp-ts-inactive-without-time) + ('not-found org-ql-regexp-ts-inactive)))) ;; Predicate needs testing only when args are present. :query (-let (((&keys :from :to :on) rest)) ;; FIXME: This used to be (when (or from to on) query), but that doesn't seem right, so I @@ -2034,6 +2052,7 @@ of the line after the heading." query t))))) ;; TODO: DRY this with the clocked predicate. + ;; NOTE: The argument `regexp' is provided by pre-processing done by `org-ql--query-predicate'. :body (cl-macrolet ((next-timestamp () `(when (re-search-forward regexp limit t) diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index d6d6bab..9562b2a 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -1146,7 +1146,15 @@ RESULTS should be a list of strings as returned by (org-ql-it ":on a number of days" (org-ql-then (org-ql-expect ('(ts-active :on 2)) - '("Take over the world"))))) + '("Take over the world")))) + + (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")) + (org-ql-expect ('(ts-active :with-time t)) + '("Skype with president of Antarctica" "Order a pizza")) + (org-ql-expect ('(ts-active :to "2017-07-04" :with-time t)) + '("Skype with president of Antarctica")))) (describe "inactive" @@ -1194,7 +1202,15 @@ RESULTS should be a list of strings as returned by (org-ql-it ":on a number of days" (org-ql-then (org-ql-expect ('(ts-inactive :on 19)) - '("Visit the moon" "Rewrite Emacs in Common Lisp"))))) + '("Visit the moon" "Rewrite Emacs in Common Lisp")))) + + (org-ql-it ":with-time" + (org-ql-expect ('(ts-inactive :with-time nil)) + nil) + (org-ql-expect ('(ts-inactive :with-time t)) + '("Visit the moon" "Learn universal sign language" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ('(ts-inactive :to "2017-07-04" :with-time t)) + nil))) (describe "both" @@ -1256,7 +1272,15 @@ RESULTS should be a list of strings as returned by (org-ql-it ":on a number of days" (org-ql-then (org-ql-expect ('(ts :on 5)) - '("Renew membership in supervillain club")))))) + '("Renew membership in supervillain club")))) + + (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")) + (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")) + (org-ql-expect ('(ts :to "2017-07-04" :with-time t)) + '("Skype with president of Antarctica"))))) (describe "Compound queries"