| commit | author | age | ||
| 76bbd0 | 1 | ;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2009-2018 Free Software Foundation, Inc. | |
| 4 | ;; | |
| 5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
| 6 | ;; Keywords: outlines, hypermedia, calendar, wp | |
| 7 | ;; Homepage: https://orgmode.org | |
| 8 | ||
| 9 | ;; This file is part of GNU Emacs. | |
| 10 | ||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
| 12 | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | |
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 15 | ;; (at your option) any later version. | |
| 16 | ||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 | ;; GNU General Public License for more details. | |
| 21 | ||
| 22 | ;; You should have received a copy of the GNU General Public License | |
| 23 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | |
| 24 | ||
| 25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 26 | ;; | |
| 27 | ;;; Commentary: | |
| 28 | ;; | |
| 29 | ;; This module implements inline tasks in Org mode. Inline tasks are | |
| 30 | ;; tasks that have all the properties of normal outline nodes, | |
| 31 | ;; including the ability to store meta data like scheduling dates, | |
| 32 | ;; TODO state, tags and properties. However, these nodes are treated | |
| 33 | ;; specially by the visibility cycling. | |
| 34 | ;; | |
| 35 | ;; Visibility cycling exempts these nodes from cycling. So whenever | |
| 36 | ;; their parent is opened, so are these tasks. This will only work | |
| 37 | ;; with `org-cycle', so if you are also using other commands to | |
| 38 | ;; show/hide entries, you will occasionally find these tasks to behave | |
| 39 | ;; like all other outline nodes, seemingly splitting the text of the | |
| 40 | ;; parent into children. | |
| 41 | ;; | |
| 42 | ;; Special fontification of inline tasks, so that they can be | |
| 43 | ;; immediately recognized. From the stars of the headline, only the | |
| 44 | ;; first and the last two will be visible, the others will be hidden | |
| 45 | ;; using the `org-hide' face. | |
| 46 | ;; | |
| 47 | ;; An inline task is identified solely by a minimum outline level, | |
| 48 | ;; given by the variable `org-inlinetask-min-level', default 15. | |
| 49 | ;; | |
| 50 | ;; If you need to have a time planning line (DEADLINE etc), drawers, | |
| 51 | ;; for example LOGBOOK of PROPERTIES, or even normal text as part of | |
| 52 | ;; the inline task, you must add an "END" headline with the same | |
| 53 | ;; number of stars. | |
| 54 | ;; | |
| 55 | ;; As an example, here are two valid inline tasks: | |
| 56 | ;; | |
| 57 | ;; **************** TODO a small task | |
| 58 | ;; | |
| 59 | ;; and | |
| 60 | ;; | |
| 61 | ;; **************** TODO another small task | |
| 62 | ;; DEADLINE: <2009-03-30 Mon> | |
| 63 | ;; :PROPERTIES: | |
| 64 | ;; :SOMETHING: or other | |
| 65 | ;; :END: | |
| 66 | ;; And here is some extra text | |
| 67 | ;; **************** END | |
| 68 | ;; | |
| 69 | ;; Also, if you want to use refiling and archiving for inline tasks, | |
| 70 | ;; The END line must be present to make things work properly. | |
| 71 | ;; | |
| 72 | ;; Note that you should not try to use inline tasks within plain list, | |
| 73 | ;; visibility cycling is known to be problematic when doing so. | |
| 74 | ;; | |
| 75 | ;; This package installs one new command: | |
| 76 | ;; | |
| 77 | ;; C-c C-x t Insert a new inline task with END line | |
| 78 | ||
| 79 | ;;; Code: | |
| 80 | ||
| 81 | (require 'org) | |
| 82 | ||
| 83 | (defgroup org-inlinetask nil | |
| 84 | "Options concerning inline tasks in Org mode." | |
| 85 | :tag "Org Inline Tasks" | |
| 86 | :group 'org-structure) | |
| 87 | ||
| 88 | (defcustom org-inlinetask-min-level 15 | |
| 89 | "Minimum level a headline must have before it is treated as an inline task. | |
| 90 | Don't set it to something higher than `29' or clocking will break since this | |
| 91 | is the hardcoded maximum number of stars `org-clock-sum' will work with. | |
| 92 | ||
| 93 | It is strongly recommended that you set `org-cycle-max-level' not at all, | |
| 94 | or to a number smaller than this one. In fact, when `org-cycle-max-level' is | |
| 95 | not set, it will be assumed to be one less than the value of smaller than | |
| 96 | the value of this variable." | |
| 97 | :group 'org-inlinetask | |
| 98 | :type '(choice | |
| 99 | (const :tag "Off" nil) | |
| 100 | (integer))) | |
| 101 | ||
| 102 | (defcustom org-inlinetask-show-first-star nil | |
| 103 | "Non-nil means display the first star of an inline task as additional marker. | |
| 104 | When nil, the first star is not shown." | |
| 105 | :tag "Org Inline Tasks" | |
| 106 | :group 'org-structure | |
| 107 | :type 'boolean) | |
| 108 | ||
| 109 | (defvar org-odd-levels-only) | |
| 110 | (defvar org-keyword-time-regexp) | |
| 111 | (defvar org-complex-heading-regexp) | |
| 112 | (defvar org-property-end-re) | |
| 113 | ||
| 114 | (defcustom org-inlinetask-default-state nil | |
| 115 | "Non-nil means make inline tasks have a TODO keyword initially. | |
| 116 | This should be the state `org-inlinetask-insert-task' should use by | |
| 117 | default, or nil if no state should be assigned." | |
| 118 | :group 'org-inlinetask | |
| 119 | :version "24.1" | |
| 120 | :type '(choice | |
| 121 | (const :tag "No state" nil) | |
| 122 | (string :tag "Specific state"))) | |
| 123 | ||
| 124 | (defun org-inlinetask-insert-task (&optional no-state) | |
| 125 | "Insert an inline task. | |
| 126 | If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'." | |
| 127 | (interactive "P") | |
| 128 | ;; Error when inside an inline task, except if point was at its very | |
| 129 | ;; beginning, in which case the new inline task will be inserted | |
| 130 | ;; before this one. | |
| 131 | (when (and (org-inlinetask-in-task-p) | |
| 132 | (not (and (org-inlinetask-at-task-p) (bolp)))) | |
| 133 | (error "Cannot nest inline tasks")) | |
| 134 | (or (bolp) (newline)) | |
| 135 | (let* ((indent (if org-odd-levels-only | |
| 136 | (1- (* 2 org-inlinetask-min-level)) | |
| 137 | org-inlinetask-min-level)) | |
| 138 | (indent-string (concat (make-string indent ?*) " "))) | |
| 139 | (insert indent-string | |
| 140 | (if (or no-state (not org-inlinetask-default-state)) | |
| 141 | "\n" | |
| 142 | (concat org-inlinetask-default-state " \n")) | |
| 143 | indent-string "END\n")) | |
| 144 | (end-of-line -1)) | |
| 145 | (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) | |
| 146 | ||
| 147 | (defun org-inlinetask-outline-regexp () | |
| 148 | "Return string matching an inline task heading. | |
| 149 | The number of levels is controlled by `org-inlinetask-min-level'." | |
| 150 | (let ((nstars (if org-odd-levels-only | |
| 151 | (1- (* org-inlinetask-min-level 2)) | |
| 152 | org-inlinetask-min-level))) | |
| 153 | (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars))) | |
| 154 | ||
| 155 | (defun org-inlinetask-end-p () | |
| 156 | "Return a non-nil value if point is on inline task's END part." | |
| 157 | (let ((case-fold-search t)) | |
| 158 | (org-match-line (concat (org-inlinetask-outline-regexp) "END[ \t]*$")))) | |
| 159 | ||
| 160 | (defun org-inlinetask-at-task-p () | |
| 161 | "Return non-nil if point is at beginning of an inline task." | |
| 162 | (and (org-match-line (concat (org-inlinetask-outline-regexp) "\\(.*\\)")) | |
| 163 | (not (org-inlinetask-end-p)))) | |
| 164 | ||
| 165 | (defun org-inlinetask-in-task-p () | |
| 166 | "Return true if point is inside an inline task." | |
| 167 | (save-excursion | |
| 168 | (beginning-of-line) | |
| 169 | (let ((case-fold-search t)) | |
| 170 | (or (looking-at-p (concat (org-inlinetask-outline-regexp) "\\(?:.*\\)")) | |
| 171 | (and (re-search-forward "^\\*+[ \t]+" nil t) | |
| 172 | (org-inlinetask-end-p)))))) | |
| 173 | ||
| 174 | (defun org-inlinetask-goto-beginning () | |
| 175 | "Go to the beginning of the inline task at point." | |
| 176 | (end-of-line) | |
| 177 | (let ((case-fold-search t) | |
| 178 | (inlinetask-re (org-inlinetask-outline-regexp))) | |
| 179 | (re-search-backward inlinetask-re nil t) | |
| 180 | (when (org-inlinetask-end-p) | |
| 181 | (re-search-backward inlinetask-re nil t)))) | |
| 182 | ||
| 183 | (defun org-inlinetask-goto-end () | |
| 184 | "Go to the end of the inline task at point. | |
| 185 | Return point." | |
| 186 | (save-match-data | |
| 187 | (beginning-of-line) | |
| 188 | (let ((case-fold-search t) | |
| 189 | (inlinetask-re (org-inlinetask-outline-regexp))) | |
| 190 | (cond | |
| 191 | ((org-inlinetask-end-p) | |
| 192 | (forward-line)) | |
| 193 | ((looking-at-p inlinetask-re) | |
| 194 | (forward-line) | |
| 195 | (cond | |
| 196 | ((org-inlinetask-end-p) (forward-line)) | |
| 197 | ((looking-at-p inlinetask-re)) | |
| 198 | ((org-inlinetask-in-task-p) | |
| 199 | (re-search-forward inlinetask-re nil t) | |
| 200 | (forward-line)) | |
| 201 | (t nil))) | |
| 202 | (t | |
| 203 | (re-search-forward inlinetask-re nil t) | |
| 204 | (forward-line))))) | |
| 205 | (point)) | |
| 206 | ||
| 207 | (defun org-inlinetask-get-task-level () | |
| 208 | "Get the level of the inline task around. | |
| 209 | This assumes the point is inside an inline task." | |
| 210 | (save-excursion | |
| 211 | (end-of-line) | |
| 212 | (re-search-backward (org-inlinetask-outline-regexp) nil t) | |
| 213 | (- (match-end 1) (match-beginning 1)))) | |
| 214 | ||
| 215 | (defun org-inlinetask-promote () | |
| 216 | "Promote the inline task at point. | |
| 217 | If the task has an end part, promote it. Also, prevents level from | |
| 218 | going below `org-inlinetask-min-level'." | |
| 219 | (interactive) | |
| 220 | (if (not (org-inlinetask-in-task-p)) | |
| 221 | (error "Not in an inline task") | |
| 222 | (save-excursion | |
| 223 | (let* ((lvl (org-inlinetask-get-task-level)) | |
| 224 | (next-lvl (org-get-valid-level lvl -1)) | |
| 225 | (diff (- next-lvl lvl)) | |
| 226 | (down-task (concat (make-string next-lvl ?*))) | |
| 227 | beg) | |
| 228 | (if (< next-lvl org-inlinetask-min-level) | |
| 229 | (error "Cannot promote an inline task at minimum level") | |
| 230 | (org-inlinetask-goto-beginning) | |
| 231 | (setq beg (point)) | |
| 232 | (replace-match down-task nil t nil 1) | |
| 233 | (org-inlinetask-goto-end) | |
| 234 | (if (eobp) (beginning-of-line) (forward-line -1)) | |
| 235 | (unless (= (point) beg) | |
| 236 | (replace-match down-task nil t nil 1) | |
| 237 | (when org-adapt-indentation | |
| 238 | (goto-char beg) | |
| 239 | (org-fixup-indentation diff)))))))) | |
| 240 | ||
| 241 | (defun org-inlinetask-demote () | |
| 242 | "Demote the inline task at point. | |
| 243 | If the task has an end part, also demote it." | |
| 244 | (interactive) | |
| 245 | (if (not (org-inlinetask-in-task-p)) | |
| 246 | (error "Not in an inline task") | |
| 247 | (save-excursion | |
| 248 | (let* ((lvl (org-inlinetask-get-task-level)) | |
| 249 | (next-lvl (org-get-valid-level lvl 1)) | |
| 250 | (diff (- next-lvl lvl)) | |
| 251 | (down-task (concat (make-string next-lvl ?*))) | |
| 252 | beg) | |
| 253 | (org-inlinetask-goto-beginning) | |
| 254 | (setq beg (point)) | |
| 255 | (replace-match down-task nil t nil 1) | |
| 256 | (org-inlinetask-goto-end) | |
| 257 | (if (eobp) (beginning-of-line) (forward-line -1)) | |
| 258 | (unless (= (point) beg) | |
| 259 | (replace-match down-task nil t nil 1) | |
| 260 | (when org-adapt-indentation | |
| 261 | (goto-char beg) | |
| 262 | (org-fixup-indentation diff))))))) | |
| 263 | ||
| 264 | (defun org-inlinetask-get-current-indentation () | |
| 265 | "Get the indentation of the last non-while line above this one." | |
| 266 | (save-excursion | |
| 267 | (beginning-of-line 1) | |
| 268 | (skip-chars-backward " \t\n") | |
| 269 | (beginning-of-line 1) | |
| 270 | (or (org-at-item-p) | |
| 271 | (looking-at "[ \t]*")) | |
| 272 | (goto-char (match-end 0)) | |
| 273 | (current-column))) | |
| 274 | ||
| 275 | (defvar org-indent-indentation-per-level) ; defined in org-indent.el | |
| 276 | ||
| 277 | (defface org-inlinetask '((t :inherit shadow)) | |
| 278 | "Face for inlinetask headlines." | |
| 279 | :group 'org-faces) | |
| 280 | ||
| 281 | (defun org-inlinetask-fontify (limit) | |
| 282 | "Fontify the inline tasks down to LIMIT." | |
| 283 | (let* ((nstars (if org-odd-levels-only | |
| 284 | (1- (* 2 (or org-inlinetask-min-level 200))) | |
| 285 | (or org-inlinetask-min-level 200))) | |
| 286 | (re (concat "^\\(\\*\\)\\(\\*\\{" | |
| 287 | (format "%d" (- nstars 3)) | |
| 288 | ",\\}\\)\\(\\*\\* .*\\)")) | |
| 289 | ;; Virtual indentation will add the warning face on the first | |
| 290 | ;; star. Thus, in that case, only hide it. | |
| 291 | (start-face (if (and (bound-and-true-p org-indent-mode) | |
| 292 | (> org-indent-indentation-per-level 1)) | |
| 293 | 'org-hide | |
| 294 | 'org-warning))) | |
| 295 | (while (re-search-forward re limit t) | |
| 296 | (if org-inlinetask-show-first-star | |
| 297 | (add-text-properties (match-beginning 1) (match-end 1) | |
| 298 | `(face ,start-face font-lock-fontified t))) | |
| 299 | (add-text-properties (match-beginning | |
| 300 | (if org-inlinetask-show-first-star 2 1)) | |
| 301 | (match-end 2) | |
| 302 | '(face org-hide font-lock-fontified t)) | |
| 303 | (add-text-properties (match-beginning 3) (match-end 3) | |
| 304 | '(face org-inlinetask font-lock-fontified t))))) | |
| 305 | ||
| 306 | (defun org-inlinetask-toggle-visibility () | |
| 307 | "Toggle visibility of inline task at point." | |
| 308 | (let ((end (save-excursion | |
| 309 | (org-inlinetask-goto-end) | |
| 310 | (if (bolp) (1- (point)) (point)))) | |
| 311 | (start (save-excursion | |
| 312 | (org-inlinetask-goto-beginning) | |
| 313 | (point-at-eol)))) | |
| 314 | (cond | |
| 315 | ;; Nothing to show/hide. | |
| 316 | ((= end start)) | |
| 317 | ;; Inlinetask was folded: expand it. | |
| 318 | ((eq (get-char-property (1+ start) 'invisible) 'outline) | |
| 319 | (outline-flag-region start end nil) | |
| 320 | (org-cycle-hide-drawers 'children)) | |
| 321 | (t (outline-flag-region start end t))))) | |
| 322 | ||
| 323 | (defun org-inlinetask-hide-tasks (state) | |
| 324 | "Hide inline tasks in buffer when STATE is `contents' or `children'. | |
| 325 | This function is meant to be used in `org-cycle-hook'." | |
| 326 | (pcase state | |
| 327 | (`contents | |
| 328 | (let ((regexp (org-inlinetask-outline-regexp))) | |
| 329 | (save-excursion | |
| 330 | (goto-char (point-min)) | |
| 331 | (while (re-search-forward regexp nil t) | |
| 332 | (org-inlinetask-toggle-visibility) | |
| 333 | (org-inlinetask-goto-end))))) | |
| 334 | (`children | |
| 335 | (save-excursion | |
| 336 | (while | |
| 337 | (or (org-inlinetask-at-task-p) | |
| 338 | (and (outline-next-heading) (org-inlinetask-at-task-p))) | |
| 339 | (org-inlinetask-toggle-visibility) | |
| 340 | (org-inlinetask-goto-end)))))) | |
| 341 | ||
| 342 | (defun org-inlinetask-remove-END-maybe () | |
| 343 | "Remove an END line when present." | |
| 344 | (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" | |
| 345 | org-inlinetask-min-level)) | |
| 346 | (replace-match ""))) | |
| 347 | ||
| 348 | (add-hook 'org-font-lock-hook 'org-inlinetask-fontify) | |
| 349 | (add-hook 'org-cycle-hook 'org-inlinetask-hide-tasks) | |
| 350 | ||
| 351 | (provide 'org-inlinetask) | |
| 352 | ||
| 353 | ;;; org-inlinetask.el ends here | |
