ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

REF clean up tags code in org-x parent file

This commit is contained in:
Nathan Dwarshuis 2021-04-18 13:37:43 -04:00
parent 77b0c061e2
commit a8a7ecb584
2 changed files with 47 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
etc/conf.org
View File

@ -2197,8 +2197,8 @@ I use tags for agenda filtering (primarily for GTD contexts, see below). Each ta
:END: :END:
Each group also has its own color, defined by its prefix symbol. Each group also has its own color, defined by its prefix symbol.
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(let ((grouped-tags (->> (--filter (stringp (car it)) org-tag-alist) (let ((grouped-tags (->> (-map #'car org-tag-alist)
(-map #'car) (-filter #'stringp)
(--group-by (elt it 0))))) (--group-by (elt it 0)))))
(cl-flet (cl-flet
((add-foreground ((add-foreground
@ -2207,8 +2207,8 @@ Each group also has its own color, defined by its prefix symbol.
(--map (list it :foreground color))))) (--map (list it :foreground color)))))
(setq org-tag-faces (setq org-tag-faces
(append (append
(add-foreground org-x-tag-location-context-prefix "PaleGreen") (add-foreground org-x-tag-location-prefix "PaleGreen")
(add-foreground org-x-tag-resource-context-prefix "SkyBlue") (add-foreground org-x-tag-resource-prefix "SkyBlue")
(add-foreground org-x-tag-misc-prefix "PaleGoldenrod") (add-foreground org-x-tag-misc-prefix "PaleGoldenrod")
(add-foreground org-x-tag-category-prefix "violet"))))) (add-foreground org-x-tag-category-prefix "violet")))))
#+END_SRC #+END_SRC

78
local/lib/org-x/org-x.el
View File

