diff --git a/org-ql.el b/org-ql.el index 193592a..342efa0 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1148,9 +1148,9 @@ It would be expanded to: Expands into a form that processes arguments to timestamp-related predicates and evaluates BODY, which is expected to evaluate to a 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 -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 result form." ;; 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 ;; 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... - `(-let (((&keys :from :to :on :type) rest) - (result)) + `(let ((from (plist-get argh :from)) + (to (plist-get argh :to)) + (on (plist-get argh :on)) + (type (plist-get argh :type)) + (result)) (ignore type) ;; Only (ts) uses it. - (pcase rest + (pcase argh (`(,(and num (pred numberp)) . ,rest*) (setf on num - rest rest*))) + argh rest*))) (when on (setq from on to on)) @@ -1207,9 +1210,9 @@ result form." (setf result (progn ,@body)) ;; 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.) - (when (and (plist-member rest :with-time) + (when (and (plist-member argh :with-time) (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 ;; a little bit ugly, but it allows us to normalize queries more ;; easily, without leaving useless arguments in the result. @@ -1949,10 +1952,10 @@ ignored." :normalizers ((`(,predicate-names ,(and num-days (pred numberp))) ;; (clocked) and (closed) implicitly look into the past. (let* ((from-day (* -1 num-days)) - (rest (list :from from-day))) + (argh (list :from from-day))) (org-ql--normalize-from-to-on `(clocked :from ,from)))) - (`(,predicate-names . ,rest) + (`(,predicate-names . ,argh) (org-ql--normalize-from-to-on `(clocked :from ,from :to ,to)))) :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))) ;; (clocked) and (closed) implicitly look into the past. (let* ((from-day (* -1 num-days)) - (rest (list :from from-day))) + (argh (list :from from-day))) (org-ql--normalize-from-to-on `(closed :from ,from)))) - (`(,predicate-names . ,rest) + (`(,predicate-names . ,argh) (org-ql--normalize-from-to-on `(closed :from ,from :to ,to)))) :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 within `org-deadline-warning-days'. Without arguments, return 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. (let ((ts (->> (ts-now) (ts-adjust 'day org-deadline-warning-days) (ts-apply :hour 23 :minute 59 :second 59)))) - `(deadline-warning :to ,ts ,@rest))) - (`(,predicate-names . ,(and rest (guard (numberp (car rest))))) + `(deadline-warning :to ,ts ,@argh))) + (`(,predicate-names . ,(and argh (guard (numberp (car argh))))) (org-ql--normalize-from-to-on `(deadline :to ,to))) - (`(,predicate-names . ,rest) + (`(,predicate-names . ,argh) (org-ql--normalize-from-to-on `(deadline :from ,from :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 . ,rest) + :preambles ((`(,predicate-names . ,argh) (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 'nil "nil") org-ql-regexp-deadline-without-time) ('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) "Return non-nil if current entry has planning timestamp in given period. 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 `(planning :to ,to))) - (`(,predicate-names . ,rest) + (`(,predicate-names . ,argh) (org-ql--normalize-from-to-on `(planning :from ,from :to ,to)))) - :preambles ((`(,predicate-names . ,rest) + :preambles ((`(,predicate-names . ,argh) (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 'nil "nil") org-ql-regexp-planning-without-time) ('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) "Return non-nil if current entry is scheduled in given period. Without arguments, return non-nil if entry is scheduled." - :normalizers ((`(,predicate-names . ,rest) + :normalizers ((`(,predicate-names . ,argh) (org-ql--normalize-from-to-on `(scheduled :from ,from :to ,to)))) - :preambles ((`(,predicate-names . ,rest) + :preambles ((`(,predicate-names . ,argh) (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 'nil "nil") org-ql-regexp-scheduled-without-time) ('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)." ;; 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)) - (`(,predicate-names . ,(and rest (guard (numberp (car rest))))) + ((`(,(or 'ts-active 'ts-a) . ,argh) `(ts :type active ,@argh)) + (`(,(or 'ts-inactive 'ts-i) . ,argh) `(ts :type inactive ,@argh)) + (`(,predicate-names . ,(and argh (guard (numberp (car argh))))) (org-ql--normalize-from-to-on `(ts :type ,type :to ,to))) - (`(,predicate-names . ,rest) + (`(,predicate-names . ,argh) (org-ql--normalize-from-to-on `(ts :type ,type :from ,from :to ,to)))) :preambles - ((`(,predicate-names . ,rest) - (list :regexp (pcase (plist-get rest :type) - ((or 'nil 'both) (pcase-exhaustive (org-ql--plist-get* rest :with-time) + ((`(,predicate-names . ,argh) + (list :regexp (pcase (plist-get argh :type) + ((or 'nil 'both) (pcase-exhaustive (org-ql--plist-get* argh :with-time) ((or 't "t") org-ql-regexp-ts-both-with-time) ((or 'nil "nil") org-ql-regexp-ts-both-without-time) ('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 'nil "nil") org-ql-regexp-ts-active-without-time) ('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 'nil "nil") org-ql-regexp-ts-inactive-without-time) ('not-found org-ql-regexp-ts-inactive)))) ;; 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 ;; that doesn't seem right, so I changed it to this if, and the ;; tests pass either way. Might deserve a little scrutiny. diff --git a/tests/test-org-ql-ert.el b/tests/test-org-ql-ert.el new file mode 100644 index 0000000..230d901 --- /dev/null +++ b/tests/test-org-ql-ert.el @@ -0,0 +1,55 @@ +;;; test-org-ql-ert.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Adam Porter + +;; Author: Adam Porter +;; 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 . + +;;; 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 diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index cd0a846..5771cca 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -511,6 +511,23 @@ with keyword arg NOW in PLIST." ;; (ts :type inactive ;; :from ,(make-ts :unix 1546322400.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"