org-inlinetask.el (13113B)
1 ;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. 4 ;; 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, text 7 ;; URL: 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 last 44 ;; two will be visible, the others will be hidden using the `org-hide' 45 ;; 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: another thing 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-macs) 82 (org-assert-version) 83 84 (require 'org) 85 86 (defgroup org-inlinetask nil 87 "Options concerning inline tasks in Org mode." 88 :tag "Org Inline Tasks" 89 :group 'org-structure) 90 91 (defcustom org-inlinetask-min-level 15 92 "Minimum level a headline must have before it is treated as an inline task. 93 Don't set it to something higher than `29' or clocking will break since this 94 is the hardcoded maximum number of stars `org-clock-sum' will work with. 95 96 It is strongly recommended that you set `org-cycle-max-level' not at all, 97 or to a number smaller than this one. See `org-cycle-max-level' 98 docstring for more details." 99 :group 'org-inlinetask 100 :type '(choice 101 (const :tag "Off" nil) 102 (integer))) 103 104 (defcustom org-inlinetask-show-first-star nil 105 "Non-nil means display the first star of an inline task as additional marker. 106 When nil, the first star is not shown." 107 :tag "Org Inline Tasks" 108 :group 'org-structure 109 :type 'boolean) 110 111 (defvar org-odd-levels-only) 112 (defvar org-keyword-time-regexp) 113 (defvar org-complex-heading-regexp) 114 (defvar org-property-end-re) 115 116 (defcustom org-inlinetask-default-state nil 117 "Non-nil means make inline tasks have a TODO keyword initially. 118 This should be the state `org-inlinetask-insert-task' should use by 119 default, or nil if no state should be assigned." 120 :group 'org-inlinetask 121 :version "24.1" 122 :type '(choice 123 (const :tag "No state" nil) 124 (string :tag "Specific state"))) 125 126 (defun org-inlinetask-insert-task (&optional no-state) 127 "Insert an inline task. 128 If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'. 129 If there is a region wrap it inside the inline task." 130 (interactive "P") 131 ;; Error when inside an inline task, except if point was at its very 132 ;; beginning, in which case the new inline task will be inserted 133 ;; before this one. 134 (when (and (org-inlinetask-in-task-p) 135 (not (and (org-inlinetask-at-task-p) (bolp)))) 136 (user-error "Cannot nest inline tasks")) 137 (or (bolp) (newline)) 138 (let* ((indent (if org-odd-levels-only 139 (1- (* 2 org-inlinetask-min-level)) 140 org-inlinetask-min-level)) 141 (indent-string (concat (make-string indent ?*) " ")) 142 (rbeg (if (org-region-active-p) (region-beginning) (point))) 143 (rend (if (org-region-active-p) (region-end) (point)))) 144 (goto-char rend) 145 (insert "\n" indent-string "END\n") 146 (goto-char rbeg) 147 (unless (bolp) (insert "\n")) 148 (insert indent-string 149 (if (or no-state (not org-inlinetask-default-state)) 150 "" 151 (concat org-inlinetask-default-state " ")) 152 (if (= rend rbeg) "" "\n")) 153 (unless (= rend rbeg) (end-of-line 0)))) 154 (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) 155 156 (defun org-inlinetask-outline-regexp () 157 "Return string matching an inline task heading. 158 The number of levels is controlled by `org-inlinetask-min-level'." 159 (let ((nstars (if org-odd-levels-only 160 (1- (* org-inlinetask-min-level 2)) 161 org-inlinetask-min-level))) 162 (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars))) 163 164 (defun org-inlinetask-end-p () 165 "Return a non-nil value if point is on inline task's END part." 166 (let ((case-fold-search t)) 167 (org-match-line (concat (org-inlinetask-outline-regexp) "END[ \t]*$")))) 168 169 (defun org-inlinetask-at-task-p () 170 "Return non-nil if point is at beginning of an inline task." 171 (and (org-match-line (concat (org-inlinetask-outline-regexp) "\\(.*\\)")) 172 (not (org-inlinetask-end-p)))) 173 174 (defun org-inlinetask-in-task-p () 175 "Return non-nil if point is inside an inline task." 176 (save-excursion 177 (forward-line 0) 178 (let ((case-fold-search t)) 179 (or (looking-at-p (concat (org-inlinetask-outline-regexp) "\\(?:.*\\)")) 180 (and (re-search-forward "^\\*+[ \t]+" nil t) 181 (org-inlinetask-end-p)))))) 182 183 (defun org-inlinetask-goto-beginning () 184 "Go to the beginning of the inline task at point." 185 (end-of-line) 186 (let ((case-fold-search t) 187 (inlinetask-re (org-inlinetask-outline-regexp))) 188 (re-search-backward inlinetask-re nil t) 189 (when (org-inlinetask-end-p) 190 (re-search-backward inlinetask-re nil t)))) 191 192 (defun org-inlinetask-goto-end () 193 "Go to the end of the inline task at point. 194 Return point." 195 (save-match-data 196 (forward-line 0) 197 (let ((case-fold-search t) 198 (inlinetask-re (org-inlinetask-outline-regexp))) 199 (cond 200 ((org-inlinetask-end-p) 201 (forward-line)) 202 ((looking-at-p inlinetask-re) 203 (forward-line) 204 (cond 205 ((org-inlinetask-end-p) (forward-line)) 206 ((looking-at-p inlinetask-re)) 207 ((org-inlinetask-in-task-p) 208 (re-search-forward inlinetask-re nil t) 209 (forward-line)) 210 (t nil))) 211 (t 212 (re-search-forward inlinetask-re nil t) 213 (forward-line))))) 214 (point)) 215 216 (defun org-inlinetask-get-task-level () 217 "Get the level of the inline task around. 218 This assumes the point is inside an inline task." 219 (save-excursion 220 (end-of-line) 221 (re-search-backward (org-inlinetask-outline-regexp) nil t) 222 (- (match-end 1) (match-beginning 1)))) 223 224 (defun org-inlinetask-promote () 225 "Promote the inline task at point. 226 If the task has an end part, promote it. Also, prevents level from 227 going below `org-inlinetask-min-level'." 228 (interactive) 229 (if (not (org-inlinetask-in-task-p)) 230 (user-error "Not in an inline task") 231 (save-excursion 232 (let* ((lvl (org-inlinetask-get-task-level)) 233 (next-lvl (org-get-valid-level lvl -1)) 234 (diff (- next-lvl lvl)) 235 (down-task (concat (make-string next-lvl ?*))) 236 beg) 237 (if (< next-lvl org-inlinetask-min-level) 238 (user-error "Cannot promote an inline task at minimum level") 239 (org-inlinetask-goto-beginning) 240 (setq beg (point)) 241 (replace-match down-task nil t nil 1) 242 (org-inlinetask-goto-end) 243 (if (and (eobp) (looking-back "END\\s-*" (line-beginning-position))) 244 (forward-line 0) 245 (forward-line -1)) 246 (unless (= (point) beg) 247 (looking-at (org-inlinetask-outline-regexp)) 248 (replace-match down-task nil t nil 1) 249 (when (eq org-adapt-indentation t) 250 (goto-char beg) 251 (org-fixup-indentation diff)))))))) 252 253 (defun org-inlinetask-demote () 254 "Demote the inline task at point. 255 If the task has an end part, also demote it." 256 (interactive) 257 (if (not (org-inlinetask-in-task-p)) 258 (user-error "Not in an inline task") 259 (save-excursion 260 (let* ((lvl (org-inlinetask-get-task-level)) 261 (next-lvl (org-get-valid-level lvl 1)) 262 (diff (- next-lvl lvl)) 263 (down-task (concat (make-string next-lvl ?*))) 264 beg) 265 (org-inlinetask-goto-beginning) 266 (setq beg (point)) 267 (replace-match down-task nil t nil 1) 268 (org-inlinetask-goto-end) 269 (if (and (eobp) (looking-back "END\\s-*" (line-beginning-position))) 270 (forward-line 0) 271 (forward-line -1)) 272 (unless (= (point) beg) 273 (looking-at (org-inlinetask-outline-regexp)) 274 (replace-match down-task nil t nil 1) 275 (when (eq org-adapt-indentation t) 276 (goto-char beg) 277 (org-fixup-indentation diff))))))) 278 279 (defvar org-indent-indentation-per-level) ; defined in org-indent.el 280 281 (defface org-inlinetask '((t :inherit shadow)) 282 "Face for inlinetask headlines." 283 :group 'org-faces) 284 285 (defun org-inlinetask-fontify (limit) 286 "Fontify the inline tasks down to LIMIT." 287 (let* ((nstars (if org-odd-levels-only 288 (1- (* 2 (or org-inlinetask-min-level 200))) 289 (or org-inlinetask-min-level 200))) 290 (re (concat "^\\(\\*\\)\\(\\*\\{" 291 (format "%d" (- nstars 3)) 292 ",\\}\\)\\(\\*\\* .*\\)")) 293 ;; Virtual indentation will add the warning face on the first 294 ;; star. Thus, in that case, only hide it. 295 (start-face (if (and (bound-and-true-p org-indent-mode) 296 (> org-indent-indentation-per-level 1)) 297 'org-hide 298 'org-warning))) 299 (while (re-search-forward re limit t) 300 (if org-inlinetask-show-first-star 301 (add-text-properties (match-beginning 1) (match-end 1) 302 `(face ,start-face font-lock-fontified t))) 303 (add-text-properties (match-beginning 304 (if org-inlinetask-show-first-star 2 1)) 305 (match-end 2) 306 '(face org-hide font-lock-fontified t)) 307 (add-text-properties (match-beginning 3) (match-end 3) 308 '(face org-inlinetask font-lock-fontified t))))) 309 310 (defun org-inlinetask-toggle-visibility (&optional state) 311 "Toggle visibility of inline task at point. 312 When optional argument STATE is `fold', fold unconditionally. 313 When STATE is `unfold', unfold unconditionally." 314 (let ((end (save-excursion 315 (org-inlinetask-goto-end) 316 (if (bolp) (1- (point)) (point)))) 317 (start (save-excursion 318 (org-inlinetask-goto-beginning) 319 (line-end-position)))) 320 (cond 321 ;; Nothing to show/hide. 322 ((= end start)) 323 ;; Inlinetask was folded: expand it. 324 ((and (not (eq state 'fold)) 325 (or (eq state 'unfold) 326 (org-fold-get-folding-spec 'headline (1+ start)))) 327 (org-fold-region start end nil 'headline)) 328 (t (org-fold-region start end t 'headline))))) 329 330 (defun org-inlinetask-hide-tasks (state) 331 "Hide inline tasks in buffer when STATE is `contents' or `children'. 332 This function is meant to be used in `org-cycle-hook'." 333 (pcase state 334 (`contents 335 (let ((regexp (org-inlinetask-outline-regexp))) 336 (save-excursion 337 (goto-char (point-min)) 338 (while (re-search-forward regexp nil t) 339 (org-inlinetask-toggle-visibility 'fold) 340 (org-inlinetask-goto-end))))) 341 (`children 342 (save-excursion 343 (while 344 (or (org-inlinetask-at-task-p) 345 (and (outline-next-heading) (org-inlinetask-at-task-p))) 346 (org-inlinetask-toggle-visibility 'fold) 347 (org-inlinetask-goto-end)))))) 348 349 (defun org-inlinetask-remove-END-maybe () 350 "Remove an END line when present." 351 (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" 352 org-inlinetask-min-level)) 353 (replace-match ""))) 354 355 (add-hook 'org-font-lock-hook 'org-inlinetask-fontify) 356 (add-hook 'org-cycle-hook 'org-inlinetask-hide-tasks) 357 358 (provide 'org-inlinetask) 359 360 ;;; org-inlinetask.el ends here