diff --git a/README.org b/README.org index a7258dc..be50959 100644 --- a/README.org +++ b/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. diff --git a/helm-org-ql.el b/helm-org-ql.el index 96604cb..d8bdb0c 100644 --- a/helm-org-ql.el +++ b/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 - ;; 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)))) + :sources (helm-org-ql-source buffers-files :name name)))) ;;;###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 - (rx ".org" eos)) - :name "helm-org-ql-org-directory")) + (helm-org-ql (org-ql-search-directories-files) + :name "Org Directory Files")) (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." diff --git a/org-ql-search.el b/org-ql-search.el index 45f349a..9ef07c0 100644 --- a/org-ql-search.el +++ b/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) diff --git a/org-ql.el b/org-ql.el index 65f1ff9..c7b9ea3 100644 --- a/org-ql.el +++ b/org-ql.el @@ -3,7 +3,7 @@ ;; Author: Adam Porter ;; 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: diff --git a/org-ql.info b/org-ql.info index f585e33..3632511 100644 --- a/org-ql.info +++ b/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: 02327481 -Node: 02227707 -Node: 02127973 -Node: 0228170 -Node: 0132203 -Node: Notes32302 -Node: Comparison with Org Agenda searches32464 -Node: org-sidebar33335 -Node: License33614 +Node: 0324862 +Node: 02327838 +Node: 02228064 +Node: 02128330 +Node: 0228527 +Node: 0132560 +Node: Notes32659 +Node: Comparison with Org Agenda searches32821 +Node: org-sidebar33692 +Node: License33971  End Tag Table