Add: helm-org-ql-source, org-ql-search-directories-files, etc.

README.org

@@ -375,6 +375,8 @@ Expands into a call to ~org-ql-select~ with the same arguments.  For convenience
 *Added*
 +  Predicates =outline-path= (alias =olp=) and =outline-path-segment= (alias =olps=).
 +  Info manual.
++  Command ~org-ql-search~ can search files in ~org-directory~; customization options are available in the ~org-ql-search~ group.
++  Function ~helm-org-ql-source~, which returns a Helm source that searches given buffers/files with ~helm-org-ql~.  It can be used for custom Helm commands that search certain files.
 
 *Internal*
 +  Added generic node data cache to speed up recursive, tree-based queries.

helm-org-ql.el

@@ -33,6 +33,7 @@
 (require 'org)
 
 (require 'org-ql)
+(require 'org-ql-search)
 
 ;; (require 'helm)
 ;; (require 'helm-org)
@@ -125,51 +126,20 @@ Is transformed into this query:
   (let ((boolean (if current-prefix-arg 'or boolean))
         (helm-input-idle-delay helm-org-ql-input-idle-delay))
     (helm :prompt (format "Query (boolean %s): " (-> boolean symbol-name upcase))
-          :sources
+          :sources (helm-org-ql-source buffers-files :name name))))
-          ;; Expansion of `helm-build-sync-source' macro.
-          (helm-make-source name 'helm-source-sync
-            :candidates (lambda nil
-                          (let* ((query (org-ql--plain-query helm-pattern boolean))
-                                 (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.
-
-                                ;; FIXME: This doesn't prevent warnings that are errors occurring during
-                                ;; byte-compilation due to partially typed values which can't be correctly
-                                ;; pre-processed, e.g. "ts:to=2019-01-0", which can't be parsed into a
-                                ;; timestamp.  A "*Compile-Log*" buffer is displayed with "Error: Wrong type
-                                ;; argument: integerp, nil".  With my Helm settings, it's hidden as soon as
-                                ;; the query is typed correctly, so it's tolerable, but I'd prefer to fix it.
-                                ;; I haven't found a way to ignore the error/warning; `with-no-warnings' has
-                                ;; no effect, and we're already using `ignore-errors'.  The only solution I
-                                ;; can think of would be to ignore the errors/warnings higher up the chain
-                                ;; 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 (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) :name "helm-org-ql-agenda-files"))
+  (helm-org-ql (org-agenda-files) :name "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
+  (helm-org-ql (org-ql-search-directories-files)
-                                (rx ".org" eos))
+               :name "Org Directory Files"))
-               :name "helm-org-ql-org-directory"))
 
 (defun helm-org-ql-show-marker (marker)
   "Show heading at MARKER."
@@ -198,6 +168,39 @@ Is transformed into this query:
 
 ;;;; Functions
 
+(cl-defun helm-org-ql-source (buffers-files &key (name "helm-org-ql"))
+  "Return Helm source named NAME that searches BUFFERS-FILES with `helm-org-ql'."
+  ;; Expansion of `helm-build-sync-source' macro.
+  (helm-make-source name 'helm-source-sync
+    :candidates (lambda nil
+                  (let* ((query (org-ql--plain-query helm-pattern))
+                         (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.
+
+                        ;; FIXME: This doesn't prevent warnings that are errors occurring during
+                        ;; byte-compilation due to partially typed values which can't be correctly
+                        ;; pre-processed, e.g. "ts:to=2019-01-0", which can't be parsed into a
+                        ;; timestamp.  A "*Compile-Log*" buffer is displayed with "Error: Wrong type
+                        ;; argument: integerp, nil".  With my Helm settings, it's hidden as soon as
+                        ;; the query is typed correctly, so it's tolerable, but I'd prefer to fix it.
+                        ;; I haven't found a way to ignore the error/warning; `with-no-warnings' has
+                        ;; no effect, and we're already using `ignore-errors'.  The only solution I
+                        ;; can think of would be to ignore the errors/warnings higher up the chain
+                        ;; 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 (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))
+
 (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."

org-ql-search.el

@@ -30,6 +30,7 @@
 (require 'cl-lib)
 
 (require 'dash)
+(require 'f)
 (require 'org-super-agenda)
 (require 's)
 
@@ -41,6 +42,30 @@
 (defvar org-ql-block-header nil
   "An optional string to override the default header in `org-ql-block' agenda blocks.")
 
+;;;; Customization
+
+(defgroup org-ql-search nil
+  "Options for `org-ql-search' commands."
+  :group 'org-ql)
+
+(defcustom org-ql-search-directories-files-regexp "\.org$"
+  "Regular expression to match Org filenames in `org-directory'.
+Files matching this regexp will be searched.  By default,
+\".org\" files are matched, but you may also select to include
+\".org_archive\" files, or use a custom regexp."
+  :type '(radio (const :tag "Normal \".org\" files" :value "\.org$")
+                (const :tag "Also include \".org_archive\" files" "\.org\\(_archive\\)?$")
+                (string :tag "Custom regular expression")))
+
+(defcustom org-ql-search-directories-files-recursive nil
+  "Recurse into subdirectories by default in `org-ql-search-directories-files'.
+This should probably be disabled by default, because
+e.g. `org-directory' may include deeply nested directories of
+non-Org files, such as a \".git\" directory, Org attachments
+directories, etc, which would make it slow to list the
+`org-directory' files recursively."
+  :type 'boolean)
+
 ;;;; Commands
 
 ;;;###autoload
@@ -91,6 +116,7 @@ Interactively, may also be:
 - `buffer': search the current buffer
 - `all': search all Org buffers
 - `agenda': search buffers returned by the function `org-agenda-files'
+- `directory': search Org files in `org-directory'
 - An expression which evaluates to a list of files/buffers
 - A space-separated list of file or buffer names
 
@@ -114,12 +140,13 @@ display the results.  By default, the value of
 necessary."
   (declare (indent defun))
   (interactive (list (pcase-exhaustive (completing-read "Buffers/Files: "
-                                                        (list 'buffer 'agenda 'all)
+                                                        (list 'buffer 'agenda 'directory 'all)
                                                         nil t)
+                       ((or "" "buffer") (current-buffer))
                        ("agenda" (org-agenda-files))
                        ("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
                                         (buffer-list)))
-                       ((or "" "buffer") (current-buffer))
+                       ("directory" (org-ql-search-directories-files))
                        ((and form (guard (rx bos "("))) (-flatten (eval (read form))))
                        (else (s-split (rx (1+ space)) else)))
                      (read-string "Query: ")
@@ -205,6 +232,22 @@ automatically from the query."
 ;;;###autoload
 (defalias 'org-ql-block 'org-ql-search-block)
 
+;;;; Functions
+
+(cl-defun org-ql-search-directories-files (&key (directories (list org-directory))
+                                                (recurse org-ql-search-directories-files-recursive)
+                                                (regexp org-ql-search-directories-files-regexp))
+  "Return list of matching files in DIRECTORIES, a list of directory paths.
+When RECURSE is non-nil, recurse into subdirectories.  When
+REGEXP is non-nil, only return files that match REGEXP."
+  (let ((files (->> directories
+                    (--map (f-files it nil recurse))
+                    -flatten)))
+    (if regexp
+        (--select (string-match regexp it)
+                  files)
+      files)))
+
 ;;;; Footer
 
 (provide 'org-ql-search)

org-ql.el

@@ -3,7 +3,7 @@
 ;; Author: Adam Porter <adam@alphapapa.net>
 ;; Url: https://github.com/alphapapa/org-ql
 ;; Version: 0.4-pre
-;; Package-Requires: ((emacs "26.1") (dash "2.13") (dash-functional "1.2.0") (org "9.0") (org-super-agenda "1.2-pre") (ov "1.0.6") (peg "0.6") (s "1.12.0") (ts "0.2-pre"))
+;; Package-Requires: ((emacs "26.1") (dash "2.13") (dash-functional "1.2.0") (f "0.17.2") (org "9.0") (org-super-agenda "1.2-pre") (ov "1.0.6") (peg "0.6") (s "1.12.0") (ts "0.2-pre"))
 ;; Keywords: hypermedia, outlines, Org, agenda
 
 ;;; Commentary:

org-ql.info

@@ -690,6 +690,11 @@ File: README.info,  Node: 04-pre,  Next: 03,  Up: Changelog
    • Predicates outline-path (alias olp) and outline-path-segment (alias
      olps).
    • Info manual.
+   • Command ‘org-ql-search’ can search files in ‘org-directory’;
+     customization options are available in the ‘org-ql-search’ group.
+   • Function ‘helm-org-ql-source’, which returns a Helm source that
+     searches given buffers/files with ‘helm-org-ql’.  It can be used
+     for custom Helm commands that search certain files.
 
    *Internal*
    • Added generic node data cache to speed up recursive, tree-based
@@ -959,16 +964,16 @@ Node: Agenda-like views17687
 Node: Listing / acting-on results19092
 Node: Changelog23694
 Node: 04-pre24201
-Node: 0324505
+Node: 0324862
-Node: 02327481
+Node: 02327838
-Node: 02227707
+Node: 02228064
-Node: 02127973
+Node: 02128330
-Node: 0228170
+Node: 0228527
-Node: 0132203
+Node: 0132560
-Node: Notes32302
+Node: Notes32659
-Node: Comparison with Org Agenda searches32464
+Node: Comparison with Org Agenda searches32821
-Node: org-sidebar33335
+Node: org-sidebar33692
-Node: License33614
+Node: License33971
 
 End Tag Table