(require 'org) (global-set-key (kbd "") #'org-agenda) (global-set-key (kbd "C-c a") #'org-agenda) (defun bh/is-project-p () "Any task with a todo keyword 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 has-subtask)))) (defun bh/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 (bh/find-project-task) (if (equal (point) task) nil t)))) (defun bh/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 bh/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 bh/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 bh/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 bh/hide-scheduled-and-waiting-next-tasks t) (defun bh/toggle-next-task-display () (interactive) (setq bh/hide-scheduled-and-waiting-next-tasks (not bh/hide-scheduled-and-waiting-next-tasks)) (when (equal major-mode 'org-agenda-mode) (org-agenda-redo)) (message "%s WAITING and SCHEDULED NEXT Tasks" (if bh/hide-scheduled-and-waiting-next-tasks "Hide" "Show"))) (defun bh/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 (bh/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 bh/skip-non-stuck-projects () "Skip trees that are not stuck projects" ;; (bh/list-sublevels-for-projects-indented) (save-restriction (widen) (let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) (if (bh/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 bh/skip-non-projects () "Skip trees that are not projects" ;; (bh/list-sublevels-for-projects-indented) (if (save-excursion (bh/skip-non-stuck-projects)) (save-restriction (widen) (let ((subtree-end (save-excursion (org-end-of-subtree t)))) (cond ((bh/is-project-p) nil) ((and (bh/is-project-subtree-p) (not (bh/is-task-p))) nil) (t subtree-end)))) (save-excursion (org-end-of-subtree t)))) (defun bh/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 ((bh/is-task-p) nil) (t next-headline))))) (defun bh/skip-project-trees-and-habits () "Skip trees that are projects" (save-restriction (widen) (let ((subtree-end (save-excursion (org-end-of-subtree t)))) (cond ((bh/is-project-p) subtree-end) ((org-is-habit-p) subtree-end) (t nil))))) (defun bh/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 bh/hide-scheduled-and-waiting-next-tasks (member "WAITING" (org-get-tags-at))) next-headline) ((bh/is-project-p) next-headline) ((and (bh/is-task-p) (not (bh/is-project-subtree-p))) next-headline) (t nil))))) (defun bh/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 ((bh/is-project-p) next-headline) ((org-is-habit-p) subtree-end) ((and (not limit-to-project) (bh/is-project-subtree-p)) subtree-end) ((and limit-to-project (bh/is-project-subtree-p) (member (org-get-todo-state) (list "NEXT"))) subtree-end) (t nil))))) (defun bh/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 ((bh/is-project-p) subtree-end) ((org-is-habit-p) subtree-end) ((bh/is-project-subtree-p) subtree-end) ((not (org-entry-is-todo-p)) subtree-end) (t nil))))) (defun bh/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 ((bh/is-project-p) next-headline) ((org-is-habit-p) subtree-end) ((and (bh/is-project-subtree-p) (member (org-get-todo-state) (list "NEXT"))) subtree-end) ((not (bh/is-project-subtree-p)) subtree-end) (t nil))))) (defun bh/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 ((bh/is-project-p) subtree-end) ((org-is-habit-p) subtree-end) (t nil))))) (defun bh/skip-non-subprojects () "Skip trees that are not projects" (let ((next-headline (save-excursion (outline-next-heading)))) (if (bh/is-subproject-p) nil next-headline))) ;; CLOCKING ;; ;; Resume clocking task when emacs is restarted (org-clock-persistence-insinuate) ;; ;; Show lot of clocking history so it's easy to pick items off the C-F11 list (setq org-clock-history-length 23) ;; Resume clocking task on clock-in if the clock is open (setq org-clock-in-resume t) ;; Change tasks to NEXT when clocking in (setq org-clock-in-switch-to-state 'bh/clock-in-to-next) ;; Separate drawers for clocking and logs (setq org-drawers (quote ("PROPERTIES" "LOGBOOK"))) ;; Save clock data and state changes and notes in the LOGBOOK drawer (setq org-clock-into-drawer t) ;; Sometimes I change tasks I'm clocking quickly - this removes clocked tasks with 0:00 duration (setq org-clock-out-remove-zero-time-clocks t) ;; Clock out when moving task to a done state (setq org-clock-out-when-done t) ;; Save the running clock and all clock history when exiting Emacs, load it on startup (setq org-clock-persist t) ;; Do not prompt to resume an active clock (setq org-clock-persist-query-resume nil) ;; Enable auto clock resolution for finding open clocks (setq org-clock-auto-clock-resolution (quote when-no-clock-is-running)) ;; Include current clocking task in clock reports (setq org-clock-report-include-clocking-task t) (setq bh/keep-clock-running nil) (defun bh/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")) (bh/is-task-p)) "NEXT") ((and (member (org-get-todo-state) (list "NEXT")) (bh/is-project-p)) "TODO")))) (defun bh/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 bh/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 bh/keep-clock-running t) (if (equal major-mode 'org-agenda-mode) ;; ;; We're 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)) (bh/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)) (bh/clock-in-organization-task-as-default))))) (defun bh/punch-out () (interactive) (setq bh/keep-clock-running nil) (when (org-clock-is-active) (org-clock-out)) (org-agenda-remove-restriction-lock)) (defun bh/clock-in-default-task () (save-excursion (org-with-point-at org-clock-default-task (org-clock-in)))) (defun bh/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 bh/keep-clock-running (bh/clock-in-default-task))))))) (defvar bh/organization-task-id "eb155a82-92b2-4f25-a3c6-0304591af2f9") ;; https://stackoverflow.com/a/10091330 (defun zin/org-agenda-skip-tag (tag &optional others) "Skip all entries that correspond to TAG. If OTHERS is true, skip all entries that do not correspond to TAG." (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))) (current-headline (or (and (org-at-heading-p) (point)) (save-excursion (org-back-to-heading))))) (if others (if (not (member tag (org-get-tags-at current-headline))) next-headline nil) (if (member tag (org-get-tags-at current-headline)) next-headline nil)))) (defun bh/clock-in-organization-task-as-default () (interactive) (org-with-point-at (org-id-find bh/organization-task-id 'marker) (org-clock-in '(16)))) (defun bh/clock-out-maybe () (when (and bh/keep-clock-running (not org-clock-clocking-in) (marker-buffer org-clock-default-task) (not org-clock-resolving-clocks-due-to-idleness)) (bh/clock-in-parent-task))) (add-hook 'org-clock-out-hook 'bh/clock-out-maybe 'append) ;; AGENDA VIEW ;; ;; Do not dim blocked tasks (setq org-agenda-compact-blocks nil) (setq org-agenda-dim-blocked-tasks nil) (setq org-agenda-block-separator 61) ;; Agenda log mode items to display (closed and state changes by default) (setq org-agenda-log-mode-items (quote (closed state))) ; For tag searches ignore tasks with scheduled and deadline dates (setq org-agenda-tags-todo-honor-ignore-options t) (setq org-icalendar-include-body nil) (setq org-icalendar-include-bbdb-anniversaries t) (setq org-icalendar-include-todo t) (setq org-icalendar-use-scheduled '(todo-start event-if-not-todo event-if-todo-not-done)) (provide 'rul-org-agenda)