ENH sort tags
This commit is contained in:
parent
9199114939
commit
1cbb0e1c41
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue