aboutsummaryrefslogtreecommitdiff
path: root/emacs
diff options
context:
space:
mode:
Diffstat (limited to 'emacs')
-rw-r--r--emacs/.emacs.d/init/ycp-org.el13
-rw-r--r--emacs/.emacs.d/lisp/my/my-org.el186
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