From c10fd841c07f3502167023b6c993b95d61656d15 Mon Sep 17 00:00:00 2001 From: SqrtMinusOne Date: Tue, 25 Jan 2022 23:07:35 +0300 Subject: [PATCH] started --- org-journal-tags.el | 87 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) diff --git a/org-journal-tags.el b/org-journal-tags.el index 4728a00..c2df17f 100644 --- a/org-journal-tags.el +++ b/org-journal-tags.el @@ -29,6 +29,93 @@ ;;; Code: (require 'org-journal) +(require 'org-macs) +(require 'cl-lib) + +(defgroup org-journal-tags () + "Manage tags for org-journal" + :group 'org-journal) + +(defcustom org-journal-tags-db-file + (if (boundp 'no-littering-var-directory) + (concat no-littering-var-directory "org-journal-tags/index") + (concat user-emacs-directory "org-journal-tags/index")) + "A location of the org-journal-tags database." + :group 'org-journal-tags + :type 'file) + +(defvar org-journal-tags-db nil + "The core org-journal-tags database.") + +(defface org-journal-tags-tag-face + '((t (:inherit warning))) + "A default face for org-journal tags." + :group 'org-journal-tags) + +(defcustom org-journal-tags-face-function #'org-journal-tags--face-default + "A function to get the face of a tag. + +The only argument is the tag string." + :group 'org-journal-tags + :type 'function) + +(defun org-journal-tags--face-default (tag) + "A function to return the default tag face for TAG." + 'org-journal-tags-tag-face) + +(cl-defstruct (org-journal-tag (:constructor org-journal-tag--create)) + name references) + +(defun org-journal-tags-db--empty () + "Create an empty org-journal-tags database." + (make-hash-table :test #'equal)) + +(defun org-journal-tags-db-load () + "Load the org-journal-tags database from the filesystem." + (if (not (file-exists-p org-journal-tags-db-file)) + (setf org-journal-tags-db (org-journal-tags-db--empty)) + (with-temp-buffer + (insert-file-contents org-journal-tags-db-file) + (goto-char (point-min)) + (setf org-journal-tags-db (read (current-buffer)))))) + +(defun org-journal-tags-db-ensure () + "Ensure that the database has been loaded." + (when (null org-journal-tags-db) (org-journal-tags-db-load))) + +(defun org-journal-tags-db-save () + (org-journal-tags-db-ensure) + (mkdir (file-name-directory org-journal-tags-db-file) t) + (let ((coding-system-for-write 'utf-8)) + (with-temp-file org-journal-tags-db-file + (let ((standard-output (current-buffer)) + (print-level nil) + (print-length nil) + (print-circle nil)) + (princ ";;; Org Journal Tags Database\n\n") + (prin1 org-journal-tags-db))))) + +(defun org-journal-tags-db-unload () + "Unload the org-journal-tags database" + (interactive) + (org-journal-tags-db-save) + (setf org-journal-tags-db nil)) + +(defun org-journal-tags--follow (&rest rest) + "TODO. Eventually this fill do something." + (message (prin1-to-string rest))) + +(org-link-set-parameters + "org-journal" + :follow #'org-journal-tags--follow + :face (lambda (&rest args) (funcall org-journal-tags-face-function args))) + +(defun org-journal-tags--extract-links () + "Extract org-journal links from the current org buffer." + (org-element-map (org-element-parse-buffer) 'link + (lambda (link) + (when (string= (org-element-property :type link) "org-journal") + link)))) (provide 'org-journal-tags) ;;; org-journal-tags.el ends here