Add: helm-org-ql

Squashed commit of the following:

commit f4c2ce37199eb6eab5038e6bdadf5d57f8d88cd3
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 9 16:56:04 2019 -0500

    Docs: Add about helm-org-ql C-x C-s

commit 845a205f7b17904cb9f8e379dc172787cdd16018
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 9 16:25:46 2019 -0500

    WIP: Update docs and add screenshot

commit d8aa8a50169d3ecdee4d85a0f7cd6e1dc26e420e
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 9 16:25:18 2019 -0500

    WIP: Ignore all query errors

    Partially typed queries might cause parsing errors.

commit 782a830a5fb7d77ea2eba3553f46cc4dcac98708
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 9 16:24:57 2019 -0500

    WIP: (deadline) and (priority)

commit d32e3e33f97dfa7593f4376c08eb31b0ccb980a2
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 9 14:26:54 2019 -0500

    WIP: Compatibility

    Trying to make it install and run cleanly even when Helm isn't
    installed.

commit 4bd9943f86ef543903e10f3b58b26c0eb366d869
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 9 13:47:41 2019 -0500

    Add: (helm-org-ql-org-directory)

commit d9a04e142ae68f83201c311fa84a46fa8f4e0ce0
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 2 12:23:51 2019 -0500

    WIP: Add helm-org-ql.el

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:

helm-org-ql.el

@@ -0,0 +1,249 @@
+;;; helm-org-ql.el --- Helm commands for org-ql  -*- lexical-binding: t; -*-
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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

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]]