jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor/Add: agenda->view/search, view-sidebar

Browse source 
Squash-merging branch wip/refactor-org-ql-agenda.

Squashed commit of the following:

commit 60d73b071830ab8f0355687a1d325a4791eeb29b
Author: Adam Porter <adam@alphapapa.net>
Date:   Wed Sep 18 04:30:55 2019 -0500

    WIP: Tidy

commit 36f65638cdb585553c0f90ef48b3908700461014
Author: Adam Porter <adam@alphapapa.net>
Date:   Wed Sep 18 04:24:45 2019 -0500

    WIP: Tidy

commit f7bae3ac8c250c4e42b79157656603da91185574
Author: Adam Porter <adam@alphapapa.net>
Date:   Wed Sep 18 04:10:36 2019 -0500

    WIP: Tidy

commit 8791b0de3404cfff9e110969b8aa30c753319335
Author: Adam Porter <adam@alphapapa.net>
Date:   Wed Sep 18 04:05:18 2019 -0500

    WIP: Remove unnecessary defvars

commit 0dd8d259a31e279ad76188640f6731f8fdf0ae88
Author: Adam Porter <adam@alphapapa.net>
Date:   Wed Sep 18 04:03:27 2019 -0500

    WIP: (org-ql-search.el) Require org-super-agenda

commit 76981fbcd3eba7d1b8d096c094a013953c2d3333
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 16 19:49:07 2019 -0500

    WIP: More refactoring

commit a3e58f4d44aa804bfd9ff537aca53647dd068329
Author: Adam Porter <adam@alphapapa.net>
Date:   Mon Sep 16 19:21:20 2019 -0500

    WIP: View list sidebar

commit 56f27cd87f0ef246d31328e4c7a41ad2a1c57553
Author: Adam Porter <adam@alphapapa.net>
Date:   Sat Aug 31 22:25:09 2019 -0500

    WIP: Split org-ql-agenda into org-ql-view and org-ql-search
This commit is contained in:
Adam Porter 2019-09-22 20:59:00 -05:00
parent 8f2a02264f
commit 5864c28cdb
7 changed files with 828 additions and 716 deletions
Download patch file Download diff file Expand all files Collapse all files

191
org-ql-search.el Normal file
View file

