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

WIP: Taxy-grouped lists of results in dynamic blocks

Browse source 
Looks like, e.g.:

\#+BEGIN: org-ql :from "~/org/main.org" :query "tags:Emacs todo:" :groups (planning todo) :sort (date reverse) :columns (todo heading planning)
+ Planned
  + To-do: PROJECT
    - PROJECT Emacs timers and frames 1640d ago
    - PROJECT :custom doesn't seem to work with custom setters · Issue #702 · jwiegley/use-package · GitHub 846d ago
  + To-do: WAITING
    - WAITING Gnus: gnus-parameter-large-newsgroup-initial-alist ignored? 1704d ago
    - WAITING byte-compiled functions don't hash consistently 1663d ago
    - WAITING Change: (org-agenda-bulk-action) Prompt w/number of marked items 1647d ago
    - WAITING org-link-match struct and functions 1636d ago
    - WAITING Emacs ~-defun~ macro idea 1296d ago
    - WAITING Check feedback 801d ago
  + To-do: UNDERWAY
    - UNDERWAY Add: By-key memoization by alphapapa · Pull Request #10 · skeeto/emacs-memoize · GitHub 1664d ago
    - UNDERWAY Setup Git syncing of Org files 1609d ago
    - UNDERWAY org-zoom-in org-zoom-out 176d ago
+ To-do: WAITING
  - WAITING Dash wand/swiss-arrows macros
  - WAITING Missing Emacs functions
  - WAITING Org-metaup destructive when region active?
  - WAITING org creates bibtex fontification buffers without setting dialect, causes error
  - WAITING =org-map-entries= calls org-agenda-prepare-buffers unnecessarily?
  - WAITING Improvement to f.el's directory-files function
  - WAITING Suggestion: Only redraw search buffer after refresh completes · Issue #293 · skeeto/elfeed · GitHub
\#+END:
This commit is contained in:
Adam Porter 2023-03-14 06:53:24 -05:00
parent 4f972547db
commit 77a4fdb7be
1 changed files with 64 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

75
org-ql-search.el
View file

@ -302,7 +302,7 @@ this (must be a single line in the Org buffer):
#+BEGIN: org-ql :query (todo \"UNDERWAY\") #+BEGIN: org-ql :query (todo \"UNDERWAY\")
:columns (priority todo heading) :sort (priority date) :columns (priority todo heading) :sort (priority date)
:ts-format \"%Y-%m-%d %H:%M\"" :ts-format \"%Y-%m-%d %H:%M\""
(-let* (((&plist :query :columns :sort :ts-format :take :from) params) (-let* (((&plist :query :columns :sort :ts-format :take :from :groups) params)
(from (pcase-exhaustive from (from (pcase-exhaustive from
(`nil (current-buffer)) (`nil (current-buffer))
((pred listp) from) ((pred listp) from)
@ -369,7 +369,20 @@ this (must be a single line in the Org buffer):
(`(,column ,_header) (`(,column ,_header)
(funcall (alist-get column format-fns) element))) (funcall (alist-get column format-fns) element)))
"")) ""))
" | "))) " | "))
(format-element-list
(element) (string-join (cl-loop for column in columns
collect (or (pcase-exhaustive column
((pred symbolp)
(funcall (alist-get column format-fns) element))
(`((,column . ,args) ,_header)
(apply (alist-get column format-fns) element args))
(`(,column . ,(and args (guard (keywordp (car args)))))
(apply (alist-get column format-fns) element args))
(`(,column ,_header)
(funcall (alist-get column format-fns) element)))
""))
" ")))
;; Table header ;; Table header
(insert "| " (string-join (--map (pcase it (insert "| " (string-join (--map (pcase it
((pred symbolp) (capitalize (symbol-name it))) ((pred symbolp) (capitalize (symbol-name it)))
@ -378,15 +391,55 @@ this (must be a single line in the Org buffer):
columns) columns)
" | ") " | ")
" |" "\n") " |" "\n")
(insert "|- \n") ; Separator hline ;; (insert "|- \n")
(let ((org-id-link-to-org-use-id 'use-existing)) ; Separator hline
(dolist (element elements) (let* ((org-id-link-to-org-use-id 'use-existing))
(let ((link (org-with-point-at (or (org-element-property :org-hd-marker element) ;; (dolist (element elements)
(org-element-property :org-marker element)) ;; (let ((link (org-with-point-at (or (org-element-property :org-hd-marker element)
(org-store-link t)))) ;; (org-element-property :org-marker element))
(insert "| " (format-element element) " |" "\n")))) ;; (org-store-link t))))
(delete-char -1) ;; (insert "| " (format-element element) " |" "\n")))
(org-table-align)))) (org-ql-dblock-taxy-insert elements :format-fn #'format-element-list :groups groups)
)
;; (delete-char -1)
;; (org-table-align)
)))
(cl-defun org-ql-dblock-taxy-insert
(items &key groups (initial-depth 0)
(format-fn (lambda (item)
;; For compatibility with Org Agenda, we
;; add the marker property to the whole
;; string (though it only seems to check
;; at BOL).
(let* ((string (gethash item taxy-org-ql-view-format-table))
(marker (or (get-text-property 0 :org-hd-marker string)
(when-let ((pos (next-single-property-change 0 :org-hd-marker string)))
(get-text-property pos :org-hd-marker string)))))
;; I don't understand why Org sometimes
;; uses one property and sometimes the
;; other.
(propertize string
'org-hd-marker marker
'org-marker marker)))))
(cl-labels ((make-fn (&rest args)
(apply #'make-taxy
:make #'make-fn
;; FIXME: The binding of `make-fn-group' here is very awkward. See below.
:take (taxy-make-take-function groups taxy-org-ql-view-keys)
args))
(insert-taxy (taxy depth)
(insert (make-string (* 2 depth) ? ) "+ " (or (taxy-name taxy) "GROUP") "\n")
(dolist (item (taxy-items taxy))
(insert-item item (1+ depth)))
(dolist (taxy (taxy-taxys taxy))
(insert-taxy taxy (1+ depth))))
(insert-item (item depth)
(insert (make-string (* 2 depth) ? ) "- " (funcall format-fn item) "\n")))
(let* ((taxy (thread-last (make-fn)
(taxy-fill items))))
(dolist (taxy (taxy-taxys taxy))
(insert-taxy taxy initial-depth)))))
;;;; Functions ;;;; Functions