|
|
@@ -0,0 +1,148 @@
|
|
|
+(defun vulpea-project-p ()
|
|
|
+ "Return non-nil if current buffer has any todo entry.
|
|
|
+
|
|
|
+TODO entries marked as done are ignored, meaning the this
|
|
|
+function returns nil if current buffer contains only completed
|
|
|
+tasks."
|
|
|
+ (seq-find ; (3)
|
|
|
+ (lambda (type)
|
|
|
+ (eq type 'todo))
|
|
|
+ (org-element-map ; (2)
|
|
|
+ (org-element-parse-buffer 'headline) ; (1)
|
|
|
+ 'headline
|
|
|
+ (lambda (h)
|
|
|
+ (org-element-property :todo-type h)))))
|
|
|
+
|
|
|
+(defun vulpea-project-update-tag ()
|
|
|
+ "Update PROJECT tag in the current buffer."
|
|
|
+ (when (and (not (active-minibuffer-window))
|
|
|
+ (vulpea-buffer-p))
|
|
|
+ (save-excursion
|
|
|
+ (goto-char (point-min))
|
|
|
+ (let* ((tags (vulpea-buffer-tags-get))
|
|
|
+ (original-tags tags))
|
|
|
+ (if (vulpea-project-p)
|
|
|
+ (setq tags (cons "project" tags))
|
|
|
+ (setq tags (remove "project" tags)))
|
|
|
+
|
|
|
+ ;; cleanup duplicates
|
|
|
+ (setq tags (seq-uniq tags))
|
|
|
+
|
|
|
+ ;; update tags if changed
|
|
|
+ (when (or (seq-difference tags original-tags)
|
|
|
+ (seq-difference original-tags tags))
|
|
|
+ (apply #'vulpea-buffer-tags-set tags))))))
|
|
|
+
|
|
|
+(defun vulpea-buffer-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 org-roam-directory))
|
|
|
+ (file-name-directory buffer-file-name))))
|
|
|
+
|
|
|
+(defun vulpea-project-files ()
|
|
|
+ "Return a list of note files containing 'project' tag." ;
|
|
|
+ (seq-uniq
|
|
|
+ (seq-map
|
|
|
+ #'car
|
|
|
+ (org-roam-db-query
|
|
|
+ [:select [nodes:file]
|
|
|
+ :from tags
|
|
|
+ :left-join nodes
|
|
|
+ :on (= tags:node-id nodes:id)
|
|
|
+ :where (like tag (quote "%\"project\"%"))]))))
|
|
|
+
|
|
|
+(defun vulpea-agenda-files-update (&rest _)
|
|
|
+ "Update the value of `org-agenda-files'."
|
|
|
+ (setq org-agenda-files (vulpea-project-files)))
|
|
|
+
|
|
|
+(add-hook 'find-file-hook #'vulpea-project-update-tag)
|
|
|
+(add-hook 'before-save-hook #'vulpea-project-update-tag)
|
|
|
+
|
|
|
+(advice-add 'org-agenda :before #'vulpea-agenda-files-update)
|
|
|
+(advice-add 'org-todo-list :before #'vulpea-agenda-files-update)
|
|
|
+
|
|
|
+;; functions borrowed from `vulpea' library
|
|
|
+;; https://github.com/d12frosted/vulpea/blob/6a735c34f1f64e1f70da77989e9ce8da7864e5ff/vulpea-buffer.el
|
|
|
+
|
|
|
+(defun vulpea-buffer-tags-get ()
|
|
|
+ "Return filetags value in current buffer."
|
|
|
+ (vulpea-buffer-prop-get-list "filetags" "[ :]"))
|
|
|
+
|
|
|
+(defun vulpea-buffer-tags-set (&rest tags)
|
|
|
+ "Set TAGS in current buffer.
|
|
|
+
|
|
|
+If filetags value is already set, replace it."
|
|
|
+ (if tags
|
|
|
+ (vulpea-buffer-prop-set
|
|
|
+ "filetags" (concat ":" (string-join tags ":") ":"))
|
|
|
+ (vulpea-buffer-prop-remove "filetags")))
|
|
|
+
|
|
|
+(defun vulpea-buffer-tags-add (tag)
|
|
|
+ "Add a TAG to filetags in current buffer."
|
|
|
+ (let* ((tags (vulpea-buffer-tags-get))
|
|
|
+ (tags (append tags (list tag))))
|
|
|
+ (apply #'vulpea-buffer-tags-set tags)))
|
|
|
+
|
|
|
+(defun vulpea-buffer-tags-remove (tag)
|
|
|
+ "Remove a TAG from filetags in current buffer."
|
|
|
+ (let* ((tags (vulpea-buffer-tags-get))
|
|
|
+ (tags (delete tag tags)))
|
|
|
+ (apply #'vulpea-buffer-tags-set tags)))
|
|
|
+
|
|
|
+(defun vulpea-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 vulpea-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-default-separators', normally
|
|
|
+\"[ \f\t\n\r\v]+\", and OMIT-NULLS is forced to t.
|
|
|
+If the property is already set, replace its value."
|
|
|
+ (vulpea-buffer-prop-set
|
|
|
+ name (combine-and-quote-strings values separators)))
|
|
|
+
|
|
|
+(defun vulpea-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 vulpea-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 (vulpea-buffer-prop-get name)))
|
|
|
+ (when (and value (not (string-empty-p value)))
|
|
|
+ (split-string-and-unquote value separators))))
|
|
|
+
|
|
|
+(defun vulpea-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 ""))))
|
