Add/Change: Use ts.el, add ts-a and ts-i
Improves performance, reduces code, and more test cases added.
This commit is contained in:
parent
913292787b
commit
4954789ca5
4 changed files with 261 additions and 154 deletions
11
README.org
11
README.org
|
|
@ -151,9 +151,11 @@ Arguments are listed next to predicate names, where applicable.
|
||||||
+ ~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 ~<=~).
|
+ ~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).
|
+ ~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).
|
||||||
+ ~ts (&key from to on)~ :: 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 strings parseable by ~parse-time-string~ but may omit the time value.
|
+ ~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 strings parseable by ~parse-time-string~ but 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 (&key from to on)~ :: Return non-nil if current entry has an active timestamp in given period. If no arguments are specified, return non-nil if entry has any active timestamp. If ~FROM~, return non-nil if entry has an active timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has an active timestamp on or before ~TO~. If ~ON~, return non-nil if entry has an active timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value.
|
+ ~ts-active~ :: Like ~ts~ called with ~:type active~.
|
||||||
+ ~ts-inactive (&key from to on)~ :: Return non-nil if current entry has an inactive timestamp in given period. If no arguments are specified, return non-nil if entry has any inactive timestamp. If ~FROM~, return non-nil if entry has an inactive timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has an inactive timestamp on or before ~TO~. If ~ON~, return non-nil if entry has an inactive timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value.
|
+ ~ts-a~ :: Like ~ts~ called with ~:type active~.
|
||||||
|
+ ~ts-inactive~ :: Like ~ts~ called with ~:type inactive~.
|
||||||
|
+ ~ts-i~ :: Like ~ts~ called with ~:type inactive~.
|
||||||
|
|
||||||
** Functions / Macros
|
** Functions / Macros
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
|
|
@ -361,6 +363,8 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience
|
||||||
+ Macro ~org-ql~ and functions ~org-ql-query~ and ~org-ql-select~ now also accept a comparator function in their ~:sort~ argument.
|
+ Macro ~org-ql~ and functions ~org-ql-query~ and ~org-ql-select~ now also accept a comparator function in their ~:sort~ argument.
|
||||||
+ Function ~org-ql-block~, which works as an Org Agenda series/composite/block command, usable in custom agenda commands defined in variable ~org-agenda-custom-commands~. (Inspired by [[https://github.com/pestctrl/emacs-config/blob/84c557982a860e86d6f67976a82ea776a7bd2c7a/config-org-new.org#my-own-agenda-renderer][Benson Chu's config]].)
|
+ Function ~org-ql-block~, which works as an Org Agenda series/composite/block command, usable in custom agenda commands defined in variable ~org-agenda-custom-commands~. (Inspired by [[https://github.com/pestctrl/emacs-config/blob/84c557982a860e86d6f67976a82ea776a7bd2c7a/config-org-new.org#my-own-agenda-renderer][Benson Chu's config]].)
|
||||||
+ Function ~org-ql-agenda--agenda~ optionally takes a list of entries as an argument.
|
+ Function ~org-ql-agenda--agenda~ optionally takes a list of entries as an argument.
|
||||||
|
+ Selectors ~ts-a~ and ~ts-i~, aliases for ~ts-active~ and ~ts-inactive~.
|
||||||
|
+ Selector ~ts~ now accepts a ~:type~ argument.
|
||||||
|
|
||||||
*Changed*
|
*Changed*
|
||||||
+ Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function.
|
+ Function ~org-ql-query~ renamed to ~org-ql-select~. ~org-ql-query~ now refers to a new function.
|
||||||
|
|
@ -375,6 +379,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience
|
||||||
|
|
||||||
*Internal*
|
*Internal*
|
||||||
+ Optimizations for some query selectors, e.g. =regexp= and =todo=. These can provide a significant improvement for some queries. See benchmarks in [[file:notes.org][notes.org]].
|
+ Optimizations for some query selectors, e.g. =regexp= and =todo=. These can provide a significant improvement for some queries. See benchmarks in [[file:notes.org][notes.org]].
|
||||||
|
+ Library [[https://github.com/alphapapa/ts.el][ts]] is now used for parsing and comparing timestamps.
|
||||||
|
|
||||||
** 0.1
|
** 0.1
|
||||||
|
|
||||||
|
|
|
||||||
122
notes.org
122
notes.org
|
|
@ -647,6 +647,128 @@ If tag inheritance is enabled, we have to check tags on every heading. When it'
|
||||||
| preamble: (tags "Emacs") | 2.08 | 0.274555 | 0 | 0 |
|
| preamble: (tags "Emacs") | 2.08 | 0.274555 | 0 | 0 |
|
||||||
| no preamble: (tags "Emacs") | slowest | 0.570116 | 0 | 0 |
|
| no preamble: (tags "Emacs") | slowest | 0.570116 | 0 | 0 |
|
||||||
|
|
||||||
|
** with/without ts.el
|
||||||
|
|
||||||
|
[2019-08-11 Sun 15:39] These results seem to show a minor performance improvement by using ~ts~, and the code is simpler.
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
;; (require 'ts)
|
||||||
|
|
||||||
|
(org-ql--defpred ts-ts (&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 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 strings parseable by
|
||||||
|
`parse-time-string' but may omit the time value."
|
||||||
|
;; TODO: DRY this with the clocked predicate.
|
||||||
|
;; 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-element--timestamp-regexp end-pos t)
|
||||||
|
(ts-parse-org (match-string 0))))
|
||||||
|
(test-timestamps (pred-form)
|
||||||
|
`(cl-loop for next-ts = (next-timestamp)
|
||||||
|
while next-ts
|
||||||
|
thereis ,pred-form)))
|
||||||
|
(save-excursion
|
||||||
|
(let ((end-pos (org-entry-end-position)))
|
||||||
|
(cond ((not (or from to)) (re-search-forward org-element--timestamp-regexp end-pos t))
|
||||||
|
((and from to) (test-timestamps (and (ts<= from next-ts)
|
||||||
|
(ts<= next-ts to))))
|
||||||
|
(from (test-timestamps (ts<= from next-ts)))
|
||||||
|
(to (test-timestamps (ts<= next-ts to))))))))
|
||||||
|
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
*** Without timestamp argument
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
(bench-multi-lexical :times 1 :ensure-equal t
|
||||||
|
:forms (("old ts" (org-ql "~/org/inbox.org"
|
||||||
|
(ts)))
|
||||||
|
("ts.el ts" (org-ql "~/org/inbox.org"
|
||||||
|
(ts-ts)))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+RESULTS:
|
||||||
|
| Form | x faster than next | Total runtime | # of GCs | Total GC runtime |
|
||||||
|
|----------+--------------------+---------------+----------+------------------|
|
||||||
|
| ts.el ts | 1.14 | 2.251801 | 0 | 0 |
|
||||||
|
| old ts | slowest | 2.560280 | 0 | 0 |
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
(bench-multi-lexical :times 20 :ensure-equal t
|
||||||
|
:forms (("old ts" (org-ql "~/src/emacs/org-ql/tests/data.org"
|
||||||
|
(ts)))
|
||||||
|
("ts.el ts" (org-ql "~/src/emacs/org-ql/tests/data.org"
|
||||||
|
(ts-ts)))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+RESULTS:
|
||||||
|
| Form | x faster than next | Total runtime | # of GCs | Total GC runtime |
|
||||||
|
|----------+--------------------+---------------+----------+------------------|
|
||||||
|
| ts.el ts | 1.05 | 0.103714 | 0 | 0 |
|
||||||
|
| old ts | slowest | 0.108663 | 0 | 0 |
|
||||||
|
|
||||||
|
*** :from
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
(bench-multi-lexical :times 1 :ensure-equal t
|
||||||
|
:forms (("old ts" (org-ql "~/org/inbox.org"
|
||||||
|
(ts :from "2017-01-01")))
|
||||||
|
("ts.el ts" (org-ql "~/org/inbox.org"
|
||||||
|
(ts-ts :from "2017-01-01")))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+RESULTS:
|
||||||
|
| Form | x faster than next | Total runtime | # of GCs | Total GC runtime |
|
||||||
|
|----------+--------------------+---------------+----------+------------------|
|
||||||
|
| ts.el ts | 1.32 | 1.299966 | 0 | 0 |
|
||||||
|
| old ts | slowest | 1.713027 | 0 | 0 |
|
||||||
|
|
||||||
|
*** :to
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
(bench-multi-lexical :times 1 :ensure-equal t
|
||||||
|
:forms (("old ts" (org-ql "~/org/inbox.org"
|
||||||
|
(ts :to "2019-01-01")))
|
||||||
|
("ts.el ts" (org-ql "~/org/inbox.org"
|
||||||
|
(ts-ts :to "2019-01-01")))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+RESULTS:
|
||||||
|
| Form | x faster than next | Total runtime | # of GCs | Total GC runtime |
|
||||||
|
|----------+--------------------+---------------+----------+------------------|
|
||||||
|
| ts.el ts | 1.01 | 1.300084 | 0 | 0 |
|
||||||
|
| old ts | slowest | 1.312208 | 0 | 0 |
|
||||||
|
|
||||||
|
*** :on
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
(bench-multi-lexical :times 1 :ensure-equal t
|
||||||
|
:forms (("old ts" (org-ql "~/org/inbox.org"
|
||||||
|
(ts :on "2019-05-14")))
|
||||||
|
("ts.el ts" (org-ql "~/org/inbox.org"
|
||||||
|
(ts-ts :on "2019-05-14")))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
#+RESULTS:
|
||||||
|
| Form | x faster than next | Total runtime | # of GCs | Total GC runtime |
|
||||||
|
|----------+--------------------+---------------+----------+------------------|
|
||||||
|
| ts.el ts | 1.17 | 0.557281 | 0 | 0 |
|
||||||
|
| old ts | slowest | 0.652149 | 0 | 0 |
|
||||||
|
|
||||||
** Using =org-element-parse-buffer=
|
** Using =org-element-parse-buffer=
|
||||||
|
|
||||||
This basically works, as a very basic kind of agenda view, but we can already see that it's much slower (at least, for single-day views) because =org-element-parse-buffer= is slow compared to the agenda code.
|
This basically works, as a very basic kind of agenda view, but we can already see that it's much slower (at least, for single-day views) because =org-element-parse-buffer= is slow compared to the agenda code.
|
||||||
|
|
|
||||||
168
org-ql.el
168
org-ql.el
|
|
@ -3,7 +3,7 @@
|
||||||
;; Author: Adam Porter <adam@alphapapa.net>
|
;; Author: Adam Porter <adam@alphapapa.net>
|
||||||
;; Url: https://github.com/alphapapa/org-ql
|
;; Url: https://github.com/alphapapa/org-ql
|
||||||
;; Version: 0.2-pre
|
;; Version: 0.2-pre
|
||||||
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.0") (s "1.12.0"))
|
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.0") (s "1.12.0") (ts "0.2"))
|
||||||
;; Keywords: hypermedia, outlines, Org, agenda
|
;; Keywords: hypermedia, outlines, Org, agenda
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
|
@ -40,6 +40,7 @@
|
||||||
(require 'subr-x)
|
(require 'subr-x)
|
||||||
|
|
||||||
(require 'dash)
|
(require 'dash)
|
||||||
|
(require 'ts)
|
||||||
|
|
||||||
;;;; Compatibility
|
;;;; Compatibility
|
||||||
|
|
||||||
|
|
@ -53,6 +54,12 @@
|
||||||
|
|
||||||
;;;; Variables
|
;;;; Variables
|
||||||
|
|
||||||
|
(defconst org-ql-tsr-regexp-inactive
|
||||||
|
(concat org-ts-regexp-inactive "\\(--?-?"
|
||||||
|
org-ts-regexp-inactive "\\)?")
|
||||||
|
;; MAYBE: Propose this for org.el.
|
||||||
|
"Regular expression matching an inactive timestamp or timestamp range.")
|
||||||
|
|
||||||
(defvar org-ql--today nil)
|
(defvar org-ql--today nil)
|
||||||
|
|
||||||
(defvar org-ql-use-preamble t
|
(defvar org-ql-use-preamble t
|
||||||
|
|
@ -232,7 +239,8 @@ NARROW corresponds to the `org-ql-select' argument NARROW."
|
||||||
|
|
||||||
(defun org-ql--pre-process-query (query)
|
(defun org-ql--pre-process-query (query)
|
||||||
"Return QUERY having been pre-processed.
|
"Return QUERY having been pre-processed.
|
||||||
Replaces bare strings with (regexp) selectors."
|
Replaces bare strings with (regexp) selectors, and appropriate
|
||||||
|
`ts'-related selectors."
|
||||||
;; This is unsophisticated, but it works.
|
;; This is unsophisticated, but it works.
|
||||||
(cl-labels ((rec (element)
|
(cl-labels ((rec (element)
|
||||||
(pcase element
|
(pcase element
|
||||||
|
|
@ -244,6 +252,8 @@ Replaces bare strings with (regexp) selectors."
|
||||||
,@(mapcar #'rec clauses)))
|
,@(mapcar #'rec clauses)))
|
||||||
;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND).
|
;; TODO: Combine (regexp) when appropriate (i.e. inside an OR, not an AND).
|
||||||
((pred stringp) `(regexp ,element))
|
((pred stringp) `(regexp ,element))
|
||||||
|
(`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest))
|
||||||
|
(`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))
|
||||||
(_ element))))
|
(_ element))))
|
||||||
(rec query)))
|
(rec query)))
|
||||||
|
|
||||||
|
|
@ -267,39 +277,21 @@ Replaces bare strings with (regexp) selectors."
|
||||||
;; 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))
|
||||||
(ts (&key from to on)
|
(ts (&key from to on (type 'both))
|
||||||
(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 (ts-parse-fill 'begin from)))
|
||||||
(when to
|
(when to
|
||||||
(setq to (org-ql--parse-time-string to 'end)))
|
(setq to (ts-parse-fill 'end to)))
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
||||||
;; function, not another `ts'.
|
;; function, not another `ts'.
|
||||||
`(org-ql--predicate-ts :from ,from :to ,to))
|
`(org-ql--predicate-ts :from ,from :to ,to
|
||||||
(ts-active (&key from to on)
|
:regexp ,(pcase type
|
||||||
(when on
|
('both org-tsr-regexp-both)
|
||||||
(setq from on
|
('active org-tsr-regexp)
|
||||||
to on))
|
('inactive org-ql-tsr-regexp-inactive)))))
|
||||||
(when from
|
|
||||||
(setq from (org-ql--parse-time-string from)))
|
|
||||||
(when to
|
|
||||||
(setq to (org-ql--parse-time-string to 'end)))
|
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
|
||||||
;; function, not another `ts'.
|
|
||||||
`(org-ql--predicate-ts-active :from ,from :to ,to))
|
|
||||||
(ts-inactive (&key from to on)
|
|
||||||
(when on
|
|
||||||
(setq from on
|
|
||||||
to on))
|
|
||||||
(when from
|
|
||||||
(setq from (org-ql--parse-time-string from)))
|
|
||||||
(when to
|
|
||||||
(setq to (org-ql--parse-time-string to 'end)))
|
|
||||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
|
||||||
;; function, not another `ts'.
|
|
||||||
`(org-ql--predicate-ts-inactive :from ,from :to ,to)))
|
|
||||||
(cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda
|
(cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda
|
||||||
(= #'=)
|
(= #'=)
|
||||||
(< #'<)
|
(< #'<)
|
||||||
|
|
@ -710,9 +702,11 @@ comparator, PRIORITY should be a priority string."
|
||||||
;; and language-independent than using from/to. Alternatively, add :before/:after, but I
|
;; and language-independent than using from/to. Alternatively, add :before/:after, but I
|
||||||
;; think the comparators are better. Also consider using a macro to DRY these out.
|
;; think the comparators are better. Also consider using a macro to DRY these out.
|
||||||
|
|
||||||
(org-ql--defpred ts (&key from to _on)
|
(org-ql--defpred ts (&key from to _on regexp)
|
||||||
;; The underscore before `on' prevents "unused lexical variable" warnings, because we
|
;; The underscore before `on' prevents "unused lexical variable" warnings,
|
||||||
;; pre-process that argument in a macro before this function is called.
|
;; 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
|
||||||
|
;; to be given by the user, so it is omitted from the docstring.
|
||||||
"Return non-nil if current entry has a timestamp in given period.
|
"Return non-nil if current entry has a timestamp in given period.
|
||||||
If no arguments are specified, return non-nil if entry has any
|
If no arguments are specified, return non-nil if entry has any
|
||||||
timestamp.
|
timestamp.
|
||||||
|
|
@ -725,116 +719,28 @@ 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.
|
If ON, return non-nil if entry has a timestamp on date ON.
|
||||||
|
|
||||||
FROM, TO, and ON should be strings parseable by
|
FROM, TO, and ON should be strings parseable by
|
||||||
`parse-time-string' but may omit the time value."
|
`parse-time-string' but 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."
|
||||||
;; TODO: DRY this with the clocked predicate.
|
;; TODO: DRY this with the clocked predicate.
|
||||||
;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written
|
;; 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'.
|
;; 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.
|
;; 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 org-element--timestamp-regexp end-pos t)
|
`(when (re-search-forward regexp end-pos t)
|
||||||
(save-excursion
|
(ts-parse-org (match-string 0))))
|
||||||
(goto-char (match-beginning 0))
|
|
||||||
(org-element-timestamp-parser))))
|
|
||||||
(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
|
||||||
do (setf beg (float-time (org-timestamp-to-time next-ts))
|
|
||||||
end (float-time (org-timestamp-to-time next-ts 'end)))
|
|
||||||
thereis ,pred-form)))
|
thereis ,pred-form)))
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(let ((end-pos (org-entry-end-position))
|
(let ((end-pos (org-entry-end-position)))
|
||||||
beg end)
|
(cond ((not (or from to)) (re-search-forward regexp end-pos t))
|
||||||
(cond ((not (or from to)) (next-timestamp))
|
((and from to) (test-timestamps (and (ts<= from next-ts)
|
||||||
((and from to) (test-timestamps (and (<= beg to)
|
(ts<= next-ts to))))
|
||||||
(>= end from))))
|
(from (test-timestamps (ts<= from next-ts)))
|
||||||
(from (test-timestamps (<= from end)))
|
(to (test-timestamps (ts<= next-ts to))))))))
|
||||||
(to (test-timestamps (<= beg to))))))))
|
|
||||||
|
|
||||||
(org-ql--defpred ts-active (&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 an active timestamp in given period.
|
|
||||||
If no arguments are specified, return non-nil if entry has any
|
|
||||||
active timestamp.
|
|
||||||
|
|
||||||
If FROM, return non-nil if entry has an active timestamp on or
|
|
||||||
after FROM.
|
|
||||||
|
|
||||||
If TO, return non-nil if entry has an active timestamp on or
|
|
||||||
before TO.
|
|
||||||
|
|
||||||
If ON, return non-nil if entry has an active timestamp on date
|
|
||||||
ON.
|
|
||||||
|
|
||||||
FROM, TO, and ON should be strings parseable by
|
|
||||||
`parse-time-string' but may omit the time value."
|
|
||||||
;; TODO: DRY this with the clocked predicate.
|
|
||||||
;; 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-element--timestamp-regexp end-pos t)
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (match-beginning 0))
|
|
||||||
(org-element-timestamp-parser))))
|
|
||||||
(test-timestamps (pred-form)
|
|
||||||
`(cl-loop for next-ts = (next-timestamp)
|
|
||||||
while next-ts
|
|
||||||
when (string-prefix-p "<" next-ts)
|
|
||||||
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 ts-inactive (&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 an inactive timestamp in given period.
|
|
||||||
If no arguments are specified, return non-nil if entry has any
|
|
||||||
inactive timestamp.
|
|
||||||
|
|
||||||
If FROM, return non-nil if entry has an inactive timestamp on or
|
|
||||||
after FROM.
|
|
||||||
|
|
||||||
If TO, return non-nil if entry has an inactive timestamp on or
|
|
||||||
before TO.
|
|
||||||
|
|
||||||
If ON, return non-nil if entry has an inactive timestamp on date
|
|
||||||
ON.
|
|
||||||
|
|
||||||
FROM, TO, and ON should be strings parseable by
|
|
||||||
`parse-time-string' but may omit the time value."
|
|
||||||
;; TODO: DRY this with the clocked predicate.
|
|
||||||
;; 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-element--timestamp-regexp end-pos t)
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (match-beginning 0))
|
|
||||||
(org-element-timestamp-parser))))
|
|
||||||
(test-timestamps (pred-form)
|
|
||||||
`(cl-loop for next-ts = (next-timestamp)
|
|
||||||
while next-ts
|
|
||||||
when (string-prefix-p "[" next-ts)
|
|
||||||
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))))))))
|
|
||||||
|
|
||||||
;;;;; Date comparison
|
;;;;; Date comparison
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -169,7 +169,16 @@ RESULTS should be a list of strings as returned by
|
||||||
:to-equal '(when (and (regexp "string-cond1") (regexp "string-cond2")) (or (regexp "string1") (regexp "string2"))))
|
:to-equal '(when (and (regexp "string-cond1") (regexp "string-cond2")) (or (regexp "string1") (regexp "string2"))))
|
||||||
(expect (org-ql--pre-process-query '(unless (and "stringcondition1" "stringcond2")
|
(expect (org-ql--pre-process-query '(unless (and "stringcondition1" "stringcond2")
|
||||||
(or "string1" "string2")))
|
(or "string1" "string2")))
|
||||||
:to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "string2")))))
|
:to-equal '(unless (and (regexp "stringcondition1") (regexp "stringcond2")) (or (regexp "string1") (regexp "string2"))))
|
||||||
|
|
||||||
|
(expect (org-ql--pre-process-query '(or (ts-active :on "2019-01-01")
|
||||||
|
(ts-a :on "2019-01-01")
|
||||||
|
(ts-inactive :on "2019-01-01")
|
||||||
|
(ts-i :on "2019-01-01")))
|
||||||
|
:to-equal '(or (ts :type active :on "2019-01-01")
|
||||||
|
(ts :type active :on "2019-01-01")
|
||||||
|
(ts :type inactive :on "2019-01-01")
|
||||||
|
(ts :type inactive :on "2019-01-01"))))
|
||||||
|
|
||||||
(describe "Query optimizing"
|
(describe "Query optimizing"
|
||||||
|
|
||||||
|
|
@ -412,28 +421,93 @@ RESULTS should be a list of strings as returned by
|
||||||
|
|
||||||
(describe "(ts)"
|
(describe "(ts)"
|
||||||
|
|
||||||
|
(describe "active"
|
||||||
|
|
||||||
|
(org-ql-it "without arguments"
|
||||||
|
(org-ql-expect ((ts :type active))
|
||||||
|
'("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" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")))
|
||||||
|
|
||||||
|
(org-ql-it ":from a timestamp"
|
||||||
|
;; TODO: Figure out why these take longer than the other (ts) tests.
|
||||||
|
(org-ql-expect ((ts :from "2017-07-08" :type active))
|
||||||
|
'("Take over the universe" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease"))
|
||||||
|
(org-ql-expect ((ts :from "2019-06-08" :type active))
|
||||||
|
nil))
|
||||||
|
|
||||||
|
(org-ql-it ":to a timestamp"
|
||||||
|
(org-ql-expect ((ts :to "2019-06-10" :type active))
|
||||||
|
'("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" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
|
||||||
|
(org-ql-expect ((ts :to "2017-07-04" :type active))
|
||||||
|
'("Skype with president of Antarctica")))
|
||||||
|
|
||||||
|
(org-ql-it ":on a timestamp"
|
||||||
|
(org-ql-expect ((ts :on "2017-07-05" :type active))
|
||||||
|
'("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
|
||||||
|
(org-ql-expect ((ts :on "2019-06-09" :type active))
|
||||||
|
nil)))
|
||||||
|
|
||||||
|
(describe "inactive"
|
||||||
|
|
||||||
|
(org-ql-it "without arguments"
|
||||||
|
(org-ql-expect ((ts :type inactive))
|
||||||
|
'("Test data" "Visit the moon" "Learn universal sign language" "Rewrite Emacs in Common Lisp")))
|
||||||
|
|
||||||
|
(org-ql-it ":from a timestamp"
|
||||||
|
(org-ql-expect ((ts :from "2017-07-06" :type inactive))
|
||||||
|
'("Visit the moon" "Rewrite Emacs in Common Lisp"))
|
||||||
|
(org-ql-expect ((ts :from "2019-06-08" :type inactive))
|
||||||
|
nil))
|
||||||
|
|
||||||
|
(org-ql-it ":to a timestamp"
|
||||||
|
(org-ql-expect ((ts :to "2019-06-10" :type inactive))
|
||||||
|
'("Test data" "Visit the moon" "Learn universal sign language" "Rewrite Emacs in Common Lisp"))
|
||||||
|
(org-ql-expect ((ts :to "2017-07-04" :type inactive))
|
||||||
|
'nil))
|
||||||
|
|
||||||
|
(org-ql-it ":on a timestamp"
|
||||||
|
(org-ql-expect ((ts :on "2017-07-05" :type inactive))
|
||||||
|
'("Test data" "Learn universal sign language"))
|
||||||
|
(org-ql-expect ((ts :on "2019-06-09" :type inactive))
|
||||||
|
nil)))
|
||||||
|
|
||||||
|
(describe "both"
|
||||||
|
|
||||||
(org-ql-it "without arguments"
|
(org-ql-it "without arguments"
|
||||||
(org-ql-expect ((ts))
|
(org-ql-expect ((ts))
|
||||||
|
'("Test data" "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 ((ts :type both))
|
||||||
'("Test data" "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")))
|
'("Test data" "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 ":from a timestamp"
|
(org-ql-it ":from a timestamp"
|
||||||
;; TODO: Figure out why these take longer than the other (ts) tests.
|
;; TODO: Figure out why these take longer than the other (ts) tests.
|
||||||
(org-ql-expect ((ts :from "2017-01-01"))
|
(org-ql-expect ((ts :from "2017-07-05"))
|
||||||
'("Test data" "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"))
|
'("Test data" "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 ((ts :from "2017-07-05" :type both))
|
||||||
|
'("Test data" "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 ((ts :from "2019-06-08"))
|
(org-ql-expect ((ts :from "2019-06-08"))
|
||||||
|
nil)
|
||||||
|
(org-ql-expect ((ts :from "2019-06-08" :type both))
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(org-ql-it ":to a timestamp"
|
(org-ql-it ":to a timestamp"
|
||||||
(org-ql-expect ((ts :to "2019-06-10"))
|
(org-ql-expect ((ts :to "2017-07-06"))
|
||||||
'("Test data" "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"))
|
'("Test data" "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 ((ts :to "2017-07-06" :type both))
|
||||||
|
'("Test data" "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 ((ts :to "2017-07-04"))
|
(org-ql-expect ((ts :to "2017-07-04"))
|
||||||
|
'("Skype with president of Antarctica"))
|
||||||
|
(org-ql-expect ((ts :to "2017-07-04" :type both))
|
||||||
'("Skype with president of Antarctica")))
|
'("Skype with president of Antarctica")))
|
||||||
|
|
||||||
(org-ql-it ":on a timestamp"
|
(org-ql-it ":on a timestamp"
|
||||||
(org-ql-expect ((ts :on "2017-07-05"))
|
(org-ql-expect ((ts :on "2017-07-05"))
|
||||||
'("Test data" "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"))
|
'("Test data" "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 ((ts :on "2017-07-05" :type both))
|
||||||
|
'("Test data" "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 ((ts :on "2019-06-09"))
|
(org-ql-expect ((ts :on "2019-06-09"))
|
||||||
nil)))
|
nil)
|
||||||
|
(org-ql-expect ((ts :on "2019-06-09" :type both))
|
||||||
|
nil))))
|
||||||
|
|
||||||
(describe "Compound queries"
|
(describe "Compound queries"
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue