WIP

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)))
+  :normalizers
-                 ;; (clocked) and (closed) implicitly look into the past.
+  ((`(,predicate-names ,(and num-days (pred numberp)))
-                 (let ((from (->> (ts-now)
+    ;; (clocked) and (closed) implicitly look into the past.
-                                  (ts-adjust 'day (* -1 num-days))
+    (let ((from (->> (ts-now)
-                                  (ts-apply :hour 0 :minute 0 :second 0))))
+                     (ts-adjust 'day (* -1 num-days))
-                   `(clocked :from ,from))))
+                     (ts-apply :hour 0 :minute 0 :second 0))))
-  :preambles ((`(,predicate-names ,(pred numberp))
+      `(clocked :from ,from))))
-               (list :regexp org-ql-clock-regexp :query t))
+  :preambles
-              (`(,predicate-names)
+  ((`(,predicate-names ,(pred numberp))
-               (list :regexp org-ql-clock-regexp :query t)))
+    (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)))
+  :normalizers
-                 ;; (clocked) and (closed) implicitly look into the past.
+  ((`(,predicate-names ,(and num-days (pred numberp)))
-                 (let ((from (->> (ts-now)
+    ;; (clocked) and (closed) implicitly look into the past.
-                                  (ts-adjust 'day (* -1 num-days))
+    (let ((from (->> (ts-now)
-                                  (ts-apply :hour 0 :minute 0 :second 0))))
+                     (ts-adjust 'day (* -1 num-days))
-                   `(closed :from ,from))))
+                     (ts-apply :hour 0 :minute 0 :second 0))))
-  :preambles ((`(,predicate-names . ,_)
+      `(closed :from ,from))))
-               ;;  Predicate still needs testing.
+  :preambles
-               (list :regexp org-closed-time-regexp :query query)))
+  ((`(,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)
+  :normalizers
-                 ;; Use `org-deadline-warning-days' as the :to arg.
+  ((`(,predicate-names auto)
-                 (let ((to (->> (ts-now)
+    ;; Use `org-deadline-warning-days' as the :to arg.
-                                (ts-adjust 'day org-deadline-warning-days)
+    (let ((to (->> (ts-now)
-                                (ts-apply :hour 23 :minute 59 :second 59))))
+                   (ts-adjust 'day org-deadline-warning-days)
-                   `(deadline-warning :to ,to)))
+                   (ts-apply :hour 23 :minute 59 :second 59))))
-                (`(,predicate-names ,(and num-days (pred numberp)))
+      `(deadline-warning :to ,to)))
-                 (let ((to (->> (ts-now)
+   (`(,predicate-names ,(and num-days (pred numberp)))
-                                (ts-adjust 'day num-days)
+    (let ((to (->> (ts-now)
-                                (ts-apply :hour 23 :minute 59 :second 59))))
+                   (ts-adjust 'day num-days)
-                   `(deadline :to ,to))))
+                   (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 . ,_)
+  :preambles
-               (list :regexp org-deadline-time-regexp :query query)))
+  ((`(,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)))
+  :normalizers
-                 (let ((to (->> (ts-now)
+  ((`(,predicate-names ,(and num-days (pred numberp)))
-                                (ts-adjust 'day num-days)
+    (let ((to (->> (ts-now)
-                                (ts-apply :hour 23 :minute 59 :second 59))))
+                   (ts-adjust 'day num-days)
-                   `(planning :to ,to))))
+                   (ts-apply :hour 23 :minute 59 :second 59))))
-  :preambles ((`(,predicate-names . ,_)
+      `(planning :to ,to))))
-               (list :regexp org-ql-planning-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)))
+                      (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 . ,_)
+  :preambles
-               (list :regexp org-scheduled-time-regexp :query query)))
+  ((`(,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))
+  :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))
+                                               (plist-get rest :on)))))
-                     ;; Predicate needs testing only when args are present.
+    ;; Use date-optimized timestamp regexp.
-                     :query (-let (((&keys :from :to :on) rest))
+    (-let (((&plist :from :to :on :type) rest))
-                              ;; FIXME: This used to be (when (or from to on) query), but that doesn't seem right, so I
+      (org-ql--from-to-on)
-                              ;; changed it to this if, and the tests pass either way.  Might deserve a little scrutiny.
+      (list :regexp (-let* ((from (or from (ts-adjust 'day (- org-ql-ts-days-from-default) (ts-now))))
-                              (if (or from to on)
+                            (to (or to (ts-adjust 'day org-ql-ts-days-to-default (ts-now)))))
-                                  query
+                      (org-ql--ts-range-to-regexp from to))
-                                t)))))
+            :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...