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

WIP: Add taxy-org-ql-view-multi, fix bugs

Browse source
This commit is contained in:
Adam Porter 2023-02-20 06:44:06 -06:00
parent 017d8c9bcf
commit d242d9c41f
1 changed files with 26 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

33
taxy-org-ql-view.el
View file

@ -373,7 +373,7 @@ that order."
(setf args (append (cl-subseq args 0 pos) (setf args (append (cl-subseq args 0 pos)
(cl-subseq args (+ 2 pos)))))) (cl-subseq args (+ 2 pos))))))
(pcase args (pcase args
(`(,(or 'nil 't)) (or name "Planned")) ((or 'nil 't) (or name "Planned"))
(_ (let ((element-ts (ts-parse-org-element planned-element))) (_ (let ((element-ts (ts-parse-org-element planned-element)))
(pcase args (pcase args
((and `(:past) ((and `(:past)
@ -489,7 +489,8 @@ contents."
(string (or (get-buffer buffer) (string (or (get-buffer buffer)
(get-buffer-create (format "*Taxy Org QL View: %s*" buffer)))))) (get-buffer-create (format "*Taxy Org QL View: %s*" buffer))))))
(instance-taxy (make-taxy-magit-section :name name)) (instance-taxy (make-taxy-magit-section :name name))
format-cons column-sizes) format-cons column-sizes
make-fn-group)
(cl-labels ((add-props (cl-labels ((add-props
;; NOTE: This mutates. Maybe good, maybe not. ;; NOTE: This mutates. Maybe good, maybe not.
(plist) (dolist (prop '(:name :from :sort :group) plist) (plist) (dolist (prop '(:name :from :sort :group) plist)
@ -522,7 +523,8 @@ contents."
(make-fn (&rest args) (make-fn (&rest args)
(apply #'make-taxy-magit-section (apply #'make-taxy-magit-section
:make #'make-fn :make #'make-fn
:take (taxy-make-take-function group taxy-org-ql-view-keys) ;; FIXME: The binding of `make-fn-group' here is very awkward. See below.
:take (taxy-make-take-function make-fn-group taxy-org-ql-view-keys)
:format-fn #'format-item :format-fn #'format-item
:heading-face-fn #'heading-face :heading-face-fn #'heading-face
:level-indent org-ql-view-level-indent :level-indent org-ql-view-level-indent
@ -545,8 +547,12 @@ contents."
(setf this-name (or this-name name) (setf this-name (or this-name name)
this-from (or this-from from) this-from (or this-from from)
this-group (or this-group group) this-group (or this-group group)
;; HACK: This binding is ugly. ;; FIXME: This binding is ugly, but it seems necessary
group this-group ;; due to the way the `make-fn' closes over the
;; argument passed to `taxy-make-take-function'
;; (passing it as an argument to `make-fn' does not
;; work).
make-fn-group (or this-group group)
this-sort (or this-sort sort)) this-sort (or this-sort sort))
(let* ((title (or this-name (let* ((title (or this-name
(org-ql-view--header-line-format (org-ql-view--header-line-format
@ -557,8 +563,7 @@ contents."
(items (org-ql-select from query (items (org-ql-select from query
:action 'element-with-markers :action 'element-with-markers
:sort sort)) :sort sort))
(taxy (thread-last (make-fn (taxy (thread-last (make-fn :name title)
:name title)
(taxy-fill items)))) (taxy-fill items))))
(push taxy (taxy-taxys instance-taxy)))) (push taxy (taxy-taxys instance-taxy))))
(setf (taxy-taxys instance-taxy) (nreverse (taxy-taxys instance-taxy)) (setf (taxy-taxys instance-taxy) (nreverse (taxy-taxys instance-taxy))
@ -580,6 +585,20 @@ contents."
(goto-char (point-min))) (goto-char (point-min)))
(pop-to-buffer (current-buffer)))))) (pop-to-buffer (current-buffer))))))
(cl-defun taxy-org-ql-view-multi
(&key buffer from sort group columns sections
&aux append)
(declare (indent defun))
(pcase-dolist ((map (:name section-name) (:from section-from)
(:sort section-sort) (:group section-group)
:queries)
sections)
(taxy-org-ql-view :buffer buffer :columns columns
:name (or section-name name) :from (or section-from from)
:sort (or section-sort sort) :group (or section-group group)
:queries queries :append append)
(setf append t)))
(defun taxy-org-ql-view-refresh () (defun taxy-org-ql-view-refresh ()
"Refresh buffer." "Refresh buffer."
(interactive) (interactive)