@ -39,10 +39,14 @@
;;; TAGS ;;; TAGS
(defconst org-x-tag-location-context-prefix ?@ (defun org-x-prepend-char (char string)
"Return STRING with CHAR prepended."
(concat (char-to-string char) string))
(defconst org-x-tag-location-prefix ?@
"Prefix character denoting location context tag.") "Prefix character denoting location context tag.")
(defconst org-x-tag-resource-context-prefix ?# (defconst org-x-tag-resource-prefix ?#
"Prefix character denoting resource context tag.") "Prefix character denoting resource context tag.")
(defconst org-x-tag-misc-prefix ?% (defconst org-x-tag-misc-prefix ?%
@ -51,89 +55,92 @@
(defconst org-x-tag-category-prefix ?_ (defconst org-x-tag-category-prefix ?_
"Prefix character denoting life category tag.") "Prefix character denoting life category tag.")
(defun org-x-prefix-string (char string)
(concat (char-to-string char) string))
(defconst org-x-tag-errand (defconst org-x-tag-errand
(org-x-prefix-string org-x-tag-location-context-prefix "errand") (org-x-prepend-char org-x-tag-location-prefix "errand")
"Tag denoting an errand location.") "Tag denoting an errand location.")
(defconst org-x-tag-home (defconst org-x-tag-home
(org-x-prefix-string org-x-tag-location-context-prefix "home") (org-x-prepend-char org-x-tag-location-prefix "home")
"Tag denoting a home location.") "Tag denoting a home location.")
(defconst org-x-tag-work (defconst org-x-tag-work
(org-x-prefix-string org-x-tag-location-context-prefix "work") (org-x-prepend-char org-x-tag-location-prefix "work")
"Tag denoting a work location.") "Tag denoting a work location.")
(defconst org-x-tag-travel (defconst org-x-tag-travel
(org-x-prefix-string org-x-tag-location-context-prefix "travel") (org-x-prepend-char org-x-tag-location-prefix "travel")
"Tag denoting a travel location.") "Tag denoting a travel location.")
(defconst org-x-tag-laptop (defconst org-x-tag-laptop
(org-x-prefix-string org-x-tag-resource-context-prefix "laptop") (org-x-prepend-char org-x-tag-resource-prefix "laptop")
"Tag denoting a laptop resource.") "Tag denoting a laptop resource.")
(defconst org-x-tag-tcult (defconst org-x-tag-tcult
(org-x-prefix-string org-x-tag-resource-context-prefix "tcult") (org-x-prepend-char org-x-tag-resource-prefix "tcult")
"Tag denoting a tissue-culture resource.") "Tag denoting a tissue-culture resource.")
(defconst org-x-tag-phone (defconst org-x-tag-phone
(org-x-prefix-string org-x-tag-resource-context-prefix "phone") (org-x-prepend-char org-x-tag-resource-prefix "phone")
"Tag denoting a phone resource.") "Tag denoting a phone resource.")
(defconst org-x-tag-note (defconst org-x-tag-note
(org-x-prefix-string org-x-tag-misc-prefix "note") (org-x-prepend-char org-x-tag-misc-prefix "note")
"Tag denoting a note.") "Tag denoting a note.")
(defconst org-x-tag-incubated (defconst org-x-tag-incubated
(org-x-prefix-string org-x-tag-misc-prefix "inc") (org-x-prepend-char org-x-tag-misc-prefix "inc")
"Tag denoting an incubated task.") "Tag denoting an incubated task.")
(defconst org-x-tag-maybe (defconst org-x-tag-maybe
(org-x-prefix-string org-x-tag-misc-prefix "maybe") (org-x-prepend-char org-x-tag-misc-prefix "maybe")
"Tag denoting a maybe task.") "Tag denoting a maybe task.")
(defconst org-x-tag-subdivision (defconst org-x-tag-subdivision
(org-x-prefix-string org-x-tag-misc-prefix "subdiv") (org-x-prepend-char org-x-tag-misc-prefix "subdiv")
"Tag denoting a task awaiting subdivision.") "Tag denoting a task awaiting subdivision.")
(defconst org-x-tag-flagged (defconst org-x-tag-flagged
(org-x-prefix-string org-x-tag-misc-prefix "flag") (org-x-prepend-char org-x-tag-misc-prefix "flag")
"Tag denoting a flagged task.") "Tag denoting a flagged task.")
(defconst org-x-tag-environmental (defconst org-x-tag-environmental
(org-x-prefix-string org-x-tag-category-prefix "env") (org-x-prepend-char org-x-tag-category-prefix "env")
"Tag denoting an environmental life category.") "Tag denoting an environmental life category.")
(defconst org-x-tag-financial (defconst org-x-tag-financial
(org-x-prefix-string org-x-tag-category-prefix "fin") (org-x-prepend-char org-x-tag-category-prefix "fin")
"Tag denoting a financial life category.") "Tag denoting a financial life category.")
(defconst org-x-tag-intellectual (defconst org-x-tag-intellectual
(org-x-prefix-string org-x-tag-category-prefix "int") (org-x-prepend-char org-x-tag-category-prefix "int")
"Tag denoting an intellectual life category.") "Tag denoting an intellectual life category.")
(defconst org-x-tag-metaphysical (defconst org-x-tag-metaphysical
(org-x-prefix-string org-x-tag-category-prefix "met") (org-x-prepend-char org-x-tag-category-prefix "met")
"Tag denoting an metaphysical life category.") "Tag denoting an metaphysical life category.")
(defconst org-x-tag-physical (defconst org-x-tag-physical
(org-x-prefix-string org-x-tag-category-prefix "phy") (org-x-prepend-char org-x-tag-category-prefix "phy")
"Tag denoting an physical life category.") "Tag denoting an physical life category.")
(defconst org-x-tag-professional (defconst org-x-tag-professional
(org-x-prefix-string org-x-tag-category-prefix "pro") (org-x-prepend-char org-x-tag-category-prefix "pro")
"Tag denoting a professional life category.") "Tag denoting a professional life category.")
(defconst org-x-tag-recreational (defconst org-x-tag-recreational
(org-x-prefix-string org-x-tag-category-prefix "rec") (org-x-prepend-char org-x-tag-category-prefix "rec")
"Tag denoting a recreational life category.") "Tag denoting a recreational life category.")
(defconst org-x-tag-social (defconst org-x-tag-social
(org-x-prefix-string org-x-tag-category-prefix "soc") (org-x-prepend-char org-x-tag-category-prefix "soc")
"Tag denoting a social life category.") "Tag denoting a social life category.")
(defconst org-x-tag-no-agenda "NA"
"Tag denoting a headlines that shouldn't go in the agenda.")
(defconst org-x-tag-refile "REFILE"
"Tag denoting a headlines that are to be refiled.")
;;; PROPERTIES ;;; PROPERTIES
(eval-and-compile (eval-and-compile
@ -221,6 +228,7 @@ entire subtrees to save time and ignore tasks")
;; org-element ;; org-element
;; TODO factor out the logbook config into a separate function
(defun org-x-element-first-lb-entry (headline) (defun org-x-element-first-lb-entry (headline)
"Return epoch time of most recent logbook item or clock from HEADLINE." "Return epoch time of most recent logbook item or clock from HEADLINE."
(let* ((config (list :log-into-drawer org-log-into-drawer (let* ((config (list :log-into-drawer org-log-into-drawer
@ -410,10 +418,11 @@ compared to REF-TIME. Returns nil if no timestamp is found."
(org-entry-get nil org-effort-property)) (org-entry-get nil org-effort-property))
(defun org-x-headline-has-context-p () (defun org-x-headline-has-context-p ()
"Return t if heading has a context." "Return non-nil if heading has a context tag."
(let ((tags (org-get-tags))) (let ((tags (org-get-tags)))
(or (> (length (org-x-filter-list-prefix "#" tags)) 0) (--any (memq (elt it 0) (list org-x-tag-resource-prefix
(> (length (org-x-filter-list-prefix "@" tags)) 0)))) org-x-tag-location-prefix))
tags)))
(defun org-x-headline-has-tag-p (tag) (defun org-x-headline-has-tag-p (tag)
"Return t if heading has tag TAG." "Return t if heading has tag TAG."
@ -903,7 +912,6 @@ don't log changes in the logbook."
(delete-region (region-beginning) (region-end)) (delete-region (region-beginning) (region-end))
(org-remove-empty-drawer-at (point))))) (org-remove-empty-drawer-at (point)))))
(defun org-x-clock-range (&optional arg) (defun org-x-clock-range (&optional arg)
"Add a completed clock entry to the current heading. "Add a completed clock entry to the current heading.
Does not touch the running clock. When called with one prefix Does not touch the running clock. When called with one prefix
@ -1133,12 +1141,12 @@ If BACK is t seek backward, else forward. Ignore blank lines."
(defun org-x-agenda-filter-non-context () (defun org-x-agenda-filter-non-context ()
"Filter all tasks with context tags." "Filter all tasks with context tags."
(interactive) (interactive)
(let* ((tags-list (mapcar #'car org-tag-alist)) (let ((context-tags
(context-tags (append (->> (-map #'car org-tag-alist)
(org-x-filter-list-prefix "@" tags-list) (-filter #'stringp)
(org-x-filter-list-prefix "#" tags-list)))) (--filter (memq (elt it 0) (list org-x-tag-resource-prefix
(setq org-agenda-tag-filter org-x-tag-location-prefix))))))
(mapcar (lambda (tag) (concat "-" tag)) context-tags)) (setq org-agenda-tag-filter (--map (concat "-" it) context-tags))
(org-agenda-filter-apply org-agenda-tag-filter 'tag))) (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
(defun org-x-agenda-filter-non-peripheral () (defun org-x-agenda-filter-non-peripheral ()