Apply #459
Some checks failed
CI / build (27.1) (push) Has been cancelled
CI / build (27.2) (push) Has been cancelled
CI / build (28.1) (push) Has been cancelled
CI / build (28.2) (push) Has been cancelled
CI / build (29.1) (push) Has been cancelled
CI / build (29.2) (push) Has been cancelled
CI / build (29.3) (push) Has been cancelled
CI / build (29.4) (push) Has been cancelled
CI / build (snapshot) (push) Has been cancelled

This commit is contained in:
Jiri Jakes 2026-08-17 19:55:50 +08:00
parent 4b8330a683
commit ed23480e4b

View file

@ -225,11 +225,16 @@ necessary."
(org-ql-view--display :buffer buffer :header header :strings strings)))) (org-ql-view--display :buffer buffer :header header :strings strings))))
;;;###autoload ;;;###autoload
(defun org-ql-search-block (query) (defun org-ql-search-block (args)
"Insert items for QUERY into current buffer. "Insert items for ARGS into current buffer.
QUERY should be an `org-ql' query form. Intended to be used as a Intended to be used as a user-defined function in
user-defined function in `org-agenda-custom-commands'. QUERY `org-agenda-custom-commands'. ARGS corresponds to the `match'
corresponds to the `match' item in the custom command form. 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 Like other agenda block commands, it searches files returned by
function `org-agenda-files'. Inserts a newline after the block. function `org-agenda-files'. Inserts a newline after the block.
@ -237,7 +242,8 @@ function `org-agenda-files'. Inserts a newline after the block.
If `org-ql-block-header' is non-nil, it is used as the header If `org-ql-block-header' is non-nil, it is used as the header
string for the block, otherwise the header is formed string for the block, otherwise the header is formed
automatically from the query." 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 (when-let* ((from (pcase org-agenda-restrict
('nil (org-agenda-files nil 'ifmode)) ('nil (org-agenda-files nil 'ifmode))
(_ (prog1 org-agenda-restrict (_ (prog1 org-agenda-restrict
@ -248,7 +254,7 @@ automatically from the query."
(narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end)))))) (narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end))))))
(items (org-ql-select from query (items (org-ql-select from query
:action 'element-with-markers :action 'element-with-markers
:narrow narrow-p))) :narrow narrow-p :sort sort)))
(when narrow-p (when narrow-p
;; Restore buffer's previous restrictions. ;; Restore buffer's previous restrictions.
(with-current-buffer from (with-current-buffer from
@ -258,16 +264,25 @@ automatically from the query."
;; FIXME: `org-agenda--insert-overriding-header' is from an Org version newer than ;; 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. ;; 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))) ;; (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 ;; 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)) :buffers-files from :query query))
nil 'face 'org-agenda-structure) "\n") nil 'face 'org-agenda-structure) "\n")
;; Calling `org-agenda-finalize' should be unnecessary, because in a "series" agenda, ;; 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. ;; `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. ;; But we do call `org-agenda-finalize-entries', which allows `org-super-agenda' to work.
;; 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 (->> items
(-map #'org-ql-view--format-element) (-map #'org-ql-view--format-element)
org-agenda-finalize-entries org-agenda-finalize-entries
insert) insert))
(insert "\n")))) (insert "\n"))))
;;;###autoload ;;;###autoload