Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add: skip-subtrees option #89

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Add: skip-subtrees option #89

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 6 additions & 2 deletions org-ql-search.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -105,7 +105,7 @@ Runs `org-occur-hook' after making the sparse tree."
num-results)))

;;;###autoload
(cl-defun org-ql-search (buffers-files query &key narrow super-groups sort title
(cl-defun org-ql-search (buffers-files query &key narrow super-groups sort title skip-subtrees
(buffer org-ql-view-buffer))
"Search for QUERY with `org-ql'.
Interactively, prompt for these variables:
Expand Down Expand Up @@ -134,6 +134,8 @@ SORT: One or a list of `org-ql' sorting functions, like `date' or

TITLE: An optional string displayed in the header.

SKIP-SUBTREES: Skip subtrees in matching entries.

BUFFER: Optionally, a buffer or name of a buffer in which to
display the results. By default, the value of
`org-ql-view-buffer' is used, and a new buffer is created if
Expand All @@ -159,6 +161,7 @@ necessary."
(read-string "Query: " (when org-ql-view-query
(format "%S" org-ql-view-query)))
:narrow (or org-ql-view-narrow (eq current-prefix-arg '(4)))
:skip-subtrees (yes-or-no-p "Skip subtrees?")
:super-groups (when (bound-and-true-p org-super-agenda-auto-selector-keywords)
(let ((keywords (cl-loop for type in org-super-agenda-auto-selector-keywords
collect (substring (symbol-name type) 6))))
Expand Down Expand Up @@ -200,7 +203,8 @@ necessary."
(results (org-ql-select buffers-files query
:action 'element-with-markers
:narrow narrow
:sort sort))
:sort sort
:skip-subtrees skip-subtrees))
(strings (-map #'org-ql-view--format-element results))
(buffer (or buffer (format "%s %s*" org-ql-view-buffer-name-prefix (or title query))))
(header (org-ql-view--header-line-format buffers-files query title))
Expand Down
6 changes: 5 additions & 1 deletion org-ql-view.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -87,6 +87,7 @@ Based on `org-agenda-mode-map'.")
(defvar-local org-ql-view-query nil)
(defvar-local org-ql-view-sort nil)
(defvar-local org-ql-view-narrow nil)
(defvar-local org-ql-view-skip-subtrees nil)
(defvar-local org-ql-view-super-groups nil)
(defvar-local org-ql-view-title nil)

Expand Down Expand Up @@ -218,12 +219,13 @@ Interactively, prompt for NAME."
(select-window window))
(cl-typecase view
(function (call-interactively view))
(list (-let* (((&plist :buffers-files :query :sort :narrow :super-groups :title) view)
(list (-let* (((&plist :buffers-files :query :sort :narrow :super-groups :title :skip-subtrees) view)
(super-groups (cl-typecase super-groups
(symbol (symbol-value super-groups))
(list super-groups))))
(org-ql-search buffers-files query
:super-groups super-groups :narrow narrow :sort sort :title title
:skip-subtrees skip-subtrees
:buffer org-ql-view-buffer))))))

;;;###autoload
Expand Down Expand Up @@ -287,6 +289,7 @@ update search arguments."
:sort org-ql-view-sort
:narrow org-ql-view-narrow
:super-groups org-ql-view-super-groups
:skip-subtrees org-ql-view-skip-subtrees
:title org-ql-view-title))
(org-ql-view-buffer (current-buffer)))
(if prompt
Expand All @@ -309,6 +312,7 @@ update search arguments."
:query org-ql-view-query
:sort org-ql-view-sort
:narrow org-ql-view-narrow
:skip-subtrees org-ql-view-skip-subtrees
:super-groups org-ql-view-super-groups
:title name)))
(map-put org-ql-views name plist #'equal)
Expand Down
40 changes: 27 additions & 13 deletions org-ql.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -142,15 +142,16 @@ match."
(cl-defun ,fn-name ,args ,docstring ,@body))))

