aboutsummaryrefslogtreecommitdiff
path: root/emacs/.emacs.d/lisp
diff options
context:
space:
mode:
authorYuchen Pei <id@ypei.org>2023-11-05 20:10:11 +1100
committerYuchen Pei <id@ypei.org>2023-11-05 20:10:11 +1100
commite94a7e4edc90ab8bbcf3a60b4f9d0771a1b08d73 (patch)
treebf66b7ab3a5a84caace39d95f5eb35bea4c74ee6 /emacs/.emacs.d/lisp
parent3b366eef720d3f7120bf894fb9266e3c8943fa8d (diff)
[emacs] Add task management in org.
- We can add a task ID to a heading, like PRO-231 - We can associate a task with another task - Blocking is marked explicitly now
Diffstat (limited to 'emacs/.emacs.d/lisp')
-rw-r--r--emacs/.emacs.d/lisp/my/my-org.el186
1 files changed, 186 insertions, 0 deletions
diff --git a/emacs/.emacs.d/lisp/my/my-org.el b/emacs/.emacs.d/lisp/my/my-org.el
index 69a4a9b..2516b6d 100644
--- a/emacs/.emacs.d/lisp/my/my-org.el
+++ b/emacs/.emacs.d/lisp/my/my-org.el
@@ -1420,5 +1420,191 @@ or filename if no title."
:priority prio)
link)))
+;;; task management
+(defcustom my-org-task-categories nil
+ "Task categories for org custom_id creation."
+ :group 'my-org
+ :type '(repeat symbol))
+
+(defcustom my-org-task-next-id-file (locate-user-emacs-file "org-task-ids")
+ "Files to store the next id of each task category."
+ :group 'my-org
+ :type 'file)
+
+(defcustom my-org-task-property-name "TASK_ID"
+ "The property field name for task ids."
+ :group 'my-org
+ :type 'string)
+
+;; (defvar my-org-task-next-ids nil
+;; "An alist of next IDs for each task category, will be read from
+;; and written to")
+
+(defun my-org-task-init ()
+ "Initialise next ids and write them to `my-org-task-next-id-file'."
+ (my-org-task-write-next-ids
+ (mapcar
+ (lambda (cat)
+ `(,cat . 0))
+ my-org-task-categories)))
+
+(defun my-org-task-read-next-ids ()
+ "Read next ids from `my-org-task-next-id-file'."
+ (when (file-exists-p my-org-task-next-id-file)
+ (with-temp-buffer
+ (insert-file-contents my-org-task-next-id-file)
+ (goto-char (point-min))
+ (read (current-buffer)))))
+
+(defun my-org-task-write-next-ids (next-ids)
+ "Write NEXT-IDS to `my-org-task-next-id-file'."
+ (with-temp-buffer
+ (insert (prin1-to-string next-ids))
+ (write-region nil nil my-org-task-next-id-file)))
+
+(defun my-org-task-increment-id (category)
+ "Increment the next id of CATEGORY.
+
+Return the next id before incrementing."
+ (let* ((next-ids (my-org-read-next-ids))
+ (next-id (alist-get category next-ids)))
+ (setf (alist-get category next-ids)
+ (1+ next-id))
+ (my-org-task-write-next-ids next-ids)
+ next-id))
+
+(defun my-org-task-remove-id ()
+ "Remove id from task at point."
+ (interactive)
+ (let* ((headline (org-entry-get (point) "ITEM"))
+ (old-id (org-entry-get (point) my-org-task-property-name))
+ (new-headline (replace-regexp-in-string
+ (format "^%s" (if old-id (format "%s " old-id) ""))
+ ""
+ headline)))
+ (org-entry-delete (point) my-org-task-property-name)
+ (org-edit-headline new-headline)))
+
+(defun my-org-task-add-id (category)
+ "Add id of CATEGORY to task at point."
+ (interactive (list (intern (completing-read
+ "Category: "
+ (mapcar
+ (lambda (cat) (format "%s" cat))
+ my-org-task-categories)))))
+ (my-org-task-remove-id)
+ (let* ((id (format "%s-%d" category (my-org-task-increment-id category)))
+ (headline (org-entry-get (point) "ITEM"))
+ (new-headline (format "%s %s" id headline)))
+ (org-entry-put (point) my-org-task-property-name id)
+ (org-edit-headline new-headline)))
+
+(defvar my-org-task-relations
+ '(("BLOCKS" . "BLOCKED_BY")
+ ("CAUSES" . "CAUSED_BY")
+ ("DUPLICATES" . "DUPLICATED_BY")
+ ("RELATED" . "RELATED")
+ ("BLOCKED_BY" . "BLOCKS")
+ ("CAUSED_BY" . "CAUSES")
+ ("DUPLICATED_BY" . "DUPLICATES"))
+ "Task relations and their dual relations.")
+
+(defcustom my-org-properties-separator ", "
+ "Separator in a property value field."
+ :group 'my-org
+ :type 'string)
+
+(defun my-org-entry-add (pom property value)
+ "Add VALUE to the values in PROPERTY at POM.
+
+The values are separated by `my-org-properties-separator'.
+See also `org-entry-add-to-multivalued-property'."
+ (let ((old (org-entry-get pom property)))
+ (if old
+ (org-entry-put
+ pom property
+ (format "%s%s%s" old my-org-properties-separator value))
+ (org-entry-put pom property value))))
+
+(defun my-org-entry-remove (pom property value)
+ "Remove VALUE from the values in PROPERTY at POM.
+
+The values are separated by `my-org-properties-separator'.
+See also `org-entry-remove-from-multivalued-property'."
+ (let* ((old (org-entry-get pom property))
+ (new (replace-regexp-in-string
+ ;; Remove value when it is the only one in the property
+ (regexp-quote value)
+ ""
+ (replace-regexp-in-string
+ ;; Remove the non-first occurrence of the value
+ (regexp-quote (format "%s%s" my-org-properties-separator value))
+ ""
+ (replace-regexp-in-string
+ ;; Remove the non-last occurrence of the value
+ (regexp-quote (format "%s%s" value my-org-properties-separator))
+ ""
+ old)))))
+ (if (string-empty-p new)
+ (org-entry-delete pom property)
+ (org-entry-put pom property new))))
+
+(defun my-org-task-associate-internal (relation)
+ "Add the last stored link as RELATION to the task at point."
+ (when-let ((link (pop org-stored-links)))
+ (my-org-entry-add (point) relation
+ (format "[[%s][%s]]" (car link) (cadr link)))))
+
+(defun my-org-task-dissociate-internal (relation)
+ "Remove the last stored link as RELATION from the task at point."
+ (when-let ((link (pop org-stored-links)))
+ (my-org-entry-remove (point) relation
+ (format "[[%s][%s]]" (car link) (cadr link)))))
+
+(defun my-org-task-associate ()
+ "Associate the task at point with another task.
+
+Use `org-goto' to choose the task to associate with. Adds the
+dual relation link-back on that task."
+ (interactive)
+ (let* ((relation
+ (completing-read "Relation: "
+ (mapcar 'car my-org-task-relations) nil t))
+ (dual (alist-get relation my-org-task-relations nil nil 'equal)))
+ (call-interactively 'org-store-link)
+ (save-excursion
+ (call-interactively 'org-goto)
+ (my-org-task-associate-internal dual)
+ (call-interactively 'org-store-link))
+ (my-org-task-associate-internal relation)))
+
+;; TODO: Choose from associated tasks rather than all possible
+;; headlines.
+(defun my-org-task-dissociate ()
+ "Dissociate the task at point with another task.
+
+Use `org-goto' to choose the task to dissociate from. Removes the
+dual relation link-back on that task."
+ (interactive)
+ (let* ((properties (org-entry-properties))
+ (relation
+ (completing-read "Relation: "
+ (mapcar 'car my-org-task-relations)
+ (lambda (prop) (alist-get prop properties nil nil 'equal))
+ t))
+ (dual (alist-get relation my-org-task-relations nil nil 'equal)))
+ (call-interactively 'org-store-link)
+ (save-excursion
+ (call-interactively 'org-goto)
+ (my-org-task-dissociate-internal dual)
+ (call-interactively 'org-store-link))
+ (my-org-task-dissociate-internal relation)))
+
+;; to override `org-entry-blocked-p'.
+(defun my-org-entry-blocked-p ()
+ "Non-nil if entry at point is blocked."
+ (and (org-entry-get (point) "BLOCKED_BY")
+ (member (org-entry-get nil "TODO") org-not-done-keywords)))
+
(provide 'my-org)
;;; my-org.el ends here