jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge: (org-ql-open-link) And associated changes

Browse source
This commit is contained in:
Adam Porter 2023-10-25 03:30:41 -05:00
commit bd2dd12a41
4 changed files with 261 additions and 124 deletions
Download patch file Download diff file Expand all files Collapse all files

7
README.org
View file

@ -119,6 +119,12 @@ Note that these commands are compatible with [[https://github.com/oantolin/embar
[[images/org-ql-find.png]]
*** org-ql-open-link
This command finds links in entries matching the input query and offers them for selection; the selected link is then opened with ~org-open-at-point~.
The input is matched using the default predicate, which means it searches both entry content and outline paths. This is helpful when a collection of links are kept in Org files: rather than having to first visit the entry containing the desired link, then locate it within the entry, and then open it, the user can simply select the link and open it directly. For example, if an entry with the heading =Emacs= contained a link named =mailing list=, one could search for =Emacs list= and open the link to the mailing list directly.
*** org-ql-refile
This command refiles the current Org entry to one selected by searching with Org QL completion. It searches files listed in ~org-refile-targets~ as well as the current buffer.
@ -554,6 +560,7 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
+ Function ~org-ql-completing-read~, used by command ~org-ql-find~, now specifies the completion category as ~org-heading~, providing compatibility with [[https://github.com/oantolin/embark][Embark]]. (This is a powerful feature, as it means any ~org-ql-find~ result can be acted on from inside the search results with Embark, which provides common actions from Org Agenda and Org speed keys bindings.) ([[https://github.com/alphapapa/org-ql/issues/299][#299]]. Thanks to [[https://github.com/oantolin][Omar Antolín Camarena]], [[https://github.com/minad][Daniel Mendler]], and [[https://github.com/akirak][Akira Komamura]].)
+ Command ~org-ql-find~ may be called in an ~org-agenda~ or ~org-ql-view~ buffer to search the buffers which contributed to the agenda/view buffer.
+ Command ~org-ql-find-path~, which searches outline paths in the current buffer.
+ Command ~org-ql-open-link~, which finds links in entries matching the given query, and opens the selected one with ~org-open-at-point~. (This is helpful when a collection of links are kept in Org files: rather than having to first visit the entry containing the desired link, then locate it within the entry, and then open it, the user can simply select the link and open it directly.)
*Compatibility*

144
org-ql-completing-read.el
View file

@ -73,14 +73,58 @@ For an experience like `org-rifle', use a newline."
(defface org-ql-completing-read-snippet '((t (:inherit font-lock-comment-face)))
"Snippets.")
(defvar org-ql-completing-read-input-regexp nil
"Current regexp for `org-ql-completing-read' input.
To be used in, e.g. annotation functions.")
;;;; Functions
(defun org-ql-completing-read-action ()
"Default action for `org-ql-completing-read'.
Returns (STRING . MARKER) cons for entry at point."
(font-lock-ensure (point-at-bol) (point-at-eol))
(cons (org-link-display-format (org-entry-get nil "ITEM")) (point-marker)))
(defun org-ql-completing-read-snippet (marker)
"Return snippet for entry at MARKER.
Returns value returned by function
`org-ql-completing-read-snippet-function' or
`org-ql-completing-read--snippet-simple', whichever returns a
value, or nil."
(pcase (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.
(org-with-point-at marker
(or (funcall org-ql-completing-read-snippet-function)
(org-ql-completing-read--snippet-simple))))
(`t ;; Interrupted: return nil (which can be concatted).
nil)
(else else)))
(defun org-ql-completing-read-path (marker)
"Return formatted outline path for entry at MARKER."
(org-with-point-at marker
(let ((path (thread-first (org-get-outline-path nil t)
(org-format-outline-path (window-width) nil "")
(org-split-string ""))))
(if org-ql-completing-read-reverse-paths
(concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/"))))))
;;;;; Completing read
;;;###autoload
(cl-defun org-ql-completing-read (buffers-files &key query-prefix query-filter
(prompt "Find entry: "))
"Return marker at Org entry in BUFFERS-FILES selected with `org-ql'.
(cl-defun org-ql-completing-read
(buffers-files &key query-prefix query-filter
(action #'org-ql-completing-read-action)
;; FIXME: Unused argument.
(annotate #'org-ql-completing-read-snippet)
(snippet #'org-ql-completing-read-snippet)
(path #'org-ql-completing-read-path)
(action-filter #'list)
(prompt "Find entry: "))
"Return marker at entry in BUFFERS-FILES selected with `org-ql'.
PROMPT is shown to the user.
QUERY-PREFIX may be a string to prepend to the query entered by
@ -107,30 +151,29 @@ single predicate)."
(let ((table (make-hash-table :test #'equal))
(disambiguations (make-hash-table :test #'equal))
(window-width (window-width))
last-input org-outline-path-cache query-tokens snippet-regexp)
last-input org-outline-path-cache query-tokens)
(cl-labels (;; (debug-message
;; (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args))
(action
() (font-lock-ensure (point-at-bol) (point-at-eol))
;; FIXME: We want the fontified heading, and `org-heading-components' returns it
;; without properties, so we have to use `org-get-heading', which added additional
;; optional arguments in a certain Org version, so in those versions, it will
;; return priority cookies and comment strings.
(let ((heading (org-link-display-format (org-entry-get (point) "ITEM"))))
(if (string-empty-p heading)
;; A heading's string can be empty, but we can't use one because it
;; wouldn't be useful to the user; and if one is found, it's very
;; likely to indicate an unnoticed mistake or corruption in the
;; file: so display a warning and don't record it as a candidate.
(warn "Empty heading at %S in %S" (point) (buffer-name))
(when (gethash heading table)
;; Disambiguate heading (even adding the path isn't enough, because that could
;; also be duplicated).
(if-let ((suffix (gethash heading disambiguations)))
(setf heading (format "%s <%s>" heading (cl-incf suffix)))
(setf heading (format "%s <%s>" heading (puthash heading 2 disambiguations)))))
(let ((marker (point-marker)))
(puthash (propertize heading 'org-marker marker) marker table)))))
(action ()
(font-lock-ensure (point-at-bol) (point-at-eol))
;; This function needs to handle multiple candidates per
;; call, so we loop over a list of values by default.
(pcase-dolist (`(,string . ,marker) (funcall action-filter (funcall action)))
(when string
(if (string-empty-p string)
;; A heading's string can be empty, but we can't use one because it
;; wouldn't be useful to the user; and if one is found, it's very
;; likely to indicate an unnoticed mistake or corruption in the
;; file: so display a warning and don't record it as a candidate.
(display-warning 'org-ql-completing-read (format-message "Empty heading at %S" marker))
(when (gethash string table)
;; Disambiguate string (even adding the path isn't enough, because that could
;; also be duplicated).
(if-let ((suffix (gethash string disambiguations)))
(setf string (format "%s <%s>" string (cl-incf suffix)))
(setf string (format "%s <%s>" string (puthash string 2 disambiguations)))))
(puthash (propertize string 'org-marker marker) marker table)))))
(path (marker)
(org-with-point-at marker
(let* ((path (thread-first (org-get-outline-path nil t)
@ -149,7 +192,7 @@ single predicate)."
(cl-loop for completion in completions
for marker = (get-text-property 0 'org-marker completion)
for prefix = (todo marker)
for suffix = (concat (path marker) " " (snippet marker))
for suffix = (concat (funcall path marker) " " (funcall snippet marker))
collect (list completion prefix suffix)))
(annotate (candidate)
;; (debug-message "ANNOTATE:%S" candidate)
@ -162,7 +205,7 @@ single predicate)."
(marker) (when-let
((snippet
(org-with-point-at marker
(or (funcall org-ql-completing-read-snippet-function snippet-regexp)
(or (funcall org-ql-completing-read-snippet-function org-ql-completing-read-input-regexp)
(org-ql-completing-read--snippet-simple)))))
(propertize (concat " " snippet)
'face 'org-ql-completing-read-snippet)))
@ -183,7 +226,16 @@ single predicate)."
(cons 'category 'org-heading)
(cons 'group-function #'group)
(cons 'affixation-function #'affix)
(cons 'annotation-function #'annotate)))
(cons 'annotation-function #'annotate)
(cons 'display-sort-function
(lambda (strings)
(let ((quoted-tokens (mapcar #'regexp-quote query-tokens)))
(sort strings
(lambda (a b)
(cl-labels ((matches
(s) (cl-loop for token in quoted-tokens
count (string-match-p token s))))
(> (matches a) (matches b))))))))))
(`t
;; (debug-message "COLLECTION:t INPUT:%S KEYS:%S"
;; input (hash-table-keys table))
@ -240,23 +292,24 @@ single predicate)."
(clrhash disambiguations)
(when query-filter
(setf input (funcall query-filter input)))
(pcase org-ql-completing-read-snippet-function
('org-ql-completing-read--snippet-regexp
(setf query-tokens
;; Remove any tokens that specify predicates or are too short.
(--select (not (or (string-match-p (rx bos (1+ (not (any ":"))) ":") it)
(< (length it) org-ql-completing-read-snippet-minimum-token-length)))
(split-string input nil t (rx space)))
snippet-regexp
(when query-tokens
;; Limiting each context word to 15 characters prevents
;; excessively long, non-word strings from ending up in
;; snippets, which can adversely affect performance.
(rx-to-string `(seq (optional (repeat 1 3 (repeat 1 15 (not space)) (0+ space)))
bow (or ,@query-tokens) (0+ (not space))
(optional (repeat 1 3 (0+ space) (repeat 1 15 (not space))))))))))
(setf query-tokens
;; Remove any tokens that specify predicates or are too short.
(--select (not (or (string-match-p (rx bos (1+ (not (any ":"))) ":") it)
(< (length it) org-ql-completing-read-snippet-minimum-token-length)))
(split-string input nil t (rx blank)))
org-ql-completing-read-input-regexp
(when query-tokens
;; Limiting each context word to 15 characters prevents
;; excessively long, non-word strings from ending up in
;; snippets, which can adversely affect performance.
(rx-to-string `(seq (optional (repeat 1 3 (repeat 1 15 (not space)) (0+ space)))
bow (or ,@query-tokens) (0+ (not space))
(optional (repeat 1 3 (0+ space) (repeat 1 15 (not space))))))))
(org-ql-select buffers-files (org-ql--query-string-to-sexp input)
:action #'action))))
(unless (listp buffers-files)
;; Since we map across this argument, we ensure it's a list.
(setf buffers-files (list buffers-files)))
;; NOTE: It seems that the `completing-read' machinery can call, abort, and re-call the
;; collection function while the user is typing, which can interrupt the machinery Org uses to
;; prepare an Org buffer when an Org file is loaded. This results in, e.g. the buffer being
@ -266,9 +319,6 @@ 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'.
(unless (listp buffers-files)
;; Since we map across this argument, we ensure it's a list.
(setf buffers-files (list buffers-files)))
(mapc #'org-ql--ensure-buffer buffers-files)
(let* ((completion-styles '(org-ql-completing-read))
(completion-styles-alist (list (list 'org-ql-completing-read #'try #'all "Org QL Find")))
@ -287,7 +337,7 @@ single predicate)."
(car (hash-table-values table))
(user-error "No results for input"))))))
(defun org-ql-completing-read--snippet-simple (&optional _regexp)
(defun org-ql-completing-read--snippet-simple ()
"Return a snippet of the current entry.
Returns up to `org-ql-completing-read-snippet-length' characters."
(save-excursion

51
org-ql-find.el
View file

@ -141,6 +141,57 @@ 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: "))
"Open a link selected with `org-ql-completing-read'.
Links found in entries matching the input query are offered as
candidates, and the selected one is opened with
`org-open-at-point'. Arguments BUFFERS-FILES, QUERY-FILTER,
QUERY-PREFIX, and PROMPT are passed to `org-ql-completing-read',
which see."
(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* ((marker (org-ql-completing-read buffers-files
:query-prefix query-prefix
:query-filter query-filter
:prompt prompt
:action-filter #'identity
:action (lambda ()
(save-excursion
(cl-loop with limit = (org-entry-end-position)
while (re-search-forward org-link-any-re limit 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)))
collect (cons link (copy-marker (match-beginning 0))))))
:snippet (lambda (&rest _)
"")
:path (lambda (marker)
(org-with-point-at marker
(let* ((path (thread-first (org-get-outline-path t t)
(org-format-outline-path (window-width) nil "")
(org-split-string "")))
(formatted-path (if org-ql-completing-read-reverse-paths
(concat "\\" (string-join (reverse path) "\\"))
(concat "/" (string-join path "/")))))
formatted-path))))))
(org-with-point-at marker
(org-open-at-point))))
(provide 'org-ql-find)
;;; org-ql-find.el ends here

183
org-ql.info
View file

@ -48,6 +48,7 @@ Usage
Commands
* org-ql-find::
* org-ql-open-link::
* org-ql-refile::
* org-ql-search::
* helm-org-ql::
@ -207,6 +208,7 @@ File: README.info, Node: Commands, Next: Queries, Up: Usage
* Menu:
* org-ql-find::
* org-ql-open-link::
* org-ql-refile::
* org-ql-search::
* helm-org-ql::
@ -216,7 +218,7 @@ File: README.info, Node: Commands, Next: Queries, Up: Usage
* org-ql-sparse-tree::

File: README.info, Node: org-ql-find, Next: org-ql-refile, Up: Commands
File: README.info, Node: org-ql-find, Next: org-ql-open-link, Up: Commands
4.1.1 org-ql-find
-----------------
@ -237,9 +239,28 @@ called on a completion candidate (i.e. a search result) to act on it
immediately, without having to visit the entry in its source Org buffer.

File: README.info, Node: org-ql-refile, Next: org-ql-search, Prev: org-ql-find, Up: Commands
File: README.info, Node: org-ql-open-link, Next: org-ql-refile, Prev: org-ql-find, Up: Commands
4.1.2 org-ql-refile
4.1.2 org-ql-open-link
----------------------
This command finds links in entries matching the input query and offers
them for selection; the selected link is then opened with
‘org-open-at-point’.
The input is matched using the default predicate, which means it
searches both entry content and outline paths. This is helpful when a
collection of links are kept in Org files: rather than having to first
visit the entry containing the desired link, then locate it within the
entry, and then open it, the user can simply select the link and open it
directly. For example, if an entry with the heading ‘Emacs’ contained a
link named ‘mailing list’, one could search for ‘Emacs list’ and open
the link to the mailing list directly.

File: README.info, Node: org-ql-refile, Next: org-ql-search, Prev: org-ql-open-link, Up: Commands
4.1.3 org-ql-refile
-------------------
This command refiles the current Org entry to one selected by searching
@ -249,7 +270,7 @@ with Org QL completion. It searches files listed in

File: README.info, Node: org-ql-search, Next: helm-org-ql, Prev: org-ql-refile, Up: Commands
4.1.3 org-ql-search
4.1.4 org-ql-search
-------------------
_Note: This command supports both sexp queries and ._
@ -297,7 +318,7 @@ entry in its source Org buffer.

File: README.info, Node: helm-org-ql, Next: org-ql-view, Prev: org-ql-search, Up: Commands
4.1.4 helm-org-ql
4.1.5 helm-org-ql
-----------------
_Note: This command uses . It is available separately in the package
@ -311,7 +332,7 @@ _Note: This command uses . It is available separately in the package

File: README.info, Node: org-ql-view, Next: org-ql-view-sidebar, Prev: helm-org-ql, Up: Commands
4.1.5 org-ql-view
4.1.6 org-ql-view
-----------------
Choose and display a view stored in ‘org-ql-views’.
@ -326,7 +347,7 @@ Choose and display a view stored in ‘org-ql-views’.

File: README.info, Node: org-ql-view-sidebar, Next: org-ql-view-recent-items, Prev: org-ql-view, Up: Commands
4.1.6 org-ql-view-sidebar
4.1.7 org-ql-view-sidebar
-------------------------
Show a sidebar window listing views stored in ‘org-ql-views’ for easy
@ -336,7 +357,7 @@ point, and press ‘c’ to customize the view at point.

File: README.info, Node: org-ql-view-recent-items, Next: org-ql-sparse-tree, Prev: org-ql-view-sidebar, Up: Commands
4.1.7 org-ql-view-recent-items
4.1.8 org-ql-view-recent-items
------------------------------
Show items in ‘FILES’ from last ‘DAYS’ days with timestamps of ‘TYPE’.
@ -347,7 +368,7 @@ returned by the function ‘org-agenda-files’.

File: README.info, Node: org-ql-sparse-tree, Prev: org-ql-view-recent-items, Up: Commands
4.1.8 org-ql-sparse-tree
4.1.9 org-ql-sparse-tree
------------------------
Arguments: ‘(query &key keep-previous (buffer (current-buffer)))’
@ -1059,6 +1080,13 @@ File: README.info, Node: 08-pre, Next: 073, Up: Changelog
agenda/view buffer.
• Command ‘org-ql-find-path’, which searches outline paths in the
current buffer.
• Command ‘org-ql-open-link’, which finds links in entries matching
the given query, and opens the selected one with
‘org-open-at-point’. (This is helpful when a collection of links
are kept in Org files: rather than having to first visit the entry
containing the desired link, then locate it within the entry, and
then open it, the user can simply select the link and open it
directly.)
*Compatibility*
@ -1811,74 +1839,75 @@ GPLv3

Tag Table:
Node: Top225
Node: Contents1824
Node: Screenshots1947
Node: Installation2065
Node: Quelpa2579
Node: Helm support3107
Node: Usage3510
Node: Commands3908
Node: org-ql-find4352
Node: org-ql-refile5167
Node: org-ql-search5490
Node: helm-org-ql7421
Node: org-ql-view7799
Node: org-ql-view-sidebar8329
Node: org-ql-view-recent-items8709
Node: org-ql-sparse-tree9205
Node: Queries10005
Node: Non-sexp query syntax11122
Node: General predicates12881
Node: Ancestor/descendant predicates19868
Node: Date/time predicates20996
Node: Functions / Macros24120
Node: Agenda-like views24418
Ref: Function org-ql-block24580
Node: Listing / acting-on results25841
Ref: Caching26049
Ref: Function org-ql-select26962
Ref: Function org-ql-query29388
Ref: Macro org-ql (deprecated)31162
Node: Custom predicates31477
Ref: Macro org-ql-defpred31701
Node: Dynamic block35142
Node: Links37866
Node: Tips38553
Node: Changelog38877
Node: 08-pre39687
Node: 07341020
Node: 07241755
Node: 07142674
Node: 0743483
Node: 06346407
Node: 06246938
Node: 06147243
Node: 0647811
Node: 05250865
Node: 05151167
Node: 0551592
Node: 04953123
Node: 04853405
Node: 04753754
Node: 04654163
Node: 04554571
Node: 04454932
Node: 04355291
Node: 04255494
Node: 04155655
Node: 0455902
Node: 03260003
Node: 03160406
Node: 0360603
Node: 02363903
Node: 02264137
Node: 02164417
Node: 0264622
Node: 0168700
Node: Notes68801
Node: Comparison with Org Agenda searches68963
Node: org-sidebar69852
Node: License70131
Node: Contents1845
Node: Screenshots1968
Node: Installation2086
Node: Quelpa2600
Node: Helm support3128
Node: Usage3531
Node: Commands3929
Node: org-ql-find4394
Node: org-ql-open-link5212
Node: org-ql-refile6067
Node: org-ql-search6395
Node: helm-org-ql8326
Node: org-ql-view8704
Node: org-ql-view-sidebar9234
Node: org-ql-view-recent-items9614
Node: org-ql-sparse-tree10110
Node: Queries10910
Node: Non-sexp query syntax12027
Node: General predicates13786
Node: Ancestor/descendant predicates20773
Node: Date/time predicates21901
Node: Functions / Macros25025
Node: Agenda-like views25323
Ref: Function org-ql-block25485
Node: Listing / acting-on results26746
Ref: Caching26954
Ref: Function org-ql-select27867
Ref: Function org-ql-query30293
Ref: Macro org-ql (deprecated)32067
Node: Custom predicates32382
Ref: Macro org-ql-defpred32606
Node: Dynamic block36047
Node: Links38771
Node: Tips39458
Node: Changelog39782
Node: 08-pre40592
Node: 07342357
Node: 07243092
Node: 07144011
Node: 0744820
Node: 06347744
Node: 06248275
Node: 06148580
Node: 0649148
Node: 05252202
Node: 05152504
Node: 0552929
Node: 04954460
Node: 04854742
Node: 04755091
Node: 04655500
Node: 04555908
Node: 04456269
Node: 04356628
Node: 04256831
Node: 04156992
Node: 0457239
Node: 03261340
Node: 03161743
Node: 0361940
Node: 02365240
Node: 02265474
Node: 02165754
Node: 0265959
Node: 0170037
Node: Notes70138
Node: Comparison with Org Agenda searches70300
Node: org-sidebar71189
Node: License71468

End Tag Table