Merge a13a930150 into e41fe9018a
This commit is contained in:
Yiming Chen
GitHub
commit
a9d523d3bb
3 changed files with 214 additions and 21 deletions
|
|
@ -189,7 +189,8 @@ Is transformed into this query:
|
|||
(ignore-errors
|
||||
;; Ignore errors that might be caused by partially typed queries.
|
||||
(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
|
||||
|
|
@ -198,26 +199,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)))
|
||||
(heading (org-get-heading t))
|
||||
(path (-> (org-get-outline-path)
|
||||
(org-format-outline-path width nil " ")
|
||||
(org-split-string " ")))
|
||||
(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)
|
||||
|
|
|
|||
170
ivy-org-ql.el
Normal file
170
ivy-org-ql.el
Normal file
|
|
@ -0,0 +1,170 @@
|
|||
;;; ivy-org-ql.el --- Ivy commands for org-ql -*- lexical-binding: t; -*-
|
||||
|
||||
;; Author: Adam Porter <adam@alphapapa.net>
|
||||
;; 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; 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)
|
||||
|
||||
;;;;; 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--query-string-to-sexp input))
|
||||
(window-width (window-width)))
|
||||
(when query
|
||||
(org-ql-select buffers-files query
|
||||
:action 'ivy-org-ql--heading-cons))))
|
||||
:dynamic-collection t
|
||||
:action 'ivy-org-ql-show-marker)))
|
||||
|
||||
(defun ivy-org-ql--heading-cons ()
|
||||
(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) ":"))
|
||||
(heading (org-get-heading t))
|
||||
(path (-> (org-get-outline-path)
|
||||
(org-format-outline-path nil nil " ")
|
||||
(org-split-string " ")))
|
||||
(path (if ivy-org-ql-reverse-paths
|
||||
(concat heading "\\" (s-join "\\" (nreverse path)))
|
||||
(concat (s-join "/" path) "/" heading)))
|
||||
(str (concat prefix path)))
|
||||
;; ivy doesn't support calling action function with a cons when dynamic-collection is on
|
||||
;; see https://github.com/abo-abo/swiper/issues/2677
|
||||
;; so we had to use text-property to store (point-marker)
|
||||
(put-text-property 0 1 'marker (point-marker) str)
|
||||
str))
|
||||
|
||||
(defun ivy-org-ql-show-marker (cand)
|
||||
(org-ql-show-marker (get-text-property 0 'marker cand)))
|
||||
|
||||
(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--query-string-to-sexp 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
|
||||
42
org-ql.el
42
org-ql.el
|
|
@ -2566,6 +2566,48 @@ If QUERY can't be converted to a string, return nil."
|
|||
(`(and . ,_) (format-and query))
|
||||
(_ (format-form query))))))
|
||||
|
||||
;;;;; 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)))
|
||||
(heading (org-get-heading t))
|
||||
(path (-> (org-get-outline-path)
|
||||
(org-format-outline-path width nil " ")
|
||||
(org-split-string " ")))
|
||||
(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 'org-ql)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue