From 4fac5a1d8423ce8fe3b2bb65d616c10f441426c8 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 26 Dec 2021 13:08:38 -0500 Subject: [PATCH] ENH use discrete file lists for org and agenda view --- etc/conf.org | 204 +++++++++++++++++++-------------------- local/lib/org-x/org-x.el | 104 +++++++++++++++++++- 2 files changed, 200 insertions(+), 108 deletions(-) diff --git a/etc/conf.org b/etc/conf.org index 16e3d1e..df58e12 100644 --- a/etc/conf.org +++ b/etc/conf.org @@ -2689,7 +2689,13 @@ The agenda files are limited to as few as possible to keep scanning and startup "~/Org/projects" "~/Org/reference/goals" "~/Org/reference/meetings" - "~/Org/reference/peripheral.org")) + "~/Org/reference/peripheral.org") + org-x-daily-planner-file "metablox.org" + org-x-action-files (list "general.org" "projects/*.org") + org-x-incubator-files (list "incubator.org") + org-x-capture-file "capture.org" + org-x-endpoint-goal-file "reference/goals/endpoint.org" + org-x-lifetime-goal-file "reference/goals/lifetime.org") #+END_SRC **** appearence ***** sticky agendas @@ -3227,9 +3233,11 @@ In the order of display 4. habits" (interactive) (nd/org-agenda-call "Timeblock" 'agenda "" - '((org-agenda-skip-function #'org-x-calendar-skip-function) + `((org-agenda-skip-function #'org-x-calendar-skip-function) (org-agenda-sorting-strategy '(time-up deadline-up scheduled-up category-keep)) (org-agenda-include-diary t) + (org-agenda-files ',(cons (org-x-get-daily-plan-file) + (org-x-get-action-files))) (org-super-agenda-groups `(,(nd/org-def-super-agenda-pred "Morning routine" (org-x-headline-has-property org-x-prop-routine @@ -3291,7 +3299,8 @@ In the order of display (org-x-update-goal-link-ids) (nd/org-agenda-call "Goals" 'todo org-x-kw-todo `((org-agenda-overriding-header "Goals") - (org-agenda-files '("~/Org/reference/goals")) + (org-agenda-files ',(list (org-x-get-endpoint-goal-file) + (org-x-get-lifetime-goal-file))) (org-agenda-sorting-strategy '(time-up scheduled-down)) (org-super-agenda-groups ',gs)))))) @@ -3302,6 +3311,7 @@ In the order of display '((org-agenda-skip-function #'org-x-calendar-skip-function) (org-agenda-sorting-strategy '(time-up deadline-up scheduled-up category-keep)) (org-agenda-include-diary t) + (org-agenda-files ',(org-x-get-action-and-incubator-files)) (org-super-agenda-groups `((:name "Habits" :order 1 :habit t) (:discard (:time-grid t)) @@ -3332,8 +3342,6 @@ tasks that are inert (which I may move to the incubator during a review phase)" (interactive) (let ((match (nd/org-mk-match-string - - org-x-tag-no-agenda - - org-x-tag-refile - org-x-tag-incubated / org-x-kw-todo | org-x-kw-next @@ -3345,6 +3353,7 @@ review phase)" (org-agenda-skip-function #'org-x-task-skip-function) (org-agenda-todo-ignore-with-date t) (org-agenda-sorting-strategy '(user-defined-up category-keep)) + (org-agenda-files ',(org-x-get-action-and-incubator-files)) (org-super-agenda-groups ',(nd/org-def-super-agenda-automap (let* ((is-atomic (org-x-headline-is-atomic-task-p)) @@ -3360,14 +3369,12 @@ review phase)" (defun nd/org-agenda-projects () "Show the projects agenda view." (interactive) - (let ((match (nd/org-mk-match-string - - org-x-tag-no-agenda - - org-x-tag-refile - - org-x-tag-incubated))) - (nd/org-agenda-call "Projects" 'tags-todo match + (let ((match (nd/org-mk-match-string - org-x-tag-incubated))) + (nd/org-agenda-call "Projects" 'tags-todo match `((org-agenda-overriding-header "Projects") (org-agenda-skip-function #'org-x-project-skip-function) (org-agenda-sorting-strategy '(category-keep)) + (org-agenda-files ',(org-x-get-action-and-incubator-files)) (org-super-agenda-groups ',(nd/org-def-super-agenda-automap (let* ((status (org-x-headline-get-project-status)) @@ -3380,15 +3387,12 @@ review phase)" (defun nd/org-agenda-incubator () "Show the incubator agenda view." (interactive) - (let ((match - (nd/org-mk-match-string - - org-x-tag-no-agenda - - org-x-tag-refile - + org-x-tag-incubated))) + (let ((match (nd/org-mk-match-string + org-x-tag-incubated))) (nd/org-agenda-call "Incubator" 'tags-todo match - '((org-agenda-overriding-header "Incubator") + `((org-agenda-overriding-header "Incubator") (org-agenda-skip-function #'org-x-incubator-skip-function) (org-agenda-sorting-strategy '(category-keep)) + (org-agenda-files ',(org-x-get-action-and-incubator-files)) (org-super-agenda-groups `((:name "Past Deadlines" :deadline past) (:name "Future Deadlines" :deadline future) @@ -3407,58 +3411,53 @@ review phase)" (defun nd/org-agenda-periodical () "Show the periodical agenda view." (interactive) - (let ((match (nd/org-mk-match-string - org-x-tag-no-agenda - - org-x-tag-refile))) - (nd/org-agenda-call "Periodicals" 'tags match - `((org-agenda-overriding-header "Periodical Status") - (org-agenda-skip-function #'org-x-periodical-skip-function) - (org-agenda-sorting-strategy '(category-keep)) - (org-super-agenda-groups - ',(nd/org-def-super-agenda-automap - (cl-case (org-x-headline-get-periodical-status) - (:uninit "0. Uninitialized") - (:unscheduled "0. Unscheduled") - (:empt "1. Empty") - (:actv "2. Active") - (t "3. Other")))))))) + (nd/org-agenda-call "Periodicals" 'search "*" + `((org-agenda-overriding-header "Periodical Status") + (org-agenda-skip-function #'org-x-periodical-skip-function) + (org-agenda-sorting-strategy '(category-keep)) + (org-agenda-files ',(org-x-get-action-files)) + (org-super-agenda-groups + ',(nd/org-def-super-agenda-automap + (cl-case (org-x-headline-get-periodical-status) + (:uninit "0. Uninitialized") + (:unscheduled "0. Unscheduled") + (:empt "1. Empty") + (:actv "2. Active") + (t "3. Other"))))))) (defun nd/org-agenda-iterators () "Show the iterator agenda view." (interactive) - (let ((match (nd/org-mk-match-string - org-x-tag-no-agenda - - org-x-tag-refile))) - (nd/org-agenda-call "Iterators" 'tags match - `((org-agenda-overriding-header "Iterator Status") - (org-agenda-skip-function #'org-x-iterator-skip-function) - (org-agenda-sorting-strategy '(category-keep)) - (org-super-agenda-groups - ',(nd/org-def-super-agenda-automap - (cl-case (org-x-headline-get-iterator-status) - (:uninit "0. Uninitialized") - (:project-error "0. Project Error") - (:unscheduled "0. Unscheduled") - (:empt "1. Empty") - (:actv "2. Active") - (t "3. Other")))))))) + (nd/org-agenda-call "Iterators" 'search "*" + `((org-agenda-overriding-header "Iterator Status") + (org-agenda-skip-function #'org-x-iterator-skip-function) + (org-agenda-sorting-strategy '(category-keep)) + (org-agenda-files ',(org-x-get-action-files)) + (org-super-agenda-groups + ',(nd/org-def-super-agenda-automap + (cl-case (org-x-headline-get-iterator-status) + (:uninit "0. Uninitialized") + (:project-error "0. Project Error") + (:unscheduled "0. Unscheduled") + (:empt "1. Empty") + (:actv "2. Active") + (t "3. Other"))))))) (defun nd/org-agenda-refile () "Show the refile agenda view." (interactive) - (let ((match (nd/org-mk-match-string - org-x-tag-no-agenda - - org-x-tag-refile))) - (nd/org-agenda-call "Refile" 'tags org-x-tag-refile - '((org-agenda-overriding-header "Tasks to Refile"))))) + (nd/org-agenda-call "Refile" 'search "*" + `((org-agenda-overriding-header "Tasks to Refile") + (org-agenda-files '(,(org-x-get-capture-file)))))) (defun nd/org-agenda-errors () "Show the critical errors agenda view." (interactive) - (let ((match (nd/org-mk-match-string - - org-x-tag-no-agenda - - org-x-tag-refile - - org-x-tag-incubated))) + (let ((match (nd/org-mk-match-string - org-x-tag-incubated))) (nd/org-agenda-call "Errors" 'tags match - '((org-agenda-overriding-header "Critical Errors") + `((org-agenda-overriding-header "Critical Errors") (org-agenda-skip-function #'org-x-error-skip-function) + (org-agenda-files ',(org-x-get-action-files)) (org-super-agenda-groups `(,(nd/org-def-super-agenda-pred "Discontinuous Projects" (org-x-headline-is-discontinous-project-task-p)) @@ -3477,59 +3476,56 @@ review phase)" (org-x-headline-is-open-meeting-without-effort-p)) (:discard (:anything t)))))))) -(defun nd/org-agenda-meetings () - "Show the meetings agenda view." - (interactive) - (let ((match (nd/org-mk-match-string - - org-x-tag-refile - + org-x-tag-meeting))) - (nd/org-agenda-call "Meetings" 'tags-todo match - '((org-agenda-overriding-header "Meetings") - ;; seems like this should be in the agenda groups, but works fine here - (org-agenda-skip-function - (lambda () - (-when-let (ts (org-x--headline-get-property-epoch-time "SCHEDULED")) - (when (< ts (- (float-time) 10368000)) - (org-x-skip-heading))))) - (org-agenda-sorting-strategy '(time-up scheduled-down)) - (org-super-agenda-groups - `(,(nd/org-def-super-agenda-pred "Open: Unscheduled Meetings" - (org-x-headline-is-open-unscheduled-meeting-p)) - ,(nd/org-def-super-agenda-pred "Open: Invalid States" - (org-x-headline-is-open-meeting-with-invalid-keyword-p)) - ,(nd/org-def-super-agenda-pred "Open: Needs Agenda Items" - (org-x-headline-is-open-meeting-without-agenda-p)) - ,(nd/org-def-super-agenda-pred "Open: Missing Location" - (org-x-headline-is-open-meeting-without-location-p)) - ,(nd/org-def-super-agenda-pred "Open: Scheduled" - (org-x-headline-is-open-meeting-p)) - ,(nd/org-def-super-agenda-pred "Closed: Unresolved Agenda" - (org-x-headline-is-closed-meeting-with-unresolved-agenda-p)) - ,(nd/org-def-super-agenda-pred "Closed: Needs Action Items" - (org-x-headline-is-closed-meeting-without-action-items-p)) - ,(nd/org-def-super-agenda-pred "Closed: Resolved" - (org-x-headline-is-closed-meeting-p)) - (:discard (:anything t)))))))) +;; (defun nd/org-agenda-meetings () +;; "Show the meetings agenda view." +;; (interactive) +;; (let ((match (nd/org-mk-match-string +;; - org-x-tag-refile +;; + org-x-tag-meeting))) +;; (nd/org-agenda-call "Meetings" 'tags-todo match +;; '((org-agenda-overriding-header "Meetings") +;; ;; seems like this should be in the agenda groups, but works fine here +;; (org-agenda-skip-function +;; (lambda () +;; (-when-let (ts (org-x--headline-get-property-epoch-time "SCHEDULED")) +;; (when (< ts (- (float-time) 10368000)) +;; (org-x-skip-heading))))) +;; (org-agenda-sorting-strategy '(time-up scheduled-down)) +;; (org-super-agenda-groups +;; `(,(nd/org-def-super-agenda-pred "Open: Unscheduled Meetings" +;; (org-x-headline-is-open-unscheduled-meeting-p)) +;; ,(nd/org-def-super-agenda-pred "Open: Invalid States" +;; (org-x-headline-is-open-meeting-with-invalid-keyword-p)) +;; ,(nd/org-def-super-agenda-pred "Open: Needs Agenda Items" +;; (org-x-headline-is-open-meeting-without-agenda-p)) +;; ,(nd/org-def-super-agenda-pred "Open: Missing Location" +;; (org-x-headline-is-open-meeting-without-location-p)) +;; ,(nd/org-def-super-agenda-pred "Open: Scheduled" +;; (org-x-headline-is-open-meeting-p)) +;; ,(nd/org-def-super-agenda-pred "Closed: Unresolved Agenda" +;; (org-x-headline-is-closed-meeting-with-unresolved-agenda-p)) +;; ,(nd/org-def-super-agenda-pred "Closed: Needs Action Items" +;; (org-x-headline-is-closed-meeting-without-action-items-p)) +;; ,(nd/org-def-super-agenda-pred "Closed: Resolved" +;; (org-x-headline-is-closed-meeting-p)) +;; (:discard (:anything t)))))))) (defun nd/org-agenda-archive () "Show the archive agenda view." (interactive) - (let ((match (nd/org-mk-match-string - - org-x-tag-no-agenda - - org-x-tag-refile - - org-x-tag-no-archive))) - (nd/org-agenda-call "Archive" 'tags-todo match - '((org-agenda-overriding-header "Archive") - (org-agenda-skip-function #'org-x-archive-skip-function) - (org-agenda-sorting-strategy '(category-keep)) - (org-super-agenda-groups - `(,(nd/org-def-super-agenda-pred "Atomic Tasks" - (org-x-headline-is-atomic-task-p)) - ,(nd/org-def-super-agenda-pred "Toplevel Projects" - (org-x-headline-is-toplevel-project-p)) - ,(nd/org-def-super-agenda-pred "Projects" - (org-x-headline-is-project-p)) - (:name "Appointments" :anything))))))) + (nd/org-agenda-call "Archive" 'search "*" + `((org-agenda-overriding-header "Archive") + (org-agenda-skip-function #'org-x-archive-skip-function) + (org-agenda-sorting-strategy '(category-keep)) + (org-agenda-files ',(org-x-get-action-files)) + (org-super-agenda-groups + `(,(nd/org-def-super-agenda-pred "Atomic Tasks" + (org-x-headline-is-atomic-task-p)) + ,(nd/org-def-super-agenda-pred "Toplevel Projects" + (org-x-headline-is-toplevel-project-p)) + ,(nd/org-def-super-agenda-pred "Projects" + (org-x-headline-is-project-p)) + (:name "Appointments" :anything)))))) #+END_SRC ** tracking and analytics :PROPERTIES: @@ -4910,7 +4906,7 @@ The function keys are nice because they are almost (not always) free in every mo ("I" #'nd/org-agenda-iterators) ("P" #'nd/org-agenda-periodical) ("a" #'nd/org-agenda-archive) - ("m" #'nd/org-agenda-meetings) + ;; ("m" #'nd/org-agenda-meetings) ("e" #'nd/org-agenda-errors)) (global-set-key (kbd "") 'org-capture) diff --git a/local/lib/org-x/org-x.el b/local/lib/org-x/org-x.el index 943ca7d..dcdd2ca 100644 --- a/local/lib/org-x/org-x.el +++ b/local/lib/org-x/org-x.el @@ -246,6 +246,32 @@ (f-join org-directory "metablox.org") "The file to which metablocks will be written.") +;; files and directories (all relative to `org-directory') + +(defvar org-x-action-files nil + "List of relative paths or globs that hold actions (not incubated).") + +(defvar org-x-incubator-files nil + "List of relative paths or globs that hold incubated actions.") + +(defvar org-x-reference-files nil + "List of relative paths or globs that hold referenced headlines.") + +(defvar org-x-capture-file nil + "Path to capture file.") + +(defvar org-x-endpoint-goal-file nil + "Path to endpoint goal file.") + +(defvar org-x-lifetime-goal-file nil + "Path to lifetime goal file.") + +(defvar org-x-daily-planner-file nil + "Path to daily plan file.") + +(defvar org-x-meeting-archive-file nil + "Path to meeting archive file.") + ;;; INTERNAL CONSTANTS ;; TODO ;unscheduled should trump all @@ -335,6 +361,76 @@ WHICH is passed to the one argument of `org-ml-parse-headlines'." (org-x-with-file path (org-ml-parse-headlines which))) +;;; ORG FILE LOCATIONS + +(defun org-x--abs-org-path (path) + "Return PATH as an absolute path string. +PATH is a assumed to be a path relative to `org-directory'. +If PATH is not relative, return nil and print a warning." + (if (f-relative-p path) + (f-canonical (f-join org-directory path)) + (message "WARNING: %s is not a relative path" path))) + +(defun org-x--valid-org-file-p (path) + "Return t if PATH points to a valid org file. +Valid means that it exists and ends in '.org'." + (cond + ((not (f-file-p path)) + (message "WARNING: %s does not exist; ignoring" path) + nil) + ((not (s-matches-p ".*\\.org" path)) + (message "WARNING: %s does not end with '.org'; ignoring" path) + nil) + (t + t))) + +(defun org-x--expand-path-list (globs) + "Return GLOBS as expanded list of paths. +GLOBS is a list of strings to be consumed by `f-glob'. Only +expand files that end in '.org' and that exist are returned. All +members of GLOBS should be relative to `org-directory'." + (->> (-map #'org-x--abs-org-path globs) + (-non-nil) + (-mapcat #'f-glob) + (-filter #'org-x--valid-org-file-p) + (-uniq))) + +(defun org-x--expand-path (path) + "Return PATH as an expanded path. +PATH must be relative to `org-directory' and end in '.org'." + (-when-let (a (org-x--abs-org-path path)) + (when (org-x--valid-org-file-p a) + a))) + +(defun org-x-get-endpoint-goal-file () + "Return the absolute path of `org-x-endpoint-goal-file'." + (org-x--expand-path org-x-endpoint-goal-file)) + +(defun org-x-get-lifetime-goal-file () + "Return the absolute path of `org-x-lifetime-goal-file'." + (org-x--expand-path org-x-lifetime-goal-file)) + +(defun org-x-get-capture-file () + "Return the absolute path of `org-x-capture-file'." + (org-x--expand-path org-x-capture-file)) + +(defun org-x-get-action-files () + "Return the absolute path of `org-x-action-files'." + (org-x--expand-path-list org-x-action-files)) + +(defun org-x-get-daily-plan-file () + "Return the absolute path of `org-x-action-files'." + (org-x--expand-path org-x-daily-planner-file)) + +(defun org-x-get-incubator-files () + "Return the absolute path of `org-x-incubator-files'." + (org-x--expand-path-list org-x-incubator-files)) + +(defun org-x-get-action-and-incubator-files () + "Return combined list of paths for incubator and action files." + (append (org-x-get-action-files) + (org-x-get-incubator-files))) + ;;; STATEFUL BUFFER HEADLINE FUNCTIONS ;; All of these functions operate on the current headline @@ -992,9 +1088,9 @@ should be this function again)." (setq org-x-agenda-goal-task-ids (-mapcat #'org-x-buffer-get-goal-ids (org-files-list)) org-x-agenda-goal-endpoint-ids - (org-x-buffer-get-goal-ids "~/Org/reference/goals/endpoint.org") + (org-x-buffer-get-goal-ids (org-x-get-endpoint-goal-file)) org-x-agenda-lifetime-ids - (org-x-get-ids-in-file "~/Org/reference/goals/lifetime.org"))) + (org-x-get-ids-in-file (org-x-get-lifetime-goal-file)))) (defun org-x-buffer-get-id-headlines (file) (cl-flet @@ -1033,8 +1129,8 @@ Assumes point is on a valid headline or org mode file." (let ((f (f-base path))) (->> (org-x-buffer-get-id-headlines path) (--map (mk-entry path f it)))))) - (-let* ((col (append (get-headlines "~/Org/reference/goals/lifetime.org") - (get-headlines "~/Org/reference/goals/endpoint.org"))) + (-let* ((col (append (get-headlines (org-x-get-lifetime-goal-file)) + (get-headlines (org-x-get-endpoint-goal-file)))) (res (completing-read "Goal to link: " col nil t)) ((&plist :title :path :id :point) (alist-get res col nil nil #'equal)) (target-id (if id id