Add: Transient view dispatcher

This commit is contained in:
Adam Porter 2020-01-27 19:26:08 -06:00
parent 68a1cf29b6
commit 6e3c0d3c68
5 changed files with 451 additions and 57 deletions

View file

@ -26,6 +26,7 @@ It includes three libraries: The =org-ql= library is flexible and may be used as
[[images/org-ql-search.gif]]
[[images/org-ql-view-dispatch.gif]]
[[images/helm-org-ql.gif]]
@ -111,7 +112,8 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable
~SORT~: One or a list of ~org-ql~ sorting functions, like ~date~ or ~priority~.
*Bindings:* Keys bound in results buffer.
+ =g=: Refresh results. With prefix, prompt to adjust search parameters.
+ =r=: Refresh results. With prefix, prompt to adjust search parameters.
+ =v=: Show =transient= view dispatcher (like Magit's popups).
+ =C-x C-s=: Save query to variable ~org-ql-views~ (accessible with command ~org-ql-view~).
*Note:* The view buffer is currently put in ~org-agenda-mode~, which means that /some/ Org Agenda commands work, such as jumping to entries and changing item priorities (without necessarily updating the view). This feature is experimental and not guaranteed to work correctly with all commands. (It works to the extent it does because the appropriate text properties are placed on each item, imitating an Agenda buffer.)
@ -128,6 +130,11 @@ This command displays matches with Helm. *Note:* Helm is not a package dependen
Choose and display a view stored in ~org-ql-views~.
*Bindings:* Keys bound in view buffer.
+ =r=: Refresh results. With prefix, prompt to adjust search parameters.
+ =v=: Show =transient= view dispatcher (like Magit's popups).
+ =C-x C-s=: Save query to variable ~org-ql-views~ (accessible with command ~org-ql-view~).
*** org-ql-view-sidebar
Show a sidebar window listing views stored in =org-ql-views= for easy access. In the sidebar, press =RET= or =mouse-1= to show the view at point, and press =c= to customize the view at point.
@ -395,7 +402,11 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience
** 0.5-pre
Nothing new yet.
*Added*
+ View dispatcher using =transient.el= (like Magit), bound to =v= in search/view buffers.
*Changed*
+ Binding to refresh search/view buffers changed to =r=.
** 0.4

View file

@ -0,0 +1,166 @@
#!/bin/bash
# NOTE: Run "setxkbmap us" before running. See https://github.com/jordansissel/xdotool/issues/49
# NOTE: <f1> should be bound to this function in the Emacs window, like this:
# (global-set-key [f1]
# (defun gif-screencast-start-or-stop ()
# (interactive)
# (if gif-screencast-mode
# (progn
# (gif-screencast-stop)
# (setq gc-cons-threshold gc-cons-threshold-original))
# (setq gc-cons-threshold-original gc-cons-threshold)
# (setq gc-cons-threshold (* 1024 1024 500))
# (gif-screencast))))
# * Functions
function ensure_window_name {
if ! [[ $(xdotool getwindowfocus getwindowname) = $1 ]]
then
echo "Wrong window!" >&2
exit 1
fi
}
function key {
xdotool key "$@"
}
function input {
raw_input "$@"
# Correct for Helm's input idle delay by sending extra commands to
# make the screenshots be taken. Not sure why two are necessary,
# but they seem to be.
key ctrl+p
sleep 0.26
key ctrl+p
}
function raw_input {
xdotool type --delay 200 "$@"
}
function view-dispatch {
key v
sleep 2
}
function view-refresh {
key r
sleep 2
}
function clear-input {
key ctrl+a ctrl+k
sleep 0.5
}
function set-field {
key $1
shift
sleep 1
clear-input
raw_input "$@"
sleep 1
key Return
sleep 1
}
function set-field-with-unique-completion {
# "$@" should be a unique completion.
key $1
shift
sleep 0.5
clear-input
key Tab
sleep 0.5
raw_input "$@"
key Tab
sleep 0.75
key Return
sleep 1
}
function complete-in-steps {
# Assumes input is clear.
key Tab
sleep 0.75
key Tab
sleep 0.75
for s in "$@"
do
raw_input "$s"
key Tab
sleep 0.75
done
sleep 1
}
# * Script
# No matter what I try, xdotool is not working properly to focus/raise/select
# a window. And for some bizarre reason, the "xdotool selectwindow" command
# outputs a completely different window ID than "xdotool search" outputs. In
# fact, the window ID it outputs does not even appear in the output of
# "xprop" for that window. I have no idea where it's getting that ID.
# So rather than cleanly selecting the proper window in the script, we have to
# do a hacky workaround by sleeping and checking the name of the active
# window.
sleep 3
ensure_window_name "data.org"
# Start gif-screencast
key F1
sleep 2
# M-x org-ql-view RET, TAB, Ov TAB, Ag TAB, RET
key alt+x
sleep 0.2
raw_input "org-ql-view"
sleep 1
key Return
sleep 1
complete-in-steps Ov Ag
key Return
sleep 2
# Edit view.
view-dispatch
set-field t "Space-related"
set-field q "tags:space,spaceship"
set-field-with-unique-completion g pri
view-refresh
# Save query
view-dispatch
key ctrl+s
sleep 1
key Return
sleep 2
# New query: Ambition
view-dispatch
set-field t Ambition
set-field q "category:ambition"
set-field s "priority"
set-field g "parent"
view-refresh
view-dispatch
set-field t "Upcoming: ambition"
set-field g ts
view-refresh
# Save view.
view-dispatch
key ctrl+s
sleep 0.75
key Return
key F1

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.8 MiB

View file

@ -2,6 +2,7 @@
;; Author: Adam Porter <adam@alphapapa.net>
;; Url: https://github.com/alphapapa/org-ql
;; Package-Requires: ((transient))
;;; Commentary:
@ -69,7 +70,8 @@ down a chain of function calls would be awkward.")
(defvar org-ql-view-map
(let ((map (copy-keymap org-agenda-mode-map)))
(define-key map "g" #'org-ql-view-refresh)
(define-key map "r" #'org-ql-view-refresh)
(define-key map "v" #'org-ql-view-dispatch)
(define-key map (kbd "C-x C-s") #'org-ql-view-save)
map)
"Keymap for `org-ql-view', `org-ql-search', and `org-ql-views' views.
@ -334,15 +336,27 @@ update search arguments."
(defun org-ql-view-save ()
"Save current `org-ql-search' buffer to `org-ql-views'."
(interactive)
(let* ((name (read-string "Save view as: "))
(let* ((name (read-string "Save view as: " org-ql-view-title))
(plist (list :buffers-files org-ql-view-buffers-files
:query org-ql-view-query
:sort org-ql-view-sort
:narrow org-ql-view-narrow
:super-groups org-ql-view-super-groups
:title name)))
(when (or (not (map-elt org-ql-views name nil #'equal))
(yes-or-no-p (format "Overwrite view \"%s\"?" name)))
(setf (map-elt org-ql-views name nil #'equal) plist)
(customize-set-variable 'org-ql-views org-ql-views)
(customize-mark-to-save 'org-ql-views))))
(defun org-ql-view-delete ()
"Delete current view (with confirmation)."
(interactive)
(when (yes-or-no-p (format "Delete view \"%s\"?" org-ql-view-title))
(setf org-ql-views
(--remove (equal (car it) org-ql-view-title)
org-ql-views))
(customize-set-variable 'org-ql-views org-ql-views)
(customize-mark-to-save 'org-ql-views)))
(defun org-ql-view-customize ()
@ -419,7 +433,7 @@ subsequent refreshing of the buffer: `org-ql-view-buffers-files',
"Return `header-line-format' for BUFFERS-FILES and QUERY.
If TITLE, prepend it to the header."
(let* ((title (if title
(concat (propertize "View:" 'face 'org-agenda-structure)
(concat (propertize "View:" 'face 'transient-argument)
title " ")
""))
(query-formatted (org-ql-view--format-query query))
@ -436,9 +450,9 @@ If TITLE, prepend it to the header."
(s-truncate available-width))
'help-echo buffers-files-formatted)))
(concat title
(propertize "Query:" 'face 'org-agenda-structure)
(propertize "Query:" 'face 'transient-argument)
query-propertized " "
(propertize "In:" 'face 'org-agenda-structure)
(propertize "In:" 'face 'transient-argument)
buffers-files-formatted)))
(defun org-ql-view--format-query (query)
@ -484,6 +498,128 @@ dates in the past, and negative for dates in the future."
(format "in %sd" (* -1 difference)))
(t "today")))
;;;; Transient
;; This section uses `transient' to allow the user to easily modify
;; and refresh views.
;; NOTE: I don't really know what I'm doing here. Even though the
;; Transient manual is written very well, not everything is covered in
;; it, so I'm having to try to imitate examples from `magit-transient'.
(require 'transient)
(defclass org-ql-view--variable (transient-variable)
;; FIXME: We don't need :scope, but maybe a slot has to be defined.
((scope :initarg :scope)))
(cl-defmethod transient-infix-set ((obj org-ql-view--variable) value)
"Set Org QL View variable defined by OBJ to VALUE."
(let ((variable (oref obj variable)))
(oset obj value value)
(set (make-local-variable (oref obj variable)) value)
(unless (or value transient--prefix)
(message "Unset %s" variable))))
(define-transient-command org-ql-view-dispatch ()
"Show Org QL View dispatcher."
[["Edit"
("t" org-ql-view--transient-title)
("q" org-ql-view--transient-query)
("i" org-ql-view--transient-in)
("s" org-ql-view--transient-sort)
("g" org-ql-view--transient-super-groups)]]
[["View"
("r" "Refresh" org-ql-view-refresh)
("v" "Select" org-ql-view)]
[""
("C-s" "Save" org-ql-view-save)
("C-k" "Delete" org-ql-view-delete)]])
(defun org-ql-view--format-transient-key-value (key value)
"Return KEY and VALUE formatted for display in Transient."
;; `window-width' minus 15 is about right. I think there's no way
;; to determine it automatically, because we can't know which column
;; Transient is starting at.
(let ((max-width (- (window-width) 15)))
(format "%s: %s" (propertize key 'face 'transient-argument)
(s-truncate max-width (format "%s" value)))))
(defun org-ql-view--format-transient-lisp-argument (key value)
"Return KEY and VALUE (a Lisp object) formatted for display in Transient."
;; `window-width' minus 15 is about right. I think there's no way
;; to determine it automatically, because we can't know which column
;; Transient is starting at.
(s-truncate (- (window-width) 15)
(concat (propertize key 'face 'transient-argument) ": "
(->> value
org-ql-view--format-query
(org-ql-view--font-lock-string 'emacs-lisp-mode)))))
(define-infix-command org-ql-view--transient-title ()
;; TODO: Add an asterisk or something when the view has been modified but not saved.
:description (lambda () (org-ql-view--format-transient-key-value "Title" org-ql-view-title))
:class 'org-ql-view--variable
:argument ""
:variable 'org-ql-view-title
:prompt "Title: "
:reader (lambda (prompt _initial-input history)
;; FIXME: Figure out how to integrate initial-input.
(read-string prompt (when org-ql-view-title
(format "%s" org-ql-view-title))
history)))
(define-infix-command org-ql-view--transient-query ()
:description (lambda () (org-ql-view--format-transient-lisp-argument "Query" org-ql-view-query))
:class 'org-ql-view--variable
:argument ""
:variable 'org-ql-view-query
:prompt "Query: "
:reader (lambda (prompt _initial-input history)
;; FIXME: Figure out how to integrate initial-input.
(let ((query (read-string prompt (when org-ql-view-query
(format "%S" org-ql-view-query))
history)))
(if (or (string-prefix-p "(" query)
(string-prefix-p "\"" query))
;; Read sexp query.
(read query)
;; Parse non-sexp query into sexp query.
(org-ql--plain-query query)))))
(define-infix-command org-ql-view--transient-in ()
:description (lambda () (org-ql-view--format-transient-lisp-argument "In buffers/files" org-ql-view-buffers-files))
:class 'org-ql-view--variable
:argument ""
:variable 'org-ql-view-buffers-files
:prompt "Buffers/files: "
:reader (lambda (_prompt _initial-input _history)
;; FIXME: Figure out how to integrate initial-input and history.
(org-ql-view--complete-buffers-files)))
(define-infix-command org-ql-view--transient-super-groups ()
:description (lambda ()
(org-ql-view--format-transient-lisp-argument "Group by" org-ql-view-super-groups))
:class 'org-ql-view--variable
:argument ""
:variable 'org-ql-view-super-groups
:prompt "Group by: "
:reader (lambda (_prompt _initial-input _history)
;; FIXME: Figure out how to integrate initial-input and history.
(org-ql-view--complete-super-groups)))
(define-infix-command org-ql-view--transient-sort ()
:description
(lambda ()
(org-ql-view--format-transient-lisp-argument "Sort by" (or org-ql-view-sort 'buffer-order)))
:class 'org-ql-view--variable
:argument ""
:variable 'org-ql-view-sort
:prompt "Sort: "
:reader (lambda (_prompt _initial-input _history)
;; FIXME: Figure out how to integrate initial-input and history.
(org-ql-view--complete-sort)))
;;;; Faces/properties
(defun org-ql-view--format-element (element)
@ -671,6 +807,65 @@ property."
(face (org-get-todo-face keyword)))
(org-add-props keyword nil 'face face)))
;;;;; Completion
(defun org-ql-view--complete-buffers-files ()
"Return value for `org-ql-view-buffers-files' using completion."
(if (and org-ql-view-buffers-files
(bufferp org-ql-view-buffers-files))
;; Buffers can't be input by name, so if the default value is a buffer, just use it.
;; TODO: Find a way to fix this.
org-ql-view-buffers-files
(pcase-exhaustive (completing-read "Buffers/Files: "
(list 'buffer 'agenda 'directory 'all)
nil nil (when org-ql-view-buffers-files
(let ((print-length nil))
(prin1-to-string (cons 'list org-ql-view-buffers-files)))))
((or "" "buffer") (current-buffer))
("agenda" (org-agenda-files))
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
(buffer-list)))
("directory" (org-ql-search-directories-files))
((and form (guard (rx bos "("))) (-flatten (eval (read form))))
(else (s-split (rx (1+ space)) else)))))
(defun org-ql-view--complete-super-groups ()
"Return value for `org-ql-view-super-groups' using completion."
(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))))
(pcase (completing-read "Group by: "
(append (list "Don't group"
"Global super-groups")
keywords)
nil nil (when org-ql-view-super-groups
(format "%S" org-ql-view-super-groups)))
("Global super-groups" org-super-agenda-groups)
((or "" "Don't group") nil)
((and keyword (guard (member keyword keywords)))
(list (list (intern (concat ":auto-" keyword)))))
(else (read else))))))
(defun org-ql-view--complete-sort ()
"Return value for `org-ql-view-sort' using completion."
(let ((input (->> (completing-read-multiple "Sort by: "
(list "buffer-order"
"date"
"deadline"
"priority"
"scheduled"
"todo")
nil nil (when org-ql-view-sort
(prin1-to-string org-ql-view-sort)))
(--remove (equal "buffer-order" it)))))
(pcase input
('nil nil)
((and (pred listp) sort)
;; Multiple sorters.
(mapcar #'intern sort))
(sort ;; One sorter.
(intern sort)))))
;;;; Footer
(provide 'org-ql-view)

View file

@ -63,6 +63,7 @@ Functions / Macros
Changelog
* 0.5-pre: 05-pre.
* 0.4: 04.
* 0.3.2: 032.
* 0.3.1: 031.
@ -93,9 +94,7 @@ File: README.info, Node: Contents, Next: Screenshots, Prev: Top, Up: Top
1 Contents
**********
• • •
• •
• • • • • •
• • • •

File: README.info, Node: Screenshots, Next: Installation, Prev: Contents, Up: Top
@ -216,8 +215,9 @@ Interactively, with prefix, leave narrowed.
priority.
*Bindings:* Keys bound in results buffer.
g: Refresh results. With prefix, prompt to adjust search
r: Refresh results. With prefix, prompt to adjust search
parameters.
• v: Show transient view dispatcher (like Magits popups).
• C-x C-s: Save query to variable org-ql-views (accessible with
command org-ql-view).
@ -251,6 +251,13 @@ File: README.info, Node: org-ql-view, Next: org-ql-view-sidebar, Prev: helm-o
Choose and display a view stored in org-ql-views.
*Bindings:* Keys bound in view buffer.
• r: Refresh results. With prefix, prompt to adjust search
parameters.
• v: Show transient view dispatcher (like Magits popups).
• C-x C-s: Save query to variable org-ql-views (accessible with
command org-ql-view).

File: README.info, Node: org-ql-view-sidebar, Next: org-ql-view-recent-items, Prev: org-ql-view, Up: Commands
@ -703,6 +710,7 @@ releases.
* Menu:
* 0.5-pre: 05-pre.
* 0.4: 04.
* 0.3.2: 032.
* 0.3.1: 031.
@ -714,9 +722,22 @@ releases.
* 0.1: 01.

File: README.info, Node: 04, Next: 032, Up: Changelog
File: README.info, Node: 05-pre, Next: 04, Up: Changelog
5.1 0.4
5.1 0.5-pre
===========
*Added*
• View dispatcher using transient.el (like Magit), bound to v in
search/view buffers.
*Changed*
• Binding to refresh search/view buffers changed to r.

File: README.info, Node: 04, Next: 032, Prev: 05-pre, Up: Changelog
5.2 0.4
=======
_Note:_ The next release, 0.5, may include changes which will require
@ -797,7 +818,7 @@ as they will be pushed to the master branch when ready.

File: README.info, Node: 032, Next: 031, Prev: 04, Up: Changelog
5.2 0.3.2
5.3 0.3.2
=========
*Fixed*
@ -810,7 +831,7 @@ File: README.info, Node: 032, Next: 031, Prev: 04, Up: Changelog

File: README.info, Node: 031, Next: 03, Prev: 032, Up: Changelog
5.3 0.3.1
5.4 0.3.1
=========
*Fixed*
@ -820,7 +841,7 @@ File: README.info, Node: 031, Next: 03, Prev: 032, Up: Changelog

File: README.info, Node: 03, Next: 023, Prev: 031, Up: Changelog
5.4 0.3
5.5 0.3
=======
*Added*
@ -885,7 +906,7 @@ File: README.info, Node: 03, Next: 023, Prev: 031, Up: Changelog

File: README.info, Node: 023, Next: 022, Prev: 03, Up: Changelog
5.5 0.2.3
5.6 0.2.3
=========
*Fixed*
@ -895,7 +916,7 @@ File: README.info, Node: 023, Next: 022, Prev: 03, Up: Changelog

File: README.info, Node: 022, Next: 021, Prev: 023, Up: Changelog
5.6 0.2.2
5.7 0.2.2
=========
*Fixed*
@ -906,7 +927,7 @@ File: README.info, Node: 022, Next: 021, Prev: 023, Up: Changelog

File: README.info, Node: 021, Next: 02, Prev: 022, Up: Changelog
5.7 0.2.1
5.8 0.2.1
=========
*Fixed*
@ -916,7 +937,7 @@ File: README.info, Node: 021, Next: 02, Prev: 022, Up: Changelog

File: README.info, Node: 02, Next: 01, Prev: 021, Up: Changelog
5.8 0.2
5.9 0.2
=======
*Added*
@ -999,8 +1020,8 @@ File: README.info, Node: 02, Next: 01, Prev: 021, Up: Changelog

File: README.info, Node: 01, Prev: 02, Up: Changelog
5.9 0.1
=======
5.10 0.1
========
First tagged release.
@ -1057,40 +1078,41 @@ GPLv3

Tag Table:
Node: Top225
Node: Contents1402
Node: Screenshots1576
Node: Installation1694
Node: Quelpa2332
Node: Usage2775
Node: Commands3124
Node: org-ql-search3597
Node: helm-org-ql5245
Node: org-ql-view5657
Node: org-ql-view-sidebar5855
Node: org-ql-view-recent-items6211
Node: org-ql-sparse-tree6695
Node: Queries7495
Node: Non-sexp query syntax8403
Node: General predicates10110
Node: Ancestor/descendant predicates14917
Node: Date/time predicates16045
Node: Functions / Macros18700
Node: Agenda-like views18933
Node: Listing / acting-on results20338
Node: Changelog24940
Node: 0425469
Node: 03229388
Node: 03129765
Node: 0329960
Node: 02332933
Node: 02233159
Node: 02133425
Node: 0233622
Node: 0137655
Node: Notes37754
Node: Comparison with Org Agenda searches37916
Node: org-sidebar38788
Node: License39067
Node: Contents1422
Node: Screenshots1545
Node: Installation1663
Node: Quelpa2301
Node: Usage2744
Node: Commands3093
Node: org-ql-search3566
Node: helm-org-ql5280
Node: org-ql-view5692
Node: org-ql-view-sidebar6189
Node: org-ql-view-recent-items6545
Node: org-ql-sparse-tree7029
Node: Queries7829
Node: Non-sexp query syntax8737
Node: General predicates10444
Node: Ancestor/descendant predicates15251
Node: Date/time predicates16379
Node: Functions / Macros19034
Node: Agenda-like views19267
Node: Listing / acting-on results20672
Node: Changelog25274
Node: 05-pre25823
Node: 0426090
Node: 03230024
Node: 03130401
Node: 0330596
Node: 02333569
Node: 02233795
Node: 02134061
Node: 0234258
Node: 0138291
Node: Notes38392
Node: Comparison with Org Agenda searches38554
Node: org-sidebar39426
Node: License39705

End Tag Table