;;;###autoload
(cl-defmacro org-ql (buffers-or-files query &key sort narrow action)
(cl-defmacro org-ql (buffers-or-files query &key sort narrow action skip-subtrees)
"Expands into a call to `org-ql-select' with the same arguments.
For convenience, arguments should be unquoted."
(declare (indent defun))
`(org-ql-select ,buffers-or-files
',query
:action ',action
:narrow ,narrow
:sort ',sort))
:sort ',sort
:skip-subtrees ,skip-subtrees))

;;;; Functions

Expand All @@ -160,7 +161,7 @@ For convenience, arguments should be unquoted."
(sxhash-equal (prin1-to-string args))))

;;;###autoload
(cl-defun org-ql-select (buffers-or-files query &key action narrow sort)
(cl-defun org-ql-select (buffers-or-files query &key action narrow sort skip-subtrees)
"Return items matching QUERY in BUFFERS-OR-FILES.

BUFFERS-OR-FILES is a file or buffer, a list of files and/or
Expand Down Expand Up @@ -191,7 +192,9 @@ SORT is either nil, in which case items are not sorted; or one or
a list of defined `org-ql' sorting methods (`date', `deadline',
`scheduled', `todo', `priority', or `random'); or a user-defined
comparator function that accepts two items as arguments and
returns nil or non-nil."
returns nil or non-nil.

If SKIP-SUBTREES is non-nil, subtrees of matching entries are skipped."
(declare (indent defun))
(-let* ((buffers (->> (cl-typecase buffers-or-files
(null (list (current-buffer)))
Expand Down Expand Up @@ -235,8 +238,10 @@ returns nil or non-nil."
(--map (with-current-buffer it
(unless (derived-mode-p 'org-mode)
(user-error "Not an Org buffer: %s" (buffer-name)))
(org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold
:predicate predicate :action action :narrow narrow)))
(org-ql--select-cached :query query :preamble preamble
:preamble-case-fold preamble-case-fold
:predicate predicate :action action
:narrow narrow :skip-subtrees skip-subtrees)))
(-flatten-n 1))))
;; Sort items
(pcase sort
Expand All @@ -251,7 +256,7 @@ returns nil or non-nil."
(_ (user-error "SORT must be either nil, one or a list of the defined sorting methods (see documentation), or a comparison function of two arguments")))))

;;;###autoload
(cl-defun org-ql-query (&key (select 'element-with-markers) from where narrow order-by)
(cl-defun org-ql-query (&key (select 'element-with-markers) from where narrow order-by skip-subtrees)
"Like `org-ql-select', but arguments are named more like a SQL query.

SELECT corresponds to the `org-ql-select' argument ACTION. It is
Expand Down Expand Up @@ -279,22 +284,26 @@ should be an `org-ql' query sexp.
ORDER-BY corresponds to the `org-ql-select' argument SORT, which
see.

NARROW corresponds to the `org-ql-select' argument NARROW."
NARROW corresponds to the `org-ql-select' argument NARROW.

SKIP-SUBTREES corresponds to the `org-ql-select' argument
SKIP-SUBTREES."
(declare (indent 0))
(org-ql-select from where
:action select
:narrow narrow
:sort order-by))
:sort order-by
:skip-subtrees skip-subtrees))

(defun org-ql--select-cached (&rest args)
"Return results for ARGS and current buffer using cache."
;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a
;; buffer is closed, or when a query is run after modifying a buffer.
(-let* (((&plist :query :preamble :action :narrow :preamble-case-fold) args)
(-let* (((&plist :query :preamble :action :narrow :preamble-case-fold :skip-subtrees) args)
(query-cache-key
;; The key must include the preamble, because some queries are replaced by
;; the preamble, leaving a nil query, which would make the key ambiguous.
(list :query query :preamble preamble :action action :preamble-case-fold preamble-case-fold
(list :query query :preamble preamble :action action :preamble-case-fold preamble-case-fold :skip-subtrees skip-subtrees
(if narrow
;; Use bounds of narrowed portion of buffer.
(cons (point-min) (point-max))
Expand All @@ -319,10 +328,11 @@ NARROW corresponds to the `org-ql-select' argument NARROW."
(t (puthash query-cache-key (or new-result 'org-ql-nil) query-cache)))
new-result))))

(cl-defun org-ql--select (&key preamble preamble-case-fold predicate action narrow
(cl-defun org-ql--select (&key preamble preamble-case-fold predicate action narrow skip-subtrees
&allow-other-keys)
"Return results of mapping function ACTION across entries in current buffer matching function PREDICATE.
If NARROW is non-nil, buffer will not be widened."
If NARROW is non-nil, buffer will not be widened.
If SKIP-SUBTREES is non-nil, subtrees of matching entries are skipped."
;; Since the mappings are stored in the variable `org-ql-predicates', macros like `flet'
;; can't be used, so we do it manually (this is same as the equivalent `flet' expansion).
;; Mappings are stored in the variable because it allows predicates to be defined with a
Expand Down Expand Up @@ -361,9 +371,13 @@ If NARROW is non-nil, buffer will not be widened."
do (outline-back-to-heading 'invisible-ok)
when (funcall predicate)
collect (funcall action)
when skip-subtrees
do (org-end-of-subtree)
do (outline-next-heading))))
(t (cl-loop when (funcall predicate)
collect (funcall action)
when skip-subtrees
do (org-end-of-subtree)
while (outline-next-heading))))))))
(--each orig-fns
;; Restore original function mappings.
Expand Down