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

Change: Use ts for all timestamp-related selectors

Browse source 
This is much simpler, and it seems quite fast with the preambles.
This commit is contained in:
Adam Porter 2019-08-13 17:06:39 -05:00
parent 40b36ecad2
commit 6b9b985c1e
3 changed files with 293 additions and 260 deletions
Download patch file Download diff file Expand all files Collapse all files

32
README.org
View file

@ -144,27 +144,34 @@ Arguments are listed next to predicate names, where applicable.
+ ~category (&optional categories)~ :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings). + ~category (&optional categories)~ :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
+ ~children (&optional query)~ :: Return non-nil if current heading has direct child headings. If ~QUERY~, test it against child headings. This selector may be nested, e.g. to match grandchild headings. + ~children (&optional query)~ :: Return non-nil if current heading has direct child headings. If ~QUERY~, test it against child headings. This selector may be nested, e.g. to match grandchild headings.
+ ~clocked (&key from to on)~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. If ~FROM~, return non-nil if entry was clocked on or after ~FROM~. If ~TO~, return non-nil if entry was clocked on or before ~TO~. If ~ON~, return non-nil if entry was clocked on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
+ ~closed (&optional comparator target-date)~ :: Return non-nil if entry's closed date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~).
+ ~date (&optional comparator target-date type)~ :: Return non-nil if Org entry at point has date of ~TYPE~ that compares with ~TARGET-DATE~ using ~COMPARATOR~. Checks all Org-formatted timestamp strings in entry. ~TYPE~ may be ~active~, ~inactive~, or ~all~, to control whether active, inactive, or all timestamps are checked. Ranges of each type are also checked. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~).
+ ~deadline (&optional comparator target-date)~ :: Return non-nil if entry's deadline compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~; or if omitted, it is determined automatically using ~org-deadline-warning-days~. ~COMPARATOR~ should be a function (like ~<=~).
+ ~descendants (&optional query)~ :: Return non-nil if current heading has descendant headings. If ~QUERY~, test it against descendant headings. This selector may be nested (if you can grok the nesting!). + ~descendants (&optional query)~ :: Return non-nil if current heading has descendant headings. If ~QUERY~, test it against descendant headings. This selector may be nested (if you can grok the nesting!).
+ ~done~ :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~. + ~done~ :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
+ ~habit~ :: Return non-nil if entry is a habit. + ~habit~ :: Return non-nil if entry is a habit.
+ ~heading (regexp)~ :: Return non-nil if current entry's heading matches ~REGEXP~ (a regexp string). + ~heading (regexp)~ :: Return non-nil if current entry's heading matches ~REGEXP~ (a regexp string).
+ ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches arguments. The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~. ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs. ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~. + ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches arguments. The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~. ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs. ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~. ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~.
+ ~planning (&optional comparator target-date)~ :: Return non-nil if entry's planning date (deadline or scheduled) compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~).
+ ~priority (&optional comparator-or-priority priority)~ :: Return non-nil if current heading has a certain priority. ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator). If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string. + ~priority (&optional comparator-or-priority priority)~ :: Return non-nil if current heading has a certain priority. ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator). If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string.
+ ~property (property &optional value)~ :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string). Note that property inheritance is currently /not/ enabled for this predicate. If you need to test with inheritance, you could use a custom predicate form, like ~(org-entry-get (point) "PROPERTY" 'inherit)~. + ~property (property &optional value)~ :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string). Note that property inheritance is currently /not/ enabled for this predicate. If you need to test with inheritance, you could use a custom predicate form, like ~(org-entry-get (point) "PROPERTY" 'inherit)~.
+ ~regexp (regexp)~ :: Return non-nil if current entry matches ~REGEXP~ (a regexp string). + ~regexp (regexp)~ :: Return non-nil if current entry matches ~REGEXP~ (a regexp string).
+ ~scheduled (&optional comparator target-date)~ :: Return non-nil if entry's scheduled date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~).
+ ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings). + ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings).
+ ~todo (&optional keywords)~ :: Return non-nil if current heading is a ~TODO~ item. With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings). When called without arguments, only matches non-done tasks (i.e. does not match keywords in ~org-done-keywords~). + ~todo (&optional keywords)~ :: Return non-nil if current heading is a ~TODO~ item. With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings). When called without arguments, only matches non-done tasks (i.e. does not match keywords in ~org-done-keywords~).
+ ~ts (&key from to on type)~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. If ~FROM~, return non-nil if entry has a timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has a timestamp on or before ~TO~. If ~ON~, return non-nil if entry has a timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value. ~TYPE~ may be ~active~ to match active timestamps, ~inactive~ to match inactive ones, or ~both~ / nil to match both types.
+ ~ts-active~ :: Like ~ts~ called with ~:type active~. *** Date/time selectors
+ ~ts-a~ :: Like ~ts~ called with ~:type active~. :PROPERTIES:
+ ~ts-inactive~ :: Like ~ts~ called with ~:type inactive~. :TOC: ignore
+ ~ts-i~ :: Like ~ts~ called with ~:type inactive~. :END:
All of these selectors take optional keyword arguments ~:from~, ~:to:~, and ~:on~. If ~:from~, return non-nil if entry has a timestamp on or after ~:from~. If ~:to~, return non-nil if entry has a timestamp on or before ~:to~. If ~:on~, return non-nil if entry has a timestamp on date ~:on~. Argument values should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value.
+ ~clocked~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
+ ~closed~ :: Return non-nil if current entry was closed in given period. If no arguments are specified, return non-nil if entry was closed at any time.
+ ~deadline~ :: Return non-nil if current entry has deadline in given period. If no arguments are specified, return non-nil if entry has any deadline.
+ ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). If no arguments are specified, return non-nil if entry is scheduled at any time.
+ ~scheduled~ :: Return non-nil if current entry is scheduled in given period. If no arguments are specified, return non-nil if entry is scheduled at any time.
+ ~ts~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp.
+ ~ts-active~ :: Like ~ts~, but only matches active timestamps.
+ ~ts-a~ :: Like ~ts~, but only matches active timestamps.
+ ~ts-inactive~ :: Like ~ts~, but only matches inactive timestamps.
+ ~ts-i~ :: Like ~ts~, but only matches inactive timestamps.
** Functions / Macros ** Functions / Macros
:PROPERTIES: :PROPERTIES:
@ -382,6 +389,9 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience
+ Macro ~org-ql~ no longer accepts a ~:markers~ argument. Instead, use argument ~:action element-with-markers~. See function ~org-ql-select~, which ~org-ql~ calls. + Macro ~org-ql~ no longer accepts a ~:markers~ argument. Instead, use argument ~:action element-with-markers~. See function ~org-ql-select~, which ~org-ql~ calls.
+ Selector ~(todo)~ no longer matches "done" keywords when used without arguments (i.e. the ones in variable ~org-done-keywords~). + Selector ~(todo)~ no longer matches "done" keywords when used without arguments (i.e. the ones in variable ~org-done-keywords~).
*Removed*
+ Selector ~(date)~, replaced by ~(ts)~.
*Fixed* *Fixed*
+ Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].) + Handle date ranges in date-based selectors. (Thanks to [[https://github.com/codygman][Cody Goodman]], [[https://github.com/swflint][Samuel W. Flint]], and [[https://github.com/vikasrawal][Vikas Rawal]].)
+ Don't overwrite bindings in =org-agenda-mode-map=. + Don't overwrite bindings in =org-agenda-mode-map=.

391
org-ql.el
View file

@ -52,7 +52,9 @@
(defun org-ql--get-tags (&optional pos local) (defun org-ql--get-tags (&optional pos local)
(org-get-tags pos local))) (org-get-tags pos local)))
;;;; Variables ;;;; Constants
;; Note the use of the `rx' `blank' keyword, which matches "horizontal" whitespace.
(defconst org-ql-tsr-regexp-inactive (defconst org-ql-tsr-regexp-inactive
(concat org-ts-regexp-inactive "\\(--?-?" (concat org-ts-regexp-inactive "\\(--?-?"
@ -60,6 +62,19 @@
;; MAYBE: Propose this for org.el. ;; MAYBE: Propose this for org.el.
"Regular expression matching an inactive timestamp or timestamp range.") "Regular expression matching an inactive timestamp or timestamp range.")
(defconst org-ql-clock-regexp
(rx bol (0+ blank) "CLOCK:" (group (1+ not-newline)))
"Regular expression matching Org \"CLOCK:\" lines.
Like `org-clock-line-re', but matches the timestamp range in a
match group.")
(defconst org-ql-planning-regexp
(rx bol (0+ blank) (or "CLOSED" "DEADLINE" "SCHEDULED") ":" (1+ blank) (group (1+ not-newline)))
"Regular expression matching Org \"planning\" lines.
That is, \"CLOSED:\", \"DEADLINE:\", or \"SCHEDULED:\".")
;;;; Variables
(defvar org-ql--today nil) (defvar org-ql--today nil)
(defvar org-ql-use-preamble t (defvar org-ql-use-preamble t
@ -275,17 +290,84 @@ Replaces bare strings with (regexp) selectors, and appropriate
;; for now. Most importantly, it works! ;; for now. Most importantly, it works!
(let (from to on) (let (from to on)
;; TODO: DRY these macrolets. ;; TODO: DRY these macrolets.
;; MAYBE: Instead of defining clocked, closed, etc. as predicates,
;; rewrite them to call --predicate-ts directly here. Only drawback,
;; I think, is that it would make documentation less automated.
(cl-macrolet ((clocked (&key from to on) (cl-macrolet ((clocked (&key from to on)
(when on (when on
(setq from on (setq from on
to on)) to on))
(when from (when from
(setq from (org-ql--parse-time-string from))) (setq from (cl-typecase from
(string (ts-parse-fill 'begin from))
(ts from))))
(when to (when to
(setq to (org-ql--parse-time-string to 'end))) (setq to (cl-typecase to
(string (ts-parse-fill 'end to))
(ts to))))
;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked' ;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked'
;; function, not another `clocked'. ;; function, not another `clocked'.
`(org-ql--predicate-clocked :from ,from :to ,to)) `(org-ql--predicate-clocked :from ,from :to ,to))
(closed (&key from to on)
(when on
(setq from on
to on))
(when from
(setq from (cl-typecase from
(string (ts-parse-fill 'begin from))
(ts from))))
(when to
(setq to (cl-typecase to
(string (ts-parse-fill 'end to))
(ts to))))
;; NOTE: The macro must expand to the actual `org-ql--predicate-closed'
;; function, not another `closed'.
`(org-ql--predicate-closed :from ,from :to ,to))
(deadline (&key from to on)
(when on
(setq from on
to on))
(when from
(setq from (cl-typecase from
(string (ts-parse-fill 'begin from))
(ts from))))
(when to
(setq to (cl-typecase to
(string (ts-parse-fill 'end to))
(ts to))))
;; NOTE: The macro must expand to the actual `org-ql--predicate-deadline'
;; function, not another `deadline'.
`(org-ql--predicate-deadline :from ,from :to ,to))
(planning (&key from to on)
(when on
(setq from on
to on))
(when from
(setq from (cl-typecase from
(string (ts-parse-fill 'begin from))
(ts from))))
(when to
(setq to (cl-typecase to
(string (ts-parse-fill 'end to))
(ts to))))
;; NOTE: The macro must expand to the actual `org-ql--predicate-planning'
;; function, not another `planning'.
`(org-ql--predicate-planning :from ,from :to ,to))
(scheduled (&key from to on)
(when on
(setq from on
to on))
(when from
(setq from (cl-typecase from
(string (ts-parse-fill 'begin from))
(ts from))))
(when to
(setq to (cl-typecase to
(string (ts-parse-fill 'end to))
(ts to))))
;; NOTE: The macro must expand to the actual `org-ql--predicate-scheduled'
;; function, not another `scheduled'.
`(org-ql--predicate-scheduled :from ,from :to ,to))
(ts (&key from to on (type 'both)) (ts (&key from to on (type 'both))
(when on (when on
(setq from on (setq from on
@ -327,22 +409,15 @@ replace the clause with a preamble."
element) element)
(pcase element (pcase element
(`(or _) element) (`(or _) element)
(`(closed . ,_) (`(clocked . ,_)
(setq org-ql-preamble (setq org-ql-preamble org-ql-clock-regexp)
(rx-to-string `(seq bol (0+ (any " ")) "CLOSED" ":" (1+ space) (1+ not-newline)) t))
;; Return element, because the predicate still needs testing.
element) element)
(`(closed) (`(closed . ,_)
(setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "CLOSED" ":") t)) (setq org-ql-preamble org-closed-time-regexp)
;; Return element, because the predicate still needs testing. ;; Return element, because the predicate still needs testing.
element) element)
(`(deadline . ,_) (`(deadline . ,_)
(setq org-ql-preamble (setq org-ql-preamble org-deadline-time-regexp)
(rx-to-string `(seq bol (0+ (any " ")) "DEADLINE" ":" (1+ space) (1+ not-newline)) t))
;; Return element, because the predicate still needs testing.
element)
(`(deadline)
(setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "DEADLINE" ":") t))
;; Return element, because the predicate still needs testing. ;; Return element, because the predicate still needs testing.
element) element)
(`(regexp . ,regexps) (`(regexp . ,regexps)
@ -360,6 +435,7 @@ replace the clause with a preamble."
;; Return nil, don't test the predicate. ;; Return nil, don't test the predicate.
nil) nil)
(`(habit) (`(habit)
;; TODO: Move regexp to const.
(setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":STYLE:" (1+ space) (setq org-ql-preamble (rx-to-string `(seq bol (0+ space) ":STYLE:" (1+ space)
"habit" (0+ space) eol))) "habit" (0+ space) eol)))
nil) nil)
@ -376,6 +452,10 @@ replace the clause with a preamble."
(`(level ,num) (`(level ,num)
(setq org-ql-preamble (rx-to-string `(seq bol (repeat ,num "*") " ") t)) (setq org-ql-preamble (rx-to-string `(seq bol (repeat ,num "*") " ") t))
nil) nil)
(`(planning . ,_)
(setq org-ql-preamble org-ql-planning-regexp)
;; Return element, because the predicate still needs testing.
element)
(`(property ,property ,value) (`(property ,property ,value)
;; We do NOT return nil, because the predicate still needs to be tested, ;; We do NOT return nil, because the predicate still needs to be tested,
;; because the regexp could match a string not inside a property drawer. ;; because the regexp could match a string not inside a property drawer.
@ -400,12 +480,7 @@ replace the clause with a preamble."
;; (1+ space) (minimal-match (1+ not-newline)) eol))) ;; (1+ space) (minimal-match (1+ not-newline)) eol)))
;; element) ;; element)
(`(scheduled . ,_) (`(scheduled . ,_)
(setq org-ql-preamble (setq org-ql-preamble org-scheduled-time-regexp)
(rx-to-string `(seq bol (0+ (any " ")) "SCHEDULED" ":" (1+ space) (1+ not-newline)) t))
;; Return element, because the predicate still needs testing.
element)
(`(scheduled)
(setq org-ql-preamble (rx-to-string `(seq bol (0+ (any " ")) "SCHEDULED" ":") t))
;; Return element, because the predicate still needs testing. ;; Return element, because the predicate still needs testing.
element) element)
;; TODO: Add selector for tags without inheritance. ;; TODO: Add selector for tags without inheritance.
@ -595,45 +670,6 @@ empty time values to 23:59:59; otherwise, to 00:00:00."
(org-ql-select (current-buffer) (org-ql-select (current-buffer)
query :narrow t :action (lambda () t)))))) query :narrow t :action (lambda () t))))))
(org-ql--defpred clocked (&key from to _on)
;; The underscore before `on' prevents "unused lexical variable" warnings, because we
;; pre-process that argument in a macro before this function is called.
"Return non-nil if current entry was clocked in given period.
If no arguments are specified, return non-nil if entry was
clocked at any time.
If FROM, return non-nil if entry was clocked on or after FROM.
If TO, return non-nil if entry was clocked on or before TO.
If ON, return non-nil if entry was clocked on date ON.
FROM, TO, and ON should be strings parseable by
`parse-time-string' but may omit the time value.
Note: Clock entries are expected to be clocked out. Currently
clocked entries (i.e. with unclosed timestamp ranges) are
ignored."
;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written
;; for end users, for which the arguments are pre-processed by `org-ql-select'.
;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled.
(cl-macrolet ((next-timestamp ()
`(when (re-search-forward org-clock-line-re end-pos t)
(org-element-property :value (org-element-context))))
(test-timestamps (pred-form)
`(cl-loop for next-ts = (next-timestamp)
while next-ts
;; Using `setf' instead of `for beg =` here prevents "unused lexical variable" warnings.
do (setf beg (float-time (org-timestamp-to-time next-ts))
end (float-time (org-timestamp-to-time next-ts 'end)))
thereis ,pred-form)))
(save-excursion
(let ((end-pos (org-entry-end-position))
beg end)
(cond ((not (or from to)) (next-timestamp))
((and from to) (test-timestamps (and (<= beg to)
(>= end from))))
(from (test-timestamps (<= from end)))
(to (test-timestamps (<= beg to))))))))
(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)."
(when-let ((category (org-get-category (point)))) (when-let ((category (org-get-category (point))))
@ -756,8 +792,102 @@ comparator, PRIORITY should be a priority string."
;;;;;; Timestamps ;;;;;; Timestamps
(org-ql--defpred clocked (&key from to _on)
;; The underscore before `on' prevents "unused lexical variable"
;; warnings, because we pre-process that argument in a macro before
;; this function is called.
"Return non-nil if current entry was clocked in given period.
If no arguments are specified, return non-nil if entry has any
timestamp.
(org-ql--defpred ts (&key from to _on regexp) If FROM, return non-nil if entry has a timestamp on or after
FROM.
If TO, return non-nil if entry has a timestamp on or before TO.
If ON, return non-nil if entry has a timestamp on date ON.
FROM, TO, and ON should be either `ts' structs, or strings
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)
;; The underscore before `on' prevents "unused lexical variable"
;; warnings, because we pre-process that argument in a macro before
;; this function is called.
"Return non-nil if current entry was closed in given period.
If no arguments are specified, return non-nil if entry has any
timestamp.
If FROM, return non-nil if entry has a timestamp on or after
FROM.
If TO, return non-nil if entry has a timestamp on or before TO.
If ON, return non-nil if entry has a timestamp on date ON.
FROM, TO, and ON should be either `ts' structs, or strings
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))
(org-ql--defpred deadline (&key from to _on)
;; The underscore before `on' prevents "unused lexical variable"
;; warnings, because we pre-process that argument in a macro before
;; this function is called.
"Return non-nil if current entry has deadline in given period.
If no arguments are specified, return non-nil if entry has any
timestamp.
If FROM, return non-nil if entry has a timestamp on or after
FROM.
If TO, return non-nil if entry has a timestamp on or before TO.
If ON, return non-nil if entry has a timestamp on date ON.
FROM, TO, and ON should be either `ts' structs, or strings
parseable by `parse-time-string' which may omit the time value."
(org-ql--predicate-ts :from from :to to :regexp org-deadline-time-regexp :match-group 1))
(org-ql--defpred planning (&key from to _on)
;; The underscore before `on' prevents "unused lexical variable"
;; warnings, because we pre-process that argument in a macro before
;; this function is called.
"Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp).
If no arguments are specified, return non-nil if entry has any
timestamp.
If FROM, return non-nil if entry has a timestamp on or after
FROM.
If TO, return non-nil if entry has a timestamp on or before TO.
If ON, return non-nil if entry has a timestamp on date ON.
FROM, TO, and ON should be either `ts' structs, or strings
parseable by `parse-time-string' which may omit the time value."
(org-ql--predicate-ts :from from :to to :regexp org-ql-planning-regexp :match-group 1))
(org-ql--defpred scheduled (&key from to _on)
;; The underscore before `on' prevents "unused lexical variable"
;; warnings, because we pre-process that argument in a macro before
;; this function is called.
"Return non-nil if current entry is scheduled in given period.
If no arguments are specified, return non-nil if entry has any
timestamp.
If FROM, return non-nil if entry has a timestamp on or after
FROM.
If TO, return non-nil if entry has a timestamp on or before TO.
If ON, return non-nil if entry has a timestamp on date ON.
FROM, TO, and ON should be either `ts' structs, or strings
parseable by `parse-time-string' which may omit the time value."
(org-ql--predicate-ts :from from :to to :regexp org-scheduled-time-regexp :match-group 1))
(org-ql--defpred ts (&key from to _on regexp (match-group 0))
;; The underscore before `on' prevents "unused lexical variable" warnings, ;; The underscore before `on' prevents "unused lexical variable" warnings,
;; because we pre-process that argument in a macro before this function is ;; because we pre-process that argument in a macro before this function is
;; called. The `regexp' argument is also provided by the macro and is not ;; called. The `regexp' argument is also provided by the macro and is not
@ -784,7 +914,7 @@ match inactive ones, or `both' / nil to match both types."
;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled. ;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled.
(cl-macrolet ((next-timestamp () (cl-macrolet ((next-timestamp ()
`(when (re-search-forward regexp end-pos t) `(when (re-search-forward regexp end-pos t)
(ts-parse-org (match-string 0)))) (ts-parse-org (match-string match-group))))
(test-timestamps (pred-form) (test-timestamps (pred-form)
`(cl-loop for next-ts = (next-timestamp) `(cl-loop for next-ts = (next-timestamp)
while next-ts while next-ts
@ -797,143 +927,6 @@ match inactive ones, or `both' / nil to match both types."
(from (test-timestamps (ts<= from next-ts))) (from (test-timestamps (ts<= from next-ts)))
(to (test-timestamps (ts<= next-ts to)))))))) (to (test-timestamps (ts<= next-ts to))))))))
;;;;; Date comparison
(defun org-ql--date-type-p (type &optional comparator target-date)
"Return non-nil if current heading has a date property of TYPE.
TYPE should be a keyword symbol, like :scheduled or :deadline.
With COMPARATOR and TARGET-DATE, return non-nil if entry's
scheduled date compares with TARGET-DATE according to COMPARATOR.
TARGET-DATE may be a string like \"2017-08-05\", or an integer
like one returned by `date-to-day'."
(when-let (;; FIXME: Add :date selector, since I put it
;; in the examples but forgot to actually
;; make it.
(timestamp (org-entry-get (point) (pcase type
(:deadline "DEADLINE")
(:scheduled "SCHEDULED")
(:closed "CLOSED"))))
(date-element (with-temp-buffer
;; FIXME: Hack: since we're using
;; (org-element-property :type date-element)
;; below, we need this date parsed into an
;; org-element element
(insert timestamp)
(goto-char 0)
(org-element-timestamp-parser))))
(pcase comparator
;; Not comparing, just checking if it has one
('nil t)
;; Compare dates
((pred functionp)
(let ((target-day-number (cl-typecase target-date
(null (+ (org-get-wdays timestamp) (org-today)))
;; Append time to target-date because `date-to-day' requires it.
(string (date-to-day (concat target-date " 00:00")))
(integer target-date))))
(pcase (org-element-property :type date-element)
((or 'active 'inactive 'active-range 'inactive-range)
(funcall comparator
(org-time-string-to-absolute
(org-element-timestamp-interpreter date-element 'ignore))
target-day-number))
(_ (error "Unknown date-element type \"%s\" in buffer %s at position %s"
(org-element-property :type date-element) (current-buffer) (point))))))
(_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer"
comparator target-date)))))
(org-ql--defpred planning (&optional comparator target-date)
"Return non-nil if entry's planning date (deadline or scheduled) compares with TARGET-DATE using COMPARATOR.
TARGET-DATE should be a string parseable by `date-to-day'.
COMPARATOR should be a function (like `<=')."
;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again.
;; FIXME: I think :date selects either :deadline, :scheduled, or :closed, but I'm not sure.
(org-ql--date-type-p :date comparator target-date))
(org-ql--defpred deadline (&optional comparator target-date)
"Return non-nil if entry's deadline compares with TARGET-DATE using COMPARATOR.
TARGET-DATE should be a string parseable by `date-to-day'; or if
omitted, it is determined automatically using
`org-deadline-warning-days'. COMPARATOR should be a
function (like `<=')."
;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again.
;; FIXME: This is slightly confusing. Using plain (deadline) does, and should, select entries
;; that have any deadline. But the common case of wanting to select entries whose deadline is
;; within the warning days (either the global setting or that entry's setting) requires the user
;; to specify the <= comparator, which is unintuitive. Maybe it would be better to use that
;; comparator by default, and use an 'any comparator to select entries with any deadline. Of
;; course, that would make the deadline selector different from the scheduled, closed, and date
;; selectors, which would also be unintuitive.
(org-ql--date-type-p :deadline comparator target-date))
(org-ql--defpred scheduled (&optional comparator target-date)
"Return non-nil if entry's scheduled date compares with TARGET-DATE using COMPARATOR.
TARGET-DATE should be a string parseable by `date-to-day'.
COMPARATOR should be a function (like `<=')."
;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again.
(org-ql--date-type-p :scheduled comparator target-date))
(org-ql--defpred closed (&optional comparator target-date)
"Return non-nil if entry's closed date compares with TARGET-DATE using COMPARATOR.
TARGET-DATE should be a string parseable by `date-to-day'.
COMPARATOR should be a function (like `<=')."
;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again.
(org-ql--date-type-p :closed comparator target-date))
(org-ql--defpred date (&optional comparator target-date (type 'active))
"Return non-nil if Org entry at point has date of TYPE that compares with TARGET-DATE using COMPARATOR.
Checks all Org-formatted timestamp strings in entry. TYPE may be
`active', `inactive', or `all', to control whether active,
inactive, or all timestamps are checked. Ranges of each type are
also checked. TARGET-DATE should be a string parseable by
`date-to-day'. COMPARATOR should be a function (like `<=')."
;; TODO: Deprecate this with a warning, suggest using (ts) instead, and remove (date) from examples.
;; MAYBE: This duplicates some code in --date-p, maybe it could be refactored DRYer.
(let* ((entry-timestamps (save-excursion
;; NOTE: It's important to `save-excursion', otherwise the point will be moved, which will
;; likely cause the action function to fail. We could wrap the call to the predicate in
;; `save-excursion', but that would do it even when not necessary, which would be slower.
(cl-loop while (re-search-forward org-element--timestamp-regexp (org-entry-end-position) t)
collect (match-string 0)))))
(pcase comparator
('nil (pcase type
('all entry-timestamps)
('active (cl-loop for timestamp in entry-timestamps
thereis (string-prefix-p "<" timestamp)))
('inactive (cl-loop for timestamp in entry-timestamps
thereis (string-prefix-p "[" timestamp)))
(_ (user-error "Invalid type for date selector. May be `active', `inactive', or `all'"))))
((pred functionp)
;; TODO: Avoid computing target-day-number every time this is called.
;; Probably need to make a lambda that has it already defined.
(let ((target-day-number (cl-typecase target-date
(null nil) ; Calculated later.
;; Append time to target-date because `date-to-day' requires it.
(string (date-to-day (concat target-date " 00:00")))
(integer target-date))))
(cl-loop for timestamp in entry-timestamps
for date-element = (with-temp-buffer
;; MAYBE: Replace with ts.el eventually.
;; TODO: Parse the element in the re-search-forward loop.
(insert timestamp)
(goto-char 0)
(org-element-timestamp-parser))
for this-target-day-number = (or target-day-number
;; FIXME: Not sure if it makes sense to check warning
;; days for non-planning timestamps, but we'll try it.
(+ (org-get-wdays timestamp) (org-today)))
thereis (when (or (eq 'all type)
(member (org-element-property :type date-element)
(pcase type
('active '(active active-range))
('inactive '(inactive inactive-range)))))
(funcall comparator (org-time-string-to-absolute
(org-element-timestamp-interpreter date-element 'ignore))
this-target-day-number)))))
(_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer"
comparator target-date)))))
;;;;; Sorting ;;;;; Sorting
;; FIXME: These appear to work properly, but it would be good to have tests for them. ;; FIXME: These appear to work properly, but it would be good to have tests for them.

130
tests/test-org-ql.el
View file

@ -280,39 +280,26 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((closed)) (org-ql-expect ((closed))
'("Learn universal sign language"))) '("Learn universal sign language")))
(org-ql-it "=" (org-ql-it ":on"
(org-ql-expect ((closed = "2017-07-05")) (org-ql-expect ((closed :on "2017-07-05"))
'("Learn universal sign language")) '("Learn universal sign language"))
(org-ql-expect ((closed = "2019-06-09")) (org-ql-expect ((closed :on "2019-06-09"))
nil)) nil))
(org-ql-it "<" (org-ql-it ":from"
;; TODO: Figure out why these tests take about 8 times longer than the other comparators in the (closed) tests. (org-ql-expect ((closed :from "2017-07-04"))
(org-ql-expect ((closed < "2019-06-10"))
'("Learn universal sign language")) '("Learn universal sign language"))
(org-ql-expect ((closed < "2017-06-10")) (org-ql-expect ((closed :from "2017-07-05"))
'("Learn universal sign language"))
(org-ql-expect ((closed :from "2017-07-06"))
nil)) nil))
(org-ql-it ">" (org-ql-it ":to"
(org-ql-expect ((closed > "2017-07-04")) (org-ql-expect ((closed :to "2017-07-04"))
'("Learn universal sign language"))
(org-ql-expect ((closed > "2019-07-05"))
nil))
(org-ql-it ">="
(org-ql-expect ((closed >= "2017-07-04"))
'("Learn universal sign language"))
(org-ql-expect ((closed >= "2017-07-05"))
'("Learn universal sign language"))
(org-ql-expect ((closed >= "2017-07-06"))
nil))
(org-ql-it "<="
(org-ql-expect ((closed <= "2017-07-04"))
nil) nil)
(org-ql-expect ((closed <= "2017-07-05")) (org-ql-expect ((closed :to "2017-07-05"))
'("Learn universal sign language")) '("Learn universal sign language"))
(org-ql-expect ((closed <= "2017-07-06")) (org-ql-expect ((closed :to "2017-07-06"))
'("Learn universal sign language")))) '("Learn universal sign language"))))
(describe "(deadline)" (describe "(deadline)"
@ -321,41 +308,28 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((deadline)) (org-ql-expect ((deadline))
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))) '("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-it "=" (org-ql-it ":on"
(org-ql-expect ((deadline = "2017-07-05")) (org-ql-expect ((deadline :on "2017-07-05"))
'("/r/emacs")) '("/r/emacs"))
(org-ql-expect ((deadline = "2019-06-09")) (org-ql-expect ((deadline :on "2019-06-09"))
nil)) nil))
(org-ql-it "<" (org-ql-it ":from"
(org-ql-expect ((deadline < "2019-06-10")) (org-ql-expect ((deadline :from "2017-07-04"))
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) '("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-expect ((deadline < "2017-06-10")) (org-ql-expect ((deadline :from "2017-07-05"))
nil))
(org-ql-it ">"
;; TODO: Figure out why these tests take much longer than e.g. the (deadline <) tests.
(org-ql-expect ((deadline > "2017-07-04 00:00"))
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")) '("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-expect ((deadline > "2019-07-05")) (org-ql-expect ((deadline :from "2017-07-06"))
nil))
(org-ql-it ">="
(org-ql-expect ((deadline >= "2017-07-04"))
'("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-expect ((deadline >= "2017-07-05"))
'("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-expect ((deadline >= "2017-07-06"))
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease")) '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease"))
(org-ql-expect ((deadline >= "2018-07-06")) (org-ql-expect ((deadline :from "2018-07-06"))
nil)) nil))
(org-ql-it "<=" (org-ql-it ":to"
(org-ql-expect ((deadline <= "2017-07-04")) (org-ql-expect ((deadline :to "2017-07-04"))
nil) nil)
(org-ql-expect ((deadline <= "2017-07-05")) (org-ql-expect ((deadline :to "2017-07-05"))
'("/r/emacs")) '("/r/emacs"))
(org-ql-expect ((deadline <= "2018-07-06")) (org-ql-expect ((deadline :to "2018-07-06"))
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")))) '("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-it "(done)" (org-ql-it "(done)"
@ -366,6 +340,34 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((habit)) (org-ql-expect ((habit))
'("Practice leaping tall buildings in a single bound"))) '("Practice leaping tall buildings in a single bound")))
(describe "(planning)"
(org-ql-it "without arguments"
(org-ql-expect ((planning))
'("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")))
(org-ql-it ":on"
(org-ql-expect ((planning :on "2017-07-05"))
'("Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
(org-ql-expect ((planning :on "2019-06-09"))
nil))
(org-ql-it ":from"
(org-ql-expect ((planning :from "2017-07-04"))
'("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
(org-ql-expect ((planning :from "2017-07-05"))
'("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" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
(org-ql-expect ((planning :from "2017-07-06"))
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease")))
(org-ql-it ":to"
(org-ql-expect ((planning :to "2017-07-04"))
'("Skype with president of Antarctica"))
(org-ql-expect ((planning :to "2017-07-05"))
'("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
(org-ql-expect ((planning :to "2018-07-06"))
'("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))))
(describe "(property)" (describe "(property)"
;; MAYBE: Add support for (property) without arguments. ;; MAYBE: Add support for (property) without arguments.
@ -402,6 +404,34 @@ RESULTS should be a list of strings as returned by
:sort todo) :sort todo)
'("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut")))) '("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon" "Order a pizza" "Get haircut"))))
(describe "(scheduled)"
(org-ql-it "without arguments"
(org-ql-expect ((scheduled))
'("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")))
(org-ql-it ":on"
(org-ql-expect ((scheduled :on "2017-07-05"))
'("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
(org-ql-expect ((scheduled :on "2019-06-09"))
nil))
(org-ql-it ":from"
(org-ql-expect ((scheduled :from "2017-07-04"))
'("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
(org-ql-expect ((scheduled :from "2017-07-05"))
'("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
(org-ql-expect ((scheduled :from "2017-07-06"))
nil))
(org-ql-it ":to"
(org-ql-expect ((scheduled :to "2017-07-04"))
'("Skype with president of Antarctica"))
(org-ql-expect ((scheduled :to "2017-07-05"))
'("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
(org-ql-expect ((scheduled :to "2018-07-06"))
'("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))))
(describe "(todo)" (describe "(todo)"
(org-ql-it "without arguments" (org-ql-it "without arguments"