WIP: (logbook) predicate
This commit is contained in:
parent
af18eac2b8
commit
73871e04e0
2 changed files with 78 additions and 0 deletions
71
org-ql.el
71
org-ql.el
|
|
@ -2134,6 +2134,77 @@ any planning prefix); it defaults to 0 (i.e. the whole regexp)."
|
||||||
(from (test-timestamps (ts<= from next-ts)))
|
(from (test-timestamps (ts<= from next-ts)))
|
||||||
(to (test-timestamps (ts<= next-ts to)))))))
|
(to (test-timestamps (ts<= next-ts to)))))))
|
||||||
|
|
||||||
|
;;;;;; Logbooks
|
||||||
|
|
||||||
|
(org-ql-defpred logbook (&key string from to on state regexp)
|
||||||
|
"Return non-nil if current entry has a logbook matching arguments.
|
||||||
|
FIXME: Document remaining arguments. NOTE: STRING argument is
|
||||||
|
accepted as first argument rather than only as keyword argument."
|
||||||
|
;; TODO: Optionally use (org-log-into-drawer) to detect per-entry
|
||||||
|
;; logbook drawers. (It would preclude various optimizations, but
|
||||||
|
;; some users might need it.)
|
||||||
|
:normalizers
|
||||||
|
((`(,predicate-names . ,rest)
|
||||||
|
(let ((string (if (stringp (car rest))
|
||||||
|
(prog1
|
||||||
|
(regexp-quote (car rest))
|
||||||
|
(setf rest (cdr rest)))
|
||||||
|
(plist-get rest :string)))
|
||||||
|
(regexp (plist-get rest :regexp))
|
||||||
|
(state (plist-get rest :state)))
|
||||||
|
(org-ql--normalize-from-to-on
|
||||||
|
`(logbook :string ,string :regexp ,regexp :state ,state
|
||||||
|
:from ,from :to ,to :on ,on)))))
|
||||||
|
|
||||||
|
;; TODO: :preambles
|
||||||
|
|
||||||
|
:body
|
||||||
|
;; For now, we'll model part of this on `org-log-beginning', though
|
||||||
|
;; it may not be fast enough to run on every potential match.
|
||||||
|
(when-let ((drawer-name (org-log-into-drawer)))
|
||||||
|
;; Look for logbook drawer in entry.
|
||||||
|
(save-excursion
|
||||||
|
(org-end-of-meta-data)
|
||||||
|
(let ((drawer-regexp (concat "^[ \t]*:" (regexp-quote drawer-name) ":[ \t]*$"))
|
||||||
|
(end (if (org-at-heading-p)
|
||||||
|
(point)
|
||||||
|
(save-excursion
|
||||||
|
(outline-next-heading)
|
||||||
|
(point))))
|
||||||
|
(case-fold-search t))
|
||||||
|
(when-let ((drawer-element (cl-loop while (re-search-forward drawer-regexp end t)
|
||||||
|
for element = (org-element-at-point)
|
||||||
|
when (eq 'drawer (org-element-type element))
|
||||||
|
return element)))
|
||||||
|
;; Logbook drawer found: narrow to it and confirm that
|
||||||
|
;; arguments are found in it.
|
||||||
|
(save-restriction
|
||||||
|
(narrow-to-region (point) (org-element-property :contents-end drawer-element))
|
||||||
|
(and (or (not string)
|
||||||
|
(save-excursion
|
||||||
|
(re-search-forward string nil t)))
|
||||||
|
(or (not regexp)
|
||||||
|
(save-excursion
|
||||||
|
(re-search-forward regexp nil t)))
|
||||||
|
;; TODO: from, to, on, state
|
||||||
|
|
||||||
|
;; TODO: Search notes added like "- Note taken on
|
||||||
|
;; [2022-03-07 Mon 13:55] \\" (this starts to get
|
||||||
|
;; complicated; org-element might help, but might
|
||||||
|
;; also be too slow..
|
||||||
|
)))))))
|
||||||
|
|
||||||
|
(defun org-ql--state-change-regexp (to &optional from)
|
||||||
|
"Return regexp matching logbook state-change line for states TO and FROM.
|
||||||
|
Regexp includes an inactive timestamp with hour:minute at
|
||||||
|
end-of-line."
|
||||||
|
(let ((from-regexp (if from
|
||||||
|
`(,(concat "\"" from "\"") (1+ blank))
|
||||||
|
"")))
|
||||||
|
(rx-to-string `(seq bol (0+ blank) "-" (repeat 1 2 " ") "State " "\"" ,to "\"" (1+ blank)
|
||||||
|
"from " ,@from-regexp (1+ blank)
|
||||||
|
(regexp ,org-ql-regexp-ts-inactive-with-time)))))
|
||||||
|
|
||||||
;; NOTE: Predicates defined: stop deferring and define normalizer and
|
;; NOTE: Predicates defined: stop deferring and define normalizer and
|
||||||
;; preamble functions now. Reversing preserves the order in which
|
;; preamble functions now. Reversing preserves the order in which
|
||||||
;; they were defined. Generally it shouldn't matter, but it might...
|
;; they were defined. Generally it shouldn't matter, but it might...
|
||||||
|
|
|
||||||
|
|
@ -245,6 +245,13 @@ with keyword arg NOW in PLIST."
|
||||||
:to-equal '(link :description "DESCRIPTION" :target "TARGET"
|
:to-equal '(link :description "DESCRIPTION" :target "TARGET"
|
||||||
:regexp-p t))))
|
:regexp-p t))))
|
||||||
|
|
||||||
|
(describe "(logbook)"
|
||||||
|
(it "with only string argument"
|
||||||
|
(expect (org-ql--normalize-query '(logbook "String ending in a period."))
|
||||||
|
:to-equal '(logbook "String ending in a period\\\."))
|
||||||
|
(expect (org-ql--query-string-to-sexp "logbook:called")
|
||||||
|
:to-equal '(logbook "called"))))
|
||||||
|
|
||||||
(describe "(outline-path)"
|
(describe "(outline-path)"
|
||||||
(it "with a regexp metacharacter"
|
(it "with a regexp metacharacter"
|
||||||
;; Ensures that normalizer doesn't infinitely loop.
|
;; Ensures that normalizer doesn't infinitely loop.
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue