From 71c8079e224b75a264ca841acb624c0328c49573 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Sun, 24 Dec 2023 05:41:25 -0600
Subject: [PATCH] WIP: (org-ql-search) Handle narrowing, and improve titles

---
 org-ql-search.el | 25 ++++++++++++++++---------
 org-ql-view.el   | 20 ++++++++++++++------
 org-ql.el        |  1 +
 3 files changed, 31 insertions(+), 15 deletions(-)

diff --git a/org-ql-search.el b/org-ql-search.el
index d44e7ea..fa2e9f5 100644
--- a/org-ql-search.el
+++ b/org-ql-search.el
@@ -168,8 +168,9 @@ SUPER-GROUPS: An `org-super-agenda' group set.  See variable
 `org-super-agenda-groups' and Info node `(org-super-agenda)Group
 selectors'.
 
-NARROW: When non-nil, don't widen buffers before
-searching.  Interactively, with prefix, leave narrowed.
+NARROW: When non-nil, don't widen buffers before searching.
+Interactively, when buffer is narrowed, search within subtree
+narrowed to.
 
 SORT: One or a list of `org-ql' sorting functions, like `date' or
 `priority' (see Info node `(org-ql)Listing / acting-on results').
@@ -181,13 +182,19 @@ display the results.  By default, the value of
 `org-ql-view-buffer' is used, and a new buffer is created if
 necessary."
   (declare (indent defun))
-  (interactive (list (org-ql-view--complete-buffers-files)
-                     (read-string "Query: " (when org-ql-view-query
-                                              (format "%S" org-ql-view-query)))
-                     ;; FIXME: Automatically narrow when searching current buffer and it's narrowed (use ID if it has one, otherwise use a marker--and then add an ID later if bookmarking the search and it doesn't have one).
-                     :narrow (or org-ql-view-narrow (eq current-prefix-arg '(4)))
-                     :super-groups (org-ql-view--complete-super-groups)
-                     :sort (org-ql-view--complete-sort)))
+  (interactive
+   (let* ((in (org-ql-view--complete-buffers-files))
+          (query (read-string "Query: " (when org-ql-view-query
+                                          (format "%S" org-ql-view-query))))
+          (narrow (if (equal in (current-buffer))
+                      (or org-ql-view-narrow
+                          (when (buffer-narrowed-p)
+                            (setf in (or (org-id-get (point-min))
+                                         (copy-marker (point-min))))))
+                    org-ql-view-narrow)))
+     (list in query :narrow narrow
+           :super-groups (org-ql-view--complete-super-groups)
+           :sort (org-ql-view--complete-sort))))
   ;; NOTE: Using `with-temp-buffer' is a hack to work around the fact that `make-local-variable'
   ;; does not work reliably from inside a `let' form when the target buffer is current on entry
   ;; to or exit from the `let', even though `make-local-variable' is actually done in
diff --git a/org-ql-view.el b/org-ql-view.el
index 19abd68..5401944 100644
--- a/org-ql-view.el
+++ b/org-ql-view.el
@@ -1056,20 +1056,28 @@ current buffer.  Otherwise IN is returned unchanged."
   (cl-labels ((expand-elt (it)
                 (cl-typecase it
                   (string (or (expanded it)
-                              (id-location it)
+                              (location-of it)
                               (error "Unknown expansion for %S" it)))
+                  (marker (or (location-of it)
+                              (error "Unknown location for %S" it)))
                   (otherwise it)))
               (expanded (filename)
                 (when-let ((expanded (expand-file-name filename))
                            ((file-readable-p expanded)))
                   expanded))
-              (id-location (id)
-                (when-let ((marker (org-id-find id 'marker))
+              (location-of (place)
+                (when-let ((marker (cl-etypecase place
+                                     (marker place)
+                                     (string (org-id-find place 'marker))))
                            (heading (org-link-display-format (org-entry-get marker "ITEM"))))
                   (setf heading (if (string-empty-p heading)
-                                    id
-                                  ;; FIXME: The help-echo gets overridden elsewhere.
-                                  (propertize heading 'help-echo (format "ID: %s" id))))
+                                    place
+                                  (or (org-id-get marker)
+                                      (string-join (org-with-point-at marker
+                                                     (org-get-outline-path t))
+                                                   " › ")))
+                        ;; FIXME: The help-echo gets overridden elsewhere.
+                        heading (propertize heading 'help-echo (format "%s" place)))
                   (format "\"%s\" in %S"
                           heading (abbreviate-file-name (buffer-file-name (marker-buffer marker)))))))
     ;; TODO: Test this more exhaustively.
diff --git a/org-ql.el b/org-ql.el
index 235a998..2b63235 100644
--- a/org-ql.el
+++ b/org-ql.el
@@ -383,6 +383,7 @@ each priority the newest items would appear first."
                                  ;; NOTE: This exhaustive pcase is essential to opening links
                                  ;; safely, as it rejects, e.g. lambdas in the IN argument.
                                  ((cl-type buffer) it)
+                                 ((cl-type marker) it)
                                  ((and (cl-type string)
                                        (pred file-readable-p))
                                   (or (find-buffer-visiting it)