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.

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

Change: (org-ql-search-block) Sort by org-ql sorter, etc. #459

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Changes from all commits
Commits
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
41 changes: 28 additions & 13 deletions org-ql-search.el
Original file line number Diff line number Diff line change
Expand Up @@ -225,19 +225,25 @@ necessary."
(org-ql-view--display :buffer buffer :header header :strings strings))))

;;;###autoload
(defun org-ql-search-block (query)
"Insert items for QUERY into current buffer.
QUERY should be an `org-ql' query form. Intended to be used as a
user-defined function in `org-agenda-custom-commands'. QUERY
corresponds to the `match' item in the custom command form.
(defun org-ql-search-block (args)
"Insert items for ARGS into current buffer.
Intended to be used as a user-defined function in
`org-agenda-custom-commands'. ARGS corresponds to the `match'
item in the custom command form. It should be a list of
arguments which may be applied to `org-ql-select', which see, but
not including its BUFFERS-FILES argument (which is supplied
through the Agenda). An additional `:header' keyword argument
may be supplied as a string, like that supplied to
`org-ql-view--display'.

Like other agenda block commands, it searches files returned by
function `org-agenda-files'. Inserts a newline after the block.

If `org-ql-block-header' is non-nil, it is used as the header
string for the block, otherwise a the header is formed
automatically from the query."
(let (narrow-p old-beg old-end)
(pcase-let ((`(,query . ,(map :header :sort)) args)
(narrow-p) (old-beg) (old-end))
(when-let* ((from (pcase org-agenda-restrict
('nil (org-agenda-files nil 'ifmode))
(_ (prog1 org-agenda-restrict
Expand All @@ -248,7 +254,7 @@ automatically from the query."
(narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end))))))
(items (org-ql-select from query
:action 'element-with-markers
:narrow narrow-p)))
:narrow narrow-p :sort sort)))
(when narrow-p
;; Restore buffer's previous restrictions.
(with-current-buffer from
Expand All @@ -258,16 +264,25 @@ automatically from the query."
;; FIXME: `org-agenda--insert-overriding-header' is from an Org version newer than
;; I'm using. Should probably declare it as a minimum Org version after upgrading.
;; (org-agenda--insert-overriding-header (or org-ql-block-header (org-ql-agenda--header-line-format from query)))
(insert (org-add-props (or org-ql-block-header (org-ql-view--header-line-format
:buffers-files from :query query))
;; FIXME: Should we really use `org-ql-block-header' AND `header', or just one of them?
(insert (org-add-props (or org-ql-block-header header
(org-ql-view--header-line-format
:buffers-files from :query query))
nil 'face 'org-agenda-structure) "\n")
;; Calling `org-agenda-finalize' should be unnecessary, because in a "series" agenda,
;; `org-agenda-multi' is bound non-nil, in which case `org-agenda-finalize' does nothing.
;; But we do call `org-agenda-finalize-entries', which allows `org-super-agenda' to work.
(->> items
(-map #'org-ql-view--format-element)
org-agenda-finalize-entries
insert)
;; However, `org-agenda-finalize-entries' sorts entries with `org-entries-lessp', which
;; overrides the sorting `org-ql' has already done, so we rebind `org-entries-lessp' to
;; prevent it from affecting sort order. (Ideally we would let `org-entries-lessp'
;; handle sorting, but that's not possible, because we can't add the `type' text property
;; it uses to sort entries, because the design of org-ql and org-agenda is fundamentally
;; different. So we have to do the sorting ourselves.)
(cl-letf (((symbol-function 'org-entries-lessp) #'ignore))
(->> items
(-map #'org-ql-view--format-element)
org-agenda-finalize-entries
insert))
(insert "\n"))))

;;;###autoload
Expand Down
Loading