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.
This commit is contained in:
parent
ee01bcb6e8
commit
deada67e1d
2 changed files with 75 additions and 0 deletions
|
|
@ -75,10 +75,38 @@ For an experience like `org-rifle', use a newline."
|
||||||
|
|
||||||
;;;; Functions
|
;;;; 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
|
;;;;; Completing read
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(cl-defun org-ql-completing-read (buffers-files &key query-prefix query-filter
|
(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: "))
|
(prompt "Find entry: "))
|
||||||
"Return marker at Org entry in BUFFERS-FILES selected with `org-ql'.
|
"Return marker at Org entry in BUFFERS-FILES selected with `org-ql'.
|
||||||
PROMPT is shown to the user.
|
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
|
;; `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
|
;; ensuring all of the BUFFERS-FILES are loaded and initialized before calling
|
||||||
;; `completing-read'.
|
;; `completing-read'.
|
||||||
|
(funcall collection-filter
|
||||||
|
(org-ql-select buffers-files (org-ql--query-string-to-sexp str)
|
||||||
|
:action #'action)))))))
|
||||||
(unless (listp buffers-files)
|
(unless (listp buffers-files)
|
||||||
;; Since we map across this argument, we ensure it's a list.
|
;; Since we map across this argument, we ensure it's a list.
|
||||||
(setf buffers-files (list buffers-files)))
|
(setf buffers-files (list buffers-files)))
|
||||||
|
|
|
||||||
|
|
@ -141,6 +141,50 @@ which see (but only the files are used)."
|
||||||
(let ((org-ql-default-predicate 'outline-path))
|
(let ((org-ql-default-predicate 'outline-path))
|
||||||
(org-ql-find (current-buffer))))
|
(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)
|
(provide 'org-ql-find)
|
||||||
|
|
||||||
;;; org-ql-find.el ends here
|
;;; org-ql-find.el ends here
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue