+agenda-fix.el 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148
  1. (defun vulpea-project-p ()
  2. "Return non-nil if current buffer has any todo entry.
  3. TODO entries marked as done are ignored, meaning the this
  4. function returns nil if current buffer contains only completed
  5. tasks."
  6. (seq-find ; (3)
  7. (lambda (type)
  8. (eq type 'todo))
  9. (org-element-map ; (2)
  10. (org-element-parse-buffer 'headline) ; (1)
  11. 'headline
  12. (lambda (h)
  13. (org-element-property :todo-type h)))))
  14. (defun vulpea-project-update-tag ()
  15. "Update PROJECT tag in the current buffer."
  16. (when (and (not (active-minibuffer-window))
  17. (vulpea-buffer-p))
  18. (save-excursion
  19. (goto-char (point-min))
  20. (let* ((tags (vulpea-buffer-tags-get))
  21. (original-tags tags))
  22. (if (vulpea-project-p)
  23. (setq tags (cons "project" tags))
  24. (setq tags (remove "project" tags)))
  25. ;; cleanup duplicates
  26. (setq tags (seq-uniq tags))
  27. ;; update tags if changed
  28. (when (or (seq-difference tags original-tags)
  29. (seq-difference original-tags tags))
  30. (apply #'vulpea-buffer-tags-set tags))))))
  31. (defun vulpea-buffer-p ()
  32. "Return non-nil if the currently visited buffer is a note."
  33. (and buffer-file-name
  34. (string-prefix-p
  35. (expand-file-name (file-name-as-directory org-roam-directory))
  36. (file-name-directory buffer-file-name))))
  37. (defun vulpea-project-files ()
  38. "Return a list of note files containing 'project' tag." ;
  39. (seq-uniq
  40. (seq-map
  41. #'car
  42. (org-roam-db-query
  43. [:select [nodes:file]
  44. :from tags
  45. :left-join nodes
  46. :on (= tags:node-id nodes:id)
  47. :where (like tag (quote "%\"project\"%"))]))))
  48. (defun vulpea-agenda-files-update (&rest _)
  49. "Update the value of `org-agenda-files'."
  50. (setq org-agenda-files (vulpea-project-files)))
  51. (add-hook 'find-file-hook #'vulpea-project-update-tag)
  52. (add-hook 'before-save-hook #'vulpea-project-update-tag)
  53. (advice-add 'org-agenda :before #'vulpea-agenda-files-update)
  54. (advice-add 'org-todo-list :before #'vulpea-agenda-files-update)
  55. ;; functions borrowed from `vulpea' library
  56. ;; https://github.com/d12frosted/vulpea/blob/6a735c34f1f64e1f70da77989e9ce8da7864e5ff/vulpea-buffer.el
  57. (defun vulpea-buffer-tags-get ()
  58. "Return filetags value in current buffer."
  59. (vulpea-buffer-prop-get-list "filetags" "[ :]"))
  60. (defun vulpea-buffer-tags-set (&rest tags)
  61. "Set TAGS in current buffer.
  62. If filetags value is already set, replace it."
  63. (if tags
  64. (vulpea-buffer-prop-set
  65. "filetags" (concat ":" (string-join tags ":") ":"))
  66. (vulpea-buffer-prop-remove "filetags")))
  67. (defun vulpea-buffer-tags-add (tag)
  68. "Add a TAG to filetags in current buffer."
  69. (let* ((tags (vulpea-buffer-tags-get))
  70. (tags (append tags (list tag))))
  71. (apply #'vulpea-buffer-tags-set tags)))
  72. (defun vulpea-buffer-tags-remove (tag)
  73. "Remove a TAG from filetags in current buffer."
  74. (let* ((tags (vulpea-buffer-tags-get))
  75. (tags (delete tag tags)))
  76. (apply #'vulpea-buffer-tags-set tags)))
  77. (defun vulpea-buffer-prop-set (name value)
  78. "Set a file property called NAME to VALUE in buffer file.
  79. If the property is already set, replace its value."
  80. (setq name (downcase name))
  81. (org-with-point-at 1
  82. (let ((case-fold-search t))
  83. (if (re-search-forward (concat "^#\\+" name ":\\(.*\\)")
  84. (point-max) t)
  85. (replace-match (concat "#+" name ": " value) 'fixedcase)
  86. (while (and (not (eobp))
  87. (looking-at "^[#:]"))
  88. (if (save-excursion (end-of-line) (eobp))
  89. (progn
  90. (end-of-line)
  91. (insert "\n"))
  92. (forward-line)
  93. (beginning-of-line)))
  94. (insert "#+" name ": " value "\n")))))
  95. (defun vulpea-buffer-prop-set-list (name values &optional separators)
  96. "Set a file property called NAME to VALUES in current buffer.
  97. VALUES are quoted and combined into single string using
  98. `combine-and-quote-strings'.
  99. If SEPARATORS is non-nil, it should be a regular expression
  100. matching text that separates, but is not part of, the substrings.
  101. If nil it defaults to `split-string-default-separators', normally
  102. \"[ \f\t\n\r\v]+\", and OMIT-NULLS is forced to t.
  103. If the property is already set, replace its value."
  104. (vulpea-buffer-prop-set
  105. name (combine-and-quote-strings values separators)))
  106. (defun vulpea-buffer-prop-get (name)
  107. "Get a buffer property called NAME as a string."
  108. (org-with-point-at 1
  109. (when (re-search-forward (concat "^#\\+" name ": \\(.*\\)")
  110. (point-max) t)
  111. (buffer-substring-no-properties
  112. (match-beginning 1)
  113. (match-end 1)))))
  114. (defun vulpea-buffer-prop-get-list (name &optional separators)
  115. "Get a buffer property NAME as a list using SEPARATORS.
  116. If SEPARATORS is non-nil, it should be a regular expression
  117. matching text that separates, but is not part of, the substrings.
  118. If nil it defaults to `split-string-default-separators', normally
  119. \"[ \f\t\n\r\v]+\", and OMIT-NULLS is forced to t."
  120. (let ((value (vulpea-buffer-prop-get name)))
  121. (when (and value (not (string-empty-p value)))
  122. (split-string-and-unquote value separators))))
  123. (defun vulpea-buffer-prop-remove (name)
  124. "Remove a buffer property called NAME."
  125. (org-with-point-at 1
  126. (when (re-search-forward (concat "\\(^#\\+" name ":.*\n?\\)")
  127. (point-max) t)
  128. (replace-match ""))))