diff --git a/org-ql.el b/org-ql.el index 90586c3..7e3766b 100644 --- a/org-ql.el +++ b/org-ql.el @@ -157,6 +157,29 @@ See Info node `(org-ql)Queries'." :type 'boolean :risky t) +(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) + ;;;; Macros ;;;###autoload @@ -1626,16 +1649,29 @@ 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." - :normalizers ((`(,predicate-names ,(and num-days (pred numberp))) - ;; (clocked) and (closed) implicitly look into the past. - (let ((from (->> (ts-now) - (ts-adjust 'day (* -1 num-days)) - (ts-apply :hour 0 :minute 0 :second 0)))) - `(clocked :from ,from)))) - :preambles ((`(,predicate-names ,(pred numberp)) - (list :regexp org-ql-clock-regexp :query t)) - (`(,predicate-names) - (list :regexp org-ql-clock-regexp :query t))) + :normalizers + ((`(,predicate-names ,(and num-days (pred numberp))) + ;; (clocked) and (closed) implicitly look into the past. + (let ((from (->> (ts-now) + (ts-adjust 'day (* -1 num-days)) + (ts-apply :hour 0 :minute 0 :second 0)))) + `(clocked :from ,from)))) + :preambles + ((`(,predicate-names ,(pred numberp)) + (list :regexp org-ql-clock-regexp :query t)) + (`(,predicate-names . ,(and rest (guard (or (plist-get rest :from) + (plist-get rest :to) + (plist-get rest :on))))) + ;; Use date-optimized timestamp regexp. + (-let (((&plist :from :to :on :type) rest)) + (org-ql--from-to-on) + (list :regexp (-let* ((from (or from (ts-adjust 'day (- org-ql-ts-days-from-default) (ts-now)))) + (to (or to (ts-adjust 'day org-ql-ts-days-to-default (ts-now)))) + (ts-regexp (org-ql--ts-range-to-regexp from to :type 'inactive))) + (rx-to-string `(seq bol (0+ blank) "CLOCK:" (1+ blank) (0+ not-newline) (regexp ,ts-regexp)))) + :query query))) + (`(,predicate-names) + (list :regexp org-ql-clock-regexp :query t))) :body (org-ql--predicate-ts :from from :to to :regexp org-ql-clock-regexp :match-group 1)) @@ -1656,15 +1692,28 @@ 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." - :normalizers ((`(,predicate-names ,(and num-days (pred numberp))) - ;; (clocked) and (closed) implicitly look into the past. - (let ((from (->> (ts-now) - (ts-adjust 'day (* -1 num-days)) - (ts-apply :hour 0 :minute 0 :second 0)))) - `(closed :from ,from)))) - :preambles ((`(,predicate-names . ,_) - ;; Predicate still needs testing. - (list :regexp org-closed-time-regexp :query query))) + :normalizers + ((`(,predicate-names ,(and num-days (pred numberp))) + ;; (clocked) and (closed) implicitly look into the past. + (let ((from (->> (ts-now) + (ts-adjust 'day (* -1 num-days)) + (ts-apply :hour 0 :minute 0 :second 0)))) + `(closed :from ,from)))) + :preambles + ((`(,predicate-names . ,(and rest (guard (or (plist-get rest :from) + (plist-get rest :to) + (plist-get rest :on))))) + ;; Use date-optimized timestamp regexp. + (-let (((&plist :from :to :on :type) rest)) + (org-ql--from-to-on) + (list :regexp (-let* ((from (or from (ts-adjust 'day (- org-ql-ts-days-from-default) (ts-now)))) + (to (or to (ts-adjust 'day org-ql-ts-days-to-default (ts-now)))) + (ts-regexp (org-ql--ts-range-to-regexp from to :type 'inactive))) + (rx-to-string `(seq bow (0+ blank) "CLOSED:" (1+ blank) (regexp ,ts-regexp)))) + :query query))) + (`(,predicate-names . ,_) + ;; Predicate still needs testing. + (list :regexp org-closed-time-regexp :query query))) :body (org-ql--predicate-ts :from from :to to :regexp org-closed-time-regexp :match-group 1 :limit (line-end-position 2))) @@ -1686,20 +1735,33 @@ 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." - :normalizers ((`(,predicate-names auto) - ;; Use `org-deadline-warning-days' as the :to arg. - (let ((to (->> (ts-now) - (ts-adjust 'day org-deadline-warning-days) - (ts-apply :hour 23 :minute 59 :second 59)))) - `(deadline-warning :to ,to))) - (`(,predicate-names ,(and num-days (pred numberp))) - (let ((to (->> (ts-now) - (ts-adjust 'day num-days) - (ts-apply :hour 23 :minute 59 :second 59)))) - `(deadline :to ,to)))) + :normalizers + ((`(,predicate-names auto) + ;; Use `org-deadline-warning-days' as the :to arg. + (let ((to (->> (ts-now) + (ts-adjust 'day org-deadline-warning-days) + (ts-apply :hour 23 :minute 59 :second 59)))) + `(deadline-warning :to ,to))) + (`(,predicate-names ,(and num-days (pred numberp))) + (let ((to (->> (ts-now) + (ts-adjust 'day num-days) + (ts-apply :hour 23 :minute 59 :second 59)))) + `(deadline :to ,to)))) ;; NOTE: Does this normalizer cause the preamble to not be used? (Adding one to the deadline-warning definition to be sure.) - :preambles ((`(,predicate-names . ,_) - (list :regexp org-deadline-time-regexp :query query))) + :preambles + ((`(,predicate-names . ,(and rest (guard (or (plist-get rest :from) + (plist-get rest :to) + (plist-get rest :on))))) + ;; Use date-optimized timestamp regexp. + (-let (((&plist :from :to :on :type) rest)) + (org-ql--from-to-on) + (list :regexp (-let* ((from (or from (ts-adjust 'day (- org-ql-ts-days-from-default) (ts-now)))) + (to (or to (ts-adjust 'day org-ql-ts-days-to-default (ts-now)))) + (ts-regexp (org-ql--ts-range-to-regexp from to :type 'active))) + (rx-to-string `(seq bow (0+ blank) "DEADLINE:" (1+ blank) (regexp ,ts-regexp)))) + :query query))) + (`(,predicate-names . ,_) + (list :regexp org-deadline-time-regexp :query query))) :body (org-ql--predicate-ts :from from :to to :regexp org-deadline-time-regexp :match-group 1 :limit (line-end-position 2))) @@ -1749,13 +1811,27 @@ 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." - :normalizers ((`(,predicate-names ,(and num-days (pred numberp))) - (let ((to (->> (ts-now) - (ts-adjust 'day num-days) - (ts-apply :hour 23 :minute 59 :second 59)))) - `(planning :to ,to)))) - :preambles ((`(,predicate-names . ,_) - (list :regexp org-ql-planning-regexp :query query))) + :normalizers + ((`(,predicate-names ,(and num-days (pred numberp))) + (let ((to (->> (ts-now) + (ts-adjust 'day num-days) + (ts-apply :hour 23 :minute 59 :second 59)))) + `(planning :to ,to)))) + :preambles + ((`(,predicate-names . ,(and rest (guard (or (plist-get rest :from) + (plist-get rest :to) + (plist-get rest :on))))) + ;; Use date-optimized timestamp regexp. + (-let (((&plist :from :to :on :type) rest)) + (org-ql--from-to-on) + (list :regexp (-let* ((from (or from (ts-adjust 'day (- org-ql-ts-days-from-default) (ts-now)))) + (to (or to (ts-adjust 'day org-ql-ts-days-to-default (ts-now)))) + (ts-regexp (org-ql--ts-range-to-regexp from to))) + (rx-to-string `(seq bow (0+ blank) (or "CLOSED" "DEADLINE" "SCHEDULED") ":" + (1+ blank) (regexp ,ts-regexp)))) + :query query))) + (`(,predicate-names . ,_) + (list :regexp org-ql-planning-regexp :query query))) :body (org-ql--predicate-ts :from from :to to :regexp org-ql-planning-regexp :match-group 1 :limit (line-end-position 2))) @@ -1782,8 +1858,20 @@ parseable by `parse-time-string' which may omit the time value." (ts-adjust 'day num-days) (ts-apply :hour 23 :minute 59 :second 59)))) `(scheduled :to ,to)))) - :preambles ((`(,predicate-names . ,_) - (list :regexp org-scheduled-time-regexp :query query))) + :preambles + ((`(,predicate-names . ,(and rest (guard (or (plist-get rest :from) + (plist-get rest :to) + (plist-get rest :on))))) + ;; Use date-optimized timestamp regexp. + (-let (((&plist :from :to :on :type) rest)) + (org-ql--from-to-on) + (list :regexp (-let* ((from (or from (ts-adjust 'day (- org-ql-ts-days-from-default) (ts-now)))) + (to (or to (ts-adjust 'day org-ql-ts-days-to-default (ts-now)))) + (ts-regexp (org-ql--ts-range-to-regexp from to :type 'active))) + (rx-to-string `(seq bow (0+ blank) "SCHEDULED:" (1+ blank) (regexp ,ts-regexp)))) + :query query))) + (`(,predicate-names . ,_) + (list :regexp org-scheduled-time-regexp :query query))) :body (org-ql--predicate-ts :from from :to to :regexp org-scheduled-time-regexp :match-group 1 :limit (line-end-position 2))) @@ -1818,20 +1906,32 @@ the end of the entry, i.e. the position returned by bound to a different positiion, e.g. for planning lines, the end of the line after the heading." ;; MAYBE: Define active/inactive ones separately? - :normalizers ((`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest)) - (`(,(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)) - ;; 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))))) + :normalizers + ((`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest)) + (`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))) + :preambles + ((`(,predicate-names . ,(and rest (guard (or (plist-get rest :from) + (plist-get rest :to) + (plist-get rest :on))))) + ;; Use date-optimized timestamp regexp. + (-let (((&plist :from :to :on :type) rest)) + (org-ql--from-to-on) + (list :regexp (-let* ((from (or from (ts-adjust 'day (- org-ql-ts-days-from-default) (ts-now)))) + (to (or to (ts-adjust 'day org-ql-ts-days-to-default (ts-now))))) + (org-ql--ts-range-to-regexp from to)) + :query query))) + (`(,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)) + ;; 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. :body (cl-macrolet ((next-timestamp () @@ -1847,6 +1947,61 @@ of the line after the heading." (from (test-timestamps (ts<= from next-ts))) (to (test-timestamps (ts<= next-ts to))))))) +(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 (pcase type + ((or 'nil 'both) (rx (0+ (not (any ">]"))) + (any ">]"))) + ('active (rx (0+ (not (any ">"))) + ">")) + ('inactive (rx (0+ (not (any "]"))) + "]")))) + (time-regexp (rx (1+ blank) + (repeat 1 2 (any "0-9")) ":" (= 2 (any "0-9")) + ;; NOTE: We don't need to test for a + ;; repeater at this time, but it might be + ;; useful in the future, so leaving this + ;; commented: (0+ (any "0-9" " +.:dhmwy-")) + )) + (suffix (if require-time + (rx-to-string `(seq (regexp ,time-regexp) + (regexp ,type-suffix))) + (rx-to-string `(seq (repeat 0 1 (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 (regexp ,type-prefix) + (or ,@(mapcar #'format-number years)) "-" + (or ,@(mapcar #'format-number months)) "-" + (or ,@(mapcar #'format-number days)) + ;; Day of week. + (optional (1+ blank) + (1+ alpha)) + (regexp ,suffix)) + t)))) + ;; NOTE: Predicates defined: stop deferring and define normalizer and ;; preamble functions now. Reversing preserves the order in which ;; they were defined. Generally it shouldn't matter, but it might...