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

Add: Sorting by TODO keyword

Browse source
This commit is contained in:
Adam Porter 2018-05-23 07:03:28 -05:00
parent 70573b98c5
commit edc9958aa1
2 changed files with 31 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

4
notes.org
View file

@ -186,6 +186,10 @@ Doesn't seem to make any difference.
(org-ql "~/src/emacs/org-super-agenda/test/test.org" (org-ql "~/src/emacs/org-super-agenda/test/test.org"
(regexp "over") (regexp "over")
:sort (date)) :sort (date))
(org-ql "~/src/emacs/org-super-agenda/test/test.org"
(todo)
:sort (todo))
#+END_SRC #+END_SRC
** Regexp matching ** Regexp matching

24
org-ql.el
View file

@ -253,16 +253,34 @@ comparator, PRIORITY should be a priority string."
PREDICATES is a list of one or more sorting methods, including: PREDICATES is a list of one or more sorting methods, including:
`deadline', `scheduled', and `priority'." `deadline', `scheduled', and `priority'."
;; FIXME: Test `date' type. ;; FIXME: Test `date' type.
(cl-flet ((sorter (symbol) (cl-flet* ((sorter (symbol)
(pcase symbol (pcase symbol
((or 'deadline 'scheduled) ((or 'deadline 'scheduled)
(apply-partially #'org-ql--date-type< (intern (concat ":" (symbol-name symbol))))) (apply-partially #'org-ql--date-type< (intern (concat ":" (symbol-name symbol)))))
('date #'org-ql--date<) ('date #'org-ql--date<)
('priority #'org-ql--priority<) ('priority #'org-ql--priority<)
;; NOTE: 'todo is handled below
;; FIXME: Add more? ;; FIXME: Add more?
(_ (user-error "Invalid sorting predicate: %s" symbol))))) (_ (user-error "Invalid sorting predicate: %s" symbol))))
(todo-keyword-pos (keyword)
;; MAYBE: Would it be faster to precompute these and do an alist lookup?
(cl-position keyword org-todo-keywords-1 :test #'string=))
(sort-by-todo-keyword (items)
(let* ((grouped-items (--group-by (when-let (keyword (org-element-property :todo-keyword it))
(substring-no-properties keyword))
items))
(sorted-groups (--sort (let* ((it-pos (todo-keyword-pos (car it)))
(other-pos (todo-keyword-pos (car other))))
(cond ((and it-pos other-pos)
(< it-pos other-pos))
(it-pos t)
(other-pos nil)))
grouped-items)))
(-flatten-n 1 (-map #'cdr sorted-groups)))))
(cl-loop for pred in (nreverse predicates) (cl-loop for pred in (nreverse predicates)
do (setq items (-sort (sorter pred) items)) do (setq items (if (eq pred 'todo)
(sort-by-todo-keyword items)
(-sort (sorter pred) items)))
finally return items))) finally return items)))
(defun org-ql--date-type< (type a b) (defun org-ql--date-type< (type a b)