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

WIP

Browse source
This commit is contained in:
Adam Porter 2020-12-19 05:35:57 -06:00
parent 208e103ecc
commit 7a72fc2605
1 changed files with 96 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

110
org-ql.el
View file

@ -1818,20 +1818,30 @@ the end of the entry, i.e. the position returned by
bound to a different positiion, e.g. for planning lines, the end bound to a different positiion, e.g. for planning lines, the end
of the line after the heading." of the line after the heading."
;; MAYBE: Define active/inactive ones separately? ;; MAYBE: Define active/inactive ones separately?
:normalizers ((`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest)) :normalizers
(`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))) ((`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest))
:preambles ((`(,predicate-names . ,rest) (`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest)))
(list :regexp (pcase (plist-get rest :type) :preambles
((or 'nil 'both) org-tsr-regexp-both) ((`(,predicate-names . ,(and rest (guard (or (plist-get rest :from)
('active org-tsr-regexp) (plist-get rest :to)))))
('inactive org-ql-tsr-regexp-inactive)) (-let (((&plist :from :to :on :type) rest))
;; Predicate needs testing only when args are present. (org-ql--from-to-on)
:query (-let (((&keys :from :to :on) rest)) (list :regexp (-let* ((from (or from (ts-adjust 'day (- org-ql-ts-days-from-default) (ts-now))))
;; FIXME: This used to be (when (or from to on) query), but that doesn't seem right, so I (to (or to (ts-adjust 'day org-ql-ts-days-to-default (ts-now)))))
;; changed it to this if, and the tests pass either way. Might deserve a little scrutiny. (org-ql--ts-range-to-regexp from to))
(if (or from to on) :query query)))
query (`(,predicate-names . ,rest)
t))))) (list :regexp (pcase (plist-get rest :type)
((or 'nil 'both) org-tsr-regexp-both)
('active org-tsr-regexp)
('inactive org-ql-tsr-regexp-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
;; changed it to this if, and the tests pass either way. Might deserve a little scrutiny.
(if (or from to on)
query
t)))))
;; TODO: DRY this with the clocked predicate. ;; TODO: DRY this with the clocked predicate.
:body :body
(cl-macrolet ((next-timestamp () (cl-macrolet ((next-timestamp ()
@ -1847,6 +1857,78 @@ of the line after the heading."
(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)))))))
(defcustom org-ql-ts-days-to-default 365
"Search up to this many days after now by default when using a timestamp predicate.
When a timestamp predicate is used without specifying a \"to\"
timestamp, search for timestamps that are up to this many days
from now.
Since most searches are probably not for timestamps far into the
future, this helps optimize timestamp-related searches."
:type 'integer)
(defcustom org-ql-ts-days-from-default (* 5 365)
"Search up to this many days before now by default when using a timestamp predicate.
When a timestamp predicate is used without specifying a \"from\"
timestamp, search for timestamps that are up to this many days
before now.
Since most searches are probably not for timestamps far into the
past, this helps optimize timestamp-related searches. But unlike
`org-ql-ts-days-to-default', this defaults to a 5-year range,
because it's assumed that users are more likely to search an
archive of notes from years past."
:type 'integer)
(cl-defun org-ql--ts-range-to-regexp (from to &key type require-time)
;; Let's start with the plainest implementation: brute-force
;; marching through all of the dates.
;; MAYBE: Handle given hour/minute/second?
;; FIXME: Docstring.
"Return a regexp matching timestamps in the range FROM-TO.
FROM and TO should be `ts' structs. TYPE may be `active',
`inactive', or nil to match both types."
;; Set the H:M:S of each timestamp to the beginning/end of the day.
(setf from (ts-apply 'hour 0 'minute 0 'second 0 from)
to (ts-apply 'hour 23 'minute 59 'second 59 to))
(let* ((type-prefix (pcase type
((or 'nil 'both) (rx (any "<[")))
('active (rx "<"))
('inactive (rx "["))))
(type-suffix (if require-time
(pcase type
((or 'nil 'both) (rx (any ">]")))
('active (rx ">"))
('inactive (rx "]")))
""))
(time-regexp (rx (1+ blank)
(repeat 1 2 (any "0-9")) ":" (= 2 (any "0-9"))
(0+ (any "0-9" " +.:dhmwy-"))))
(suffix (if require-time
(rx-to-string `(seq (regexp ,time-regexp)
(regexp ,type-suffix)))
(rx-to-string `(seq (0+ (regexp ,time-regexp))
(regexp ,type-suffix)))))
years months days)
(cl-loop do (progn
(cl-pushnew (ts-year from) years)
(cl-pushnew (ts-month from) months)
(cl-pushnew (ts-day from) days))
until (and (eql (ts-year from) (ts-year to))
(eql (ts-month from) (ts-month to))
(eql (ts-day from) (ts-day to)))
do (ts-incf (ts-day from)))
(cl-flet ((format-number
(number) (format "%02d" number)))
(rx-to-string `(seq (or bol space)
(regexp ,type-prefix)
(or ,@(mapcar #'format-number years)) "-"
(or ,@(mapcar #'format-number months)) "-"
(or ,@(mapcar #'format-number days))
(regexp ,suffix)
(or eol space))
t))))
;; NOTE: Predicates defined: stop deferring and define normalizer and ;; NOTE: Predicates defined: stop deferring and define normalizer and
;; preamble functions now. Reversing preserves the order in which ;; preamble functions now. Reversing preserves the order in which
;; they were defined. Generally it shouldn't matter, but it might... ;; they were defined. Generally it shouldn't matter, but it might...