From be92d531ecbc85d38777e82d7f2e80f4e6150070 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Fri, 16 Aug 2019 12:30:37 -0500 Subject: [PATCH] Add: org-ql-view, org-ql-views, org-ql-search-save --- README.org | 7 ++++++ examples.org | 28 ---------------------- org-ql-agenda.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 69 insertions(+), 28 deletions(-) diff --git a/README.org b/README.org index fe8f963..9a39fdf 100644 --- a/README.org +++ b/README.org @@ -123,6 +123,7 @@ Alternatively, they may be grouped by: + *Showing an agenda-like view:* - ~org-ql-search~ (command) + - ~org-ql-view~ (command) - ~org-ql-block~ (agenda function) - ~org-ql-agenda~ (macro) + *Returning a list of matches or acting on them:* @@ -157,6 +158,7 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable *Bindings:* + =g=: Refresh results. ++ =C-x C-s=: Save query to variable ~org-ql-views~ (accessible with command ~org-ql-view~). [[images/org-ql-search.gif]] @@ -164,6 +166,10 @@ Here's an example of using it to generate an agenda-like view for certain files [[images/org-ql-search-snippet.png]] +*** org-ql-view + +Choose and display a view stored in ~org-ql-views~. + ** Queries A query is a lisp form which may contain arbitrary lisp forms, as well as certain built-in predicates. It is byte-compiled into a predicate function which is tested with point on each heading in an Org buffer; when it returns non-nil, the heading matches the query. @@ -427,6 +433,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience + Function ~org-ql-search~ and macro ~org-ql-agenda~ accept a ~:title~ argument, which is displayed in the header. + Command ~org-ql-search~ offers global ~org-super-agenda-groups~ in completion. + Customization group ~org-ql~. ++ Command ~org-ql-view~, which displays views saved to variable ~org-ql-views~, which can be saved from ~org-ql-search~ buffers with command ~org-ql-search-save~, which is bound to =C-x C-s= in view buffers. + Variable ~org-ql-view-map~, active in view buffers displayed by ~org-ql-search~, ~org-ql-agenda~, and ~org-ql-view~. *Changed* diff --git a/examples.org b/examples.org index 1855094..759ea3e 100644 --- a/examples.org +++ b/examples.org @@ -4,38 +4,10 @@ :PROPERTIES: :TOC: this :END: - - [[#stored-views-command][Stored views command]] - [[#show-entries-with-recent-timestamps][Show entries with recent timestamps]] - [[#stuck-projects-block-agenda][Stuck projects block agenda]] - [[#listing-bills-coming-due][Listing bills coming due]] -* Stored views command - -This defines a simple list of stored views and a command to easily access them with completion, which may be more convenient than defining a command for each view. - -#+BEGIN_SRC elisp - (defun org-ql-view (&optional view) - "Choose and display a stored `org-ql' view." - (interactive (list (completing-read "View: " (mapcar #'car org-ql-views)))) - (funcall (alist-get view org-ql-views nil nil #'string=))) - - (setq org-ql-views - (list (cons "Stuck Projects" (lambda () - (org-ql-agenda (org-agenda-files) - (and (todo) - (not (todo "TO-WATCH" "TO-READ" "MAYBE" "SOMEDAY")) - (children) - (not (children (todo))) - (not (habit))) - :title "Stuck Projects" - :sort (priority date) - :super-groups ((:name "Home" :tag "home") - (:tag ("Emacs" "computer") :order 100) - (:auto-parent t) - (:todo "WAITING") - (:auto-category t))))))) -#+END_SRC - * Show entries with recent timestamps #+BEGIN_SRC elisp diff --git a/org-ql-agenda.el b/org-ql-agenda.el index 6ac4dd4..b62eeb2 100644 --- a/org-ql-agenda.el +++ b/org-ql-agenda.el @@ -27,6 +27,7 @@ ;;; Code: (require 'cl-lib) +(require 'map) (require 'org) (require 'org-element) (require 'org-agenda) @@ -76,6 +77,42 @@ Based on `org-agenda-mode-map'.") (defvar org-ql-super-groups) (defvar org-ql-title) +;;;; Customization + +(defcustom org-ql-views + (list (cons "Recent entries" (cl-function + (lambda (days &optional (type 'ts)) + (interactive (list (read-number "Days: ") + (->> '(ts ts-active ts-inactive clocked closed deadline planning scheduled) + (completing-read "Timestamp type: ") + intern))) + (let ((from (->> (ts-now) + (ts-adjust 'day (* -1 days)) + (ts-apply :hour 0 :minute 0 :second 0) + ;; Formatting isn't required, but it looks better in the header than a struct. + ts-format))) + (org-ql-search (org-agenda-files) + `(,type :from ,from :to ,(ts-format (ts-now))) + :title "Recent Entries" + :sort '(date priority todo) + :groups '((:todo "DONE") + (:auto-parent t) + (:auto-todo t))))))) + (cons "Stuck Projects" (lambda () + (interactive) + (org-ql-search (org-agenda-files) + '(and (todo) + (children) + (not (children (todo "NEXT")))) + :title "Stuck Projects" + :sort '(priority date))))) + "Alist of `org-ql-view' commands. +Each value should be a function that calls, +e.g. `org-ql-search' as desired." + :group 'org-ql + :type '(alist :key-type string + :value-type function)) + ;;;; Macros ;; FIXME: DRY these two macros. @@ -220,6 +257,31 @@ TITLE: An optional string displayed in the header." :title org-ql-title :buffer (current-buffer))) +(defun org-ql-search-save () + "Save current `org-ql-search' buffer to `org-ql-views'." + (interactive) + (let* ((name (read-string "Save view as: ")) + (buffers-files-sexp (cl-etypecase org-ql-buffers-files + (string org-ql-buffers-files) + (list `(list ,@org-ql-buffers-files)) + (null nil))) + (function `(lambda () + (interactive) + (org-ql-search ,buffers-files-sexp + ',org-ql-query + :sort ',org-ql-sort + :narrow ,org-ql-narrow + :groups ',org-ql-super-groups + :title ,name)))) + (map-put org-ql-views name function #'equal) + (customize-set-variable 'org-ql-views org-ql-views) + (customize-mark-to-save 'org-ql-views))) + +(defun org-ql-view (&optional view) + "Choose and display a view stored in `org-ql-views'." + (interactive (list (completing-read "View: " (mapcar #'car org-ql-views)))) + (call-interactively (alist-get view org-ql-views nil nil #'string=))) + ;;;; Functions ;; TODO: Move the action-fn down into --filter-buffer, so users can avoid calling the