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

This commit is contained in:
Adam Porter 2019-10-07 11:01:09 -05:00
parent 34cdbd5c87
commit 7fa0d83a54
5 changed files with 101 additions and 48 deletions

View file

@ -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.

View file

@ -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."

View file

@ -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)

View file

@ -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:

View file

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