From deada67e1d2ecd95f19c73d65ca258d08e27ac87 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Sun, 5 Feb 2023 21:30:32 -0600 Subject: [PATCH 01/11] 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 From 28f5aa3100497f2ff847cb825628b1f03509dc82 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 16 Mar 2023 07:11:11 -0500 Subject: [PATCH 02/11] WIP: Many improvements Now need to do some kind of sorting... --- org-ql-completing-read.el | 106 +++++++++++++++++++------------------- org-ql-find.el | 40 +++++++------- 2 files changed, 74 insertions(+), 72 deletions(-) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index d3c3f2a..127a866 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -73,41 +73,46 @@ 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 (table) - "Default action for `org-ql-completing-read'." +(defun org-ql-completing-read-action () + "Default action for `org-ql-completing-read'. +Returns (STRING . MARKER) cons." (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)) + (cons (org-entry-get nil "ITEM") (point-marker))) -(defun org-ql-completing-read-annotate (candidate table) - "FIXME: Docstring." +(defun org-ql-completing-read-snippet (marker) (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)))) + (org-with-point-at marker + (or (funcall org-ql-completing-read-snippet-function) + (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: ")) +(cl-defun org-ql-completing-read + (buffers-files &key query-prefix query-filter + (action #'org-ql-completing-read-action) + (annotate #'org-ql-completing-read-snippet) + (snippet #'org-ql-completing-read-snippet) + (path (lambda (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 ""))) + (formatted-path (if org-ql-completing-read-reverse-paths + (concat "\\" (string-join (reverse path) "\\")) + (concat "/" (string-join path "/"))))) + formatted-path)))) + (action-filter #'list) + (prompt "Find entry: ")) "Return marker at Org entry in BUFFERS-FILES selected with `org-ql'. PROMPT is shown to the user. @@ -135,7 +140,7 @@ 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 @@ -177,7 +182,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) @@ -268,35 +273,30 @@ 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 space))) + 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)))))))) + ;; 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 + ;; left in fundamental-mode, unprepared to be used as an Org buffer, which breaks many things + ;; and is very confusing for the user. Ideally, of course, we would solve this in + ;; `org-ql-select', and we already attempt to, but that function is called by the + ;; `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'. (org-ql-select buffers-files (org-ql--query-string-to-sexp input) :action #'action)))) - ;; 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 - ;; left in fundamental-mode, unprepared to be used as an Org buffer, which breaks many things - ;; and is very confusing for the user. Ideally, of course, we would solve this in - ;; `org-ql-select', and we already attempt to, but that function is called by the - ;; `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))) @@ -318,7 +318,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 diff --git a/org-ql-find.el b/org-ql-find.el index 34e39ee..c750f17 100644 --- a/org-ql-find.el +++ b/org-ql-find.el @@ -159,31 +159,33 @@ which see (but only the files are used)." (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)) + (let* ((marker (org-ql-completing-read buffers-files + :query-prefix query-prefix + :query-filter query-filter :prompt prompt - :collection-filter #'flatten-list - :action (lambda (table) + :action-filter #'identity + :action (lambda () (save-excursion - (cl-loop while (re-search-forward org-link-any-re (org-entry-end-position) t) + (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)) - (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)))))))) + (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 marker)))) + (org-open-at-point)))) (provide 'org-ql-find) From e030627aeb75d654e42e3e250ff108f950946a75 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 16 Mar 2023 07:39:29 -0500 Subject: [PATCH 03/11] WIP: Add display-sort-function --- org-ql-completing-read.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index 127a866..0456a29 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -216,7 +216,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)) From 6c18f133e9d29796fac0af75cc10e0ba8900b173 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 16 Mar 2023 07:44:10 -0500 Subject: [PATCH 04/11] Tidy: Function, docstrings, commented code --- org-ql-completing-read.el | 69 +++++++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 29 deletions(-) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index 0456a29..e787972 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -86,6 +86,11 @@ Returns (STRING . MARKER) cons." (cons (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." (while-no-input ;; Using `while-no-input' here doesn't make it as ;; responsive as, e.g. Helm while typing, but it seems to @@ -94,6 +99,17 @@ Returns (STRING . MARKER) cons." (or (funcall org-ql-completing-read-snippet-function) (org-ql-completing-read--snippet-simple))))) +(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 ""))) + (formatted-path (if org-ql-completing-read-reverse-paths + (concat "\\" (string-join (reverse path) "\\")) + (concat "/" (string-join path "/"))))) + formatted-path))) + ;;;;; Completing read ;;;###autoload @@ -102,18 +118,10 @@ Returns (STRING . MARKER) cons." (action #'org-ql-completing-read-action) (annotate #'org-ql-completing-read-snippet) (snippet #'org-ql-completing-read-snippet) - (path (lambda (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 ""))) - (formatted-path (if org-ql-completing-read-reverse-paths - (concat "\\" (string-join (reverse path) "\\")) - (concat "/" (string-join path "/"))))) - formatted-path)))) + (path #'org-ql-completing-read-path) (action-filter #'list) (prompt "Find entry: ")) - "Return marker at Org entry in BUFFERS-FILES selected with `org-ql'. + "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 @@ -139,31 +147,34 @@ single predicate)." ;; (message "ORG-QL-COMPLETING-READ: Starts.") (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) (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 + (action () + (font-lock-ensure (point-at-bol) (point-at-eol)) + ;; FIXME: We want the fontified string, 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))))) + + ;; 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. + (warn "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) From 3f08d45ace858f184dcc96511df05738ffcd1d89 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 22 Sep 2023 22:03:30 -0500 Subject: [PATCH 05/11] Fix: (org-ql-completing-read-action) Format link --- org-ql-completing-read.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index e787972..7870247 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -83,7 +83,7 @@ To be used in, e.g. annotation functions.") "Default action for `org-ql-completing-read'. Returns (STRING . MARKER) cons." (font-lock-ensure (point-at-bol) (point-at-eol)) - (cons (org-entry-get nil "ITEM") (point-marker))) + (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. From 9aba73a28b7c09822f016caae41408b8963ac104 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 22 Sep 2023 22:57:28 -0500 Subject: [PATCH 06/11] WIP --- org-ql-completing-read.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index 7870247..d67ca86 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -147,6 +147,7 @@ single predicate)." ;; (message "ORG-QL-COMPLETING-READ: Starts.") (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) (cl-labels (;; (debug-message ;; (f &rest args) (apply #'message (concat "ORG-QL-COMPLETING-READ: " f) args)) @@ -206,7 +207,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))) From 7ecb4a8b10bcfebc50107df6892faf10987c9478 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 22 Sep 2023 22:58:05 -0500 Subject: [PATCH 07/11] Tidy --- org-ql-completing-read.el | 5 ----- 1 file changed, 5 deletions(-) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index d67ca86..23a5aea 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -153,11 +153,6 @@ single predicate)." ;; (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 string, 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. - ;; 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))) From 40b25ac3193a5ce4dc79e24537270c754b42647a Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 22 Sep 2023 23:12:06 -0500 Subject: [PATCH 08/11] Fix: (org-ql-completing-read-snippet) while-no-input --- org-ql-completing-read.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index 23a5aea..7807c64 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -91,13 +91,17 @@ Returns value returned by function `org-ql-completing-read-snippet-function' or `org-ql-completing-read--snippet-simple', whichever returns a value, or nil." - (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))))) + (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." From a802579f865b7975eb67345ea6091a0a2dd9b6d2 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 25 Oct 2023 03:19:29 -0500 Subject: [PATCH 09/11] Tidy --- org-ql-completing-read.el | 40 +++++++++++++++++++-------------------- org-ql-find.el | 7 ++++++- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index 7807c64..8284502 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -81,7 +81,7 @@ To be used in, e.g. annotation functions.") (defun org-ql-completing-read-action () "Default action for `org-ql-completing-read'. -Returns (STRING . MARKER) cons." +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))) @@ -98,21 +98,19 @@ value, or nil." (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). + (`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 ""))) - (formatted-path (if org-ql-completing-read-reverse-paths - (concat "\\" (string-join (reverse path) "\\")) - (concat "/" (string-join path "/"))))) - formatted-path))) + (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 @@ -166,7 +164,7 @@ single predicate)." ;; 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" marker) + (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). @@ -297,7 +295,7 @@ single predicate)." ;; 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))) + (split-string input nil t (rx blank))) org-ql-completing-read-input-regexp (when query-tokens ;; Limiting each context word to 15 characters prevents @@ -306,20 +304,20 @@ single predicate)." (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)))))))) - ;; 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 - ;; left in fundamental-mode, unprepared to be used as an Org buffer, which breaks many things - ;; and is very confusing for the user. Ideally, of course, we would solve this in - ;; `org-ql-select', and we already attempt to, but that function is called by the - ;; `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'. (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 + ;; left in fundamental-mode, unprepared to be used as an Org buffer, which breaks many things + ;; and is very confusing for the user. Ideally, of course, we would solve this in + ;; `org-ql-select', and we already attempt to, but that function is called by the + ;; `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'. (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"))) diff --git a/org-ql-find.el b/org-ql-find.el index c750f17..394b3a4 100644 --- a/org-ql-find.el +++ b/org-ql-find.el @@ -144,7 +144,12 @@ which see (but only the files are used)." ;;;###autoload (cl-defun org-ql-open-link (buffers-files &key query-prefix query-filter (prompt "Open link: ")) - "FIXME: Docstring." + "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 From 58d29d0fff1160a0d9c6c95d46a8467c5309b0f8 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 25 Oct 2023 03:21:03 -0500 Subject: [PATCH 10/11] Comment: Add FIXME --- org-ql-completing-read.el | 1 + 1 file changed, 1 insertion(+) diff --git a/org-ql-completing-read.el b/org-ql-completing-read.el index 8284502..3f25345 100644 --- a/org-ql-completing-read.el +++ b/org-ql-completing-read.el @@ -118,6 +118,7 @@ value, or nil." (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) From 2319fc9d8baf98883a7aea833c86104d9e4e6a0b Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Wed, 25 Oct 2023 03:29:03 -0500 Subject: [PATCH 11/11] Docs: Update changelog, Usage --- README.org | 7 ++ org-ql.info | 183 ++++++++++++++++++++++++++++++---------------------- 2 files changed, 113 insertions(+), 77 deletions(-) diff --git a/README.org b/README.org index cf3cbb7..bdc2e99 100644 --- a/README.org +++ b/README.org @@ -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* diff --git a/org-ql.info b/org-ql.info index cc86437..d187c05 100644 --- a/org-ql.info +++ b/org-ql.info @@ -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