WIP
This commit is contained in:
Adam Porter
parent
a24b41d7e5
commit
26c58c6c77
3 changed files with 118 additions and 52 deletions
146
org-ql.el
146
org-ql.el
|
|
@ -146,12 +146,16 @@ This list should not contain any duplicates."))
|
|||
(defvar org-ql-regexp-part-ts-date
|
||||
(rx (repeat 4 digit) "-" (repeat 2 digit) "-" (repeat 2 digit)
|
||||
;; Day of week
|
||||
(optional " " (1+ alpha))
|
||||
;; Repeaters (not sure if the colon is necessary, but it's in the org.el one)
|
||||
(optional (repeat 1 2 (seq " " (repeat 1 2 (any "-+:")) (1+ digit) (any "hdwmy")))))
|
||||
(optional " " (1+ alpha)))
|
||||
"Matches the inner, date part of an Org timestamp, both active and inactive.
|
||||
Also matches optional day-of-week and repeaters. Used to build
|
||||
other timestamp regexps.")
|
||||
Also matches optional day-of-week. Used to build other timestamp
|
||||
regexps.")
|
||||
|
||||
(defvar org-ql-regexp-part-ts-repeaters
|
||||
;; Repeaters (not sure if the colon is necessary, but it's in the org.el one)
|
||||
(rx (repeat 1 2 (seq " " (repeat 1 2 (any "-+:")) (1+ digit) (any "hdwmy"))))
|
||||
"Matches the repeater part of an Org timestamp.
|
||||
Includes leading space character.")
|
||||
|
||||
(defvar org-ql-regexp-part-ts-time
|
||||
(rx " " (repeat 1 2 digit) ":" (repeat 2 digit))
|
||||
|
|
@ -159,40 +163,57 @@ other timestamp regexps.")
|
|||
Includes leading space character. Used to build other timestamp
|
||||
regexps.")
|
||||
|
||||
;; NOTE: The inactive timestamp regexps don't allow repeaters. I don't know if this is
|
||||
;; officially correct, but it seems to make sense, and would be easy to change if necessary.
|
||||
|
||||
(defvar org-ql-regexp-ts-both
|
||||
(rx-to-string
|
||||
`(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) (optional (regexp ,org-ql-regexp-part-ts-time)) ">")
|
||||
(seq "[" (regexp ,org-ql-regexp-part-ts-date) (optional (regexp ,org-ql-regexp-part-ts-time)) "]")))
|
||||
`(or (seq "<" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(optional (regexp ,org-ql-regexp-part-ts-time))
|
||||
(optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">")
|
||||
(seq "[" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(optional (regexp ,org-ql-regexp-part-ts-time)))))
|
||||
"Matches both active and inactive Org timestamps, with or without time.")
|
||||
|
||||
(defvar org-ql-regexp-ts-both-with-time
|
||||
(rx-to-string `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) (regexp ,org-ql-regexp-part-ts-time) ">")
|
||||
(seq "[" (regexp ,org-ql-regexp-part-ts-date) (regexp ,org-ql-regexp-part-ts-time) "]")))
|
||||
(rx-to-string `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(regexp ,org-ql-regexp-part-ts-time)
|
||||
(optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">")
|
||||
(seq "[" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(regexp ,org-ql-regexp-part-ts-time) "]")))
|
||||
"Matches both active and inactive Org timestamps, with time.")
|
||||
|
||||
(defvar org-ql-regexp-ts-both-without-time
|
||||
(rx-to-string `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date) ">")
|
||||
(rx-to-string `(or (seq "<" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">")
|
||||
(seq "[" (regexp ,org-ql-regexp-part-ts-date) "]")))
|
||||
"Matches both active and inactive Org timestamps, without time.")
|
||||
|
||||
(defvar org-ql-regexp-ts-active
|
||||
(rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) (optional (regexp ,org-ql-regexp-part-ts-time)) ">"))
|
||||
(rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(optional (regexp ,org-ql-regexp-part-ts-time))
|
||||
(optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">"))
|
||||
"Matches active Org timestamps, with or without time.")
|
||||
|
||||
(defvar org-ql-regexp-ts-active-with-time
|
||||
(rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) (regexp ,org-ql-regexp-part-ts-time) ">"))
|
||||
(rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(regexp ,org-ql-regexp-part-ts-time)
|
||||
(optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">"))
|
||||
"Matches active Org timestamps, with time.")
|
||||
|
||||
(defvar org-ql-regexp-ts-active-without-time
|
||||
(rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date) ">"))
|
||||
(rx-to-string `(seq "<" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(optional (regexp ,org-ql-regexp-part-ts-repeaters)) ">"))
|
||||
"Matches active Org timestamps, without time.")
|
||||
|
||||
(defvar org-ql-regexp-ts-inactive
|
||||
(rx-to-string `(seq "[" (regexp ,org-ql-regexp-part-ts-date) (optional (regexp ,org-ql-regexp-part-ts-time)) "]"))
|
||||
(rx-to-string `(seq "[" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(optional (regexp ,org-ql-regexp-part-ts-time))"]"))
|
||||
"Matches inactive Org timestamps, with or without time.")
|
||||
|
||||
(defvar org-ql-regexp-ts-inactive-with-time
|
||||
(rx-to-string `(seq "[" (regexp ,org-ql-regexp-part-ts-date) (regexp ,org-ql-regexp-part-ts-time) "]"))
|
||||
(rx-to-string `(seq "[" (regexp ,org-ql-regexp-part-ts-date)
|
||||
(regexp ,org-ql-regexp-part-ts-time)"]"))
|
||||
"Matches inactive Org timestamps, with time.")
|
||||
|
||||
(defvar org-ql-regexp-ts-inactive-without-time
|
||||
|
|
@ -200,33 +221,54 @@ regexps.")
|
|||
"Matches inactive Org timestamps, without time.")
|
||||
|
||||
(defvar org-ql-regexp-planning
|
||||
(rx-to-string `(seq bow (or "CLOSED" "SCHEDULED" "DEADLINE") ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-both))))
|
||||
"Matches DEADLINE or SCHEDULED keyword with timestamp, with or without time.")
|
||||
(rx-to-string `(seq bow (or (seq "CLOSED" ":" (0+ " ")
|
||||
(group-n 1 (regexp ,org-ql-regexp-ts-inactive)))
|
||||
(seq (or "DEADLINE" "SCHEDULED") ":" (0+ " ")
|
||||
(group-n 1 (regexp ,org-ql-regexp-ts-active))))))
|
||||
"Matches CLOSED, DEADLINE or SCHEDULED keyword with timestamp, with or without time.")
|
||||
|
||||
(defvar org-ql-regexp-planning-with-time
|
||||
(rx-to-string `(seq bow (or "CLOSED" "SCHEDULED" "DEADLINE") ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-both-with-time))))
|
||||
"Matches DEADLINE or SCHEDULED keyword with timestamp, with time.")
|
||||
(rx-to-string `(seq bow (or (seq "CLOSED" ":" (0+ " ")
|
||||
(group-n 1 (regexp ,org-ql-regexp-ts-inactive-with-time)))
|
||||
(seq (or "DEADLINE" "SCHEDULED") ":" (0+ " ")
|
||||
(group-n 1 (regexp ,org-ql-regexp-ts-active-with-time))))))
|
||||
"Matches CLOSED, DEADLINE or SCHEDULED keyword with timestamp, with time.")
|
||||
|
||||
(defvar org-ql-regexp-planning-without-time
|
||||
(rx-to-string `(seq bow (or "CLOSED" "SCHEDULED" "DEADLINE") ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-both-without-time))))
|
||||
"Matches DEADLINE or SCHEDULED keyword with timestamp, without time.")
|
||||
(rx-to-string `(seq bow (or (seq "CLOSED" ":" (0+ " ")
|
||||
(group-n 1 (regexp ,org-ql-regexp-ts-inactive-without-time)))
|
||||
(seq (or "DEADLINE" "SCHEDULED") ":" (0+ " ")
|
||||
(group-n 1 (regexp ,org-ql-regexp-ts-active-without-time))))))
|
||||
"Matches CLOSED, DEADLINE or SCHEDULED keyword with timestamp, without time.")
|
||||
|
||||
(defvar org-ql-regexp-deadline
|
||||
(rx-to-string `(seq bow "DEADLINE" ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-active))))
|
||||
"Matches DEADLINE keyword with a time-and-hour stamp, with or without time.")
|
||||
|
||||
(defvar org-ql-regexp-deadline-with-time
|
||||
(rx-to-string `(seq bow "DEADLINE" ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-active-with-time))))
|
||||
"Matches DEADLINE keyword with a time-and-hour stamp, with time.")
|
||||
|
||||
(defvar org-ql-regexp-deadline-without-time
|
||||
(rx-to-string `(seq bow "DEADLINE" ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-active-without-time))))
|
||||
"Matches DEADLINE keyword with a time-and-hour stamp, without time.")
|
||||
|
||||
(defvar org-ql-regexp-scheduled
|
||||
(rx-to-string `(seq bow "SCHEDULED" ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-both))))
|
||||
(group (regexp ,org-ql-regexp-ts-active))))
|
||||
"Matches SCHEDULED keyword with a time-and-hour stamp, with or without time.")
|
||||
|
||||
(defvar org-ql-regexp-scheduled-with-time
|
||||
(rx-to-string `(seq bow "SCHEDULED" ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-both-with-time))))
|
||||
(group (regexp ,org-ql-regexp-ts-active-with-time))))
|
||||
"Matches SCHEDULED keyword with a time-and-hour stamp, with time.")
|
||||
|
||||
(defvar org-ql-regexp-scheduled-without-time
|
||||
(rx-to-string `(seq bow "SCHEDULED" ":" (0+ " ")
|
||||
(group (regexp ,org-ql-regexp-ts-both-without-time))))
|
||||
(group (regexp ,org-ql-regexp-ts-active-without-time))))
|
||||
"Matches SCHEDULED keyword with a time-and-hour stamp, without time.")
|
||||
|
||||
;;;; Customization
|
||||
|
|
@ -742,29 +784,38 @@ Arguments STRING, POS, FILL, and LEVEL are according to
|
|||
(let ((byte-compile-log-warning-function #'org-ql--byte-compile-warning))
|
||||
(byte-compile
|
||||
`(lambda ()
|
||||
;; NOTE: `clocked' and `closed' don't have WITH-TIME args, because they should always have a time.
|
||||
;; TODO: If possible, all of this argument processing should be done in each predicate's normalizers.
|
||||
(cl-macrolet ((clocked (&key from to on)
|
||||
(org-ql--from-to-on)
|
||||
`(org-ql--predicate-clocked :from ,from :to ,to))
|
||||
(closed (&key from to on (with-time 'not-found))
|
||||
(org-ql--from-to-on)
|
||||
`(org-ql--predicate-closed :from ,from :to ,to :with-time ,with-time))
|
||||
`(org-ql--predicate-closed :from ,from :to ,to))
|
||||
(deadline (&key from to on (with-time 'not-found))
|
||||
(org-ql--from-to-on)
|
||||
`(org-ql--predicate-deadline :from ,from :to ,to :with-time ,with-time))
|
||||
`(org-ql--predicate-deadline
|
||||
:from ,from :to ,to :with-time ',with-time
|
||||
:regexp ,(pcase-exhaustive with-time
|
||||
('t org-ql-regexp-deadline-with-time)
|
||||
('nil org-ql-regexp-deadline-without-time)
|
||||
('not-found org-ql-regexp-deadline))))
|
||||
(planning (&key from to on (with-time 'not-found))
|
||||
(org-ql--from-to-on)
|
||||
`(org-ql--predicate-planning :from ,from :to ,to :with-time ',with-time
|
||||
:regexp ,(pcase-exhaustive with-time
|
||||
('t org-ql-regexp-planning-with-time)
|
||||
('nil org-ql-regexp-planning-without-time)
|
||||
('not-found org-ql-regexp-planning))))
|
||||
`(org-ql--predicate-planning
|
||||
:from ,from :to ,to :with-time ',with-time
|
||||
:regexp ,(pcase-exhaustive with-time
|
||||
('t org-ql-regexp-planning-with-time)
|
||||
('nil org-ql-regexp-planning-without-time)
|
||||
('not-found org-ql-regexp-planning))))
|
||||
(scheduled (&key from to on (with-time 'not-found))
|
||||
(org-ql--from-to-on)
|
||||
`(org-ql--predicate-scheduled :from ,from :to ,to :with-time ',with-time
|
||||
:regexp ,(pcase-exhaustive with-time
|
||||
('t org-ql-regexp-scheduled-with-time)
|
||||
('nil org-ql-regexp-scheduled-without-time)
|
||||
('not-found org-ql-regexp-scheduled))))
|
||||
`(org-ql--predicate-scheduled
|
||||
:from ,from :to ,to :with-time ',with-time
|
||||
:regexp ,(pcase-exhaustive with-time
|
||||
('t org-ql-regexp-scheduled-with-time)
|
||||
('nil org-ql-regexp-scheduled-without-time)
|
||||
('not-found org-ql-regexp-scheduled))))
|
||||
(ts (&key from to on (type 'both) (with-time 'not-found))
|
||||
(org-ql--from-to-on)
|
||||
`(org-ql--predicate-ts
|
||||
|
|
@ -1837,6 +1888,7 @@ parseable by `parse-time-string' which may omit the time value."
|
|||
(org-ql--predicate-ts :from from :to to :regexp org-ql-clock-regexp :match-group 1))
|
||||
|
||||
(org-ql-defpred closed (&key from to _on)
|
||||
;; TODO: Should this use the new org-ql-regexps?
|
||||
;; The underscore before `on' prevents "unused lexical variable"
|
||||
;; warnings, because we pre-process that argument in a macro before
|
||||
;; this function is called.
|
||||
|
|
@ -1866,7 +1918,7 @@ parseable by `parse-time-string' which may omit the time value."
|
|||
(org-ql--predicate-ts :from from :to to :regexp org-closed-time-regexp :match-group 1
|
||||
:limit (line-end-position 2)))
|
||||
|
||||
(org-ql-defpred deadline (&key from to _on)
|
||||
(org-ql-defpred deadline (&key from to _on regexp _with-time)
|
||||
;; The underscore before `on' prevents "unused lexical variable"
|
||||
;; warnings, because we pre-process that argument in a macro before
|
||||
;; this function is called.
|
||||
|
|
@ -1895,13 +1947,19 @@ parseable by `parse-time-string' which may omit the time value."
|
|||
(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 . ,rest)
|
||||
(list :query query
|
||||
:regexp (pcase-exhaustive (org-ql--plist-get* rest :with-time)
|
||||
('t org-ql-regexp-deadline-with-time)
|
||||
('nil org-ql-regexp-deadline-without-time)
|
||||
('not-found org-ql-regexp-deadline)))))
|
||||
:body
|
||||
(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 regexp :match-group 1
|
||||
:limit (line-end-position 2)))
|
||||
|
||||
(org-ql-defpred deadline-warning (&key from to)
|
||||
;; TODO: Should this also accept a WITH-TIME argument?
|
||||
;; TODO: Should this use the new org-ql-regexps?
|
||||
"Internal selector used to handle `org-deadline-warning-days' and deadlines with warning periods."
|
||||
:preambles ((`(,predicate-names . ,_)
|
||||
(list :regexp org-deadline-time-regexp :query query)))
|
||||
|
|
@ -1964,7 +2022,7 @@ parseable by `parse-time-string' which may omit the time value."
|
|||
(org-ql--predicate-ts :from from :to to :match-group 1 :limit (line-end-position 2)
|
||||
:regexp regexp))
|
||||
|
||||
(org-ql-defpred scheduled (&key from to _on regexp with-time)
|
||||
(org-ql-defpred scheduled (&key from to _on regexp _with-time)
|
||||
;; The underscore before `on' prevents "unused lexical variable"
|
||||
;; warnings, because we pre-process that argument in a macro before
|
||||
;; this function is called.
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@ SCHEDULED: <2017-07-05 Wed +2d>
|
|||
:END:
|
||||
|
||||
** TODO [#B] Renew membership in supervillain club
|
||||
DEADLINE: <2017-07-10 Mon -1w>
|
||||
DEADLINE: <2017-07-10 Mon 23:59 -1w>
|
||||
|
||||
** DONE [#B] Learn universal sign language
|
||||
CLOSED: [2017-07-05 Wed 03:02]
|
||||
|
|
|
|||
|
|
@ -637,7 +637,15 @@ RESULTS should be a list of strings as returned by
|
|||
'("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-then
|
||||
(org-ql-expect ('(deadline :to today))
|
||||
'("/r/emacs")))))
|
||||
'("/r/emacs"))))
|
||||
|
||||
(org-ql-it ":with-time"
|
||||
(org-ql-expect ('(deadline :with-time nil))
|
||||
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Internet" "Spaceship lease" "/r/emacs"))
|
||||
(org-ql-expect ('(deadline :with-time t))
|
||||
'("Renew membership in supervillain club"))
|
||||
(org-ql-expect ('(deadline :to "2017-07-10" :with-time t))
|
||||
'("Renew membership in supervillain club"))))
|
||||
|
||||
(org-ql-it "(done)"
|
||||
(org-ql-expect ('(done))
|
||||
|
|
@ -835,9 +843,9 @@ RESULTS should be a list of strings as returned by
|
|||
|
||||
(org-ql-it ":with-time"
|
||||
(org-ql-expect ('(planning :with-time nil))
|
||||
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "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" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
|
||||
(org-ql-expect ('(planning :with-time t))
|
||||
'("Skype with president of Antarctica" "Learn universal sign language" "Order a pizza"))
|
||||
'("Skype with president of Antarctica" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza"))
|
||||
(org-ql-expect ('(planning :to "2017-07-04" :with-time t))
|
||||
'("Skype with president of Antarctica"))))
|
||||
|
||||
|
|
@ -1158,9 +1166,9 @@ RESULTS should be a list of strings as returned by
|
|||
|
||||
(org-ql-it ":with-time"
|
||||
(org-ql-expect ('(ts-active :with-time nil))
|
||||
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "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" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
|
||||
(org-ql-expect ('(ts-active :with-time t))
|
||||
'("Skype with president of Antarctica" "Order a pizza"))
|
||||
'("Skype with president of Antarctica" "Renew membership in supervillain club" "Order a pizza"))
|
||||
(org-ql-expect ('(ts-active :to "2017-07-04" :with-time t))
|
||||
'("Skype with president of Antarctica"))))
|
||||
|
||||
|
|
@ -1284,9 +1292,9 @@ RESULTS should be a list of strings as returned by
|
|||
|
||||
(org-ql-it ":with-time"
|
||||
(org-ql-expect ('(ts :with-time nil))
|
||||
'("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "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" "Visit Mars" "Visit the moon" "Practice leaping tall buildings in a single bound" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp"))
|
||||
(org-ql-expect ('(ts :with-time t))
|
||||
'("Skype with president of Antarctica" "Visit the moon" "Learn universal sign language" "Order a pizza" "Rewrite Emacs in Common Lisp"))
|
||||
'("Skype with president of Antarctica" "Visit the moon" "Renew membership in supervillain club" "Learn universal sign language" "Order a pizza" "Rewrite Emacs in Common Lisp"))
|
||||
(org-ql-expect ('(ts :to "2017-07-04" :with-time t))
|
||||
'("Skype with president of Antarctica")))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue