diff options
Diffstat (limited to '_spacemacs.d/config/my-org-helpers.el')
| -rw-r--r-- | _spacemacs.d/config/my-org-helpers.el | 399 |
1 files changed, 399 insertions, 0 deletions
diff --git a/_spacemacs.d/config/my-org-helpers.el b/_spacemacs.d/config/my-org-helpers.el new file mode 100644 index 0000000..e3c30c1 --- /dev/null +++ b/_spacemacs.d/config/my-org-helpers.el @@ -0,0 +1,399 @@ +;;; my-org-helpers.el --- Custom Helper Functions for Org Mode +;; -*- mode: emacs-lisp -*- +;; vim: set ts=8 sw=2 tw=0 fenc=utf-8 ft=lisp: +;; +;; Aaron LI +;; Created: 2016-12-07 +;; + +;;; Commentary: +;; Custom helper functions for Org mode +;; +;; [1] Norang: Org Mode (by Bernt Hansen) +;; http://doc.norang.ca/org-mode.html +;; + +;;; Code: + + +(defun my/verify-refile-target () + "Exclude todo keywords with a done state from refile targets" + (not (member (nth 2 (org-heading-components)) org-done-keywords))) + +(defun my/remove-empty-drawer-on-clock-out () + "Remove empty `LOGBOOK' drawers on clock out" + (interactive) + (save-excursion + (beginning-of-line 0) + (org-remove-empty-drawer-at "LOGBOOK" (point)))) + +(defun my/find-project-task () + "Move point to the parent (project) task if any" + (save-restriction + (widen) + (let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point)))) + (while (org-up-heading-safe) + (when (member (nth 2 (org-heading-components)) org-todo-keywords-1) + (setq parent-task (point)))) + (goto-char parent-task) + parent-task))) + +(defun my/is-project-p () + "Any task with a subtask using a todo keyword" + (save-restriction + (widen) + (let ((has-subtask) + (subtree-end (save-excursion (org-end-of-subtree t))) + (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1))) + (save-excursion + (forward-line 1) + (while (and (not has-subtask) + (< (point) subtree-end) + (re-search-forward "^\*+ " subtree-end t)) + (when (member (org-get-todo-state) org-todo-keywords-1) + (setq has-subtask t)))) + (and is-a-task has-subtask)))) + +(defun my/is-project-subtree-p () + "Any task with a todo keyword that is in a project subtree. +Callers of this function already widen the buffer view." + (let ((task (save-excursion (org-back-to-heading 'invisible-ok) + (point)))) + (save-excursion + (my/find-project-task) + (if (equal (point) task) + nil + t)))) + +(defun my/is-task-p () + "Any task with a todo keyword and no subtask" + (save-restriction + (widen) + (let ((has-subtask) + (subtree-end (save-excursion (org-end-of-subtree t))) + (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1))) + (save-excursion + (forward-line 1) + (while (and (not has-subtask) + (< (point) subtree-end) + (re-search-forward "^\*+ " subtree-end t)) + (when (member (org-get-todo-state) org-todo-keywords-1) + (setq has-subtask t)))) + (and is-a-task (not has-subtask))))) + +(defun my/is-subproject-p () + "Any task which is a subtask of another project" + (let ((is-subproject) + (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1))) + (save-excursion + (while (and (not is-subproject) (org-up-heading-safe)) + (when (member (nth 2 (org-heading-components)) org-todo-keywords-1) + (setq is-subproject t)))) + (and is-a-task is-subproject))) + +(defun my/list-sublevels-for-projects-indented () + "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks. + This is normally used by skipping functions where this variable is already local to the agenda." + (if (marker-buffer org-agenda-restrict-begin) + (setq org-tags-match-list-sublevels 'indented) + (setq org-tags-match-list-sublevels nil)) + nil) + +(defun my/list-sublevels-for-projects () + "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks. + This is normally used by skipping functions where this variable is already local to the agenda." + (if (marker-buffer org-agenda-restrict-begin) + (setq org-tags-match-list-sublevels t) + (setq org-tags-match-list-sublevels nil)) + nil) + +(defvar my/hide-scheduled-and-waiting-next-tasks t) + +(defun my/toggle-next-task-display () + (interactive) + (setq my/hide-scheduled-and-waiting-next-tasks (not my/hide-scheduled-and-waiting-next-tasks)) + (when (equal major-mode 'org-agenda-mode) + (org-agenda-redo)) + (message "%s WAITING and SCHEDULED NEXT Tasks" (if my/hide-scheduled-and-waiting-next-tasks "Hide" "Show"))) + +(defun my/skip-stuck-projects () + "Skip trees that are not stuck projects" + (save-restriction + (widen) + (let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) + (if (my/is-project-p) + (let* ((subtree-end (save-excursion (org-end-of-subtree t))) + (has-next )) + (save-excursion + (forward-line 1) + (while (and (not has-next) (< (point) subtree-end) (re-search-forward "^\\*+ NEXT " subtree-end t)) + (unless (member "WAITING" (org-get-tags-at)) + (setq has-next t)))) + (if has-next + nil + next-headline)) ; a stuck project, has subtasks but no next task + nil)))) + +(defun my/skip-non-stuck-projects () + "Skip trees that are not stuck projects" + ;; (my/list-sublevels-for-projects-indented) + (save-restriction + (widen) + (let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) + (if (my/is-project-p) + (let* ((subtree-end (save-excursion (org-end-of-subtree t))) + (has-next )) + (save-excursion + (forward-line 1) + (while (and (not has-next) (< (point) subtree-end) (re-search-forward "^\\*+ NEXT " subtree-end t)) + (unless (member "WAITING" (org-get-tags-at)) + (setq has-next t)))) + (if has-next + next-headline + nil)) ; a stuck project, has subtasks but no next task + next-headline)))) + +(defun my/skip-non-projects () + "Skip trees that are not projects" + ;; (my/list-sublevels-for-projects-indented) + (if (save-excursion (my/skip-non-stuck-projects)) + (save-restriction + (widen) + (let ((subtree-end (save-excursion (org-end-of-subtree t)))) + (cond + ((my/is-project-p) + nil) + ((and (my/is-project-subtree-p) (not (my/is-task-p))) + nil) + (t + subtree-end)))) + (save-excursion (org-end-of-subtree t)))) + +(defun my/skip-non-tasks () + "Show non-project tasks. +Skip project and sub-project tasks, habits, and project related tasks." + (save-restriction + (widen) + (let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) + (cond + ((my/is-task-p) + nil) + (t + next-headline))))) + +(defun my/skip-project-trees-and-habits () + "Skip trees that are projects" + (save-restriction + (widen) + (let ((subtree-end (save-excursion (org-end-of-subtree t)))) + (cond + ((my/is-project-p) + subtree-end) + ((org-is-habit-p) + subtree-end) + (t + nil))))) + +(defun my/skip-projects-and-habits-and-single-tasks () + "Skip trees that are projects, tasks that are habits, single non-project tasks" + (save-restriction + (widen) + (let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) + (cond + ((org-is-habit-p) + next-headline) + ((and my/hide-scheduled-and-waiting-next-tasks + (member "WAITING" (org-get-tags-at))) + next-headline) + ((my/is-project-p) + next-headline) + ((and (my/is-task-p) (not (my/is-project-subtree-p))) + next-headline) + (t + nil))))) + +(defun my/skip-project-tasks-maybe () + "Show tasks related to the current restriction. +When restricted to a project, skip project and sub project tasks, habits, NEXT tasks, and loose tasks. +When not restricted, skip project and sub-project tasks, habits, and project related tasks." + (save-restriction + (widen) + (let* ((subtree-end (save-excursion (org-end-of-subtree t))) + (next-headline (save-excursion (or (outline-next-heading) (point-max)))) + (limit-to-project (marker-buffer org-agenda-restrict-begin))) + (cond + ((my/is-project-p) + next-headline) + ((org-is-habit-p) + subtree-end) + ((and (not limit-to-project) + (my/is-project-subtree-p)) + subtree-end) + ((and limit-to-project + (my/is-project-subtree-p) + (member (org-get-todo-state) (list "NEXT"))) + subtree-end) + (t + nil))))) + +(defun my/skip-project-tasks () + "Show non-project tasks. +Skip project and sub-project tasks, habits, and project related tasks." + (save-restriction + (widen) + (let* ((subtree-end (save-excursion (org-end-of-subtree t)))) + (cond + ((my/is-project-p) + subtree-end) + ((org-is-habit-p) + subtree-end) + ((my/is-project-subtree-p) + subtree-end) + (t + nil))))) + +(defun my/skip-non-project-tasks () + "Show project tasks. +Skip project and sub-project tasks, habits, and loose non-project tasks." + (save-restriction + (widen) + (let* ((subtree-end (save-excursion (org-end-of-subtree t))) + (next-headline (save-excursion (or (outline-next-heading) (point-max))))) + (cond + ((my/is-project-p) + next-headline) + ((org-is-habit-p) + subtree-end) + ((and (my/is-project-subtree-p) + (member (org-get-todo-state) (list "NEXT"))) + subtree-end) + ((not (my/is-project-subtree-p)) + subtree-end) + (t + nil))))) + +(defun my/skip-projects-and-habits () + "Skip trees that are projects and tasks that are habits" + (save-restriction + (widen) + (let ((subtree-end (save-excursion (org-end-of-subtree t)))) + (cond + ((my/is-project-p) + subtree-end) + ((org-is-habit-p) + subtree-end) + (t + nil))))) + +(defun my/skip-non-subprojects () + "Skip trees that are not projects" + (let ((next-headline (save-excursion (outline-next-heading)))) + (if (my/is-subproject-p) + nil + next-headline))) + +(setq my/keep-clock-running nil) + +(defun my/clock-in-to-next (kw) + "Switch a task from TODO to NEXT when clocking in. +Skips capture tasks, projects, and subprojects. +Switch projects and subprojects from NEXT back to TODO" + (when (not (and (boundp 'org-capture-mode) org-capture-mode)) + (cond + ((and (member (org-get-todo-state) (list "TODO")) + (my/is-task-p)) + "NEXT") + ((and (member (org-get-todo-state) (list "NEXT")) + (my/is-project-p)) + "TODO")))) + +(defun my/punch-in (arg) + "Start continuous clocking and set the default task to the +selected task. If no task is selected set the Organization task +as the default task." + (interactive "p") + (setq my/keep-clock-running t) + (if (equal major-mode 'org-agenda-mode) + ;; We are in the agenda + (let* ((marker (org-get-at-bol 'org-hd-marker)) + (tags (org-with-point-at marker (org-get-tags-at)))) + (if (and (eq arg 4) tags) + (org-agenda-clock-in '(16)) + (my/clock-in-organization-task-as-default))) + ;; We are NOT in the agenda + (save-restriction + (widen) + ; Find the tags on the current task + (if (and (equal major-mode 'org-mode) + (not (org-before-first-heading-p)) + (eq arg 4)) + (org-clock-in '(16)) + (my/clock-in-organization-task-as-default))))) + +(defun my/punch-out () + (interactive) + (setq my/keep-clock-running nil) + (when (org-clock-is-active) + (org-clock-out)) + (org-agenda-remove-restriction-lock)) + +(defun my/clock-in-default-task () + (save-excursion + (org-with-point-at org-clock-default-task + (org-clock-in)))) + +(defun my/clock-in-parent-task () + "Move point to the parent (project) task if any and clock in" + (let ((parent-task)) + (save-excursion + (save-restriction + (widen) + (while (and (not parent-task) (org-up-heading-safe)) + (when (member (nth 2 (org-heading-components)) org-todo-keywords-1) + (setq parent-task (point)))) + (if parent-task + (org-with-point-at parent-task + (org-clock-in)) + (when my/keep-clock-running + (my/clock-in-default-task))))))) + +(defun my/clock-in-organization-task-as-default () + (interactive) + (org-with-point-at (org-id-find my/organization-task-id 'marker) + (org-clock-in '(16)))) + +(defun my/clock-out-maybe () + (when (and my/keep-clock-running + (not org-clock-clocking-in) + (marker-buffer org-clock-default-task) + (not org-clock-resolving-clocks-due-to-idleness)) + (my/clock-in-parent-task))) + + +(defun my/skip-non-archivable-tasks () + "Skip trees that are not available for archiving" + (save-restriction + (widen) + ;; Consider only tasks with done todo headings as archivable candidates + (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))) + (subtree-end (save-excursion (org-end-of-subtree t)))) + (if (member (org-get-todo-state) org-todo-keywords-1) + (if (member (org-get-todo-state) org-done-keywords) + (let* ((daynr (string-to-int (format-time-string "%d" (current-time)))) + (a-month-ago (* 60 60 24 (+ daynr 1))) + (last-month (format-time-string "%Y-%m-" (time-subtract (current-time) (seconds-to-time a-month-ago)))) + (this-month (format-time-string "%Y-%m-" (current-time))) + (subtree-is-current (save-excursion + (forward-line 1) + (and (< (point) subtree-end) + (re-search-forward (concat last-month "\\|" this-month) subtree-end t))))) + (if subtree-is-current + subtree-end ; Has a date in this month or last month, skip it + nil)) ; available to archive + (or subtree-end (point-max))) + next-headline)))) + + +(provide 'my-org-helpers) + +;;; my-org-helpers.el ends here |