+agenda-fix.el 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173
  1. ;;; +agenda-fix.el --- Description -*- lexical-binding: t; -*-
  2. ;;
  3. ;; Copyright (C) 2023 Colin Powell
  4. ;;
  5. ;; Author: Colin Powell <colin@unbl.ink>
  6. ;; Maintainer: Colin Powell <colin@unbl.ink>
  7. ;; Created: November 14, 2023
  8. ;; Modified: November 14, 2023
  9. ;; Version: 0.0.1
  10. ;; Keywords: abbrev bib c calendar comm convenience data docs emulations extensions faces files frames games hardware help hypermedia i18n internal languages lisp local maint mail matching mouse multimedia news outlines processes terminals tex tools unix vc wp
  11. ;; Homepage: https://github.com/powellc/+pdf-page-nums
  12. ;; Package-Requires: ((emacs "24.3"))
  13. ;;
  14. ;; This file is not part of GNU Emacs.
  15. ;;
  16. ;;; Commentary:
  17. ;;; Provides some helper functions that dynamically include files in a cache for org mode agenda.
  18. ;;
  19. ;; Description
  20. ;;
  21. ;;; Code:
  22. (provide '+agenda-fix)
  23. (defun vulpea-project-p ()
  24. "Return non-nil if current buffer has any todo entry.
  25. TODO entries marked as done are ignored, meaning the this
  26. function returns nil if current buffer contains only completed
  27. tasks."
  28. (seq-find ; (3)
  29. (lambda (type)
  30. (eq type 'todo))
  31. (org-element-map ; (2)
  32. (org-element-parse-buffer 'headline) ; (1)
  33. 'headline
  34. (lambda (h)
  35. (org-element-property :todo-type h)))))
  36. (defun vulpea-project-update-tag ()
  37. "Update PROJECT tag in the current buffer."
  38. (when (and (not (active-minibuffer-window))
  39. (vulpea-buffer-p))
  40. (save-excursion
  41. (goto-char (point-min))
  42. (let* ((tags (vulpea-buffer-tags-get))
  43. (original-tags tags))
  44. (if (vulpea-project-p)
  45. (setq tags (cons "project" tags))
  46. (setq tags (remove "project" tags)))
  47. ;; cleanup duplicates
  48. (setq tags (seq-uniq tags))
  49. ;; update tags if changed
  50. (when (or (seq-difference tags original-tags)
  51. (seq-difference original-tags tags))
  52. (apply #'vulpea-buffer-tags-set tags))))))
  53. (defun vulpea-buffer-p ()
  54. "Return non-nil if the currently visited buffer is a note."
  55. (and buffer-file-name
  56. (string-prefix-p
  57. (expand-file-name (file-name-as-directory org-roam-directory))
  58. (file-name-directory buffer-file-name))))
  59. (defun vulpea-project-files ()
  60. "Return a list of note files containing 'project' tag." ;
  61. (seq-uniq
  62. (seq-map
  63. #'car
  64. (org-roam-db-query
  65. [:select [nodes:file]
  66. :from tags
  67. :left-join nodes
  68. :on (= tags:node-id nodes:id)
  69. :where (like tag (quote "%\"project\"%"))]))))
  70. (defun vulpea-agenda-files-update (&rest _)
  71. "Update the value of `org-agenda-files'."
  72. (setq org-agenda-files (vulpea-project-files)))
  73. (add-hook 'find-file-hook #'vulpea-project-update-tag)
  74. (add-hook 'before-save-hook #'vulpea-project-update-tag)
  75. (advice-add 'org-agenda :before #'vulpea-agenda-files-update)
  76. (advice-add 'org-todo-list :before #'vulpea-agenda-files-update)
  77. ;; functions borrowed from `vulpea' library
  78. ;; https://github.com/d12frosted/vulpea/blob/6a735c34f1f64e1f70da77989e9ce8da7864e5ff/vulpea-buffer.el
  79. (defun vulpea-buffer-tags-get ()
  80. "Return filetags value in current buffer."
  81. (vulpea-buffer-prop-get-list "filetags" "[ :]"))
  82. (defun vulpea-buffer-tags-set (&rest tags)
  83. "Set TAGS in current buffer.
  84. If filetags value is already set, replace it."
  85. (if tags
  86. (vulpea-buffer-prop-set
  87. "filetags" (concat ":" (string-join tags ":") ":"))
  88. (vulpea-buffer-prop-remove "filetags")))
  89. (defun vulpea-buffer-tags-add (tag)
  90. "Add a TAG to filetags in current buffer."
  91. (let* ((tags (vulpea-buffer-tags-get))
  92. (tags (append tags (list tag))))
  93. (apply #'vulpea-buffer-tags-set tags)))
  94. (defun vulpea-buffer-tags-remove (tag)
  95. "Remove a TAG from filetags in current buffer."
  96. (let* ((tags (vulpea-buffer-tags-get))
  97. (tags (delete tag tags)))
  98. (apply #'vulpea-buffer-tags-set tags)))
  99. (defun vulpea-buffer-prop-set (name value)
  100. "Set a file property called NAME to VALUE in buffer file.
  101. If the property is already set, replace its value."
  102. (setq name (downcase name))
  103. (org-with-point-at 1
  104. (let ((case-fold-search t))
  105. (if (re-search-forward (concat "^#\\+" name ":\\(.*\\)")
  106. (point-max) t)
  107. (replace-match (concat "#+" name ": " value) 'fixedcase)
  108. (while (and (not (eobp))
  109. (looking-at "^[#:]"))
  110. (if (save-excursion (end-of-line) (eobp))
  111. (progn
  112. (end-of-line)
  113. (insert "\n"))
  114. (forward-line)
  115. (beginning-of-line)))
  116. (insert "#+" name ": " value "\n")))))
  117. (defun vulpea-buffer-prop-set-list (name values &optional separators)
  118. "Set a file property called NAME to VALUES in current buffer.
  119. VALUES are quoted and combined into single string using
  120. `combine-and-quote-strings'.
  121. If SEPARATORS is non-nil, it should be a regular expression
  122. matching text that separates, but is not part of, the substrings.
  123. If nil it defaults to `split-string-default-separators', normally
  124. \"[ \f\t\n\r\v]+\", and OMIT-NULLS is forced to t.
  125. If the property is already set, replace its value."
  126. (vulpea-buffer-prop-set
  127. name (combine-and-quote-strings values separators)))
  128. (defun vulpea-buffer-prop-get (name)
  129. "Get a buffer property called NAME as a string."
  130. (org-with-point-at 1
  131. (when (re-search-forward (concat "^#\\+" name ": \\(.*\\)")
  132. (point-max) t)
  133. (buffer-substring-no-properties
  134. (match-beginning 1)
  135. (match-end 1)))))
  136. (defun vulpea-buffer-prop-get-list (name &optional separators)
  137. "Get a buffer property NAME as a list using SEPARATORS.
  138. If SEPARATORS is non-nil, it should be a regular expression
  139. matching text that separates, but is not part of, the substrings.
  140. If nil it defaults to `split-string-default-separators', normally
  141. \"[ \f\t\n\r\v]+\", and OMIT-NULLS is forced to t."
  142. (let ((value (vulpea-buffer-prop-get name)))
  143. (when (and value (not (string-empty-p value)))
  144. (split-string-and-unquote value separators))))
  145. (defun vulpea-buffer-prop-remove (name)
  146. "Remove a buffer property called NAME."
  147. (org-with-point-at 1
  148. (when (re-search-forward (concat "\\(^#\\+" name ":.*\n?\\)")
  149. (point-max) t)
  150. (replace-match ""))))