├── README.md └── org-time-budgets.el /README.md: -------------------------------------------------------------------------------- 1 | # Org Time Budgets 2 | 3 | This package provides functions to define time budgets per week and 4 | display clocked time in a fancy table. 5 | 6 | ```elisp 7 | (setq org-time-budgets '((:title "Business" :match "+business" :budget "30:00" :blocks (workday week)) 8 | (:title "Sideprojects" :match "+personal+project" :budget "14:00" :blocks (day week)) 9 | (:title "Practice Music" :match "+music+practice" :budget "2:55" :blocks (nil week)) 10 | (:title "Exercise" :match "+exercise" :budget "5:15" :blocks (day)) 11 | (:title "Language" :match "+lang" :budget "5:15" :blocks (day week)))) 12 | ``` 13 | 14 | Running the function `org-time-budgets-table` will return something like: 15 | 16 | ``` 17 | Business [|||||.........] 02:47 / 06:00 [||............] 05:46 / 30:00 18 | Sideprojects [||||..........] 00:36 / 02:00 [|.............] 01:10 / 14:00 19 | Practice Music [|||||.........] 01:04 / 02:55 20 | Exercise [..............] 00:00 / 00:45 21 | Language [|||||||||||...] 00:36 / 00:45 [|||...........] 01:10 / 05:15 22 | ``` 23 | 24 | ## Defining budget `:blocks` 25 | 26 | With the `:blocks` parameter you can define the time blocks to show in 27 | the agenda. It takes a list with any number of entries. Valid entries 28 | are: 29 | * `week` to show the total clocked time this week. 30 | * `day` to show todays budget based on a 7 day week. 31 | * `workday` to show todays budget based on a 5 day week. 32 | * `nil` to display nothing for this block in the budgets table. Use 33 | this to align your different budgets. 34 | 35 | The default value is `(day week)`. 36 | 37 | ## Adding `org-time-budgets` to your Agenda 38 | 39 | You can add your `org-time-budgets` to the top of your `org-agenda` by 40 | doing something like: 41 | 42 | ```elisp 43 | (setq org-agenda-custom-commands 44 | '(("a" "Agenda" 45 | ((agenda "" ((org-agenda-sorting-strategy '(habit-down time-up priority-down category-keep user-defined-up)))) 46 | (org-time-budgets-in-agenda-maybe))))) 47 | ``` 48 | 49 | The budgets table can be toggled using V in the agenda. 50 | 51 | ## Contribute 52 | 53 | I don't want this thing to die. And I would like to learn cool stuff! :-) 54 | 55 | * **Improve performance** 56 | I would love to learn how to make this package faster! 57 | Currently I am using default org-mode functions for gathering 58 | clocked times. Maybe there is a better and more performant way. 59 | * **Add block types** 60 | Currently time budgets can be per `'day`, `'workday` and `'week`, maybe 61 | something else is cool too. 62 | 63 | ## License 64 | 65 | GNUv3! 66 | -------------------------------------------------------------------------------- /org-time-budgets.el: -------------------------------------------------------------------------------- 1 | ;;; org-time-budgets.el --- Define time budgets and display clocked time. 2 | 3 | ;; Author: Arthur Leonard Andersen 4 | ;; Created: November 08, 2015 5 | ;; Version: 1.0.1 6 | ;; Package-Requires: ((alert "0.5.10") (cl-lib "0.5")) 7 | 8 | ;; This file is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation; either version 3, or (at your option) 11 | ;; any later version. 12 | 13 | ;; This file is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with GNU Emacs; see the file COPYING. If not, write to 20 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21 | ;; Boston, MA 02111-1307, USA. 22 | 23 | ;;; Commentary: 24 | 25 | ;; `org-time-budgets' lets you define time budgets and display your 26 | ;; clocked time in a neat table with progressbars. 27 | 28 | ;;; Code: 29 | (eval-when-compile 30 | (require 'cl-lib)) 31 | 32 | (require 'org) 33 | (require 'org-clock) 34 | (require 'org-table) 35 | (require 'org-agenda) 36 | 37 | (defgroup org-time-budgets nil 38 | "Org time budgets customization." 39 | :tag "Org Time Budgets" 40 | :group 'org-progress) 41 | 42 | (defcustom org-time-budgets nil 43 | "The list of time budgets. 44 | 45 | See this example: 46 | 47 | '((:title \"Business\" :match \"+business\" :budget \"30:00\" :blocks (workday week)) 48 | (:title \"Practice Music\" :match \"+practice+music\" :budget \"4:00\" :blocks (nil week)) 49 | (:title \"Exercise\" :match \"+exercise\" :budget \"5:00\" :blocks (day)))" 50 | :group 'org-time-budgets 51 | :type 'list) 52 | 53 | (defvar org-time-budgets-show-budgets t 54 | "If non-nil, show time-budgets in agenda buffers.") 55 | 56 | (defface org-time-budgets-done-face 57 | '((((background light)) (:foreground "#4df946")) 58 | (((background dark)) (:foreground "#228b22"))) 59 | "Face for budgets which are fulfilled." 60 | :group 'org-time-budgets 61 | :group 'org-faces) 62 | 63 | (defface org-time-budgets-close-face 64 | '((((background light)) (:foreground "#ffc500")) 65 | (((background dark)) (:foreground "#b8860b"))) 66 | "Face for budgets which are close to being fulfilled." 67 | :group 'org-time-budgets 68 | :group 'org-faces) 69 | 70 | (defface org-time-budgets-todo-face 71 | '((((background light)) (:foreground "#fc7560")) 72 | (((background dark)) (:foreground "#8b0000"))) 73 | "Face for budgets which are not yet fulfilled." 74 | :group 'org-time-budgets 75 | :group 'org-faces) 76 | 77 | (defun org-time-budgets-minutes-to-string (minutes) 78 | "Return the given MINUTES as string HH:MM." 79 | (let ((secs0 (abs (* minutes 60)))) 80 | (org-format-seconds "%.2h:%.2m" secs0))) 81 | 82 | (defun org-time-budgets-string-to-minutes (string) 83 | "Return the given STRING of format HH:MM as minutes." 84 | (/ (string-to-number 85 | (org-table-time-string-to-seconds string)) 86 | 60)) 87 | 88 | (defun org-time-budgets-bar (width progress goal) 89 | "Create a simple progress bar with WIDTH, displaying the PROGRESS relative to the set GOAL." 90 | (let* ((progress-percent (/ (float progress) (float goal))) 91 | (progress-width (floor (* progress-percent width))) 92 | (progress (make-string (min (max 0 progress-width) width) ?|)) 93 | (spacer (make-string (max 0 (- width progress-width)) ?.)) 94 | (face (cond 95 | ((>= progress-percent 1.0) 'org-time-budgets-done-face) 96 | ((> progress-percent 0.7) 'org-time-budgets-close-face) 97 | (t 'org-time-budgets-todo-face)))) 98 | (concat 99 | (propertize progress 'face face) 100 | spacer))) 101 | 102 | (defun org-time-budgets-time (filters) 103 | "Return the clocked time matching FILTERS in agenda files." 104 | (apply '+ 105 | (mapcar (lambda (file) 106 | (nth 1 (save-window-excursion 107 | (find-file file) 108 | (org-clock-get-table-data file filters)))) 109 | (org-agenda-files)))) 110 | 111 | (defun org-time-budgets-format-block (block) 112 | (let ((current (case block 113 | (day (org-time-budgets-time `(:match ,match :block today))) 114 | (workday (org-time-budgets-time `(:match ,match :block today))) 115 | (week (org-time-budgets-time `(:match ,match :tstart ,tstart-s :tend ,tend-s))))) 116 | (budget (case block 117 | (day (/ range-budget 7)) 118 | (workday (/ range-budget 5)) 119 | (week range-budget)))) 120 | (if (and current budget) 121 | (format "[%s] %s / %s" 122 | (org-time-budgets-bar 14 current budget) 123 | (org-time-budgets-minutes-to-string current) 124 | (org-time-budgets-minutes-to-string budget)) 125 | " "))) 126 | 127 | (defun org-time-budgets-table () 128 | "List the time budgets in a table." 129 | (let ((title-column-width (apply #'max 130 | (mapcar #'(lambda (budget) (string-width (plist-get budget :title))) 131 | org-time-budgets)))) 132 | (mapconcat #'(lambda (budget) 133 | (let* ((title (plist-get budget :title)) 134 | (match (or (plist-get budget :match) 135 | (plist-get budget :tags))) ;; support for old :tags syntax 136 | (blocks (or (plist-get budget :blocks) 137 | (case (plist-get budget :block) ;; support for old :block syntax 138 | (week '(day week)) 139 | (workweek '(workday week))) 140 | '(day week))) 141 | (trange (org-clock-special-range 'thisweek)) 142 | (tstart (nth 0 trange)) 143 | (tstart-s (format-time-string "[%Y-%m-%d]" tstart)) 144 | (tend (nth 1 trange)) 145 | (tend-s (format-time-string "[%Y-%m-%d]" tend)) 146 | (days-til-week-ends (ceiling 147 | (time-to-number-of-days 148 | (time-subtract tend (current-time))))) 149 | (range-budget (org-time-budgets-string-to-minutes (plist-get budget :budget)))) 150 | (format "%s %s" 151 | (concat 152 | title 153 | (make-string (max 0 (- title-column-width (string-width title))) ?\s)) 154 | (mapconcat 155 | #'org-time-budgets-format-block 156 | blocks 157 | " ")))) 158 | org-time-budgets 159 | "\n"))) 160 | 161 | (defun org-time-budgets-in-agenda (arg) 162 | "Insert the `org-time-budget-table' at the top of the current 163 | agenda." 164 | (save-excursion 165 | (let ((agenda-start-day (nth 1 (get-text-property (point) 'org-last-args))) 166 | (inhibit-read-only t)) 167 | ;; find top of agenda 168 | (while (not (and (get-text-property (point) 'org-date-line) 169 | (equal (get-text-property (point) 'day) agenda-start-day))) 170 | (forward-line -1)) 171 | (insert (org-time-budgets-table) "\n\n")))) 172 | 173 | (defun org-time-budgets-in-agenda-maybe (arg) 174 | "Return budgets table if org-time-budgets-show-budgets is set." 175 | (when org-time-budgets-show-budgets 176 | (org-time-budgets-in-agenda arg))) 177 | 178 | (defun org-time-budgets-toggle-time-budgets () 179 | "Toggle display of time-budgets in an agenda buffer." 180 | (interactive) 181 | (org-agenda-check-type t 'agenda) 182 | (setq org-time-budgets-show-budgets (not org-time-budgets-show-budgets)) 183 | (org-agenda-redo) 184 | (org-agenda-set-mode-name) 185 | (message "Time-Budgets turned %s" 186 | (if org-time-budgets-show-budgets "on" "off"))) 187 | 188 | ;; free agenda-mode-map keys are rare 189 | (org-defkey org-agenda-mode-map "V" 'org-time-budgets-toggle-time-budgets) 190 | 191 | (provide 'org-time-budgets) 192 | 193 | ;;; org-time-budgets.el ends here 194 | --------------------------------------------------------------------------------