From deada67e1d2ecd95f19c73d65ca258d08e27ac87 Mon Sep 17 00:00:00 2001
From: Adam Porter <adam@alphapapa.net>
Date: Sun, 5 Feb 2023 21:30:32 -0600
Subject: [PATCH] WIP: org-ql-open-link

Need to tidy up and generalize org-ql-completing-read a bit more, but
this is basically working, and should be very useful.
---
 org-ql-completing-read.el | 31 +++++++++++++++++++++++++++
 org-ql-find.el            | 44 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 75 insertions(+)

diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el
index e224e4b..d3c3f2a 100644
--- a/org-ql-completing-read.el
+++ b/org-ql-completing-read.el
@@ -75,10 +75,38 @@ For an experience like `org-rifle', use a newline."
 
 ;;;; Functions
 
+(defun org-ql-completing-read-action (table)
+  "Default action for `org-ql-completing-read'."
+  (font-lock-ensure (point-at-bol) (point-at-eol))
+  (let* ((path (thread-first (org-get-outline-path t t)
+                             (org-format-outline-path window-width nil "")
+                             (org-split-string "")))
+         (path (if org-ql-completing-read-reverse-paths
+                   (string-join (nreverse path) "\\")
+                 (string-join path "/"))))
+    (puthash path (point-marker) table)
+    path))
+
+(defun org-ql-completing-read-annotate (candidate table)
+  "FIXME: Docstring."
+  (while-no-input
+    ;; Using `while-no-input' here doesn't make it as
+    ;; responsive as, e.g. Helm while typing, but it seems to
+    ;; help a little when using the org-rifle-style snippets.
+    (or (org-ql-completing-read-snippet (gethash candidate table)) "")))
+
+(defun org-ql-completing-read-snippet (marker)
+  (org-with-point-at marker
+    (or (funcall org-ql-completing-read-snippet-function snippet-regexp)
+        (org-ql-completing-read--snippet-simple))))
+
 ;;;;; Completing read
 
 ;;;###autoload
 (cl-defun org-ql-completing-read (buffers-files &key query-prefix query-filter
+                                                (action #'org-ql-completing-read-action)
+                                                (annotate #'org-ql-completing-read-annotate)
+                                                (collection-filter #'identity)
                                                 (prompt "Find entry: "))
   "Return marker at Org entry in BUFFERS-FILES selected with `org-ql'.
 PROMPT is shown to the user.
@@ -266,6 +294,9 @@ single predicate)."
       ;; `completing-read' machinery, which interrupts it, so we must work around this problem by
       ;; ensuring all of the BUFFERS-FILES are loaded and initialized before calling
       ;; `completing-read'.
+      (funcall collection-filter
+               (org-ql-select buffers-files (org-ql--query-string-to-sexp str)
+                 :action #'action)))))))
       (unless (listp buffers-files)
         ;; Since we map across this argument, we ensure it's a list.
         (setf buffers-files (list buffers-files)))
diff --git a/org-ql-find.el b/org-ql-find.el
index 1b85b77..34e39ee 100644
--- a/org-ql-find.el
+++ b/org-ql-find.el
@@ -141,6 +141,50 @@ which see (but only the files are used)."
   (let ((org-ql-default-predicate 'outline-path))
     (org-ql-find (current-buffer))))
 
+;;;###autoload
+(cl-defun org-ql-open-link (buffers-files &key query-prefix query-filter
+                                          (prompt "Open link: "))
+  "FIXME: Docstring."
+  (interactive
+   ;; FIXME: Factor this out.
+   (list (if current-prefix-arg
+             (mapcar #'get-buffer
+                     (completing-read-multiple
+                      "Buffers: "
+                      (cl-loop for buffer in (buffer-list)
+                               when (eq 'org-mode (buffer-local-value 'major-mode buffer))
+                               collect (buffer-name buffer))
+                      nil t))
+           (progn
+             (unless (eq major-mode 'org-mode)
+               (user-error "This is not an Org buffer: %S" (current-buffer)))
+             (current-buffer)))))
+  (let* ((org-ql-completing-read-snippet-function nil)
+         (marker (org-ql-completing-read buffers-files
+                   :query-prefix "rifle:"
+                   :query-filter (lambda (input)
+                                   (replace-regexp-in-string (rx (1+ space)) "," input t t))
+                   :prompt prompt
+                   :collection-filter #'flatten-list
+                   :action (lambda (table)
+                             (save-excursion
+                               (cl-loop while (re-search-forward org-link-any-re (org-entry-end-position) t)
+                                        for link = (string-trim (match-string 0))
+                                        do (progn
+                                             (set-text-properties 0 (length link) '(face org-link) link)
+                                             (setf link (org-link-display-format link))
+                                             (puthash link (copy-marker (match-beginning 0)) table))
+                                        collect link)))
+                   :annotate (lambda (candidate table)
+                               (org-with-point-at (gethash candidate table)
+                                 (concat "  "
+                                         (org-format-outline-path (reverse (org-get-outline-path 'with-self))
+                                                                  nil nil "\\")
+                                         "::"
+                                         (abbreviate-file-name (buffer-file-name))))))))
+    (org-with-point-at marker
+      (org-open-at-point marker))))
+
 (provide 'org-ql-find)
 
 ;;; org-ql-find.el ends here