diff options
Diffstat (limited to '_spacemacs.d/config/aly-org-helpers.el')
| -rw-r--r-- | _spacemacs.d/config/aly-org-helpers.el | 399 |
1 files changed, 0 insertions, 399 deletions
diff --git a/_spacemacs.d/config/aly-org-helpers.el b/_spacemacs.d/config/aly-org-helpers.el deleted file mode 100644 index 3254c79..0000000 --- a/_spacemacs.d/config/aly-org-helpers.el +++ /dev/null @@ -1,399 +0,0 @@ -;;; aly-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 aly/verify-refile-target () - "Exclude todo keywords with a done state from refile targets" - (not (member (nth 2 (org-heading-components)) org-done-keywords))) - -(defun aly/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 aly/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 aly/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 aly/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 - (aly/find-project-task) - (if (equal (point) task) - nil - t)))) - -(defun aly/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 aly/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 aly/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 aly/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 aly/hide-scheduled-and-waiting-next-tasks t) - -(defun aly/toggle-next-task-display () - (interactive) - (setq aly/hide-scheduled-and-waiting-next-tasks (not aly/hide-scheduled-and-waiting-next-tasks)) - (when (equal major-mode 'org-agenda-mode) - (org-agenda-redo)) - (message "%s WAITING and SCHEDULED NEXT Tasks" (if aly/hide-scheduled-and-waiting-next-tasks "Hide" "Show"))) - -(defun aly/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 (aly/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 aly/skip-non-stuck-projects () - "Skip trees that are not stuck projects" - ;; (aly/list-sublevels-for-projects-indented) - (save-restriction - (widen) - (let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) - (if (aly/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 aly/skip-non-projects () - "Skip trees that are not projects" - ;; (aly/list-sublevels-for-projects-indented) - (if (save-excursion (aly/skip-non-stuck-projects)) - (save-restriction - (widen) - (let ((subtree-end (save-excursion (org-end-of-subtree t)))) - (cond - ((aly/is-project-p) - nil) - ((and (aly/is-project-subtree-p) (not (aly/is-task-p))) - nil) - (t - subtree-end)))) - (save-excursion (org-end-of-subtree t)))) - -(defun aly/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 - ((aly/is-task-p) - nil) - (t - next-headline))))) - -(defun aly/skip-project-trees-and-habits () - "Skip trees that are projects" - (save-restriction - (widen) - (let ((subtree-end (save-excursion (org-end-of-subtree t)))) - (cond - ((aly/is-project-p) - subtree-end) - ((org-is-habit-p) - subtree-end) - (t - nil))))) - -(defun aly/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 aly/hide-scheduled-and-waiting-next-tasks - (member "WAITING" (org-get-tags-at))) - next-headline) - ((aly/is-project-p) - next-headline) - ((and (aly/is-task-p) (not (aly/is-project-subtree-p))) - next-headline) - (t - nil))))) - -(defun aly/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 - ((aly/is-project-p) - next-headline) - ((org-is-habit-p) - subtree-end) - ((and (not limit-to-project) - (aly/is-project-subtree-p)) - subtree-end) - ((and limit-to-project - (aly/is-project-subtree-p) - (member (org-get-todo-state) (list "NEXT"))) - subtree-end) - (t - nil))))) - -(defun aly/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 - ((aly/is-project-p) - subtree-end) - ((org-is-habit-p) - subtree-end) - ((aly/is-project-subtree-p) - subtree-end) - (t - nil))))) - -(defun aly/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 - ((aly/is-project-p) - next-headline) - ((org-is-habit-p) - subtree-end) - ((and (aly/is-project-subtree-p) - (member (org-get-todo-state) (list "NEXT"))) - subtree-end) - ((not (aly/is-project-subtree-p)) - subtree-end) - (t - nil))))) - -(defun aly/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 - ((aly/is-project-p) - subtree-end) - ((org-is-habit-p) - subtree-end) - (t - nil))))) - -(defun aly/skip-non-subprojects () - "Skip trees that are not projects" - (let ((next-headline (save-excursion (outline-next-heading)))) - (if (aly/is-subproject-p) - nil - next-headline))) - -(setq aly/keep-clock-running nil) - -(defun aly/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")) - (aly/is-task-p)) - "NEXT") - ((and (member (org-get-todo-state) (list "NEXT")) - (aly/is-project-p)) - "TODO")))) - -(defun aly/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 aly/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)) - (aly/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)) - (aly/clock-in-organization-task-as-default))))) - -(defun aly/punch-out () - (interactive) - (setq aly/keep-clock-running nil) - (when (org-clock-is-active) - (org-clock-out)) - (org-agenda-remove-restriction-lock)) - -(defun aly/clock-in-default-task () - (save-excursion - (org-with-point-at org-clock-default-task - (org-clock-in)))) - -(defun aly/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 aly/keep-clock-running - (aly/clock-in-default-task))))))) - -(defun aly/clock-in-organization-task-as-default () - (interactive) - (org-with-point-at (org-id-find aly/organization-task-id 'marker) - (org-clock-in '(16)))) - -(defun aly/clock-out-maybe () - (when (and aly/keep-clock-running - (not org-clock-clocking-in) - (marker-buffer org-clock-default-task) - (not org-clock-resolving-clocks-due-to-idleness)) - (aly/clock-in-parent-task))) - - -(defun aly/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 'aly-org-helpers) - -;;; aly-org-helpers.el ends here |