.emacs.d/emacs/org.el

396 lines
15 KiB
EmacsLisp

(use-feature org
:bind (("C-c a" . org-agenda)
("C-c c" . org-capture)
:map org-mode-map
("C-c ]" . nil)
("C-c [" . nil)
("C-c ," . nil)
("C->" . org-do-demote)
("C-<" . org-do-promote))
:hook (org-mode . visual-line-mode)
:config
(setq org-refile-targets (quote ((nil :maxlevel . 9)
(org-agenda-files :maxlevel . 9))))
(setq org-default-notes-file "~/org/agenda.org")
(setq org-hide-leading-stars t)
(setq org-timestamp-rounding-minutes '(5 5))
(setq org-agenda-compact-blocks t)
(setq org-agenda-dim-blocked-tasks nil)
(setq org-enforce-todo-dependencies t)
(setq org-fast-tag-selection-include-todo t)
(setq org-use-fast-todo-selection t)
(setq org-use-fast-todo-selection t)
(setq org-fast-tag-selection-single-key 'expert)
(setq diary-file "~/org/diary.org")
(setq org-agenda-files (quote ("~/org/agenda.org")))
(add-hook 'org-agenda-finalize-hook '+remove-agenda-regions))
(defun +is-project-p ()
"A task with a 'PROJ' keyword"
(member (nth 2 (org-heading-components)) '("PROJ")))
(defun +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))))
(setq org-clock-in-switch-to-state '+clock-in-to-next)
(defun +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"))
(not (+is-project-p)))
"NEXT")
((and (member (org-get-todo-state) (list "NEXT"))
(+is-project-p))
"TODO"))))
(defun +find-project-task ()
"Any task with a todo keyword that is in a project subtree"
(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)) '("PROJ"))
(setq parent-task (point))))
(goto-char parent-task)
parent-task)))
(defun +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
(+find-project-task)
(if (equal (point) task)
nil t))))
(defun +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 +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
(+find-project-task)
(if (equal (point) task)
nil
t))))
(defvar +hide-deadline-next-tasks t)
(defun +select-with-tag-function (select-fun-p)
(save-restriction
(widen)
(let ((next-headline
(save-excursion (or (outline-next-heading)
(point-max)))))
(if (funcall select-fun-p) nil next-headline))))
(defun +select-projects ()
"Selects tasks which are project headers"
(+select-with-tag-function #'+is-project-p))
(defun +select-project-tasks ()
"Skips tags which belong to projects (and is not a project itself)"
(+select-with-tag-function
#'(lambda () (and
(not (+is-project-p))
(+is-project-subtree-p)))))
(defun +select-standalone-tasks ()
"Skips tags which belong to projects. Is neither a project, nor does it blong to a project"
(+select-with-tag-function
#'(lambda () (and
(not (+is-project-p))
(not (+is-project-subtree-p))))))
(defun +select-projects-and-standalone-tasks ()
"Skips tags which are not projects"
(+select-with-tag-function
#'(lambda () (or
(+is-project-p)
(+is-project-subtree-p)))))
(defun +org-agenda-project-warning ()
"Is a project stuck or waiting. If the project is not stuck,
show nothing. However, if it is stuck and waiting on something,
show this warning instead."
(if (+org-agenda-project-is-stuck)
(if (+org-agenda-project-is-waiting) " !W" " !S") ""))
(defun +org-agenda-project-is-stuck ()
"Is a project stuck"
(if (+is-project-p) ; first, check that it's a project
(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 t)) ; signify that this project is stuck
nil)) ; if it's not a project, return an empty string
(defun +org-agenda-project-is-waiting ()
"Is a project stuck"
(if (+is-project-p) ; first, check that it's a project
(let* ((subtree-end (save-excursion (org-end-of-subtree t))))
(save-excursion
(re-search-forward "^\\*+ WAITING" subtree-end t)))
nil)) ; if it's not a project, return an empty string
;; Some helper functions for agenda views
(defun +org-agenda-prefix-string ()
"Format"
(let ((path (org-format-outline-path (org-get-outline-path))) ; "breadcrumb" path
(stuck (+org-agenda-project-warning))) ; warning for stuck projects
(if (> (length path) 0)
(concat stuck ; add stuck warning
" [" path "]") ; add "breadcrumb"
stuck)))
(defun +org-agenda-add-location-string ()
"Gets the value of the LOCATION property"
(let ((loc (org-entry-get (point) "LOCATION")))
(if (> (length loc) 0)
(concat "{" loc "} ")
"")))
(defvar +org-agenda-block--today-schedule
'(agenda "" ((org-agenda-overriding-header "Today's Schedule:")
(org-agenda-span 'day)
(org-agenda-ndays 1)
(org-agenda-start-on-weekday nil)
(org-agenda-start-day "+0d")))
"A block showing a 1 day schedule.")
(defvar +org-agenda-block--weekly-log
'(agenda "" ((org-agenda-overriding-header "Weekly Log")))
"A block showing my schedule and logged tasks for this week.")
(defvar +org-agenda-block--previous-calendar-data
'(agenda "" ((org-agenda-overriding-header "Previous Calendar Data (last 3 weeks)")
(org-agenda-start-day "-21d")
(org-agenda-span 21)
(org-agenda-start-on-weekday nil)))
"A block showing my schedule and logged tasks for the last few weeks.")
(defvar +org-agenda-block--upcoming-calendar-data
'(agenda "" ((org-agenda-overriding-header "Upcoming Calendar Data (next 2 weeks)")
(org-agenda-start-day "0d")
(org-agenda-span 14)
(org-agenda-start-on-weekday nil)))
"A block showing my schedule for the next couple weeks.")
(defvar +org-agenda-block--next-tasks
'(tags-todo "-INACTIVE-SOMEDAY-CANCELLED-ARCHIVE/!NEXT"
((org-agenda-overriding-header "Next Tasks:")
))
"Next tasks.")
(defvar +org-agenda-block--todo-tasks
'(tags-todo "-INACTIVE-SOMEDAY-CANCELLED-ARCHIVE/!TODO"
((org-agenda-overriding-header "Todo Tasks:")
))
"Next tasks.")
(defvar +org-agenda-block--waiting-tasks
'(tags-todo "-INACTIVE-SOMEDAY-CANCELLED-ARCHIVE/!WAITING"
((org-agenda-overriding-header "Waiting Tasks:")
))
"Tasks marked as waiting.")
(defvar +org-agenda-block--active-projects
'(tags-todo "-INACTIVE-SOMEDAY-CANCELLED-REFILEr/!"
((org-agenda-overriding-header "Active Projects:")
(org-agenda-skip-function '+select-projects)))
"All active projects: no inactive/someday/cancelled/refile.")
(defvar +org-agenda-block--standalone-tasks
'(tags-todo "-INACTIVE-SOMEDAY-CANCELLED-REFILE-ARCHIVE-STYLE=\"habit\"/!-NEXT"
((org-agenda-overriding-header "Standalone Tasks:")
(org-agenda-skip-function '+select-standalone-tasks)))
"Tasks (TODO) that do not belong to any projects.")
(defvar +org-agenda-block--remaining-project-tasks
'(tags-todo "-INACTIVE-SOMEDAY-CANCELLED-WAITING-REFILE-ARCHIVE/!-NEXT"
((org-agenda-overriding-header "Remaining Project Tasks:")
(org-agenda-skip-function '+select-project-tasks)))
"Non-NEXT TODO items belonging to a project.")
(defvar +org-agenda-block--inactive-tags
'(tags-todo "-SOMEDAY-ARCHIVE-CANCELLED/!INACTIVE"
((org-agenda-overriding-header "Inactive Projects and Tasks")
(org-tags-match-list-sublevels nil)))
"Inactive projects and tasks.")
(defvar +org-agenda-block--someday-tags
'(tags-todo "-INACTIVE-ARCHIVE-CANCELLED/!SOMEDAY"
((org-agenda-overriding-header "Someday Projects and Tasks")
(org-tags-match-list-sublevels nil)))
"Someday projects and tasks.")
(defvar +org-agenda-block--end-of-agenda
'(tags "ENDOFAGENDA"
((org-agenda-overriding-header "End of Agenda")
(org-tags-match-list-sublevels nil)))
"End of the agenda.")
(defvar +org-agenda-display-settings
'((org-agenda-start-with-log-mode t)
(org-agenda-log-mode-items '(clock))
(org-agenda-prefix-format '((agenda . " %-12:c%?-12t %(+org-agenda-add-location-string)% s")
(timeline . " % s")
(todo . " %-12:c %(+org-agenda-prefix-string) ")
(tags . " %-12:c %(+org-agenda-prefix-string) ")
(search . " %i %-12:c")))
(org-agenda-todo-ignore-deadlines 'near)
(org-agenda-todo-ignore-scheduled t))
"Display settings for my agenda views.")
(defvar +org-agenda-entry-display-settings
'(,+org-agenda-display-settings
(org-agenda-entry-text-mode t))
"Display settings for my agenda views with entry text.")
(setq org-todo-keywords
'((sequence "TODO(t)" "NEXT(n)" "PROJ(p)" "|" "DONE(d)")
(sequence "TASK(T)")
(sequence "WAITING(w@/!)" "INACTIVE(i)" "SOMEDAY(s)" "|" "CANCELLED(c@/!)")))
(setq org-todo-state-tags-triggers
'(("CANCELLED" ("CANCELLED" . t))
("WAITING" ("SOMEDAY") ("INACTIVE") ("WAITING" . t))
("INACTIVE" ("WAITING") ("SOMEDAY") ("INACTIVE" . t))
("SOMEDAY" ("WAITING") ("INACTIVE") ("SOMEDAY" . t))
(done ("WAITING") ("INACTIVE") ("SOMEDAY"))
("TODO" ("WAITING") ("CANCELLED") ("INACTIVE") ("SOMEDAY"))
("TASK" ("WAITING") ("CANCELLED") ("INACTIVE") ("SOMEDAY"))
("NEXT" ("WAITING") ("CANCELLED") ("INACTIVE") ("SOMEDAY"))
("PROJ" ("WAITING") ("CANCELLED") ("INACTIVE") ("SOMEDAY"))
("DONE" ("WAITING") ("CANCELLED") ("INACTIVE") ("SOMEDAY"))))
(defvar org-capture-templates
'(("t" "todo" entry (file org-default-notes-file)
"* TODO %?\n%u\n%a\n")
("b" "Blank" entry (file org-default-notes-file)
"* %?\n%u")
("m" "Meeting" entry (file org-default-notes-file)
"* Meeting with %? :MEETING:\n")
("d" "Diary" entry (file+datetree 'diary-file)
"* %?\n%U\n")
("i" "Idea" entry (file org-default-notes-file)
"* %? :IDEA: \n%u")
("n" "Next Task" entry (file+headline org-default-notes-file "Tasks")
"** NEXT %? \nDEADLINE: %t")))
(setq org-agenda-time-grid
(quote
((daily today remove-match)
(800 1200 1600 2000)
"......" "----------------")))
(setq org-agenda-custom-commands
`((" " "Export Schedule"
(,+org-agenda-block--today-schedule
,+org-agenda-block--next-tasks
,+org-agenda-block--active-projects
,+org-agenda-block--end-of-agenda)
,+org-agenda-display-settings)
("l" "Weekly Log"
(,+org-agenda-block--weekly-log)
,+org-agenda-display-settings)
("r " "Agenda Review (all)"
(,+org-agenda-block--next-tasks
,+org-agenda-block--active-projects
,+org-agenda-block--standalone-tasks
,+org-agenda-block--waiting-tasks
,+org-agenda-block--remaining-project-tasks
,+org-agenda-block--inactive-tags
,+org-agenda-block--someday-tags
,+org-agenda-block--end-of-agenda)
,+org-agenda-display-settings)
("rn" "Agenda Review (next tasks)"
(,+org-agenda-block--next-tasks
,+org-agenda-block--end-of-agenda)
,+org-agenda-display-settings)
("rp" "Agenda Review (previous calendar data)"
(,+org-agenda-block--previous-calendar-data
,+org-agenda-block--end-of-agenda)
,+org-agenda-display-settings)
("ru" "Agenda Review (upcoming calendar data)"
(,+org-agenda-block--upcoming-calendar-data
,+org-agenda-block--end-of-agenda)
,+org-agenda-display-settings)
("rw" "Agenda Review (waiting tasks)"
(,+org-agenda-block--waiting-tasks
,+org-agenda-block--end-of-agenda)
,+org-agenda-display-settings)
("rP" "Agenda Review (projects list)"
(,+org-agenda-block--active-projects
,+org-agenda-block--end-of-agenda)
,+org-agenda-display-settings)
("ri" "Agenda Review (someday and inactive projects/tasks)"
(,+org-agenda-block--someday-tags
,+org-agenda-block--inactive-tags
,+org-agenda-block--end-of-agenda)
,+org-agenda-display-settings)))
;; Search for a "=" and go to the next line
(defun +org-agenda-next-section ()
"Go to the next section in an org agenda buffer."
(interactive)
(if (search-forward "===" nil t 1)
(forward-line 1)
(goto-char (point-max)))
(beginning-of-line))
;; Search for a "=" and go to the previous line
(defun +org-agenda-prev-section ()
"Go to the next section in an org agenda buffer."
(interactive)
(forward-line -2)
(if (search-forward "===" nil t -1)
(forward-line 1)
(goto-char (point-min))))
(defun +remove-agenda-regions ()
(save-excursion
(goto-char (point-min))
(let ((region-large t))
(while (and (< (point) (point-max)) region-large)
(set-mark (point))
(+org-agenda-next-section)
(if (< (- (region-end) (region-beginning)) 5) (setq region-large nil)
(if (< (count-lines (region-beginning) (region-end)) 4)
(delete-region (region-beginning) (region-end)))
)))))
(add-hook 'org-agenda-finalize-hook '+remove-agenda-regions)