diff options
Diffstat (limited to 'emacs/.emacs.d/lisp/my')
| -rw-r--r-- | emacs/.emacs.d/lisp/my/my-org.el | 186 |
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 |