@ -0,0 +1,191 @@
;;; org-ql-search.el --- Search commands for org-ql -*- lexical-binding: t; -*-
;; Author: Adam Porter <adam@alphapapa.net>
;; Url: https://github.com/alphapapa/org-ql
;;; Commentary:
;; This library is part of the package `org-ql'; it's not a standalone
;; library. It implements search commands for Org buffers.
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(require 'dash)
(require 'org-super-agenda)
(require 's)
(require 'org-ql)
(require 'org-ql-view)
;;;; Commands
;;;###autoload
(cl-defun org-ql-sparse-tree (query &key keep-previous (buffer (current-buffer)))
"Show a sparse tree for QUERY in BUFFER and return number of results.
The tree will show the lines where the query matches, and any
other context defined in `org-show-context-detail', which see.
QUERY is an `org-ql' query sexp (quoted, since this is a
function). BUFFER defaults to the current buffer.
When KEEP-PREVIOUS is non-nil (interactively, with prefix), the
outline is not reset to the overview state before finding
matches, which allows stacking calls to this command.
Runs `org-occur-hook' after making the sparse tree."
;; Code based on `org-occur'.
;; TODO: Use `helm-org-ql' plain-text query processing.
(interactive (list (read-minibuffer "Query: ")
:keep-previous current-prefix-arg))
(with-current-buffer buffer
(unless keep-previous
;; We don't do highlighting, because queries aren't regexps, but
;; we remove existing `org-occur' highlights, just in case.
(org-remove-occur-highlights nil nil t)
(org-overview))
(let ((num-results 0))
(org-ql-select buffer query
:action (lambda ()
(org-show-context 'occur-tree)
(cl-incf num-results)))
(unless org-sparse-tree-open-archived-trees
(org-hide-archived-subtrees (point-min) (point-max)))
(run-hooks 'org-occur-hook)
(unless (get-buffer-window buffer)
(pop-to-buffer buffer))
(message "%d matches" num-results)
num-results)))
;;;###autoload
(cl-defun org-ql-search (buffers-files query &key narrow super-groups sort title
(buffer org-ql-view-buffer))
"Read QUERY and search with `org-ql'.
Interactively, prompt for these variables:
BUFFERS-FILES: A list of buffers and/or files to search.
Interactively, may also be:
- `buffer': search the current buffer
- `all': search all Org buffers
- `agenda': search buffers returned by the function `org-agenda-files'
- An expression which evaluates to a list of files/buffers
- A space-separated list of file or buffer names
SUPER-GROUPS: An `org-super-agenda' group set. See variable
`org-super-agenda-groups'.
NARROW: When non-nil, don't widen buffers before
searching. Interactively, with prefix, leave narrowed.
SORT: One or a list of `org-ql' sorting functions, like `date' or
`priority'.
TITLE: An optional string displayed in the header.
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
necessary."
(declare (indent defun))
(interactive (list (pcase-exhaustive (completing-read "Buffers/Files: "
(list 'buffer 'agenda 'all)
nil t)
("agenda" (org-agenda-files))
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
(buffer-list)))
("buffer" (current-buffer))
((and form (guard (rx bos "("))) (-flatten (eval (read form))))
(else (s-split (rx (1+ space)) else)))
(read-minibuffer "Query: ")
:narrow (eq current-prefix-arg '(4))
:super-groups (when (bound-and-true-p org-super-agenda-auto-selector-keywords)
(pcase (completing-read "Group by: "
(append (list "Don't group"
"Global super-groups")
(cl-loop for type in org-super-agenda-auto-selector-keywords
collect (substring (symbol-name type) 6))))
("Global super-groups" org-super-agenda-groups)
("Don't group" nil)
(property (list (list (intern (concat ":auto-" property)))))))
:sort (pcase (completing-read "Sort by: "
(list "Don't sort"
"date"
"deadline"
"priority"
"scheduled"
"todo"))
("Don't sort" nil)
(sort (intern sort)))))
(let* ((results (org-ql-select buffers-files query
:action 'element-with-markers
:narrow narrow
:sort sort))
(strings (-map #'org-ql-view--format-element results))
(title (or title (format "%S in %S" query buffers-files)))
(buffer (or buffer (format "%s %s*" org-ql-view-buffer-name-prefix title)))
(header (org-ql-view--header-line-format buffers-files query title))
;; Bind variables for `org-ql-view--display' to set.
(org-ql-view-buffers-files buffers-files)
(org-ql-view-query query)
(org-ql-view-sort sort)
(org-ql-view-narrow narrow)
(org-ql-view-super-groups super-groups)
(org-ql-view-title title))
(when super-groups
(let ((org-super-agenda-groups super-groups))
(setf strings (org-super-agenda--group-items strings))))
(org-ql-view--display :buffer buffer :header header
:string (s-join "\n" strings))))
(defun org-ql-search-block (query)
"Insert items for QUERY into current buffer.
QUERY should be an `org-ql' query form. Like other agenda block
commands, it searches files returned by function
`org-agenda-files'. 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. Inserts a newline
after the block."
(when-let* ((from (org-agenda-files nil 'ifmode))
(items (org-ql-select from query
:action 'element-with-markers)))
;; Not sure if calling the prepare function is necessary, but let's follow the pattern.
(org-agenda-prepare)
;; 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 (org-ql-search--header-line-format from query))
(insert (org-add-props (org-ql-view--header-line-format from 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)
(insert "\n")))
;;;###autoload
(defalias 'org-ql-block 'org-ql-search-block)
;;;; Footer
(provide 'org-ql-search)
;;; org-ql-search.el ends here