From d0fa5fb5f22b0fee8a4accfceff570fdf94be725 Mon Sep 17 00:00:00 2001 From: Marc Date: Sat, 3 May 2025 06:43:15 +0200 Subject: [PATCH] agenda now dynamically based on files with tag "agenda" --- config.org | 162 ++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 154 insertions(+), 8 deletions(-) diff --git a/config.org b/config.org index dafacf4..7ba6ac4 100644 --- a/config.org +++ b/config.org @@ -1182,6 +1182,144 @@ https://github.com/jwiegley/use-package/issues/319 :map org-mode-map ("S-" . org-shiftright) ("S-" . org-shiftleft)) :init + (defun my--org-files-with-tag (dir tag) + "Return a list of .org files in DIR recursively that have a #+FILETAGS: TAG." + (let ((files (directory-files-recursively dir "\\.org$")) + (tag-re (format "^#\\+filetags:.*\\:%s\\:" (regexp-quote tag)))) + (seq-filter + (lambda (file) + (with-temp-buffer + (insert-file-contents file nil 0 1000) + (goto-char (point-min)) + (re-search-forward tag-re nil t))) + files))) + + (defun my--org-agenda-files-update () + "Update `org-agenda-files` from MY--PATH_ORG_FILES based on file tag :agenda:." + (when (derived-mode-p 'org-mode) + (setq org-agenda-files (my--org-files-with-tag MY--PATH_ORG_FILES "agenda")))) + + (defun my--todo-p () + "Return non-nil if current buffer has any todo entry. + +TODO entries marked as done are ignored, meaning this function +returns nil if current buffer contains only completed tasks." + (seq-find + (lambda (type) + (eq type 'todo)) + (org-element-map + (org-element-parse-buffer 'headline) + 'headline + (lambda (h) + (org-element-property :todo-type h))))) + + (defun my--todo-update-tag () + "Update AGENDA tag in the current buffer." + (when (and (not (active-minibuffer-window)) + (my--buffer-note-p)) + (save-excursion + (goto-char (point-min)) + (let* ((tags (my--buffer-tags-get)) + (original-tags tags)) + (if (my--todo-p) + (setq tags (cons "agenda" tags)) + (setq tags (remove "agenda" tags))) + + ;;cleanup duplicates + (when (or (seq-difference tags original-tags) + (seq-difference original-tags tags)) + (apply #'my--buffer-tags-set tags)))))) + + (defun my--buffer-note-p () + "Return non-nil if the currently visited buffer is a note." + (and buffer-file-name + (string-prefix-p + (expand-file-name (file-name-as-directory MY--PATH_ORG_FILES)) + (file-name-directory buffer-file-name)))) + + (defun my--buffer-tags-get () + "Return filetags value in current buffer." + (my--buffer-prop-get-list "filetags" "[ :]")) + + (defun my--buffer-tags-set (&rest tags) + "Set TAGS in current buffer. +If filetags value is already set, replace it." + (if tags + (my--buffer-prop-set + "filetags" (concat ":" (string-join tags ":") ":")) + (my--buffer-prop-remove "filetags"))) + + (defun my--buffer-tags-add (tag) + "Add a TAG to filetags in current buffer." + (let* ((tags (my--buffer-tags-get)) + (tags (append tags (list tag)))) + (apply #'my--buffer-tags-set tags))) + + (defun my--buffer-tags-remove (tag) + "Remove a TAG from filetags in current buffer." + (let* ((tags (my--buffer-tags-get)) + (tags (delete tag tags))) + (apply #'my--buffer-tags-set tags))) + + (defun my--buffer-prop-set (name value) + "Set a file property called NAME to VALUE in buffer file. +If the property is already set, replace its value." + (setq name (downcase name)) + (org-with-point-at 1 + (let ((case-fold-search t)) + (if (re-search-forward (concat "^#\\+" name ":\\(.*\\)") + (point-max) t) + (replace-match (concat "#+" name ": " value) 'fixedcase) + (while (and (not (eobp)) + (looking-at "^[#:]")) + (if (save-excursion (end-of-line) (eobp)) + (progn + (end-of-line) + (insert "\n")) + (forward-line) + (beginning-of-line))) + (insert "#+" name ": " value "\n"))))) + + (defun my--buffer-prop-set-list (name values &optional separators) + "Set a file property called NAME to VALUES in current buffer. +VALUES are quoted and combined into single string using +`combine-and-quote-strings'. +If SEPARATORS is non-nil, it should be a regular expression +matching text that separates, but is not part of, the substrings. +If nil it defaults to `split-string-and-unquote', normally +\"[ \f\t\n\r\v]+\", and OMIT-NULLS is forced to t. +If the property is already set, replace its value." + (my--buffer-prop-set + name (combine-and-quote-strings values separators))) + + (defun my--buffer-prop-get (name) + "Get a buffer property called NAME as a string." + (org-with-point-at 1 + (when (re-search-forward (concat "^#\\+" name ": \\(.*\\)") + (point-max) t) + (buffer-substring-no-properties + (match-beginning 1) + (match-end 1))))) + + (defun my--buffer-prop-get-list (name &optional separators) + "Get a buffer property NAME as a list using SEPARATORS. +If SEPARATORS is non-nil, it should be a regular expression +matching text that separates, but is not part of, the substrings. +If nil it defaults to `split-string-default-separators', normally +\"[ \f\t\n\r\v]+\", and OMIT-NULLS is forced to t." + (let ((value (my--buffer-prop-get name))) + (when (and value (not (string-empty-p value))) + (split-string-and-unquote value separators)))) + + (defun my--buffer-prop-remove (name) + "Remove a buffer property called NAME." + (org-with-point-at 1 + (when (re-search-forward (concat "\\(^#\\+" name ":.*\n?\\)") + (point-max) t) + (replace-match "")))) + + + ;; (defun my--org-agenda-files-set () ;; "Sets default agenda files. ;; Necessary when updating roam agenda todos." @@ -1192,14 +1330,14 @@ https://github.com/jwiegley/use-package/issues/319 ;; (nconc org-agenda-files ;; (directory-files-recursively MY--PATH_ORG_FILES_MOBILE "\\.org$")))) ;; (my--org-agenda-files-set) - (setq org-agenda-files - (cl-remove-if (lambda (file) - ;; exclude some subdirs - (let ((excluded-dirs '("notes" "dummy"))) - (cl-some (lambda (dir) (string-match-p (concat "/" dir "/") file)) - excluded-dirs))) -;; (string-match-p "/notes/" file)) - (directory-files-recursively MY--PATH_ORG_FILES "\\.org$"))) + (setq org-agenda-files (my--org-files-with-tag MY--PATH_ORG_FILES "agenda")) +;; (cl-remove-if (lambda (file) +;; ;; exclude some subdirs +;; (let ((excluded-dirs '("notes" "dummy"))) +;; (cl-some (lambda (dir) (string-match-p (concat "/" dir "/") file)) +;; excluded-dirs))) +;; ;; (string-match-p "/notes/" file)) +; (directory-files-recursively MY--PATH_ORG_FILES "\\.org$")) ;;) (defun my--org-skip-subtree-if-priority (priority) "Skip an agenda subtree if it has a priority of PRIORITY. @@ -1211,6 +1349,14 @@ https://github.com/jwiegley/use-package/issues/319 (if (= pri-value pri-current) subtree-end nil))) + (add-hook 'find-file-hook #'my--todo-update-tag) + (add-hook 'before-save-hook #'my--todo-update-tag) + (add-hook 'after-save-hook #'my--org-agenda-files-update) +;; (add-to-list 'org-tags-exclude-from-inheritance "agenda") ;;removed in org 9.5 + ;; use inheritance except for "agenda" + (setq org-use-tag-inheritance + (lambda (tags) (remove "agenda" tags))) + :config (when *work_remote* (org-add-link-type "outlook" 'my--org-outlook-open)