diff --git a/README.org b/README.org index 00fe0b0..180bf2c 100644 --- a/README.org +++ b/README.org @@ -6,7 +6,7 @@ [[https://melpa.org/#/org-ql][file:https://melpa.org/packages/org-ql-badge.svg]] [[https://stable.melpa.org/#/org-ql][file:https://stable.melpa.org/packages/org-ql-badge.svg]] -~org-ql~ is a lispy query language for Org files. It allows you to find Org entries matching certain criteria and return a list of them or perform actions on them. Commands are also provided which display a buffer with matching results, similar to an Org Agenda buffer. +~org-ql~ is a lispy query language for Org files. It allows you to find Org entries matching certain criteria and return a list of them or perform actions on them. Commands are also provided which display matching results. * Contents :PROPERTIES: @@ -120,7 +120,7 @@ Installing with [[https://framagit.org/steckerhalter/quelpa][Quelpa]] is easy: The functionality provided may be grouped by: -+ *Interactive commands:* ~org-ql-search~, ~org-ql-view~, =org-ql-sparse-tree=. ++ *Interactive commands:* ~org-ql-search~, ~org-ql-view~, =org-ql-sparse-tree=, =helm-org-ql=. + *Non-interactive functions and macros:* - ~org-ql~ (macro) - ~org-ql-select~ (function) @@ -137,6 +137,8 @@ Alternatively, they may be grouped by: - ~org-ql-agenda~ (macro) + *Showing a tree in a buffer:* - =org-ql-sparse-tree= (command) ++ *Showing results with Helm*: + - =helm-org-ql= (command) + *Returning a list of matches or acting on them:* - ~org-ql~ (macro) - ~org-ql-select~ (function) @@ -177,6 +179,16 @@ Here's an example of using it to generate an agenda-like view for certain files [[images/org-ql-search-snippet.png]] +*** helm-org-ql + +This command displays matches with Helm. *Note:* Helm is not a package dependency, so this command only works if the package =helm-org= is installed. + +Note also that queries in this command are specially handled so that quotes around strings may be omitted for ease of typing. + ++ Press =C-x C-s= in the Helm session to save the results to an =org-ql-search= buffer. + +[[images/helm-org-ql.gif]] + *** org-ql-view Choose and display a view stored in ~org-ql-views~. @@ -462,6 +474,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience ** 0.3-pre *Added* ++ Command =helm-org-ql=. + Command =org-ql-sparse-tree=, like =org-sparse-tree= for =org-ql= queries. (Thanks to [[https://github.com/akirak][Akira Komamura]].) + Per-buffer, per-heading tag caching, which increases the speed of tags-related queries by 6-7x. + More tags-related predicates and aliases: diff --git a/helm-org-ql.el b/helm-org-ql.el new file mode 100644 index 0000000..d83c0a6 --- /dev/null +++ b/helm-org-ql.el @@ -0,0 +1,249 @@ +;;; helm-org-ql.el --- Helm commands for org-ql -*- lexical-binding: t; -*- + +;; Author: Adam Porter +;; URL: https://github.com/alphapapa/org-ql + +;;; Commentary: + +;; This library includes Helm commands for `org-ql'. Note that Helm +;; is not declared as a package dependency, so this does not cause +;; Helm 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 Helm. + +;;; 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 + +(require 'org) + +(require 'org-ql) + +;; (require 'helm) +;; (require 'helm-org) + +;;;; Compatibility + +;; Declare Helm functions since Helm may not be installed. +(declare-function helm "ext:helm") +(declare-function helm-run-after-exit "ext:helm") +(declare-function helm-buffer-get "ext:helm-lib") +(declare-function helm-make-source "ext:helm-source") +(declare-function helm-org-goto-marker "ext:helm-org") + +;; Silence byte-compiler about variables. +(defvar helm-map) +(defvar helm-pattern) +(defvar helm-input-idle-delay) + +;;;; Variables + +(defvar helm-org-ql-map + (let ((map (copy-keymap helm-map)) + (mappings '( + "C-x C-s" helm-org-ql-save + ))) + (cl-loop for (key fn) on mappings by #'cddr + do (define-key map (kbd key) fn)) + map) + "Keymap for `helm-org-ql' sessions. +Based on `helm-map'.") + +(defvar-local helm-org-ql-buffers-files nil + "Used for `helm-org-ql-save'.") + +;;;; Customization + +(defgroup helm-org-ql nil + "Options for `helm-org-ql'." + :group 'org-ql) + +(defcustom helm-org-ql-reverse-paths t + "Whether to reverse Org outline paths in `helm-org-ql' results." + :type 'boolean) + +(defcustom helm-org-ql-input-idle-delay 0.25 + "Seconds to wait after typing stops before running query." + :type 'number) + +(defcustom helm-org-ql-actions + (list (cons "Show heading in source buffer" 'helm-org-ql-show-marker) + (cons "Show heading in indirect buffer" 'helm-org-ql-show-marker-indirect)) + "Alist of actions for `helm-org-ql' commands." + :type '(alist :key-type (string :tag "Description") + :value-type (function :tag "Command"))) + +;;;; Commands + +;;;###autoload +(cl-defun helm-org-ql (buffers-files &optional (no-and current-prefix-arg)) + "Display results in BUFFERS-FILES for an `org-ql' query using Helm. +Interactively, search the current buffer. + +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. + +Also, unless NO-AND is non-nil (interactively, with prefix), all +query tokens are wrapped in an implied (and) form. This is +because a query must be a sexp, so when typing multiple clauses, +either (and) or (or) would be required around them, and (and) is +typically more useful, because it narrows down results. + +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 ((helm-input-idle-delay helm-org-ql-input-idle-delay)) + (helm :prompt (format "Query (boolean %s): " (if no-and + "OR" + "AND")) + :sources + ;; Expansion of `helm-build-sync-source' macro. + (helm-make-source "helm-org-ql-agenda-files" 'helm-source-sync + :candidates #'(lambda nil + (let* ((query (helm-org-ql--input-to-query helm-pattern no-and)) + (window-width (window-width (helm-window)))) + (when query + (with-current-buffer (helm-buffer-get) + (setq helm-org-ql-buffers-files buffers-files)) + (ignore-errors + ;; Ignore errors that might be caused by partially typed queries. + (org-ql-select buffers-files query + :action (list 'helm-org-ql--heading window-width)))))) + :match #'identity + :fuzzy-match nil + :multimatch nil + :volatile t + :keymap helm-org-ql-map + :action helm-org-ql-actions)))) + +;;;###autoload +(defun helm-org-ql-agenda-files () + "Search agenda files with `helm-org-ql', which see." + (interactive) + (helm-org-ql (org-agenda-files))) + +;;;###autoload +(defun helm-org-ql-org-directory () + "Search Org files in `org-directory' with `helm-org-ql'." + (interactive) + (helm-org-ql (directory-files org-directory 'full + (rx ".org" eos)))) + +(defun helm-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 helm-org-ql-show-marker-indirect (marker) + "Show heading at MARKER with `org-tree-to-indirect-buffer'." + (interactive) + (helm-org-ql-show-marker marker) + (org-tree-to-indirect-buffer)) + +(defun helm-org-ql-save () + "Show `helm-org-ql' search in an `org-ql-search' buffer." + (interactive) + (let ((buffers-files (with-current-buffer (helm-buffer-get) + helm-org-ql-buffers-files)) + (query (helm-org-ql--input-to-query helm-pattern))) + (helm-run-after-exit #'org-ql-search buffers-files query))) + +;;;; Functions + +(defun helm-org-ql--input-to-query (input &optional no-and) + "Return `org-ql' query sexp for string INPUT. +Unless NO-AND is non-nil (interactively, with prefix), all query +tokens are wrapped in an implied (and) form, and plain +symbols (except at the beginning of a sexp) are replaced with +strings." + (unless (s-blank-str? input) + (setf input (format "(%s %s)" (if no-and "or" "and") input)) + (when-let* ((query (ignore-errors + ;; Ignore errors in case input is an + ;; incomplete string or sexp. + (read input)))) + (cl-labels ((rec (form) + ;; Replace some symbols with strings so users don't + ;; have to type quotation marks around all strings. + ;; Not perfect, but should be more useful. + (pcase-exhaustive form + ((pred stringp) form) + (`(deadline auto) form) + ((or '> '>= '< '<= '=) + ;; Comparators, probably for (priority). + form) + ((guard (string-match (rx bos ":" (1+ anything) ":" eos) + (prin1-to-string form))) + ;; An Org tag, not a Lisp keyword. + (prin1-to-string form)) + ((pred keywordp) form) + ((pred numberp) form) + ((guard (string-prefix-p "!" (prin1-to-string form))) + ;; Negation of a string. + `(not ,(substring (prin1-to-string form) 1))) + ((pred atom) (prin1-to-string form)) + ((pred listp) `(,(car form) + ,@(mapcar #'rec (cdr form))))))) + (rec query))))) + +(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-split-string (org-format-outline-path (org-get-outline-path) + width nil "") + "")) + (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) + +;;; helm-org-ql.el ends here diff --git a/images/helm-org-ql.gif b/images/helm-org-ql.gif new file mode 100644 index 0000000..16b5f34 Binary files /dev/null and b/images/helm-org-ql.gif differ diff --git a/notes.org b/notes.org index 56b374c..2851f48 100644 --- a/notes.org +++ b/notes.org @@ -737,46 +737,6 @@ Also, maybe instead of having a single =date= selector, I should have =scheduled (not (done))))) #+END_SRC -** Helm - -#+BEGIN_SRC elisp - (defun helm-org-ql-heading () - (let* ((path (mapconcat 'identity - (nreverse (org-split-string (org-format-outline-path (org-get-outline-path) - 1000 nil "") - "")) - org-sticky-header-outline-path-reversed-separator)) - (s (concat (org-sticky-header--get-prefix) - (org-get-heading) - org-sticky-header-outline-path-reversed-separator - path))) - (remove-list-of-text-properties 0 (length s) '(line-prefix) s) - (s-trim (if (> (length s) (window-width)) - (concat (substring s 0 (- (window-width) 2)) - "..") - s)))) - - (defun helm-org-ql-next () - (interactive) - (helm :sources (list (helm-build-sync-source "helm-org-ql" - ;; :after-init-hook helm-org-rifle-after-init-hook - :candidates (lambda () - (or (when-let* ((items (org-ql-select (org-agenda-files) - '(todo "NEXT") - :action 'element-with-markers - :sort '(priority date)))) - (--map (let* ((marker (org-element-property :org-marker it))) - (org-with-point-at marker - (cons (helm-org-ql-heading) marker))) - items)) - (list "NONE"))) - :match 'identity - :multiline nil - :volatile t - :action 'helm-org-rifle-actions - :keymap helm-org-rifle-map)))) -#+END_SRC - * In the wild ** [[https://github.com/AloisJanicek/.doom.d-2nd][Alois Janicek]]