Add: Call some ts-type predicates with a number/auto

This commit is contained in:
Adam Porter 2019-08-18 21:28:06 -05:00
parent 99a18dff2a
commit ab3d1178b9
5 changed files with 136 additions and 30 deletions

View file

@ -44,16 +44,16 @@ More examples are available in [[examples.org]].
:action '(org-toggle-tag "Emacs" 'on)) :action '(org-toggle-tag "Emacs" 'on))
;; Return a list of bills coming due, searching all Org Agenda files, ;; Return a list of bills coming due, searching all Org Agenda files,
;; sorted by deadline. Deadlines are compared with ;; sorted by deadline. The `auto' argument to `deadline' means to match
;; `org-deadline-warning-days', which is implied by the plain `<=' in ;; entries whose deadlines fall within `org-deadline-warning-days'.
;; the `deadline' predicate. `org-ql-query' works like `org-ql-select' ;; `org-ql-query' works like `org-ql-select' but offers arguments named
;; but offers arguments named like SQL queries. ;; like SQL queries.
(org-ql-query (org-ql-query
:select #'org-get-heading :select #'org-get-heading
:from (org-agenda-files) :from (org-agenda-files)
:where '(and (not (done)) :where '(and (not (done))
(tags "bills") (tags "bills")
(deadline <=)) (deadline auto))
:order-by 'deadline) :order-by 'deadline)
;;=> ("TODO Electric bill" "TODO Water bill") ;;=> ("TODO Electric bill" "TODO Water bill")
@ -205,17 +205,23 @@ Arguments are listed next to predicate names, where applicable.
All of these selectors take optional keyword arguments ~:from~, ~:to:~, and ~:on~. If ~:from~, return non-nil if entry has a timestamp on or after ~:from~. If ~:to~, return non-nil if entry has a timestamp on or before ~:to~. If ~:on~, return non-nil if entry has a timestamp on date ~:on~. Argument values should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value. All of these selectors take optional keyword arguments ~:from~, ~:to:~, and ~:on~. If ~:from~, return non-nil if entry has a timestamp on or after ~:from~. If ~:to~, return non-nil if entry has a timestamp on or before ~:to~. If ~:on~, return non-nil if entry has a timestamp on date ~:on~. Argument values should be either ~ts~ structs, or strings parseable by ~parse-time-string~ which may omit the time value.
+ ~clocked~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
+ ~closed~ :: Return non-nil if current entry was closed in given period. If no arguments are specified, return non-nil if entry was closed at any time.
+ ~deadline~ :: Return non-nil if current entry has deadline in given period. If no arguments are specified, return non-nil if entry has any deadline.
+ ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). If no arguments are specified, return non-nil if entry is scheduled at any time.
+ ~scheduled~ :: Return non-nil if current entry is scheduled in given period. If no arguments are specified, return non-nil if entry is scheduled at any time.
+ ~ts~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp. + ~ts~ :: Return non-nil if current entry has a timestamp in given period. If no arguments are specified, return non-nil if entry has any timestamp.
+ ~ts-active~ :: Like ~ts~, but only matches active timestamps. + ~ts-active~ :: Like ~ts~, but only matches active timestamps.
+ ~ts-a~ :: Like ~ts~, but only matches active timestamps. + ~ts-a~ :: Like ~ts~, but only matches active timestamps.
+ ~ts-inactive~ :: Like ~ts~, but only matches inactive timestamps. + ~ts-inactive~ :: Like ~ts~, but only matches inactive timestamps.
+ ~ts-i~ :: Like ~ts~, but only matches inactive timestamps. + ~ts-i~ :: Like ~ts~, but only matches inactive timestamps.
The following selectors can also take a single argument, a number, which looks backward or forward a number of days. The number can also be negative to invert the direction.
*Backward-looking:*
+ ~clocked~ :: Return non-nil if current entry was clocked in given period. If no arguments are specified, return non-nil if entry was clocked at any time. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
+ ~closed~ :: Return non-nil if current entry was closed in given period. If no arguments are specified, return non-nil if entry was closed at any time.
*Forward-looking:*
+ ~deadline~ :: Return non-nil if current entry has deadline in given period. If argument is =auto=, return non-nil if entry has deadline within =org-deadline-warning-days=. If no arguments are specified, return non-nil if entry has any deadline.
+ ~planning~ :: Return non-nil if current entry has planning timestamp in given period (i.e. its deadline, scheduled, or closed timestamp). If no arguments are specified, return non-nil if entry is scheduled at any time.
+ ~scheduled~ :: Return non-nil if current entry is scheduled in given period. If no arguments are specified, return non-nil if entry is scheduled at any time.
** Functions / Macros ** Functions / Macros
:PROPERTIES: :PROPERTIES:
:TOC: ignore-children :TOC: ignore-children

