Compare commits
10 commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
85540f5231 | ||
|
|
51bd90bb03 | ||
|
|
92cf211b02 | ||
|
|
2b4e6f09ca | ||
|
|
b7c0edfc71 | ||
|
|
3d6747f427 | ||
|
|
5924b37cb7 | ||
|
|
24993c9a25 | ||
|
|
0b288f01de | ||
|
|
e66af03aee |
3 changed files with 110 additions and 35 deletions
73
org-ql.el
73
org-ql.el
|
|
@ -1148,9 +1148,9 @@ It would be expanded to:
|
||||||
Expands into a form that processes arguments to timestamp-related
|
Expands into a form that processes arguments to timestamp-related
|
||||||
predicates and evaluates BODY, which is expected to evaluate to a
|
predicates and evaluates BODY, which is expected to evaluate to a
|
||||||
timestamp-related query predicate form. It expects the variable
|
timestamp-related query predicate form. It expects the variable
|
||||||
`rest' to be bound to a list of the predicate's arguments. In
|
`argh' to be bound to a list of the predicate's arguments. In
|
||||||
BODY, these variables are bound to normalized values, when
|
BODY, these variables are bound to normalized values, when
|
||||||
applicable: `from', `to', `on', `type'. If `rest' includes a
|
applicable: `from', `to', `on', `type'. If `argh' includes a
|
||||||
`:with-time' argument, it is automatically added to BODY's
|
`:with-time' argument, it is automatically added to BODY's
|
||||||
result form."
|
result form."
|
||||||
;; Several attempts to use `cl-macrolet' and `cl-symbol-macrolet' failed, so I resorted
|
;; Several attempts to use `cl-macrolet' and `cl-symbol-macrolet' failed, so I resorted
|
||||||
|
|
@ -1162,13 +1162,16 @@ result form."
|
||||||
;; do with the version of map.el being used (although it happens locally even in
|
;; do with the version of map.el being used (although it happens locally even in
|
||||||
;; a clean sandbox, which should produce the same result as on CI). Maybe the
|
;; a clean sandbox, which should produce the same result as on CI). Maybe the
|
||||||
;; real fix would be to make makem.sh support dependency versions...
|
;; real fix would be to make makem.sh support dependency versions...
|
||||||
`(-let (((&keys :from :to :on :type) rest)
|
`(let ((from (plist-get argh :from))
|
||||||
(result))
|
(to (plist-get argh :to))
|
||||||
|
(on (plist-get argh :on))
|
||||||
|
(type (plist-get argh :type))
|
||||||
|
(result))
|
||||||
(ignore type) ;; Only (ts) uses it.
|
(ignore type) ;; Only (ts) uses it.
|
||||||
(pcase rest
|
(pcase argh
|
||||||
(`(,(and num (pred numberp)) . ,rest*)
|
(`(,(and num (pred numberp)) . ,rest*)
|
||||||
(setf on num
|
(setf on num
|
||||||
rest rest*)))
|
argh rest*)))
|
||||||
(when on
|
(when on
|
||||||
(setq from on
|
(setq from on
|
||||||
to on))
|
to on))
|
||||||
|
|
@ -1207,9 +1210,9 @@ result form."
|
||||||
(setf result (progn ,@body))
|
(setf result (progn ,@body))
|
||||||
;; Add :with-time to the result when necessary, but only when it's not already present.
|
;; Add :with-time to the result when necessary, but only when it's not already present.
|
||||||
;; (This is messy, but we do this to make predicate definition and normalization easier.)
|
;; (This is messy, but we do this to make predicate definition and normalization easier.)
|
||||||
(when (and (plist-member rest :with-time)
|
(when (and (plist-member argh :with-time)
|
||||||
(not (memq :with-time result)))
|
(not (memq :with-time result)))
|
||||||
(setf result (append result (list :with-time (plist-get rest :with-time)))))
|
(setf result (append result (list :with-time (plist-get argh :with-time)))))
|
||||||
;; Remove certain keyword arguments whose value is nil. This is
|
;; Remove certain keyword arguments whose value is nil. This is
|
||||||
;; a little bit ugly, but it allows us to normalize queries more
|
;; a little bit ugly, but it allows us to normalize queries more
|
||||||
;; easily, without leaving useless arguments in the result.
|
;; easily, without leaving useless arguments in the result.
|
||||||
|
|
@ -1949,10 +1952,10 @@ ignored."
|
||||||
:normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
|
:normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
|
||||||
;; (clocked) and (closed) implicitly look into the past.
|
;; (clocked) and (closed) implicitly look into the past.
|
||||||
(let* ((from-day (* -1 num-days))
|
(let* ((from-day (* -1 num-days))
|
||||||
(rest (list :from from-day)))
|
(argh (list :from from-day)))
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(clocked :from ,from))))
|
`(clocked :from ,from))))
|
||||||
(`(,predicate-names . ,rest)
|
(`(,predicate-names . ,argh)
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(clocked :from ,from :to ,to))))
|
`(clocked :from ,from :to ,to))))
|
||||||
:preambles ((`(,predicate-names ,(pred numberp))
|
:preambles ((`(,predicate-names ,(pred numberp))
|
||||||
|
|
@ -1969,10 +1972,10 @@ Without arguments, return non-nil if entry is closed."
|
||||||
:normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
|
:normalizers ((`(,predicate-names ,(and num-days (pred numberp)))
|
||||||
;; (clocked) and (closed) implicitly look into the past.
|
;; (clocked) and (closed) implicitly look into the past.
|
||||||
(let* ((from-day (* -1 num-days))
|
(let* ((from-day (* -1 num-days))
|
||||||
(rest (list :from from-day)))
|
(argh (list :from from-day)))
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(closed :from ,from))))
|
`(closed :from ,from))))
|
||||||
(`(,predicate-names . ,rest)
|
(`(,predicate-names . ,argh)
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(closed :from ,from :to ,to))))
|
`(closed :from ,from :to ,to))))
|
||||||
:preambles ((`(,predicate-names . ,_)
|
:preambles ((`(,predicate-names . ,_)
|
||||||
|
|
@ -1987,23 +1990,23 @@ Without arguments, return non-nil if entry is closed."
|
||||||
If argument is `auto', return non-nil if entry has deadline
|
If argument is `auto', return non-nil if entry has deadline
|
||||||
within `org-deadline-warning-days'. Without arguments, return
|
within `org-deadline-warning-days'. Without arguments, return
|
||||||
non-nil if entry has a deadline."
|
non-nil if entry has a deadline."
|
||||||
:normalizers ((`(,predicate-names auto . ,rest)
|
:normalizers ((`(,predicate-names auto . ,argh)
|
||||||
;; Use `org-deadline-warning-days' as the :to arg.
|
;; Use `org-deadline-warning-days' as the :to arg.
|
||||||
(let ((ts (->> (ts-now)
|
(let ((ts (->> (ts-now)
|
||||||
(ts-adjust 'day org-deadline-warning-days)
|
(ts-adjust 'day org-deadline-warning-days)
|
||||||
(ts-apply :hour 23 :minute 59 :second 59))))
|
(ts-apply :hour 23 :minute 59 :second 59))))
|
||||||
`(deadline-warning :to ,ts ,@rest)))
|
`(deadline-warning :to ,ts ,@argh)))
|
||||||
(`(,predicate-names . ,(and rest (guard (numberp (car rest)))))
|
(`(,predicate-names . ,(and argh (guard (numberp (car argh)))))
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(deadline :to ,to)))
|
`(deadline :to ,to)))
|
||||||
(`(,predicate-names . ,rest)
|
(`(,predicate-names . ,argh)
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(deadline :from ,from :to ,to))))
|
`(deadline :from ,from :to ,to))))
|
||||||
;; NOTE: Does this normalizer cause the preamble to not be used?
|
;; NOTE: Does this normalizer cause the preamble to not be used?
|
||||||
;; (Adding one to the deadline-warning definition to be sure.)
|
;; (Adding one to the deadline-warning definition to be sure.)
|
||||||
:preambles ((`(,predicate-names . ,rest)
|
:preambles ((`(,predicate-names . ,argh)
|
||||||
(list :query query
|
(list :query query
|
||||||
:regexp (pcase-exhaustive (org-ql--plist-get* rest :with-time)
|
:regexp (pcase-exhaustive (org-ql--plist-get* argh :with-time)
|
||||||
((or 't "t") org-ql-regexp-deadline-with-time)
|
((or 't "t") org-ql-regexp-deadline-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-deadline-without-time)
|
((or 'nil "nil") org-ql-regexp-deadline-without-time)
|
||||||
('not-found org-ql-regexp-deadline)))))
|
('not-found org-ql-regexp-deadline)))))
|
||||||
|
|
@ -2044,15 +2047,15 @@ non-nil if entry has a deadline."
|
||||||
(org-ql-defpred planning (&key from to _on regexp _with-time)
|
(org-ql-defpred planning (&key from to _on regexp _with-time)
|
||||||
"Return non-nil if current entry has planning timestamp in given period.
|
"Return non-nil if current entry has planning timestamp in given period.
|
||||||
Without arguments, return non-nil if entry has any planning timestamp."
|
Without arguments, return non-nil if entry has any planning timestamp."
|
||||||
:normalizers ((`(,predicate-names . ,(and rest (guard (numberp (car rest)))))
|
:normalizers ((`(,predicate-names . ,(and argh (guard (numberp (car argh)))))
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(planning :to ,to)))
|
`(planning :to ,to)))
|
||||||
(`(,predicate-names . ,rest)
|
(`(,predicate-names . ,argh)
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(planning :from ,from :to ,to))))
|
`(planning :from ,from :to ,to))))
|
||||||
:preambles ((`(,predicate-names . ,rest)
|
:preambles ((`(,predicate-names . ,argh)
|
||||||
(list :query query
|
(list :query query
|
||||||
:regexp (pcase-exhaustive (org-ql--plist-get* rest :with-time)
|
:regexp (pcase-exhaustive (org-ql--plist-get* argh :with-time)
|
||||||
((or 't "t") org-ql-regexp-planning-with-time)
|
((or 't "t") org-ql-regexp-planning-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-planning-without-time)
|
((or 'nil "nil") org-ql-regexp-planning-without-time)
|
||||||
('not-found org-ql-regexp-planning)))))
|
('not-found org-ql-regexp-planning)))))
|
||||||
|
|
@ -2065,12 +2068,12 @@ Without arguments, return non-nil if entry has any planning timestamp."
|
||||||
(org-ql-defpred scheduled (&key from to _on regexp _with-time)
|
(org-ql-defpred scheduled (&key from to _on regexp _with-time)
|
||||||
"Return non-nil if current entry is scheduled in given period.
|
"Return non-nil if current entry is scheduled in given period.
|
||||||
Without arguments, return non-nil if entry is scheduled."
|
Without arguments, return non-nil if entry is scheduled."
|
||||||
:normalizers ((`(,predicate-names . ,rest)
|
:normalizers ((`(,predicate-names . ,argh)
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(scheduled :from ,from :to ,to))))
|
`(scheduled :from ,from :to ,to))))
|
||||||
:preambles ((`(,predicate-names . ,rest)
|
:preambles ((`(,predicate-names . ,argh)
|
||||||
(list :query query
|
(list :query query
|
||||||
:regexp (pcase-exhaustive (org-ql--plist-get* rest :with-time)
|
:regexp (pcase-exhaustive (org-ql--plist-get* argh :with-time)
|
||||||
((or 't "t") org-ql-regexp-scheduled-with-time)
|
((or 't "t") org-ql-regexp-scheduled-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-scheduled-without-time)
|
((or 'nil "nil") org-ql-regexp-scheduled-without-time)
|
||||||
('not-found org-ql-regexp-scheduled)))))
|
('not-found org-ql-regexp-scheduled)))))
|
||||||
|
|
@ -2096,32 +2099,32 @@ of REGEXP's group that matches the Org timestamp (i.e. excluding
|
||||||
any planning prefix); it defaults to 0 (i.e. the whole regexp)."
|
any planning prefix); it defaults to 0 (i.e. the whole regexp)."
|
||||||
;; MAYBE: Define active/inactive ones separately?
|
;; MAYBE: Define active/inactive ones separately?
|
||||||
:normalizers
|
:normalizers
|
||||||
((`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest))
|
((`(,(or 'ts-active 'ts-a) . ,argh) `(ts :type active ,@argh))
|
||||||
(`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))
|
(`(,(or 'ts-inactive 'ts-i) . ,argh) `(ts :type inactive ,@argh))
|
||||||
(`(,predicate-names . ,(and rest (guard (numberp (car rest)))))
|
(`(,predicate-names . ,(and argh (guard (numberp (car argh)))))
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(ts :type ,type :to ,to)))
|
`(ts :type ,type :to ,to)))
|
||||||
(`(,predicate-names . ,rest)
|
(`(,predicate-names . ,argh)
|
||||||
(org-ql--normalize-from-to-on
|
(org-ql--normalize-from-to-on
|
||||||
`(ts :type ,type :from ,from :to ,to))))
|
`(ts :type ,type :from ,from :to ,to))))
|
||||||
|
|
||||||
:preambles
|
:preambles
|
||||||
((`(,predicate-names . ,rest)
|
((`(,predicate-names . ,argh)
|
||||||
(list :regexp (pcase (plist-get rest :type)
|
(list :regexp (pcase (plist-get argh :type)
|
||||||
((or 'nil 'both) (pcase-exhaustive (org-ql--plist-get* rest :with-time)
|
((or 'nil 'both) (pcase-exhaustive (org-ql--plist-get* argh :with-time)
|
||||||
((or 't "t") org-ql-regexp-ts-both-with-time)
|
((or 't "t") org-ql-regexp-ts-both-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-ts-both-without-time)
|
((or 'nil "nil") org-ql-regexp-ts-both-without-time)
|
||||||
('not-found org-ql-regexp-ts-both)))
|
('not-found org-ql-regexp-ts-both)))
|
||||||
('active (pcase-exhaustive (org-ql--plist-get* rest :with-time)
|
('active (pcase-exhaustive (org-ql--plist-get* argh :with-time)
|
||||||
((or 't "t") org-ql-regexp-ts-active-with-time)
|
((or 't "t") org-ql-regexp-ts-active-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-ts-active-without-time)
|
((or 'nil "nil") org-ql-regexp-ts-active-without-time)
|
||||||
('not-found org-ql-regexp-ts-active)))
|
('not-found org-ql-regexp-ts-active)))
|
||||||
('inactive (pcase-exhaustive (org-ql--plist-get* rest :with-time)
|
('inactive (pcase-exhaustive (org-ql--plist-get* argh :with-time)
|
||||||
((or 't "t") org-ql-regexp-ts-inactive-with-time)
|
((or 't "t") org-ql-regexp-ts-inactive-with-time)
|
||||||
((or 'nil "nil") org-ql-regexp-ts-inactive-without-time)
|
((or 'nil "nil") org-ql-regexp-ts-inactive-without-time)
|
||||||
('not-found org-ql-regexp-ts-inactive))))
|
('not-found org-ql-regexp-ts-inactive))))
|
||||||
;; Predicate needs testing only when args are present.
|
;; Predicate needs testing only when args are present.
|
||||||
:query (-let (((&keys :from :to :on) rest))
|
:query (-let (((&keys :from :to :on) argh))
|
||||||
;; TODO: This used to be (when (or from to on) query), but
|
;; TODO: 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
|
;; that doesn't seem right, so I changed it to this if, and the
|
||||||
;; tests pass either way. Might deserve a little scrutiny.
|
;; tests pass either way. Might deserve a little scrutiny.
|
||||||
|
|
|
||||||
55
tests/test-org-ql-ert.el
Normal file
55
tests/test-org-ql-ert.el
Normal file
|
|
@ -0,0 +1,55 @@
|
||||||
|
;;; test-org-ql-ert.el --- -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2021 Adam Porter
|
||||||
|
|
||||||
|
;; Author: Adam Porter <adam@alphapapa.net>
|
||||||
|
;; Keywords:
|
||||||
|
|
||||||
|
;; This program is free software; you can redistribute it and/or modify
|
||||||
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
;; the Free Software Foundation, either version 3 of the License, or
|
||||||
|
;; (at your option) any later version.
|
||||||
|
|
||||||
|
;; This program is distributed in the hope that it will be useful,
|
||||||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;; GNU General Public License for more details.
|
||||||
|
|
||||||
|
;; You should have received a copy of the GNU General Public License
|
||||||
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
;;;; Requirements
|
||||||
|
|
||||||
|
(require 'ert)
|
||||||
|
|
||||||
|
(require 'org-ql)
|
||||||
|
|
||||||
|
;;;; Variables
|
||||||
|
|
||||||
|
|
||||||
|
;;;; Customization
|
||||||
|
|
||||||
|
|
||||||
|
;;;; Commands
|
||||||
|
|
||||||
|
|
||||||
|
;;;; Functions
|
||||||
|
|
||||||
|
(ert-deftest org-ql--normalize-query ()
|
||||||
|
(should (equal (org-ql--normalize-query '(ts-active :on "2019-01-01"))
|
||||||
|
`(ts :type active
|
||||||
|
:from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
|
||||||
|
:to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01"))))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;; Footer
|
||||||
|
|
||||||
|
(provide 'test-org-ql-ert)
|
||||||
|
|
||||||
|
;;; test-org-ql-ert.el ends here
|
||||||
|
|
@ -511,6 +511,23 @@ with keyword arg NOW in PLIST."
|
||||||
;; (ts :type inactive
|
;; (ts :type inactive
|
||||||
;; :from ,(make-ts :unix 1546322400.0)
|
;; :from ,(make-ts :unix 1546322400.0)
|
||||||
;; :to ,(make-ts :unix 1546408799.0))))
|
;; :to ,(make-ts :unix 1546408799.0))))
|
||||||
|
|
||||||
|
(expect (org-ql--normalize-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
|
||||||
|
:from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
|
||||||
|
:to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01")))
|
||||||
|
(ts :type active
|
||||||
|
:from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
|
||||||
|
:to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01")))
|
||||||
|
(ts :type inactive
|
||||||
|
:from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
|
||||||
|
:to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01")))
|
||||||
|
(ts :type inactive
|
||||||
|
:from ,(ts-apply :hour 0 :minute 0 :second 0 (ts-parse "2019-01-01"))
|
||||||
|
:to ,(ts-apply :hour 23 :minute 59 :second 59 (ts-parse "2019-01-01")))))
|
||||||
)
|
)
|
||||||
|
|
||||||
(describe "Query preambles"
|
(describe "Query preambles"
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue