diff options
| -rw-r--r-- | emacs/.emacs.d/init/ycp-org.el | 13 | ||||
| -rw-r--r-- | emacs/.emacs.d/lisp/my/my-org.el | 186 |
2 files changed, 198 insertions, 1 deletions
diff --git a/emacs/.emacs.d/init/ycp-org.el b/emacs/.emacs.d/init/ycp-org.el index b20f33e..815216c 100644 --- a/emacs/.emacs.d/init/ycp-org.el +++ b/emacs/.emacs.d/init/ycp-org.el @@ -155,6 +155,13 @@ (my-package org-agenda (:delay 10) + ;; We want to prevent switching not-done to done for items with + ;; not-done children or checkboxes (see + ;; `org-enforce-todo-dependencies' and + ;; `org-enforce-todo-checkbox-dependencies' but we don't want them + ;; marked as blocked, because blocked should be marked explicitly + ;; and dimmed when they are truly blocked by a task somewhere else. + (my-override org-entry-blocked-p) (my-keybind global-map "C-c g" 'my-org-store-agenda-view-A) (setq org-agenda-confirm-kill t) (setq org-agenda-follow-indirect t) @@ -165,7 +172,7 @@ (setq org-agenda-todo-ignore-with-date 'all) (setq org-agenda-todo-ignore-timestamp 'all) (setq org-agenda-tags-todo-honor-ignore-options t) - (setq org-agenda-dim-blocked-tasks nil) + (setq org-agenda-dim-blocked-tasks t) (setq org-agenda-sticky t) (setq org-agenda-inhibit-startup t) (my-setq-from-local org-agenda-files) @@ -307,6 +314,10 @@ (setq org-use-speed-commands t) (setq org-speed-commands '(("User commands") + ("." . my-org-task-add-id) + ("'" . my-org-task-associate) + ("!" . my-org-task-remove-id) + ("\"" . my-org-task-dissociate) ("T" . my-org-swap-referral-with-headline) ("D" . my-org-clean-up-entry) ("g" . org-delete-property) 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 |