View file

@ -11,7 +11,7 @@
* Show entries with recent timestamps * Show entries with recent timestamps
#+BEGIN_SRC elisp #+BEGIN_SRC elisp
(cl-defun org-ql-agenda-recent-items (days &optional (type 'ts)) (cl-defun org-ql-view-recent-items (days &optional (type 'ts))
"Show items from previous DAYS days with timestamps of TYPE. "Show items from previous DAYS days with timestamps of TYPE.
TYPE may be `ts', `ts-active', `ts-inactive', `clocked', TYPE may be `ts', `ts-active', `ts-inactive', `clocked',
`closed', `deadline', `planning', or `scheduled'." `closed', `deadline', `planning', or `scheduled'."
@ -19,28 +19,23 @@
(->> '(ts ts-active ts-inactive clocked closed deadline planning scheduled) (->> '(ts ts-active ts-inactive clocked closed deadline planning scheduled)
(completing-read "Timestamp type: ") (completing-read "Timestamp type: ")
intern))) intern)))
(let ((from (->> (ts-now) (org-ql-search (org-agenda-files)
(ts-adjust 'day (* -1 days)) `(,type ,days)
(ts-apply :hour 0 :minute 0 :second 0) :title "Recent items"
;; Formatting isn't required, but it looks better in the header than a struct. :sort '(date priority todo)
ts-format))) :groups '((:todo "DONE")
(org-ql-search (org-agenda-files) (:name "Log" :category "log" :tag "log")
`(,type :from ,from :to ,(ts-format (ts-now))) (:auto-parent t)
:title "Recent items" (:auto-todo t))))
:sort '(date priority todo)
:groups '((:todo "DONE")
(:category "log" :tag "log")
(:auto-parent t)
(:auto-todo t)))))
;; Show entries with any timestamp from last 7 days: ;; Show entries with any timestamp from last 7 days:
(org-ql-agenda-recent-items 7) (org-ql-view-recent-items 7)
;; Show entries clocked in last 7 days: ;; Show entries clocked in last 30 days:
(org-ql-agenda-recent-items 30 'clocked) (org-ql-view-recent-items 30 'clocked)
;; Show entries closed in last 7 days: ;; Show entries closed in last 30 days:
(org-ql-agenda-recent-items 30 'closed) (org-ql-view-recent-items 30 'closed)
#+END_SRC #+END_SRC
* Stuck projects block agenda * Stuck projects block agenda

View file

@ -35,7 +35,7 @@
(-if-let* ((header "Bills due within 3 days") (-if-let* ((header "Bills due within 3 days")
(items (org-ql "~/org/main.org" (items (org-ql "~/org/main.org"
(and (deadline <= (+ 3 today)) (and (deadline 3)
(tags "bills")) (tags "bills"))
:action (org-get-heading 'no-tags 'no-todo))) :action (org-get-heading 'no-tags 'no-todo)))
(string (concat "<ul>" (string (concat "<ul>"

View file

@ -267,6 +267,10 @@ NARROW corresponds to the `org-ql-select' argument NARROW."
Replaces bare strings with (regexp) selectors, and appropriate Replaces bare strings with (regexp) selectors, and appropriate
`ts'-related selectors." `ts'-related selectors."
;; This is unsophisticated, but it works. ;; This is unsophisticated, but it works.
;; TODO: Maybe query pre-processing should be done in one place,
;; rather than here and in --query-predicate.
;; NOTE: Don't be scared by the `pcase' patterns! They make this
;; all very easy once you grok the backquoting and unquoting.
(cl-labels ((rec (element) (cl-labels ((rec (element)
(pcase element (pcase element
(`(or . ,clauses) `(or ,@(mapcar #'rec clauses))) (`(or . ,clauses) `(or ,@(mapcar #'rec clauses)))
@ -283,6 +287,38 @@ Replaces bare strings with (regexp) selectors, and appropriate
(`(children) '(children (lambda () t))) (`(children) '(children (lambda () t)))
(`(descendants ,query) `(descendants ',query)) (`(descendants ,query) `(descendants ',query))
(`(descendants) '(descendants (lambda () t))) (`(descendants) '(descendants (lambda () t)))
;; Timestamp-based predicates. I think this is the way that makes the most sense:
;; set the limit to N days in the future, adjusted to 23:59:59 (since Org doesn't
;; support timestamps down to the second, anyway, there should be no need to adjust
;; it forward to 00:00:00 of the next day). That way, e.g. if it's Monday at 3 PM,
;; and N is 1, rather than showing items up to 3 PM Tuesday, it will show items any
;; time on Tuesday. If this isn't desired, the user can pass a specific timestamp.
(`(,(and pred (or 'clocked 'closed))
,(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))))
`(,pred :from ,from)))
(`(deadline 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)))
(`(,(and pred (or 'deadline 'scheduled 'planning))
,(and num-days (pred numberp)))
(let ((to (->> (ts-now)
(ts-adjust 'day num-days)
(ts-apply :hour 23 :minute 59 :second 59))))
`(,pred :to ,to)))
(`(,(and pred (or 'deadline 'scheduled 'planning))
,(and type (or :from :to :on))
,(and num-days (pred numberp)))
(let ((target (->> (ts-now)
(ts-adjust 'day num-days)
(ts-apply :hour 23 :minute 59 :second 59))))
`(,pred ,type ,target)))
(`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest)) (`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest))
(`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest)) (`(,(or 'ts-inactive 'ts-i) . ,rest) `(ts :type inactive ,@rest))
(_ element)))) (_ element))))
@ -783,6 +819,14 @@ comparator, PRIORITY should be a priority string."
;; TODO: Remove the _on vars from these arg lists. I think they're not ;; TODO: Remove the _on vars from these arg lists. I think they're not
;; necessary, or shouldn't be, since --pre-process-query should handle them. ;; necessary, or shouldn't be, since --pre-process-query should handle them.
;; NOTE: These docstrings apply to the functions defined by `org-ql--defpref',
;; not necessarily to the way users are expected to call them in queries. The
;; queries are pre-processed by `org-ql--pre-process-query' to handle
;; arguments which are constant during a query's execution.
;; TODO: Update the macro to define a user-facing docstring so I don't
;; have to manually update the documentation.
(org-ql--defpred clocked (&key from to _on) (org-ql--defpred clocked (&key from to _on)
;; The underscore before `on' prevents "unused lexical variable" ;; The underscore before `on' prevents "unused lexical variable"
;; warnings, because we pre-process that argument in a macro before ;; warnings, because we pre-process that argument in a macro before
@ -840,6 +884,26 @@ FROM, TO, and ON should be either `ts' structs, or strings
parseable by `parse-time-string' which may omit the time value." parseable by `parse-time-string' which may omit the time value."
(org-ql--predicate-ts :from from :to to :regexp org-deadline-time-regexp :match-group 1)) (org-ql--predicate-ts :from from :to to :regexp org-deadline-time-regexp :match-group 1))
(org-ql--defpred deadline-warning (&key from to)
"Internal selector used to handle `org-deadline-warning-days' and deadlines with warning periods."
(save-excursion
(forward-line 1)
(when (re-search-forward org-deadline-time-regexp (line-end-position) t)
(-let* ((context (org-element-context))
;; Since we need to handle warning periods, we parse the
;; Org timestamp as an org-element rather than as a string.
((_planning (_closed _nil _deadline element . _rest)) context)
((_timestamp (&keys :warning-value :warning-unit)) element)
(ts (ts-parse-org-element element))
(ts (pcase warning-unit
('nil ts)
((and unit (or 'year 'month 'day))
(->> ts (ts-adjust unit (* -1 warning-value))))
('week (->> ts (ts-adjust 'day (* -7 warning-value)))))))
(cond ((and from to) (ts-in from to ts))
(from (ts<= from ts))
(to (ts<= ts to)))))))
(org-ql--defpred planning (&key from to _on) (org-ql--defpred planning (&key from to _on)
;; The underscore before `on' prevents "unused lexical variable" ;; The underscore before `on' prevents "unused lexical variable"
;; warnings, because we pre-process that argument in a macro before ;; warnings, because we pre-process that argument in a macro before

View file

@ -110,6 +110,15 @@ RESULTS should be a list of strings as returned by
:action (org-ql-test-org-get-heading)) :action (org-ql-test-org-get-heading))
:to-equal ,results)) :to-equal ,results))
(defmacro org-ql-then (&rest body)
"Wrap BODY, setting `ts-now' to return timestamp at 2017-07-05 12:00:00."
;; The same time used in `org-super-agenda--test-date', which is where the test data comes from.
(declare (indent defun))
`(cl-letf (((symbol-function 'ts-now)
(lambda ()
(make-ts :year 2017 :month 7 :day 5 :hour 12 :minute 0 :second 0))))
,@body))
;;;; Tests ;;;; Tests
(describe "org-ql" (describe "org-ql"
@ -250,6 +259,11 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((clocked)) (org-ql-expect ((clocked))
'("Learn universal sign language"))) '("Learn universal sign language")))
(org-ql-it "with a number"
(org-ql-then
(org-ql-expect ((clocked 10))
'("Learn universal sign language"))))
(org-ql-it ":from a timestamp" (org-ql-it ":from a timestamp"
(org-ql-expect ((clocked :from "2017-07-05")) (org-ql-expect ((clocked :from "2017-07-05"))
'("Learn universal sign language")) '("Learn universal sign language"))
@ -282,6 +296,11 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((closed)) (org-ql-expect ((closed))
'("Learn universal sign language"))) '("Learn universal sign language")))
(org-ql-it "with a number"
(org-ql-then
(org-ql-expect ((closed 10))
'("Learn universal sign language"))))
(org-ql-it ":on" (org-ql-it ":on"
(org-ql-expect ((closed :on "2017-07-05")) (org-ql-expect ((closed :on "2017-07-05"))
'("Learn universal sign language")) '("Learn universal sign language"))
@ -310,9 +329,20 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((deadline)) (org-ql-expect ((deadline))
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))) '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")))
(org-ql-it "auto"
(org-ql-then
(org-ql-expect ((deadline auto))
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))))
(org-ql-it "with a number"
(org-ql-then
(org-ql-expect ((deadline 2))
'("Take over the world" "/r/emacs"))))
(org-ql-it ":on" (org-ql-it ":on"
(org-ql-expect ((deadline :on "2017-07-05")) (org-ql-expect ((deadline :on "2017-07-05"))
'("/r/emacs")) '("/r/emacs"))
(org-ql-expect ((deadline :on "2019-06-09")) (org-ql-expect ((deadline :on "2019-06-09"))
nil)) nil))
@ -348,6 +378,11 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((planning)) (org-ql-expect ((planning))
'("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")))
(org-ql-it "with a number"
(org-ql-then
(org-ql-expect ((planning 2))
'("Take over the world" "Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))))
(org-ql-it ":on" (org-ql-it ":on"
(org-ql-expect ((planning :on "2017-07-05")) (org-ql-expect ((planning :on "2017-07-05"))
'("Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp")) '("Practice leaping tall buildings in a single bound" "Learn universal sign language" "Order a pizza" "Get haircut" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
@ -412,6 +447,12 @@ RESULTS should be a list of strings as returned by
(org-ql-expect ((scheduled)) (org-ql-expect ((scheduled))
'("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))) '("Skype with president of Antarctica" "Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")))
(org-ql-it "with a number"
(org-ql-then
;; Using -1 is the easiest way to exclude some results but not all for testing this.
(org-ql-expect ((scheduled -1))
'("Skype with president of Antarctica"))))
(org-ql-it ":on" (org-ql-it ":on"
(org-ql-expect ((scheduled :on "2017-07-05")) (org-ql-expect ((scheduled :on "2017-07-05"))
'("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp")) '("Practice leaping tall buildings in a single bound" "Order a pizza" "Get haircut" "Fix flux capacitor" "Shop for groceries" "Rewrite Emacs in Common Lisp"))