From 73871e04e07abcbb080654a6f19021165c996e0e Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Mon, 7 Mar 2022 13:49:45 -0600
Subject: [PATCH] WIP: (logbook) predicate

---
 org-ql.el            | 71 ++++++++++++++++++++++++++++++++++++++++++++
 tests/test-org-ql.el |  7 +++++
 2 files changed, 78 insertions(+)

diff --git a/org-ql.el b/org-ql.el
index ffed560..924f12a 100644
--- a/org-ql.el
+++ b/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)))
             (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
 ;; preamble functions now.  Reversing preserves the order in which
 ;; they were defined.  Generally it shouldn't matter, but it might...
diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el
index 0b7f2bb..e8cde6a 100644
--- a/tests/test-org-ql.el
+++ b/tests/test-org-ql.el
@@ -245,6 +245,13 @@ with keyword arg NOW in PLIST."
                 :to-equal '(link :description "DESCRIPTION" :target "TARGET"
                                  :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)"
       (it "with a regexp metacharacter"
         ;; Ensures that normalizer doesn't infinitely loop.