Add: (ts) predicates, improved tests
This commit is contained in:
Adam Porter
parent
3a10fe593d
commit
943bb6d6c0
4 changed files with 1005 additions and 107 deletions
|
|
@ -90,7 +90,6 @@ Note that, for convenience, standard numeric comparator function symbols (~<~, ~
|
|||
+ ~category (&optional categories)~ :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
|
||||
+ ~clocked (&key from to on)~ :: 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. If ~FROM~, return non-nil if entry was clocked on or after ~FROM~. If ~TO~, return non-nil if entry was clocked on or before ~TO~. If ~ON~, return non-nil if entry was clocked on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value. Note: Clock entries are expected to be clocked out. Currently clocked entries (i.e. with unclosed timestamp ranges) are ignored.
|
||||
+ ~closed (&optional comparator target-date)~ :: Return non-nil if entry's closed date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~).
|
||||
+ ~date (&optional comparator target-date type)~ :: Return non-nil if Org entry at point has date of ~TYPE~ that compares with ~TARGET-DATE~ using ~COMPARATOR~. Checks all Org-formatted timestamp strings in entry. ~TYPE~ may be ~active~, ~inactive~, or ~all~, to control whether active, inactive, or all timestamps are checked. Ranges of each type are also checked. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~).
|
||||
+ ~deadline (&optional comparator target-date)~ :: Return non-nil if entry's deadline compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~).
|
||||
+ ~done~ :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
|
||||
+ ~habit~ :: Return non-nil if entry is a habit.
|
||||
|
|
@ -103,6 +102,9 @@ Note that, for convenience, standard numeric comparator function symbols (~<~, ~
|
|||
+ ~scheduled (&optional comparator target-date)~ :: Return non-nil if entry's scheduled date compares with ~TARGET-DATE~ using ~COMPARATOR~. ~TARGET-DATE~ should be a string parseable by ~date-to-day~. ~COMPARATOR~ should be a function (like ~<=~).
|
||||
+ ~tags (&optional tags)~ :: Return non-nil if current heading has one or more of ~TAGS~ (a list of strings).
|
||||
+ ~todo (&optional keywords)~ :: Return non-nil if current heading is a ~TODO~ item. With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings).
|
||||
+ ~ts (&key from to on)~ :: 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. 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~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value.
|
||||
+ ~ts-active (&key from to on)~ :: Return non-nil if current entry has an active timestamp in given period. If no arguments are specified, return non-nil if entry has any active timestamp. If ~FROM~, return non-nil if entry has an active timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has an active timestamp on or before ~TO~. If ~ON~, return non-nil if entry has an active timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value.
|
||||
+ ~ts-inactive (&key from to on)~ :: Return non-nil if current entry has an inactive timestamp in given period. If no arguments are specified, return non-nil if entry has any inactive timestamp. If ~FROM~, return non-nil if entry has an inactive timestamp on or after ~FROM~. If ~TO~, return non-nil if entry has an inactive timestamp on or before ~TO~. If ~ON~, return non-nil if entry has an inactive timestamp on date ~ON~. ~FROM~, ~TO~, and ~ON~ should be strings parseable by ~parse-time-string~ but may omit the time value.
|
||||
|
||||
** Functions / Macros
|
||||
:PROPERTIES:
|
||||
|
|
|
|||
297
org-ql.el
297
org-ql.el
|
|
@ -46,7 +46,7 @@ This list should not contain any duplicates.")
|
|||
|
||||
(cl-defmacro org-ql--defpredicate (name args docstring &rest body)
|
||||
"FIXME: docstring"
|
||||
(declare (debug (symbolp listp stringp body))
|
||||
(declare (debug (symbolp listp stringp def-body))
|
||||
(indent defun))
|
||||
(let ((fn-name (intern (concat "org-ql--predicate-" (symbol-name name))))
|
||||
(pred-name (intern (symbol-name name))))
|
||||
|
|
@ -137,24 +137,59 @@ a list of defined `org-ql' sorting methods: `date', `deadline',
|
|||
;; possibly somewhere in-between. At the least, we should do
|
||||
;; this in a more flexible, abstracted way, but this will do
|
||||
;; for now. Most importantly, it works!
|
||||
(cl-macrolet ((clocked (&key from to on)
|
||||
(when on
|
||||
(setq from on
|
||||
to on))
|
||||
(when from
|
||||
(setq from (org-ql--parse-time-string from)))
|
||||
(when to
|
||||
(setq to (org-ql--parse-time-string to 'end)))
|
||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked'
|
||||
;; function, not another `clocked'.
|
||||
`(org-ql--predicate-clocked :from ,from :to ,to)))
|
||||
(cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda
|
||||
(= #'=)
|
||||
(< #'<)
|
||||
(> #'>)
|
||||
(<= #'<=)
|
||||
(>= #'>=))
|
||||
,query)))))
|
||||
(let (from to on)
|
||||
;; TODO: DRY these macrolets.
|
||||
(cl-macrolet ((clocked (&key from to on)
|
||||
(when on
|
||||
(setq from on
|
||||
to on))
|
||||
(when from
|
||||
(setq from (org-ql--parse-time-string from)))
|
||||
(when to
|
||||
(setq to (org-ql--parse-time-string to 'end)))
|
||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-clocked'
|
||||
;; function, not another `clocked'.
|
||||
`(org-ql--predicate-clocked :from ,from :to ,to))
|
||||
(ts (&key from to on)
|
||||
(when on
|
||||
(setq from on
|
||||
to on))
|
||||
(when from
|
||||
(setq from (org-ql--parse-time-string from)))
|
||||
(when to
|
||||
(setq to (org-ql--parse-time-string to 'end)))
|
||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
||||
;; function, not another `ts'.
|
||||
`(org-ql--predicate-ts :from ,from :to ,to))
|
||||
(ts-active (&key from to on)
|
||||
(when on
|
||||
(setq from on
|
||||
to on))
|
||||
(when from
|
||||
(setq from (org-ql--parse-time-string from)))
|
||||
(when to
|
||||
(setq to (org-ql--parse-time-string to 'end)))
|
||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
||||
;; function, not another `ts'.
|
||||
`(org-ql--predicate-ts-active :from ,from :to ,to))
|
||||
(ts-inactive (&key from to on)
|
||||
(when on
|
||||
(setq from on
|
||||
to on))
|
||||
(when from
|
||||
(setq from (org-ql--parse-time-string from)))
|
||||
(when to
|
||||
(setq to (org-ql--parse-time-string to 'end)))
|
||||
;; NOTE: The macro must expand to the actual `org-ql--predicate-ts'
|
||||
;; function, not another `ts'.
|
||||
`(org-ql--predicate-ts-inactive :from ,from :to ,to)))
|
||||
(cl-symbol-macrolet ((today org-ql--today) ; Necessary because of byte-compiling the lambda
|
||||
(= #'=)
|
||||
(< #'<)
|
||||
(> #'>)
|
||||
(<= #'<=)
|
||||
(>= #'>=))
|
||||
,query))))))
|
||||
(action (byte-compile action))
|
||||
;; TODO: Figure out how to use or reimplement the org-scanner-tags feature.
|
||||
;; (org-use-tag-inheritance t)
|
||||
|
|
@ -446,6 +481,127 @@ comparator, PRIORITY should be a priority string."
|
|||
;; Check that PROPERTY has VALUE
|
||||
(string-equal value (org-entry-get (point) property 'selective)))))))
|
||||
|
||||
;;;;;; Timestamps
|
||||
|
||||
;; TODO: DRY these ts predicates.
|
||||
|
||||
(org-ql--defpredicate ts (&key from to on)
|
||||
"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.
|
||||
|
||||
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.
|
||||
|
||||
FROM, TO, and ON should be strings parseable by
|
||||
`parse-time-string' but may omit the time value."
|
||||
;; TODO: DRY this with the clocked predicate.
|
||||
;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written
|
||||
;; for end users, for which the arguments are pre-processed by `org-ql-query'.
|
||||
;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled.
|
||||
(cl-macrolet ((next-timestamp ()
|
||||
`(when (re-search-forward org-element--timestamp-regexp end-pos t)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(org-element-timestamp-parser))))
|
||||
(test-timestamps (pred-form)
|
||||
`(cl-loop for next-ts = (next-timestamp)
|
||||
while next-ts
|
||||
for beg = (float-time (org-timestamp--to-internal-time next-ts))
|
||||
for end = (float-time (org-timestamp--to-internal-time next-ts 'end))
|
||||
thereis ,pred-form)))
|
||||
(save-excursion
|
||||
(let ((end-pos (org-entry-end-position)))
|
||||
(cond ((not (or from to)) (next-timestamp))
|
||||
((and from to) (test-timestamps (and (<= beg to)
|
||||
(>= end from))))
|
||||
(from (test-timestamps (<= from end)))
|
||||
(to (test-timestamps (<= beg to))))))))
|
||||
|
||||
(org-ql--defpredicate ts-active (&key from to on)
|
||||
"Return non-nil if current entry has an active timestamp in given period.
|
||||
If no arguments are specified, return non-nil if entry has any
|
||||
active timestamp.
|
||||
|
||||
If FROM, return non-nil if entry has an active timestamp on or
|
||||
after FROM.
|
||||
|
||||
If TO, return non-nil if entry has an active timestamp on or
|
||||
before TO.
|
||||
|
||||
If ON, return non-nil if entry has an active timestamp on date
|
||||
ON.
|
||||
|
||||
FROM, TO, and ON should be strings parseable by
|
||||
`parse-time-string' but may omit the time value."
|
||||
;; TODO: DRY this with the clocked predicate.
|
||||
;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written
|
||||
;; for end users, for which the arguments are pre-processed by `org-ql-query'.
|
||||
;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled.
|
||||
(cl-macrolet ((next-timestamp ()
|
||||
`(when (re-search-forward org-element--timestamp-regexp end-pos t)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(org-element-timestamp-parser))))
|
||||
(test-timestamps (pred-form)
|
||||
`(cl-loop for next-ts = (next-timestamp)
|
||||
while next-ts
|
||||
when (string-prefix-p "<" next-ts)
|
||||
for beg = (float-time (org-timestamp--to-internal-time next-ts))
|
||||
for end = (float-time (org-timestamp--to-internal-time next-ts 'end))
|
||||
thereis ,pred-form)))
|
||||
(save-excursion
|
||||
(let ((end-pos (org-entry-end-position)))
|
||||
(cond ((not (or from to)) (next-timestamp))
|
||||
((and from to) (test-timestamps (and (<= beg to)
|
||||
(>= end from))))
|
||||
(from (test-timestamps (<= from end)))
|
||||
(to (test-timestamps (<= beg to))))))))
|
||||
|
||||
(org-ql--defpredicate ts-inactive (&key from to on)
|
||||
"Return non-nil if current entry has an inactive timestamp in given period.
|
||||
If no arguments are specified, return non-nil if entry has any
|
||||
inactive timestamp.
|
||||
|
||||
If FROM, return non-nil if entry has an inactive timestamp on or
|
||||
after FROM.
|
||||
|
||||
If TO, return non-nil if entry has an inactive timestamp on or
|
||||
before TO.
|
||||
|
||||
If ON, return non-nil if entry has an inactive timestamp on date
|
||||
ON.
|
||||
|
||||
FROM, TO, and ON should be strings parseable by
|
||||
`parse-time-string' but may omit the time value."
|
||||
;; TODO: DRY this with the clocked predicate.
|
||||
;; NOTE: FROM and TO are actually expected to be Unix timestamps. The docstring is written
|
||||
;; for end users, for which the arguments are pre-processed by `org-ql-query'.
|
||||
;; FIXME: This assumes every "clocked" entry is a range. Unclosed clock entries are not handled.
|
||||
(cl-macrolet ((next-timestamp ()
|
||||
`(when (re-search-forward org-element--timestamp-regexp end-pos t)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(org-element-timestamp-parser))))
|
||||
(test-timestamps (pred-form)
|
||||
`(cl-loop for next-ts = (next-timestamp)
|
||||
while next-ts
|
||||
when (string-prefix-p "[" next-ts)
|
||||
for beg = (float-time (org-timestamp--to-internal-time next-ts))
|
||||
for end = (float-time (org-timestamp--to-internal-time next-ts 'end))
|
||||
thereis ,pred-form)))
|
||||
(save-excursion
|
||||
(let ((end-pos (org-entry-end-position)))
|
||||
(cond ((not (or from to)) (next-timestamp))
|
||||
((and from to) (test-timestamps (and (<= beg to)
|
||||
(>= end from))))
|
||||
(from (test-timestamps (<= from end)))
|
||||
(to (test-timestamps (<= beg to))))))))
|
||||
|
||||
;;;;; Date comparison
|
||||
|
||||
(defun org-ql--date-type-p (type &optional comparator target-date)
|
||||
|
|
@ -527,57 +683,58 @@ COMPARATOR should be a function (like `<=')."
|
|||
;; NOTE: This was a defsubst before being defined with the macro. Might be good to make it a defsubst again.
|
||||
(org-ql--date-type-p :closed comparator target-date))
|
||||
|
||||
(org-ql--defpredicate date (&optional comparator target-date (type 'active))
|
||||
"Return non-nil if Org entry at point has date of TYPE that compares with TARGET-DATE using COMPARATOR.
|
||||
Checks all Org-formatted timestamp strings in entry. TYPE may be
|
||||
`active', `inactive', or `all', to control whether active,
|
||||
inactive, or all timestamps are checked. Ranges of each type are
|
||||
also checked. TARGET-DATE should be a string parseable by
|
||||
`date-to-day'. COMPARATOR should be a function (like `<=')."
|
||||
;; MAYBE: This duplicates some code in --date-p, maybe it could be refactored DRYer.
|
||||
(let* ((entry-timestamps (save-excursion
|
||||
;; NOTE: It's important to `save-excursion', otherwise the point will be moved, which will
|
||||
;; likely cause the action function to fail. We could wrap the call to the predicate in
|
||||
;; `save-excursion', but that would do it even when not necessary, which would be slower.
|
||||
(cl-loop while (re-search-forward org-element--timestamp-regexp (org-entry-end-position) t)
|
||||
collect (match-string 0)))))
|
||||
(pcase comparator
|
||||
('nil (pcase type
|
||||
('all entry-timestamps)
|
||||
('active (cl-loop for timestamp in entry-timestamps
|
||||
thereis (string-prefix-p "<" timestamp)))
|
||||
('inactive (cl-loop for timestamp in entry-timestamps
|
||||
thereis (string-prefix-p "[" timestamp)))
|
||||
(_ (user-error "Invalid type for date selector. May be `active', `inactive', or `all'"))))
|
||||
((pred functionp)
|
||||
;; TODO: Avoid computing target-day-number every time this is called.
|
||||
;; Probably need to make a lambda that has it already defined.
|
||||
(let ((target-day-number (cl-typecase target-date
|
||||
(null nil) ; Calculated later.
|
||||
;; Append time to target-date because `date-to-day' requires it.
|
||||
(string (date-to-day (concat target-date " 00:00")))
|
||||
(integer target-date))))
|
||||
(cl-loop for timestamp in entry-timestamps
|
||||
for date-element = (with-temp-buffer
|
||||
;; MAYBE: Replace with ts.el eventually.
|
||||
;; TODO: Parse the element in the re-search-forward loop.
|
||||
(insert timestamp)
|
||||
(goto-char 0)
|
||||
(org-element-timestamp-parser))
|
||||
for this-target-day-number = (or target-day-number
|
||||
;; FIXME: Not sure if it makes sense to check warning
|
||||
;; days for non-planning timestamps, but we'll try it.
|
||||
(+ (org-get-wdays timestamp) (org-today)))
|
||||
thereis (when (or (eq 'all type)
|
||||
(member (org-element-property :type date-element)
|
||||
(pcase type
|
||||
('active '(active active-range))
|
||||
('inactive '(inactive inactive-range)))))
|
||||
(funcall comparator (org-time-string-to-absolute
|
||||
(org-element-timestamp-interpreter date-element 'ignore))
|
||||
this-target-day-number)))))
|
||||
(_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer"
|
||||
comparator target-date)))))
|
||||
;; (org-ql--defpredicate date (&optional comparator target-date (type 'active))
|
||||
;; "Return non-nil if Org entry at point has date of TYPE that compares with TARGET-DATE using COMPARATOR.
|
||||
;; Checks all Org-formatted timestamp strings in entry. TYPE may be
|
||||
;; `active', `inactive', or `all', to control whether active,
|
||||
;; inactive, or all timestamps are checked. Ranges of each type are
|
||||
;; also checked. TARGET-DATE should be a string parseable by
|
||||
;; `date-to-day'. COMPARATOR should be a function (like `<=')."
|
||||
;; ;; NOTE: I think the `ts' predicate obsoletes this, but I'm leaving it commented for now.
|
||||
;; ;; MAYBE: This duplicates some code in --date-p, maybe it could be refactored DRYer.
|
||||
;; (let* ((entry-timestamps (save-excursion
|
||||
;; ;; NOTE: It's important to `save-excursion', otherwise the point will be moved, which will
|
||||
;; ;; likely cause the action function to fail. We could wrap the call to the predicate in
|
||||
;; ;; `save-excursion', but that would do it even when not necessary, which would be slower.
|
||||
;; (cl-loop while (re-search-forward org-element--timestamp-regexp (org-entry-end-position) t)
|
||||
;; collect (match-string 0)))))
|
||||
;; (pcase comparator
|
||||
;; ('nil (pcase type
|
||||
;; ('all entry-timestamps)
|
||||
;; ('active (cl-loop for timestamp in entry-timestamps
|
||||
;; thereis (string-prefix-p "<" timestamp)))
|
||||
;; ('inactive (cl-loop for timestamp in entry-timestamps
|
||||
;; thereis (string-prefix-p "[" timestamp)))
|
||||
;; (_ (user-error "Invalid type for date selector. May be `active', `inactive', or `all'"))))
|
||||
;; ((pred functionp)
|
||||
;; ;; TODO: Avoid computing target-day-number every time this is called.
|
||||
;; ;; Probably need to make a lambda that has it already defined.
|
||||
;; (let ((target-day-number (cl-typecase target-date
|
||||
;; (null nil) ; Calculated later.
|
||||
;; ;; Append time to target-date because `date-to-day' requires it.
|
||||
;; (string (date-to-day (concat target-date " 00:00")))
|
||||
;; (integer target-date))))
|
||||
;; (cl-loop for timestamp in entry-timestamps
|
||||
;; for date-element = (with-temp-buffer
|
||||
;; ;; MAYBE: Replace with ts.el eventually.
|
||||
;; ;; TODO: Parse the element in the re-search-forward loop.
|
||||
;; (insert timestamp)
|
||||
;; (goto-char 0)
|
||||
;; (org-element-timestamp-parser))
|
||||
;; for this-target-day-number = (or target-day-number
|
||||
;; ;; FIXME: Not sure if it makes sense to check warning
|
||||
;; ;; days for non-planning timestamps, but we'll try it.
|
||||
;; (+ (org-get-wdays timestamp) (org-today)))
|
||||
;; thereis (when (or (eq 'all type)
|
||||
;; (member (org-element-property :type date-element)
|
||||
;; (pcase type
|
||||
;; ('active '(active active-range))
|
||||
;; ('inactive '(inactive inactive-range)))))
|
||||
;; (funcall comparator (org-time-string-to-absolute
|
||||
;; (org-element-timestamp-interpreter date-element 'ignore))
|
||||
;; this-target-day-number)))))
|
||||
;; (_ (user-error "COMPARATOR (%s) must be a function, and DATE (%s) must be a string or day-number integer"
|
||||
;; comparator target-date)))))
|
||||
|
||||
;;;;; Sorting
|
||||
|
||||
|
|
|
|||
528
tests/data.org
528
tests/data.org
|
|
@ -1,10 +1,528 @@
|
|||
#+TODO: TODO TODAY NEXT STARTED IN-PROGRESS UNDERWAY WAITING SOMEDAY MAYBE CHECK | DONE CANCELED
|
||||
|
||||
* Test data
|
||||
|
||||
* Data
|
||||
Rather than using my personal agenda every time I want to take a screenshot, how about this.
|
||||
|
||||
** Clocked
|
||||
Will try to open the agenda view as if it was [2017-07-05 Wed]
|
||||
|
||||
*** Clocked from 2018-12-01 00:00 to 2018-12-10 23:59
|
||||
:LOGBOOK:
|
||||
CLOCK: [2018-12-01 Sat 00:00]--[2018-12-10 Mon 23:59] => 239:59
|
||||
** TODO [#A] Take over the universe :universe:ambition:
|
||||
DEADLINE: <2017-07-15 Sat -1m>
|
||||
:PROPERTIES:
|
||||
:agenda-group: plans
|
||||
:CATEGORY: ambition
|
||||
:END:
|
||||
|
||||
*** TODO [#A] Take over the world :world:
|
||||
DEADLINE: <2017-07-07 Fri>
|
||||
|
||||
I'd like to be finished with this before the weekend...
|
||||
|
||||
**** TODO [#A] Skype with president of Antarctica :world:meetings:
|
||||
SCHEDULED: <2017-07-04 Tue 21:00>
|
||||
|
||||
Not sure what his timezone is...
|
||||
|
||||
*** TODO [#B] Take over Mars
|
||||
|
||||
**** TODO Visit Mars :space:travel:planet:
|
||||
DEADLINE: <2017-09-20 Wed -3m>
|
||||
|
||||
Ah, the red planet...
|
||||
|
||||
*** TODO [#C] Take over the moon
|
||||
|
||||
**** WAITING Visit the moon :space:travel:
|
||||
DEADLINE: <2017-08-27 Sun -2m>
|
||||
:LOGBOOK:
|
||||
- State "WAITING" from [2017-07-24 Mon 19:01]
|
||||
:END:
|
||||
|
||||
Just waiting on that callback from NASA...
|
||||
|
||||
*** TODO Practice leaping tall buildings in a single bound :personal:
|
||||
SCHEDULED: <2017-07-05 Wed +2d>
|
||||
:PROPERTIES:
|
||||
:STYLE: habit
|
||||
:END:
|
||||
|
||||
*** TODO [#B] Renew membership in supervillain club
|
||||
DEADLINE: <2017-07-10 Mon -1w>
|
||||
|
||||
*** DONE [#B] Learn universal sign language
|
||||
CLOSED: [2017-07-05 Wed 03:02]
|
||||
:PROPERTIES:
|
||||
:ID: 729de245-75fa-43b4-845a-57af61109485
|
||||
:END:
|
||||
:LOGBOOK:
|
||||
- CLOSING NOTE [2017-07-05 Wed 03:02] \\
|
||||
All done!
|
||||
CLOCK: [2017-07-05 Wed 02:00]--[2017-07-05 Wed 03:02] => 1:02
|
||||
:END:
|
||||
|
||||
** TODO Order a pizza :food:dinner:
|
||||
SCHEDULED: <2017-07-05 Wed 18:00>
|
||||
:PROPERTIES:
|
||||
:Effort: 5
|
||||
:END:
|
||||
|
||||
** TODO [#C] Get haircut :personal:@town:
|
||||
SCHEDULED: <2017-07-05 Wed>
|
||||
|
||||
Should probably do this before I take over the world. Want to look my best. (Not that it will matter once I'm in charge.)
|
||||
|
||||
** TODO [#B] Internet :bills:
|
||||
DEADLINE: <2017-07-21 Fri -1m>
|
||||
|
||||
** TODO [#A] Spaceship lease :bills:spaceship:
|
||||
DEADLINE: <2017-08-01 Tue -1m>
|
||||
:PROPERTIES:
|
||||
:agenda-group: bills
|
||||
:END:
|
||||
|
||||
** TODO [#B] Fix flux capacitor :spaceship:shopping:@computer:
|
||||
SCHEDULED: <2017-07-05 Wed>
|
||||
|
||||
If I don't, the frobnicator will probably fall off halfway to Mars...
|
||||
|
||||
Gotta buy one first, though.
|
||||
|
||||
** Recurring
|
||||
:PROPERTIES:
|
||||
:agenda-group: recurring
|
||||
:END:
|
||||
|
||||
*** CHECK /r/emacs :website:Emacs:
|
||||
DEADLINE: <2017-07-05 Wed +1w>
|
||||
|
||||
*** TODO Shop for groceries :food:shopping:@town:
|
||||
SCHEDULED: <2017-07-05 Wed +1w>
|
||||
:PROPERTIES:
|
||||
:Effort: 30
|
||||
:END:
|
||||
|
||||
*** Sunrise/sunset
|
||||
|
||||
%%(org-super-agenda--test-diary-sunrise)
|
||||
%%(org-super-agenda--test-diary-sunset)
|
||||
|
||||
** Ideas
|
||||
:PROPERTIES:
|
||||
:CATEGORY: ideas
|
||||
:END:
|
||||
|
||||
*** SOMEDAY Rewrite Emacs in Common Lisp :Emacs:elisp:computers:software:programming:
|
||||
SCHEDULED: <2017-07-05 Wed>
|
||||
:LOGBOOK:
|
||||
- State "SOMEDAY" from "MAYBE" [2017-07-24 Mon 18:59]
|
||||
- State "MAYBE" from [2017-07-24 Mon 18:58]
|
||||
:END:
|
||||
|
||||
I mean, since no one has ever tried doing it before...
|
||||
|
||||
*** SOMEDAY Write a symphony :music:
|
||||
:PROPERTIES:
|
||||
:agenda-group: plans
|
||||
:END:
|
||||
|
||||
I don't know when I'll get to this, so it's undated.
|
||||
|
||||
* Code
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(org-time-string-to-absolute (org-entry-get (point) "SCHEDULED"))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC elisp :results none
|
||||
;; Setup code
|
||||
(require 'org-super-agenda)
|
||||
(org-super-agenda-mode 1)
|
||||
(require 'org-habit)
|
||||
(setq org-todo-keywords
|
||||
'((sequence "TODO(t!)" "TODAY(a!)" "NEXT(n!)" "STARTED(s!)" "IN-PROGRESS(p!)" "UNDERWAY(u!)" "WAITING(w@)" "SOMEDAY(o!)" "MAYBE(m!)" "|" "DONE(d@)" "CANCELED(c@)")
|
||||
(sequence "CHECK(k!)" "|" "DONE(d@)")
|
||||
(sequence "TO-READ(r!)" "READING(R!)" "|" "HAVE-READ(d@)")
|
||||
(sequence "TO-WATCH(!)" "WATCHING(!)" "SEEN(!)")))
|
||||
(with-current-buffer "test.org" (revert-buffer))
|
||||
|
||||
(defmacro with-org-today-date (date &rest body)
|
||||
"Run BODY with the `org-today' function set to return simply DATE.
|
||||
DATE should be a date-time string (both date and time must be included)."
|
||||
(declare (indent defun))
|
||||
`(let ((day (date-to-day ,date))
|
||||
(orig (symbol-function 'org-today)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(fset 'org-today (lambda () day))
|
||||
,@body)
|
||||
(fset 'org-today orig))))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC elisp :results none
|
||||
(defun diary-sunrise ()
|
||||
(let ((dss (diary-sunrise-sunset)))
|
||||
(with-temp-buffer
|
||||
(insert dss)
|
||||
(goto-char (point-min))
|
||||
(search-forward ",")
|
||||
(buffer-substring (point-min) (match-beginning 0)))))
|
||||
|
||||
(defun diary-sunset ()
|
||||
(let ((dss (diary-sunrise-sunset))
|
||||
start end)
|
||||
(with-temp-buffer
|
||||
(insert dss)
|
||||
(goto-char (point-min))
|
||||
(search-forward ", ")
|
||||
(setq start (match-end 0))
|
||||
(search-forward " at")
|
||||
(setq end (match-beginning 0))
|
||||
(goto-char start)
|
||||
(capitalize-word 1)
|
||||
(buffer-substring start end))))
|
||||
#+END_SRC
|
||||
|
||||
*Note:* Removing tests from here as they're added to =test.el=.
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
|
||||
(org-super-agenda--test-with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/emacs/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-super-agenda-groups
|
||||
'((:name "Time grid items in all-uppercase with RosyBrown1 foreground"
|
||||
:time-grid t
|
||||
:transformer (--> it
|
||||
(upcase it)
|
||||
(propertize it 'face '(:foreground "RosyBrown1"))))
|
||||
(:name "Priority >= C items underlined, on black background"
|
||||
:face (:background "black" :underline t)
|
||||
:not (:priority>= "C")
|
||||
:order 100))))
|
||||
(org-agenda nil "a")))
|
||||
(org-super-agenda--test-with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/emacs/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-super-agenda-groups
|
||||
'((:name none
|
||||
:time-grid t)
|
||||
(:name "Should be all-uppercase RosyBrown1 on black"
|
||||
:face (:background "black" :foreground "RosyBrown1")
|
||||
:transformer #'upcase
|
||||
:not (:priority>= "C")
|
||||
:order 100))))
|
||||
(org-agenda nil "a")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-super-agenda-groups
|
||||
'((:name none
|
||||
:time-grid t)
|
||||
(:name none
|
||||
:not (:priority>= "C")
|
||||
:order 100))))
|
||||
(org-agenda nil "a")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-super-agenda-groups
|
||||
'((:name "Items with child TODOs"
|
||||
:children todo))))
|
||||
(org-agenda nil "a")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-super-agenda-groups
|
||||
'((:name "Items with child TODOs"
|
||||
:children "CHECK"))))
|
||||
(org-agenda nil "a")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-agenda-custom-commands
|
||||
'(("u" "Super view"
|
||||
((agenda "" ((org-super-agenda-groups
|
||||
'((:name "Today"
|
||||
:time-grid t
|
||||
:scheduled today
|
||||
:deadline today)))))
|
||||
(todo "" ((org-super-agenda-groups
|
||||
'((:name "Projects"
|
||||
:children t)
|
||||
(:discard (:anything t)))))))))))
|
||||
(org-agenda nil "u")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-agenda-custom-commands
|
||||
'(("u" "Super view"
|
||||
((agenda "" ((org-super-agenda-groups
|
||||
'((:name "Today"
|
||||
:time-grid today)))))
|
||||
(todo "" ((org-super-agenda-groups
|
||||
'((:name "Projects"
|
||||
:children t)
|
||||
(:discard (:anything t)))))))))))
|
||||
(org-agenda nil "u")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-agenda-custom-commands
|
||||
'(("u" "Super view"
|
||||
((agenda "" ((org-super-agenda-groups
|
||||
'((:name "Schedule"
|
||||
:time-grid t
|
||||
:date today)
|
||||
(:name "Due today"
|
||||
:deadline today)
|
||||
(:name "Due soon"
|
||||
:deadline t)))))
|
||||
(todo "" ((org-agenda-overriding-header "")
|
||||
(org-super-agenda-groups
|
||||
'((:name "Projects"
|
||||
:children t)
|
||||
(:discard (:anything t)))))))))))
|
||||
(org-agenda nil "u")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
(org-super-agenda-groups
|
||||
'((:scheduled (before "2017-07-06")))))
|
||||
(org-agenda nil "a")))
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-super-agenda-groups
|
||||
'((:todo "WAITING")))
|
||||
(org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
|
||||
(org-todo-list)))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-super-agenda-groups
|
||||
'((:todo "SOMEDAY")))
|
||||
(org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
|
||||
(org-tags-view nil "Emacs")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-super-agenda-groups
|
||||
'((:todo "CHECK")))
|
||||
(org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
|
||||
;; org-search-view doesn't seem to set the todo-state property, so the matcher doesn't work
|
||||
(org-search-view nil "Emacs")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-super-agenda-groups
|
||||
'((:regexp ("moon" "mars"))))
|
||||
(org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
|
||||
(org-search-view nil "space")))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-super-agenda-groups
|
||||
'((:todo "SOMEDAY")))
|
||||
(org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
|
||||
(org-agenda-list nil nil 'day)))
|
||||
|
||||
#+END_SRC
|
||||
|
||||
** Agenda examining
|
||||
|
||||
This helps a lot.
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(defun data-debug-show-string-with-properties (s)
|
||||
(with-current-buffer (get-buffer-create "argh")
|
||||
(erase-buffer)
|
||||
(print s (current-buffer))
|
||||
|
||||
;; Convert string reader representations to plain lists that can be set
|
||||
(cl-loop for (match replace) in '(("#(" "'(")
|
||||
("#<" "'(")
|
||||
(">" ")"))
|
||||
do (progn
|
||||
(goto-char (point-min))
|
||||
(while (search-forward match nil 'noerror)
|
||||
(replace-match replace 'fixedcase 'literal))))
|
||||
|
||||
;; Surround content in a list which `argh' is set to, then eval
|
||||
;; the buffer to do it
|
||||
(goto-char (point-min))
|
||||
(insert "(setq argh (list '")
|
||||
(delete-forward-char 2)
|
||||
(goto-char (point-max))
|
||||
(insert "))")
|
||||
|
||||
;; Okay, sure, eval'ing the buffer is dangerous and bad and wrong.
|
||||
;; But this is the only way I can find to make this work. (Maybe
|
||||
;; `text-properties-at' could be used to get actual lists...)
|
||||
(eval-buffer)
|
||||
|
||||
(data-debug-show-stuff argh "argh")
|
||||
;; (switch-to-buffer (current-buffer))
|
||||
))
|
||||
|
||||
(defun data-debug-show-current-line-with-properties ()
|
||||
(interactive)
|
||||
(data-debug-show-string-with-properties (buffer-substring (line-beginning-position) (line-end-position))))
|
||||
|
||||
(with-current-buffer "*Org Agenda*"
|
||||
(data-debug-show-string-with-properties (seq-subseq (split-string (buffer-string) "\n")
|
||||
0 5)))
|
||||
#+END_SRC
|
||||
|
||||
** Agenda censoring
|
||||
|
||||
For sharing screenshots of the agenda without revealing private data.
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(defun org-agenda-sharpie ()
|
||||
"Censor the text of items in the agenda."
|
||||
(interactive)
|
||||
(let (regexp old-heading new-heading properties)
|
||||
;; Save face properties of line in agenda to reapply to changed text
|
||||
(setq properties (text-properties-at (point)))
|
||||
|
||||
;; Go to source buffer
|
||||
(org-with-point-at (org-find-text-property-in-string 'org-marker
|
||||
(buffer-substring (line-beginning-position)
|
||||
(line-end-position)))
|
||||
;; Save old heading text and ask for new text
|
||||
(line-beginning-position)
|
||||
(unless (org-at-heading-p)
|
||||
;; Not sure if necessary
|
||||
(org-back-to-heading))
|
||||
(setq old-heading (when (looking-at org-complex-heading-regexp)
|
||||
(match-string 4))))
|
||||
(setq new-heading (read-from-minibuffer "Overwrite visible heading with: "))
|
||||
(add-text-properties 0 (length new-heading) properties new-heading)
|
||||
;; Back to agenda buffer
|
||||
(save-excursion
|
||||
(when (and old-heading new-heading)
|
||||
;; Replace agenda text
|
||||
(let ((inhibit-read-only t))
|
||||
(goto-char (line-beginning-position))
|
||||
(when (search-forward old-heading (line-end-position))
|
||||
(replace-match new-heading 'fixedcase 'literal)))))))
|
||||
#+END_SRC
|
||||
|
||||
** Auto grouping
|
||||
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-super-agenda-groups
|
||||
'((:auto-group t)))
|
||||
(org-agenda-files (list "~/src/org-super-agenda/test/test.org")))
|
||||
(org-agenda-list nil nil 'day)))
|
||||
#+END_SRC
|
||||
|
||||
** Auto categories
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(let ((org-super-agenda-groups
|
||||
'((:auto-category t))))
|
||||
(org-agenda-list nil nil 'day))
|
||||
#+END_SRC
|
||||
|
||||
** Date
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(-let* ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
((sec minute hour day month year dow dst utcoff) (list 0 0 0 5 7 2017 3 t nil))
|
||||
(last-day-of-month
|
||||
;; A hack that seems to work fine
|
||||
(1+ (calendar-last-day-of-month month year)))
|
||||
(target-date (format "%d-%02d-%02d" year month last-day-of-month))
|
||||
(org-super-agenda-groups
|
||||
`((:deadline (before ,target-date))
|
||||
(:discard (:anything t)))))
|
||||
(org-todo-list)))
|
||||
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(-let* ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-agenda-span 'day)
|
||||
((sec minute hour day month year dow dst utcoff) (list 0 0 0 5 7 2017 3 t nil))
|
||||
(last-day-of-month (calendar-last-day-of-month month year))
|
||||
(target-date (format "%d-%02d-%02d" year month last-day-of-month))
|
||||
(org-super-agenda-groups
|
||||
`((:deadline (before ,target-date))
|
||||
(:discard (:anything t)))))
|
||||
(org-todo-list)))
|
||||
#+END_SRC
|
||||
|
||||
** Effort
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(with-org-today-date "2017-07-05 00:00"
|
||||
(let ((org-agenda-files (list "~/src/org-super-agenda/test/test.org"))
|
||||
(org-super-agenda-groups
|
||||
'((:effort< "0:06"))))
|
||||
(org-agenda-list nil nil 'day)))
|
||||
#+END_SRC
|
||||
|
||||
** Misc
|
||||
|
||||
*** let-plist
|
||||
|
||||
I don't need this right now, but it might come in handy here or elsewhere.
|
||||
|
||||
#+BEGIN_SRC elisp
|
||||
(defmacro osa/let-plist (keys plist &rest body)
|
||||
"`cl-destructuring-bind' without the boilerplate for plists."
|
||||
;; See https://emacs.stackexchange.com/q/22542/3871
|
||||
|
||||
;; I really don't understand why Emacs doesn't have this already.
|
||||
;; So many things come close to it: pcase, pcase-let, map-let,
|
||||
;; cl-destructuring-bind, -let...but none of them let you simply
|
||||
;; bind all the values of a plist to variables with the same name as
|
||||
;; their keys. You always have to type the name of the key twice.
|
||||
|
||||
;; For example, compare these two forms:
|
||||
|
||||
;; (-let (((&keys :from from :to to :date date :subject subject) email))
|
||||
;; (list from to date subject))
|
||||
|
||||
;; (osa/let-plist (:from :to :date :subject) email
|
||||
;; (list from to date subject))
|
||||
|
||||
;; Now, sure, sometimes you need to bind values to differently named
|
||||
;; variables. But when you don't, I know which one I prefer.
|
||||
(declare (indent defun))
|
||||
(setq keys (cl-loop for key in keys
|
||||
collect (intern (replace-regexp-in-string (rx bol ":") ""
|
||||
(symbol-name key)))))
|
||||
`(cl-destructuring-bind
|
||||
(&key ,@keys &allow-other-keys)
|
||||
,plist
|
||||
,@body))
|
||||
#+END_SRC
|
||||
|
||||
** Profiling
|
||||
|
||||
#+BEGIN_SRC elisp :results none
|
||||
(defmacro profile-it (times &rest body)
|
||||
`(let (output)
|
||||
(dolist (p '("org-super-agenda-" "map" "org-" "string-" "s-" "buffer-" "append" "delq" "map" "list" "car" "save-" "outline-" "delete-dups" "sort" "line-" "nth" "concat" "char-to-string" "rx-" "goto-" "when" "search-" "re-"))
|
||||
(elp-instrument-package p))
|
||||
(dotimes (x ,times)
|
||||
,@body)
|
||||
(elp-results)
|
||||
(elp-restore-all)
|
||||
(point-min)
|
||||
(forward-line 20)
|
||||
(delete-region (point) (point-max))
|
||||
(setq output (buffer-substring-no-properties (point-min) (point-max)))
|
||||
(kill-buffer)
|
||||
(delete-window)
|
||||
output))
|
||||
#+END_SRC
|
||||
|
|
|
|||
|
|
@ -26,45 +26,266 @@
|
|||
;;;; Requirements
|
||||
|
||||
(require 'org-ql)
|
||||
(require 'org-ql-agenda)
|
||||
|
||||
;;;; Variables
|
||||
|
||||
|
||||
|
||||
;;;; Functions
|
||||
|
||||
(defun org-ql-test-insert-result ()
|
||||
"FIXME: docstring"
|
||||
(interactive)
|
||||
(let* ((value (eval (elisp--preceding-sexp)))
|
||||
(prefix (if (and value (listp value))
|
||||
"'"
|
||||
"")))
|
||||
(insert " :to-equal "
|
||||
prefix
|
||||
(format "%S" value))))
|
||||
|
||||
;;;; Tests
|
||||
|
||||
(describe "org-ql"
|
||||
(before-all
|
||||
(setq test-buffer (find-file-noselect (concat default-directory "tests/data.org"))))
|
||||
|
||||
(describe "Can select entries clocked..."
|
||||
(it "...at any time"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked)
|
||||
:action (org-get-heading t t))
|
||||
:to-equal '("Clocked from 2018-12-01 00:00 to 2018-12-10 23:59")))
|
||||
(it "...after (:from) a timestamp"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :from "2018-11-10")
|
||||
:action (org-get-heading t t))
|
||||
:to-equal '("Clocked from 2018-12-01 00:00 to 2018-12-10 23:59")))
|
||||
(it "...up to (:to) a timestamp"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :to "2018-12-30")
|
||||
:action (org-get-heading t t))
|
||||
:to-equal '("Clocked from 2018-12-01 00:00 to 2018-12-10 23:59")))
|
||||
(it "...on a date"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :on "2018-12-02")
|
||||
:action (org-get-heading t t))
|
||||
:to-equal '("Clocked from 2018-12-01 00:00 to 2018-12-10 23:59")))
|
||||
(it "...within a date range"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :from "2018-12-03" :to "2018-12-11")
|
||||
:action (org-get-heading t t))
|
||||
:to-equal '("Clocked from 2018-12-01 00:00 to 2018-12-10 23:59")))))
|
||||
(before-all
|
||||
|
||||
(defun org-ql-test-org-get-heading ()
|
||||
;; For Org 9.0.5.
|
||||
(substring-no-properties (org-get-heading t t)))
|
||||
(defun org-ql-test-org-get-heading ()
|
||||
;; For Org 9.1.9.
|
||||
(substring-no-properties (org-get-heading t t t t)))
|
||||
|
||||
(setq test-buffer (find-file-noselect (concat default-directory "tests/data.org"))
|
||||
num-headings (with-current-buffer test-buffer
|
||||
(org-with-wide-buffer
|
||||
(goto-char (point-min))
|
||||
(cl-loop while (re-search-forward org-heading-regexp nil t)
|
||||
sum 1)))))
|
||||
|
||||
(describe "Predicates"
|
||||
|
||||
(describe "(category)"
|
||||
(it "without arguments"
|
||||
(expect (length (org-ql test-buffer
|
||||
(category)
|
||||
:action (org-ql-test-org-get-heading)))
|
||||
:to-equal num-headings))
|
||||
(it "with a category"
|
||||
(expect (org-ql test-buffer
|
||||
(category "ambition")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Take over the universe" "Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language"))))
|
||||
|
||||
(describe "(clocked)"
|
||||
(it "without arguments"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked)
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language")))
|
||||
(it ":from a timestamp"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :from "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :from "2017-07-06")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it ":to a timestamp"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :to "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :to "2017-07-04")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it ":on a date"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :on "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :on "2018-12-02")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it "within a range (:from and :to)"
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :from "2017-07-04" :to "2018-12-11")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :from "2017-07-06" :to "2018-12-11")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil)
|
||||
(expect (org-ql test-buffer
|
||||
(clocked :from "2017-07-01" :to "2017-07-04")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil)))
|
||||
|
||||
(describe "(closed)"
|
||||
(it "without arguments"
|
||||
(expect (org-ql test-buffer
|
||||
(closed)
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language")))
|
||||
(it "="
|
||||
(expect (org-ql test-buffer
|
||||
(closed = "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(closed = "2019-06-09")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it "<"
|
||||
;; TODO: Figure out why these tests take about 8 times longer than the other comparators in the (closed) tests.
|
||||
(expect (org-ql test-buffer
|
||||
(closed < "2019-06-10")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(closed < "2017-06-10")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it ">"
|
||||
(expect (org-ql test-buffer
|
||||
(closed > "2017-07-04")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(closed > "2019-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it ">="
|
||||
(expect (org-ql test-buffer
|
||||
(closed >= "2017-07-04")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(closed >= "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(closed >= "2017-07-06")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it "<="
|
||||
(expect (org-ql test-buffer
|
||||
(closed <= "2017-07-04")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil)
|
||||
(expect (org-ql test-buffer
|
||||
(closed <= "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))
|
||||
(expect (org-ql test-buffer
|
||||
(closed <= "2017-07-06")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Learn universal sign language"))))
|
||||
|
||||
(describe "(deadline)"
|
||||
(it "without arguments"
|
||||
(expect (org-ql test-buffer
|
||||
(deadline)
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs")))
|
||||
(it "="
|
||||
(expect (org-ql test-buffer
|
||||
(deadline = "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("/r/emacs"))
|
||||
(expect (org-ql test-buffer
|
||||
(deadline = "2019-06-09")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it "<"
|
||||
(expect (org-ql test-buffer
|
||||
(deadline < "2019-06-10")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))
|
||||
(expect (org-ql test-buffer
|
||||
(deadline < "2017-06-10")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it ">"
|
||||
;; TODO: Figure out why these tests take much longer than e.g. the (deadline <) tests.
|
||||
(expect (org-ql test-buffer
|
||||
(deadline > "2017-07-04 00:00")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))
|
||||
(expect (org-ql test-buffer
|
||||
(deadline > "2019-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it ">="
|
||||
(expect (org-ql test-buffer
|
||||
(deadline >= "2017-07-04")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))
|
||||
(expect (org-ql test-buffer
|
||||
(deadline >= "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))
|
||||
(expect (org-ql test-buffer
|
||||
(deadline >= "2017-07-06")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease"))
|
||||
(expect (org-ql test-buffer
|
||||
(deadline >= "2018-07-06")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it "<="
|
||||
(expect (org-ql test-buffer
|
||||
(deadline <= "2017-07-04")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil)
|
||||
(expect (org-ql test-buffer
|
||||
(deadline <= "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("/r/emacs"))
|
||||
(expect (org-ql test-buffer
|
||||
(deadline <= "2018-07-06")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Take over the universe" "Take over the world" "Visit Mars" "Visit the moon" "Renew membership in supervillain club" "Internet" "Spaceship lease" "/r/emacs"))))
|
||||
|
||||
(describe "(ts)"
|
||||
(it "without arguments"
|
||||
(expect (org-ql test-buffer
|
||||
(ts)
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Test data" "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")))
|
||||
(it ":from a timestamp"
|
||||
;; TODO: Figure out why these take longer than the other (ts) tests.
|
||||
(expect (org-ql test-buffer
|
||||
(ts :from "2017-01-01")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Test data" "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"))
|
||||
(expect (org-ql test-buffer
|
||||
(ts :from "2019-06-08")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
(it ":to a timestamp"
|
||||
(expect (org-ql test-buffer
|
||||
(ts :to "2019-06-10")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Test data" "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"))
|
||||
(expect (org-ql test-buffer
|
||||
(ts :to "2017-07-04")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Skype with president of Antarctica")))
|
||||
(it ":on a timestamp"
|
||||
(expect (org-ql test-buffer
|
||||
(ts :on "2017-07-05")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal '("Test data" "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"))
|
||||
(expect (org-ql test-buffer
|
||||
(ts :on "2019-06-09")
|
||||
:action (org-ql-test-org-get-heading))
|
||||
:to-equal nil))
|
||||
)
|
||||
|
||||
;; TODO: Other predicates.
|
||||
))
|
||||
|
||||
;;; org-ql.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue