From 23372f5a51ec48030bab275daa2bd0238cfa6b7b Mon Sep 17 00:00:00 2001 From: Aaron LI Date: Mon, 12 Dec 2016 16:43:06 +0800 Subject: _spacemacs: Rewrite org configurations Credit: http://doc.norang.ca/org-mode.html --- _spacemacs.d/config/aly-org-config.el | 263 +++++++++++++++++++++- _spacemacs.d/config/aly-org-helpers.el | 399 +++++++++++++++++++++++++++++++++ 2 files changed, 655 insertions(+), 7 deletions(-) create mode 100644 _spacemacs.d/config/aly-org-helpers.el diff --git a/_spacemacs.d/config/aly-org-config.el b/_spacemacs.d/config/aly-org-config.el index b215d01..0fb46f5 100644 --- a/_spacemacs.d/config/aly-org-config.el +++ b/_spacemacs.d/config/aly-org-config.el @@ -1,4 +1,4 @@ -;;; aly-org-config.el --- My configurations for org-mode +;;; aly-org-config.el --- Custom Configurations for Org Mode ;; -*- mode: emacs-lisp -*- ;; vim: set ts=8 sw=2 tw=0 fenc=utf-8 ft=lisp: ;; @@ -7,19 +7,262 @@ ;; ;;; Commentary: -;; My custom configurations for the `org' of spacemacs. -;; https://github.com/syl20bnr/spacemacs/blob/master/layers/org/README.org +;; Custom configurations for Emacs Org mode +;; +;; [1] Spacemacs: Org layer +;; https://github.com/syl20bnr/spacemacs/blob/master/layers/org/README.org +;; [2] Norang: Org Mode (by Bernt Hansen) +;; http://doc.norang.ca/org-mode.html ;; ;;; Code: +;; Default task to clock in whenever the clock normally stops +(defvar aly/organization-task-id "bb7f1326-bda4-11e6-a30d-185e0f33a428") + +;; Allow single character alphabetical bullets +;; Need to be set before `org.el' is loaded +(setq org-list-allow-alphabetical t) + ;; NOTE: ;; Spacemacs use the `org' from the ELPA instead of the one shipped with -;; Emacs. Then, any `org'-related code should NOT be loaded before +;; Emacs. Therefore, any `org'-related code should NOT be loaded before ;; `dotspacemacs/user-config'. (with-eval-after-load 'org + (require 'org-habit) + (require 'org-clock) + (require 'ox-latex) + + ;; Load custom helper functions for Org + (require 'aly-org-helpers) + + ;; Default location to look for Org files + (setq org-directory '("~/org")) + ;; Directories of files / files to be used for agenda display (setq org-agenda-files '("~/org")) - ;; active Babel languages + ;; Default file for storing notes, also the fallback file for capture + (setq org-default-notes-file "~/org/refile.org") + + ;; TODO state keywords and face settings + (setq org-todo-keywords + '((sequence "TODO(t)" "NEXT(n)" "|" "DONE(d)") + (sequence "WAITING(w@/!)" "HOLD(h@/!)" "|" + "CANCELLED(c@/!)" "MAIL" "PHONE" "MEETING"))) + ;(setq org-todo-keyword-faces + ; '(("TODO" :foreground "red" :weight bold) + ; ("NEXT" :foreground "blue" :weight bold) + ; ("DONE" :foreground "forest green" :weight bold) + ; ("WAITING" :foreground "orange" :weight bold) + ; ("HOLD" :foreground "magenta" :weight bold) + ; ("CANCELLED" :foreground "forest green" :weight bold) + ; ("MAIL" :foreground "forest green" :weight bold) + ; ("PHONE" :foreground "forest green" :weight bold) + ; ("MEETING" :foreground "forest green" :weight bold))) + ;; Automatically assign tags on state changes + (setq org-todo-state-tags-triggers + '(("CANCELLED" ("CANCELLED" . t)) ;; add "CANCELLED" tag + ("WAITING" ("WAITING" . t)) ;; add "WAITING" tag + ("HOLD" ("WAITING") ("HOLD" . t)) + (done ("WAITING") ("HOLD")) ;; remove "WAITING" and "HOLD" tags + ("TODO" ("WAITING") ("CANCELLED") ("HOLD")) + ("TODO" ("WAITING") ("CANCELLED") ("HOLD")) + ("DONE" ("WAITING") ("CANCELLED") ("HOLD")))) + + ;; Allow to select a state while bypass the associated logging + (setq org-treat-S-cursor-todo-selection-as-state-change nil) + + ;; Capture templates + (setq org-capture-templates + '(("t" "Task" entry (file "") + "* TODO %?\n%U\n%a\n" :clock-in t :clock-resume t) + ("n" "Note" entry (file "") + "* %? :NOTE:\n%U\n%a\n" :clock-in t :clock-resume t) + ("d" "Diary" entry (file+datetree "diary.org") + "* %?\n%U\n" :clock-in t :clock-resume t) + ("p" "Phone Call" entry (file "") + "* PHONE %? :PHONE:\n%U" :clock-in t :clock-resume t) + ("m" "Meeting" entry (file "") + "* MEETING with %? :MEETING:\n%U" :clock-in t :clock-resume t) + ("h" "Habit" entry (file "") + "* NEXT %?\n%U\n%a\nSCHEDULED: %(format-time-string \"%<<%Y-%m-%d %a .+1d/3d>>\")\n:PROPERTIES:\n:STYLE: habit\n:REPEAT_TO_STATE: NEXT\n:END:\n") + )) + + ;; Remove empty `LOGBOOK' drawers on clock out + (add-hook 'org-clock-out-hook 'aly/remove-empty-drawer-on-clock-out 'append) + + ;; More handy shortcuts + (global-set-key (kbd "") 'org-agenda) + + ;; Exclude `DONE' state tasks from refile targets + (setq org-refile-target-verify-function 'aly/verify-refile-target) + + ;; Do not dim blocked tasks + (setq org-agenda-dim-blocked-tasks nil) + ;; Compact the block agenda view + (setq org-agenda-compact-blocks t) + ;; Custom agenda command definitions + (setq org-agenda-custom-commands + '(("N" "Notes" tags "NOTE" + ((org-agenda-overriding-header "Notes") + (org-tags-match-list-sublevels t))) + ("h" "Habits" tags-todo "STYLE=\"habit\"" + ((org-agenda-overriding-header "Habits") + (org-agenda-sorting-strategy + '(todo-state-down effort-up category-keep)))) + (" " "Agenda" + ((agenda "" nil) + (tags "REFILE" + ((org-agenda-overriding-header "Tasks to Refile") + (org-tags-match-list-sublevels nil))) + (tags-todo "-CANCELLED/!" + ((org-agenda-overriding-header "Stuck Projects") + (org-agenda-skip-function 'aly/skip-non-stuck-projects) + (org-agenda-sorting-strategy + '(category-keep)))) + (tags-todo "-HOLD-CANCELLED/!" + ((org-agenda-overriding-header "Projects") + (org-agenda-skip-function 'aly/skip-non-projects) + (org-tags-match-list-sublevels 'indented) + (org-agenda-sorting-strategy + '(category-keep)))) + (tags-todo "-CANCELLED/!NEXT" + ((org-agenda-overriding-header + (concat "Project Next Tasks" + (if aly/hide-scheduled-and-waiting-next-tasks + "" + " (including WAITING and SCHEDULED tasks)"))) + (org-agenda-skip-function 'aly/skip-projects-and-habits-and-single-tasks) + (org-tags-match-list-sublevels t) + (org-agenda-todo-ignore-scheduled aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-todo-ignore-deadlines aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-todo-ignore-with-date aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-sorting-strategy + '(todo-state-down effort-up category-keep)))) + (tags-todo "-REFILE-CANCELLED-WAITING-HOLD/!" + ((org-agenda-overriding-header + (concat "Project Subtasks" + (if aly/hide-scheduled-and-waiting-next-tasks + "" + " (including WAITING and SCHEDULED tasks)"))) + (org-agenda-skip-function 'aly/skip-non-project-tasks) + (org-agenda-todo-ignore-scheduled aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-todo-ignore-deadlines aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-todo-ignore-with-date aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-sorting-strategy + '(category-keep)))) + (tags-todo "-REFILE-CANCELLED-WAITING-HOLD/!" + ((org-agenda-overriding-header + (concat "Standalone Tasks" + (if aly/hide-scheduled-and-waiting-next-tasks + "" + " (including WAITING and SCHEDULED tasks)"))) + (org-agenda-skip-function 'aly/skip-project-tasks) + (org-agenda-todo-ignore-scheduled aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-todo-ignore-deadlines aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-todo-ignore-with-date aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-sorting-strategy + '(category-keep)))) + (tags-todo "-CANCELLED+WAITING|HOLD/!" + ((org-agenda-overriding-header + (concat "Waiting and Postponed Tasks" + (if aly/hide-scheduled-and-waiting-next-tasks + "" + " (including WAITING and SCHEDULED tasks)"))) + (org-agenda-skip-function 'aly/skip-non-tasks) + (org-tags-match-list-sublevels nil) + (org-agenda-todo-ignore-scheduled aly/hide-scheduled-and-waiting-next-tasks) + (org-agenda-todo-ignore-deadlines aly/hide-scheduled-and-waiting-next-tasks))) + (tags "-REFILE/" + ((org-agenda-overriding-header "Tasks to Archive") + (org-agenda-skip-function 'aly/skip-non-archivable-tasks) + (org-tags-match-list-sublevels nil)))) + nil))) + + (defun aly/org-auto-exclude-function (tag) + "Automatic task exclusion in the agenda with `/ RET'" + (and (cond + ((string= tag "hold") t) ; exclude "HOLD" tasks + ) + (concat "-" tag))) + (setq org-agenda-auto-exclude-function 'aly/org-auto-exclude-function) + + ;; Clocking + ;; + ;; Resume clocking task when Emacs is restarted + (org-clock-persistence-insinuate) + ;; Save the running clock and all clock history when exiting Emacs, + ;; and 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 'when-no-clock-is-running) + ;; Show lot of clocking history so it's easy to pick items off the 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 'aly/clock-in-to-next) + ;; Separate drawers for clocking and logs + (setq org-drawers '("PROPERTIES" "LOGBOOK")) + ;; Save clock data and state changes and notes in the `LOGBOOK' drawer + (setq org-clock-into-drawer t) + ;; Remove 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) + (add-hook 'org-clock-out-hook 'aly/clock-out-maybe 'append) + ;; Use discrete minute intervals (no rounding) increments for time editing + (setq org-time-stamp-rounding-minutes '(1 1)) + + ;; Agenda clock report parameters + (setq org-agenda-clockreport-parameter-plist + '(:link t :maxlevel 5 :fileskip0 t :compact t :narrow 80)) + ;; Set default column view headings: Task Effort ClockSummary + (setq org-columns-default-format + "%80ITEM(task) %10Effort(Effort){:} %10CLOCKSUM") + ;; Global `Effort' estimate values, + ;; and global `STYLE' property values for completion + (setq org-global-properties + '(("Effort_ALL" . "0:15 0:30 0:45 1:00 2:00 3:00 4:00 5:00 6:00 0:00") + ("STYLE_ALL" . "habit"))) + ;; Agenda log mode items to display (closed and state changes by default) + (setq org-agenda-log-mode-items '(closed state)) + + ;; Tags with fast selection keys + (setq org-tag-alist + '((:startgroup) + ("@office" . ?o) + ("@home" . ?H) + ("@dorm" . ?d) + (:endgroup) + ("WAITING" . ?w) + ("HOLD" . ?h) + ("PERSONAL" . ?P) + ("WORK" . ?W) + ("ORG" . ?O) + ("ASTRO" . ?a) + ("NOTE" . ?n) + ("CANCELLED" . ?c) + ("FLAGGED" . ??))) + ;; Allow setting single tags without the menu + (setq org-fast-tag-selection-single-key (quote expert)) + ;; For tag searches ignore tasks with scheduled and deadline dates + (setq org-agenda-tags-todo-honor-ignore-options t) + + ;; Any task with a subtask using a todo keyword is a project. + ;; Projects are "stuck" if they have no subtask with a `NEXT' todo keyword. + + ;; Only show today's agenda by default + (setq org-agenda-span 'day) + ;; Disable the default stuck projects agenda view + (setq org-stuck-projects '("" nil nil "")) + + ;; Archive + (setq org-archive-mark-done nil) + (setq org-archive-location "%s_archive::* Archived Tasks") + + ;; Enable in-using Babel languages (org-babel-do-load-languages 'org-babel-load-languages '((emacs-lisp . t) @@ -27,9 +270,15 @@ (python . t) (ditaa . t) )) - ;; set the path to the `ditaa' program + + ;; Set the bullet symbols for `org-bullets' + (setq org-bullets-bullet-list '("♠" "♥" "♣" "♦")) ;; "SHoCkeD" ordering + + ;; Set the path to the `ditaa' program (setq org-ditaa-jar-path "~/.spacemacs.d/local/ditaa/ditaa.jar") - ) ;; with-eval-after-load 'org + + ;; END: Org-mode configurations + ) (provide 'aly-org-config) diff --git a/_spacemacs.d/config/aly-org-helpers.el b/_spacemacs.d/config/aly-org-helpers.el new file mode 100644 index 0000000..3254c79 --- /dev/null +++ b/_spacemacs.d/config/aly-org-helpers.el @@ -0,0 +1,399 @@ +;;; 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 -- cgit v1.2.2