ENH sort tags

This commit is contained in:
Nathan Dwarshuis 2022-01-23 20:28:22 -05:00
parent 9199114939
commit 1cbb0e1c41
1 changed files with 57 additions and 39 deletions

View File

@ -119,23 +119,6 @@ that file as it currently sits on disk.")
;; TODO pretty sure this will never be used ;; TODO pretty sure this will never be used
(org-x-dag-id->is-floating-p id))) (org-x-dag-id->is-floating-p id)))
(defun org-x-dag-collapse-tags (tags)
"Return TAGS with duplicates removed.
In the case of mutually exclusive tags, only the first tag
encountered will be returned."
(-let (((x non-x) (--separate (memq (elt it 0) org-x-exclusive-prefixes) tags)))
(->> (--group-by (elt it 0) x)
(--map (car (cdr it)) )
(append (-uniq non-x))
;; this removes the 'inherited' property on some of the tags, which
;; makes the agenda look cleaner (to me) since there are no
;; double-colons to separate inherited from non-inherited
;;
;; NOTE: this appears to have no effect on `org-agenda-tags' (eg the
;; inherited tags still show up in the menu properly)
(-map #'substring-no-properties))))
(defun org-x-dag-id->tags (inherit? init id) (defun org-x-dag-id->tags (inherit? init id)
(cl-labels (cl-labels
((ascend ((ascend
@ -150,9 +133,9 @@ encountered will be returned."
tags))) tags)))
;; likewise, init tags have the lowest precedence (the likely use case for ;; likewise, init tags have the lowest precedence (the likely use case for
;; this argument is for file tags) ;; this argument is for file tags)
(org-x-dag-collapse-tags (append (org-x-dag-id->local-tags id) (let ((local-tags (org-x-dag-id->local-tags id))
(and inherit? (ascend id nil)) (parent-tags (and inherit? (ascend id nil))))
init)))) (append local-tags parent-tags init))))
(defun org-x-dag-id->headline-children (id) (defun org-x-dag-id->headline-children (id)
(->> (plist-get org-x-dag :dag) (->> (plist-get org-x-dag :dag)
@ -347,6 +330,40 @@ If FORCE is non-nil, sync no matter what."
;; NODE FORMATTING ;; NODE FORMATTING
(defconst org-x-dag-tag-prefix-order (list org-x-tag-misc-prefix
org-x-tag-resource-prefix
org-x-tag-location-prefix
org-x-tag-category-prefix)
"Order in which tags should appear in the agenda buffer (from right to left.")
(defun org-x-dag-collapse-tags (tags)
"Return TAGS with duplicates removed.
In the case of mutually exclusive tags, only the first tag
encountered will be returned."
(-let (((x non-x) (--separate (memq (elt it 0) org-x-exclusive-prefixes) tags)))
(->> (--group-by (elt it 0) x)
(--map (car (cdr it)) )
(append (-uniq non-x))
;; this removes the 'inherited' property on some of the tags, which
;; makes the agenda look cleaner (to me) since there are no
;; double-colons to separate inherited from non-inherited
;;
;; NOTE: this appears to have no effect on `org-agenda-tags' (eg the
;; inherited tags still show up in the menu properly)
(-map #'substring-no-properties))))
(defun org-x-dag-sort-tags (tags)
(cl-flet
((get-ranking
(tag)
(-if-let (i (-elem-index (elt tag 0) org-x-dag-tag-prefix-order))
(1+ i)
0)))
(->> (--map (cons it (get-ranking it)) tags)
(--sort (< (cdr it) (cdr other)))
(-map #'car))))
(defun org-x-dag-add-default-props (item) (defun org-x-dag-add-default-props (item)
(org-add-props item nil (org-add-props item nil
'org-not-done-regexp org-not-done-regexp 'org-not-done-regexp org-not-done-regexp
@ -357,6 +374,9 @@ If FORCE is non-nil, sync no matter what."
(defun org-x-dag-format-tag-node (category tags key) (defun org-x-dag-format-tag-node (category tags key)
;; ASSUME I don't use subtree-level categories ;; ASSUME I don't use subtree-level categories
(-let* (;; (category (org-get-category)) (-let* (;; (category (org-get-category))
(tags* (->> tags
(org-x-dag-collapse-tags)
(org-x-dag-sort-tags)))
(head (org-get-heading)) (head (org-get-heading))
(level (-> (org-x-dag-id->metaprop key :level) (level (-> (org-x-dag-id->metaprop key :level)
(make-string ?s))) (make-string ?s)))
@ -368,7 +388,7 @@ If FORCE is non-nil, sync no matter what."
(marker (org-agenda-new-marker)) (marker (org-agenda-new-marker))
;; no idea what this function actually does ;; no idea what this function actually does
((ts . ts-type) (org-agenda-entry-get-agenda-timestamp (point))) ((ts . ts-type) (org-agenda-entry-get-agenda-timestamp (point)))
(item (org-agenda-format-item "" head level category tags)) (item (org-agenda-format-item "" head level category tags*))
(priority (org-get-priority item))) (priority (org-get-priority item)))
(-> (org-x-dag-add-default-props item) (-> (org-x-dag-add-default-props item)
(org-add-props nil (org-add-props nil
@ -463,7 +483,7 @@ If FORCE is non-nil, sync no matter what."
((get-project-or-task-status ((get-project-or-task-status
(key) (key)
(-if-let (children (org-x-dag-id->headline-children key)) (-if-let (children (org-x-dag-id->headline-children key))
(let* ((tags (org-x-dag-id->tags nil parent-tags key)) (let* ((tags (org-x-dag-id->tags nil ,parent-tags key))
(child-results (funcall ,callback key tags children)) (child-results (funcall ,callback key tags children))
;; ASSUME the car of the results will be the toplevel ;; ASSUME the car of the results will be the toplevel
;; key/status pair for this (sub)project ;; key/status pair for this (sub)project
@ -610,7 +630,11 @@ If FORCE is non-nil, sync no matter what."
(it-file) (it-file)
(-when-let (keys ,pre-form*) (-when-let (keys ,pre-form*)
(org-x-with-file it-file (org-x-with-file it-file
(--mapcat ,form keys))))) ;; NOTE there are other ways in org to get the category; the
;; only one I ever cared about was the filename. Very simple,
;; category = filename. Done
(let ((it-category (f-base it-file)))
(--mapcat ,form keys))))))
(-non-nil (-mapcat #'proc-file ,files)))))) (-non-nil (-mapcat #'proc-file ,files))))))
(defun org-x-dag-scan-projects () (defun org-x-dag-scan-projects ()
@ -627,9 +651,8 @@ If FORCE is non-nil, sync no matter what."
'x-status status 'x-status status
'x-priority priority)))))) 'x-priority priority))))))
(format-key (format-key
(key) (cat key)
(let ((cat (org-get-category)) (let ((tags (org-x-dag-id->tags t org-file-tags key)))
(tags (org-x-dag-id->tags t org-file-tags key)))
;; TODO don't hardcode these things ;; TODO don't hardcode these things
(org-x-dag-with-key key (org-x-dag-with-key key
(unless (or (member org-x-tag-incubated tags) (unless (or (member org-x-tag-incubated tags)
@ -640,7 +663,7 @@ If FORCE is non-nil, sync no matter what."
(org-x-dag-with-files (org-x-get-action-files) (org-x-dag-with-files (org-x-get-action-files)
(and (org-x-dag-id->is-toplevel-p it) (and (org-x-dag-id->is-toplevel-p it)
(not (org-x-dag-id->is-done-p it))) (not (org-x-dag-id->is-done-p it)))
(format-key it)))) (format-key it-category it))))
(defun org-x-dag-scan-iterators () (defun org-x-dag-scan-iterators ()
(cl-flet* (cl-flet*
@ -655,10 +678,9 @@ If FORCE is non-nil, sync no matter what."
(org-x-dag-id->is-toplevel-p it) (org-x-dag-id->is-toplevel-p it)
(let ((tags (org-x-dag-id->tags t org-file-tags it))) (let ((tags (org-x-dag-id->tags t org-file-tags it)))
(unless (member org-x-tag-incubated tags) (unless (member org-x-tag-incubated tags)
(let ((cat (org-get-category)))
(org-x-dag-with-key it (org-x-dag-with-key it
(when (org-x-dag-headline-is-iterator-p) (when (org-x-dag-headline-is-iterator-p)
(list (format-result tags cat it)))))))))) (list (format-result tags it-category it)))))))))
(defun org-x-dag-get-task-nodes (id) (defun org-x-dag-get-task-nodes (id)
(declare (indent 2)) (declare (indent 2))
@ -694,12 +716,9 @@ If FORCE is non-nil, sync no matter what."
'x-status s))))))))) 'x-status s)))))))))
(org-x-dag-with-files (org-x-get-action-files) (org-x-dag-with-files (org-x-get-action-files)
(org-x-dag-id->is-toplevel-p it) (org-x-dag-id->is-toplevel-p it)
;; TODO this is firing for each key, probably not necessary but whatever,
;; not that slow
(let ((category (org-get-category)))
(-if-let (project-tasks (org-x-dag-get-task-nodes it)) (-if-let (project-tasks (org-x-dag-get-task-nodes it))
(--map (format-key category nil it) project-tasks) (--map (format-key it-category nil it) project-tasks)
(list (format-key category t it))))))) (list (format-key it-category t it))))))
(defun org-x-dag-scan-incubated () (defun org-x-dag-scan-incubated ()
(cl-flet (cl-flet
@ -719,8 +738,7 @@ If FORCE is non-nil, sync no matter what."
(org-x-dag-with-files (org-x-get-action-and-incubator-files) (org-x-dag-with-files (org-x-get-action-and-incubator-files)
(and (org-x-dag-id->is-toplevel-p it) (and (org-x-dag-id->is-toplevel-p it)
(not (org-x-dag-id->is-done-p it))) (not (org-x-dag-id->is-done-p it)))
(let ((category (org-get-category))) (list (format-key it-category it)))))
(list (format-key category it))))))
(defun org-x-dag-scan-archived () (defun org-x-dag-scan-archived ()
(cl-flet (cl-flet