diff --git a/helm-org-ql.el b/helm-org-ql.el index 821ea62..1a3424e 100644 --- a/helm-org-ql.el +++ b/helm-org-ql.el @@ -208,7 +208,8 @@ Is transformed into this query: ;; where byte-compilation is actually done, but it might not be a good idea ;; to always ignore such errors/warnings. (org-ql-select buffers-files query - :action `(helm-org-ql--heading ,window-width)))))) + :action (lambda () + (org-ql--heading-cons window-width helm-org-ql-reverse-paths))))))) :match #'identity :fuzzy-match nil :multimatch nil @@ -217,26 +218,6 @@ Is transformed into this query: :keymap helm-org-ql-map :action helm-org-ql-actions)) -(defun helm-org-ql--heading (window-width) - "Return string for Helm for heading at point. -WINDOW-WIDTH should be the width of the Helm window." - (font-lock-ensure (point-at-bol) (point-at-eol)) - ;; TODO: It would be better to avoid calculating the prefix and width - ;; at each heading, but there's no easy way to do that once in each - ;; buffer, unless we manually called `org-ql' in each buffer, which - ;; I'd prefer not to do. Maybe I should add a feature to `org-ql' to - ;; call a setup function in a buffer before running queries. - (let* ((prefix (concat (buffer-name) ":")) - (width (- window-width (length prefix))) - (path (-> (org-get-outline-path) - (org-format-outline-path width nil "") - (org-split-string ""))) - (heading (org-get-heading t)) - (path (if helm-org-ql-reverse-paths - (concat heading "\\" (s-join "\\" (nreverse path))) - (concat (s-join "/" path) "/" heading)))) - (cons (concat prefix path) (point-marker)))) - ;;;; Footer (provide 'helm-org-ql) diff --git a/ivy-org-ql.el b/ivy-org-ql.el new file mode 100644 index 0000000..e32920f --- /dev/null +++ b/ivy-org-ql.el @@ -0,0 +1,154 @@ +;;; ivy-org-ql.el --- Ivy commands for org-ql -*- lexical-binding: t; -*- + +;; Author: Adam Porter +;; URL: https://github.com/alphapapa/org-ql + +;;; Commentary: + +;; This library includes Ivy commands for `org-ql'. Note that Ivy +;; is not declared as a package dependency, so this does not cause +;; Ivy to be installed. In the future, this file may have its own +;; package recipe, which would allow it to be installed separately and +;; declare a dependency on Ivy. + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +;;;; Requirements + +(eval-when-compile + (require 'org-ql) + (require 'org-ql-search)) + +;;;; Compatibility + +;; Declare Ivy functions since Ivy may not be installed. +(declare-function ivy-read "ext:ivy") + +;; Silence byte-compiler about variables. + +;;;; Ivy + +;; Everything inside `with-eval-after-load'. + +;;;###autoload +(with-eval-after-load 'ivy + +;;;;; Variables + + ;; TODO: ivy-org-ql-views command. + + ;; TODO: helm-org-ql-buffers-files + +;;;;; Customization + + (defgroup ivy-org-ql nil + "Options for `ivy-org-ql'." + :group 'org-ql) + + (defcustom ivy-org-ql-reverse-paths t + "Whether to reverse Org outline paths in `ivy-org-ql' results." + :type 'boolean) + + (defcustom ivy-org-ql-dynamic-exhibit-delay-ms 250 + "Milliseconds to wait after typing stops before running query." + :type 'integer) + + (defcustom ivy-org-ql-actions + (list (cons "Show heading in source buffer" 'ivy-org-ql-show-marker) + (cons "Show heading in indirect buffer" 'ivy-org-ql-show-marker-indirect)) + "Alist of actions for `ivy-org-ql' commands." + :type '(alist :key-type (string :tag "Description") + :value-type (function :tag "Command"))) + +;;;;; Commands + + (cl-defun ivy-org-ql (buffers-files + &key (boolean 'and) (name "ivy-org-ql")) + "Display results in BUFFERS-FILES for an `org-ql' non-sexp query using Ivy. +Interactively, search the current buffer. Note that this command +only accepts non-sexp, \"plain\" queries. + +NOTE: Atoms in the query are turned into strings where +appropriate, which makes it unnecessary to type quotation marks +around words that are intended to be searched for as indepenent +strings. + +All query tokens are wrapped in the operator BOOLEAN (default +`and'; with prefix, `or'). + +For example, this raw input: + + Emacs git + +Is transformed into this query: + + (and \"Emacs\" \"git\") + +However, quoted strings remain quoted, so this input: + + \"something else\" (tags \"funny\") + +Is transformed into this query: + + (and \"something else\" (tags \"funny\"))" + (interactive (list (current-buffer))) + (let ((boolean (if current-prefix-arg 'or boolean)) + (ivy-dynamic-exhibit-delay-ms ivy-org-ql-dynamic-exhibit-delay-ms)) + (ivy-read (format "Query (boolean %s): " (-> boolean symbol-name upcase)) + (lambda (input) + (let ((query (org-ql--plain-query input)) + (window-width (window-width))) + (when query + (ignore-errors + (org-ql-select files query + :action (lambda () + (org-ql--heading-cons window-width ivy-org-ql-reverse-paths))))))) + :dynamic-collection t + :action ivy-org-ql-actions))) + + (defun ivy-org-ql-agenda-files () + "Search agenda files with `ivy-org-ql', which see." + (interactive) + (ivy-org-ql (org-agenda-files) :name "Org Agenda Files")) + + (defun ivy-org-ql-org-directory () + "Search Org files in `org-directory' with `ivy-org-ql'." + (interactive) + (ivy-org-ql (org-ql-search-directories-files) + :name "Org Directory Files"))) + +;; FIXME: ivy-org-ql-save +;; (defun ivy-org-ql-save () +;; "Show `ivy-org-ql' search in an `org-ql-search' buffer." +;; (interactive) +;; (let ((buffers-files (with-current-buffer (ivy-buffer-get) +;; ivy-org-ql-buffers-files)) +;; (query (org-ql--plain-query ivy-pattern))) +;; (ivy-run-after-exit #'org-ql-search buffers-files query))) + +;; FIXME: ivy-org-ql-views +;; (defun ivy-org-ql-views () +;; "Show an `org-ql' view selected with Ivy." +;; (interactive) +;; (ivy :sources ivy-source-org-ql-views)) + +;;;; Footer + +(provide 'ivy-org-ql) + +;;; ivy-org-ql.el ends here diff --git a/org-ql.el b/org-ql.el index 7e15cc0..ff5159d 100644 --- a/org-ql.el +++ b/org-ql.el @@ -1522,6 +1522,48 @@ Multiple predicates are combined with BOOLEAN." (org-ql--def-plain-query-fn)) +;;;;; Helm/Ivy common functions + +(defun org-ql-show-marker (marker) + "Show heading at MARKER." + (interactive) + ;; This function is necessary because `helm-org-goto-marker' calls + ;; `re-search-backward' to go backward to the start of a heading, + ;; which, when the marker is already at the desired heading, causes + ;; it to go to the previous heading. I don't know why it does that. + (switch-to-buffer (marker-buffer marker)) + (goto-char marker) + (org-show-entry)) + +(defun org-ql-show-marker-indirect (marker) + "Show heading at MARKER with `org-tree-to-indirect-buffer'." + (interactive) + (org-ql-show-marker marker) + (org-tree-to-indirect-buffer)) + +(defun org-ql--heading-cons (window-width reverse-path) + "Return cons for heading at point, suitable for Helm/Ivy. +The cons includes (OUTLINE-PATH-STRING . HEADING-MARKER). +WINDOW-WIDTH should be the width of the Helm/Ivy window in +characters. If REVERSE-PATH is non-nil, the outline path is +reversed." + (font-lock-ensure (point-at-bol) (point-at-eol)) + ;; TODO: It would be better to avoid calculating the prefix and width + ;; at each heading, but there's no easy way to do that once in each + ;; buffer, unless we manually called `org-ql' in each buffer, which + ;; I'd prefer not to do. Maybe I should add a feature to `org-ql' to + ;; call a setup function in a buffer before running queries. + (let* ((prefix (concat (buffer-name) ":")) + (width (- window-width (length prefix))) + (path (-> (org-get-outline-path) + (org-format-outline-path width nil "") + (org-split-string ""))) + (heading (org-get-heading t)) + (path (if reverse-path + (concat heading "\\" (s-join "\\" (nreverse path))) + (concat (s-join "/" path) "/" heading)))) + (cons (concat prefix path) (point-marker)))) + ;;;; Footer (provide 'org-ql)